File Coverage

blib/lib/POE/Component/Server/FTP/ControlSession.pm
Criterion Covered Total %
statement 12 350 3.4
branch 0 124 0.0
condition 0 21 0.0
subroutine 4 46 8.7
pod 0 35 0.0
total 16 576 2.7


line stmt bran cond sub pod time code
1             package POE::Component::Server::FTP::ControlSession;
2              
3             ###########################################################################
4             ### POE::Component::Server::FTP::ControlSession
5             ### L.M.Orchard (deus_x@pobox.com)
6             ### David Davis (xantus@cpan.org)
7             ###
8             ### TODO:
9             ### -- Better PASV port picking
10             ### -- Support both ASCII and BINARY transfer types
11             ### -- More logging!!
12             ### -- MOTD after login
13             ### -- MOTD before login (seperate)
14             ###
15             ### Copyright (c) 2001 Leslie Michael Orchard. All Rights Reserved.
16             ### This module is free software; you can redistribute it and/or
17             ### modify it under the same terms as Perl itself.
18             ###
19             ### Changes Copyright (c) 2003-2004 David Davis and Teknikill Software
20             ###########################################################################
21              
22 1     1   7 use strict;
  1         2  
  1         43  
23              
24 1     1   6 use POE qw(Session Wheel::ReadWrite Driver::SysRW Wheel::SocketFactory);
  1         2  
  1         7  
25 1     1   1293 use POE::Component::Server::FTP::DataSession;
  1         4  
  1         119  
26 1     1   904 use POE::Component::Server::FTP::ControlFilter;
  1         2  
  1         6527  
27              
28             sub new {
29 0     0 0   my $type = shift;
30 0           my $opt = shift;
31              
32 0           my $self = bless { }, $type;
33              
34 0           POE::Session->create(
35             #options => { default=>1, trace=>1 },
36             args => [ $opt ],
37             object_states => [
38             $self => {
39             _start => '_start',
40             _stop => '_stop',
41             _default => '_default',
42             _child => '_child',
43             _reset_timeout => '_reset_timeout',
44             _write_log => '_write_log',
45             _write_log_error => '_write_log_error',
46             send => 'send',
47             time_out => 'time_out',
48             receive => 'receive',
49             flushed => 'flushed',
50             error => 'error',
51             signals => 'signals',
52              
53             QUIT => 'QUIT',
54             USER => 'USER',
55             PASS => 'PASS',
56             TYPE => 'TYPE',
57             SYST => 'SYST',
58             MDTM => 'MDTM',
59             CHMOD => 'CHMOD',
60             DELE => 'DELE',
61             MKD => 'MKD',
62             RMD => 'RMD',
63             CDUP => 'CDUP',
64             CWD => 'CWD',
65             PWD => 'PWD',
66             NLST => 'NLST',
67             LIST => 'LIST',
68             PORT => 'PORT',
69             RETR => 'RETR',
70             STOR => 'STOR',
71             PASV => 'PASV',
72             NOOP => 'NOOP',
73             REST => 'REST',
74             ABOR => 'ABOR',
75             APPE => 'APPE',
76             SIZE => 'SIZE',
77            
78             SITE => 'SITE',
79              
80             # unimplemented
81             # RNFR => 'RNFR',
82              
83             # rfc 0775 may not be fully supported...
84             XMKD => 'XMKD',
85             XRMD => 'XRMD',
86             XPWD => 'PWD',
87             XCUP => 'CDUP',
88             XCWD => 'CWD',
89              
90             # rfc 737
91             XSEN => 'XSEN',
92             }
93             ],
94             );
95              
96 0           return $self;
97             }
98              
99             sub _start {
100 0     0     my ($kernel, $heap, $session, $opt) = @_[KERNEL, HEAP, SESSION, ARG0];
101              
102 0           eval("use $opt->{FilesystemClass}");
103 0 0         if ($@) {
104 0           die "$@";
105             }
106              
107 0           my $fs = ("$opt->{FilesystemClass}")->new($opt->{FilesystemArgs});
108              
109             # watch for SIGINT
110 0           $kernel->sig('INT', 'signals');
111              
112             # start reading and writing
113 0           $heap->{control} = POE::Wheel::ReadWrite->new(
114             # on this handle
115             Handle => $opt->{Handle},
116             # using sysread and syswrite
117             Driver => POE::Driver::SysRW->new(),
118             Filter => POE::Component::Server::FTP::ControlFilter->new(),
119             # generating this event for requests
120             InputEvent => 'receive',
121             # generating this event for errors
122             ErrorEvent => 'error',
123             # generating this event for all-sent
124             FlushedEvent => 'flushed',
125             );
126              
127 0           $heap->{pasv} = 0;
128 0           $heap->{auth} = 0;
129 0           $heap->{rest} = 0;
130 0           $heap->{host} = $opt->{PeerAddr};
131 0           $heap->{port} = $opt->{PeerPort};
132 0           $heap->{filesystem} = $fs;
133 0           %{$heap->{params}} = %{ $opt };
  0            
  0            
134            
135 0 0         if ($heap->{params}{'TimeOut'} > 0) {
136 0           $heap->{time_out} = $kernel->delay_set(time_out => $heap->{params}{'TimeOut'});
137 0           $kernel->call($session->ID => _write_log => 4 => "Timeout set: id ".$heap->{time_out});
138             }
139            
140 0           $kernel->call($heap->{params}{'Alias'} => notify =>
141             'ftpd_connected' => {
142             session => $session,
143             report_ip => $opt->{ReportIP},
144             local_ip => $opt->{LocalIP},
145             local_port => $opt->{LocalPort},
146             peer_addr => $opt->{PeerAddr},
147             peer_port => $opt->{PeerPort},
148             }
149             );
150            
151 0           $kernel->call($session->ID => _write_log => 4 => "Control session started for $heap->{host} : $heap->{port}");
152              
153 0           $kernel->yield(send => "220 $opt->{Domain} FTP server ($opt->{Version} ".localtime()." ready.)");
154             }
155              
156             sub _stop {
157 0     0     my ($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION];
158 0           $kernel->call($heap->{params}{'Alias'} => notify => 'ftpd_disconnected' => { session => $session });
159 0           $kernel->call($session->ID => _write_log => 4 => "Client session ended with $heap->{host} : $heap->{port}");
160             }
161              
162             sub _child {
163 0     0     my ($kernel, $heap, $session, $action, $child) = @_[KERNEL, HEAP, SESSION, ARG0, ARG1];
164              
165 0 0         if ($action eq 'create') {
    0          
166 0           $kernel->call($heap->{params}{'Alias'} => notify => 'ftpd_dcon_create' => { dcon_session => $child });
167 0           $kernel->call($session->ID => _write_log => 4 => "child session created ".$child->ID);
168 0           $heap->{pending_session} = $child;
169             } elsif ($action eq 'lose') {
170 0           $kernel->call($heap->{params}{'Alias'} => notify => 'ftpd_dcon_destroy' => { dcon_session => $child });
171 0           $kernel->call($session->ID => _write_log => 3 => sprintf("Transfer complete %d kB/s of %d bytes",($child->get_heap->{bps}/1023),$child->get_heap->{total_bytes}));
172 0           $kernel->call($session->ID => _write_log => 4 => "child lost (session ".$child->ID.")");
173 0           $kernel->call($session->ID => "_reset_timeout");
174 0 0         if ($heap->{params}{'LimitSceme'} eq 'ip') {
175 0           my $cheap = $child->get_heap;
176 0           $kernel->call($heap->{params}{'Alias'} => _dcon_cleanup => $cheap->{type}, $cheap->{remote_ip} => $child->ID);
177             }
178 0 0         if (defined $heap->{abor}) {
179 0           delete $heap->{abor};
180             } else {
181 0           $kernel->yield(send => "226 Transfer complete.");
182             }
183 0           delete $heap->{pending_session};
184             }
185            
186 0           return 0;
187             }
188              
189             sub send {
190 0     0 0   my ($kernel, $session, $heap, $txt) = @_[KERNEL, SESSION, HEAP, ARG0];
191            
192 0 0         if ($heap->{control}) {
193 0           $heap->{control}->put($txt);
194             }
195             }
196              
197             sub _write_log_error {
198 0     0     my ($kernel, $session, $heap, $syscall_ret, $errno, $errtxt) = @_[KERNEL, SESSION, HEAP, ARG0, ARG1, ARG2];
199            
200 0           $kernel->call($session->ID => _write_log => 3 => "Error from forked process $syscall_ret ($errno) $errtxt");
201             }
202              
203             sub time_out {
204 0     0 0   my ($kernel, $session, $heap) = @_[KERNEL, SESSION, HEAP];
205              
206             # if we have a child session, then there must be a transfer
207             # going on, reset the timer
208 0 0 0       if (defined $heap->{pending_session} &&
209             $heap->{params}{'TimeOut'} > 0) {
210 0           $kernel->call($heap->{params}{'Alias'} => notify => { event => 'ftpd_time_out', time_inactive => $heap->{params}{'TimeOut'}, });
211 0           $heap->{time_out} = $kernel->delay_set(time_out => $heap->{params}{'TimeOut'});
212 0           $kernel->call($session->ID => _write_log => 4 => "Timeout re-set: id ".$heap->{time_out});
213 0           return;
214             }
215            
216 0 0         unless ($heap->{control}) {
217 0           $kernel->alarm_remove_all();
218 0           delete $heap->{control};
219             }
220            
221 0 0         if ($heap->{auth} == 0) {
222 0           $kernel->call($session->ID => _write_log => 2 => "Session ".$session->ID." timed out before login (".$heap->{params}{'TimeOut'}.")");
223 0           $kernel->yield(send => "421 Disconnecting you because you did't login before ".$heap->{params}{'TimeOut'}." seconds, Goodbye.");
224             } else {
225 0           $kernel->call($session->ID => _write_log => 2 => "Session ".$session->ID." timed out (".$heap->{params}{'TimeOut'}.")");
226 0           $kernel->yield(send => "421 Disconnecting you because you were inactive for ".$heap->{params}{'TimeOut'}." seconds, Goodbye.");
227             }
228            
229 0           $kernel->alarm_remove_all();
230 0           $heap->{shutdown_on_flush} = 1;
231             }
232              
233             sub receive {
234 0     0 0   my ($kernel, $session, $heap, $cmd) = @_[KERNEL, SESSION, HEAP, ARG0];
235              
236 0           $kernel->call($session->ID => _write_log => 4 => "Received input from $heap->{host} : $heap->{port} -> $cmd->{cmd} (".join(',',@{$cmd->{args}}).")");
  0            
237              
238 0 0         if ($heap->{auth} == 1) {
239 0           $kernel->call($session->ID => '_reset_timeout');
240             }
241 0           $kernel->post($session, $cmd->{cmd}, \@{$cmd->{args}});
  0            
242             }
243              
244             sub error {
245 0     0 0   my ($kernel, $heap, $session, $operation, $errnum, $errstr) = @_[KERNEL, HEAP, SESSION, ARG0, ARG1, ARG2];
246              
247 0 0         if ($errnum) {
248 0           $kernel->call($session->ID => _write_log => 4 => "Session with $heap->{host} : $heap->{port} encountered $operation error $errnum: $errstr");
249             } else {
250 0           $kernel->call($session->ID => _write_log => 4 => "Client at $heap->{host} : $heap->{port} disconnected");
251             }
252            
253 0           $kernel->call($heap->{params}{'Alias'} => notify => 'ftpd_disconnected' => { session => $session });
254              
255             # either way, stop this session
256 0           $kernel->alarm_remove_all();
257 0           delete $heap->{control};
258             }
259              
260             sub flushed {
261 0     0 0   my ($kernel, $heap) = @_[KERNEL, HEAP];
262              
263 0 0         if ($heap->{shutdown_on_flush}) {
264 0           delete $heap->{control};
265             }
266              
267             # if (defined $heap->{pending_session} && $heap->{listening} == 0) {
268             # this broke stuff, now execute is yielded another way
269             # $kernel->post($heap->{pending_session}->ID, 'execute');
270             # }
271             }
272              
273              
274             sub signals {
275 0     0 0   my ($kernel, $heap, $session, $signal_name) = @_[KERNEL, HEAP, SESSION, ARG0];
276            
277 0           $kernel->call($session->ID => _write_log => 4 => "Session with $heap->{host} : $heap->{port} caught SIG $signal_name");
278             # do not handle the signal
279 0           return 0;
280             }
281              
282             sub SITE {
283 0     0 0   my ($kernel, $heap, $session, $args) = @_[KERNEL, HEAP, SESSION, ARG0];
284            
285 0 0         if ($heap->{auth} == 0) {
286 0           $kernel->yield(send => "530 Not logged in");
287             } else {
288 0           my $cmd = shift(@$args);
289 0           $kernel->call($session->ID,$cmd,$args);
290             }
291             }
292              
293             sub NOOP {
294 0     0 0   my ($kernel, $heap, $session, $args) = @_[KERNEL, HEAP, SESSION, ARG0];
295            
296 0 0         if ($heap->{auth} == 0) {
297 0           $kernel->yield(send => "530 Not logged in");
298             } else {
299             # resetting the timeout is done in receive()
300 0           $kernel->yield(send => "200 No-op okay.");
301             }
302             }
303              
304             sub XSEN {
305 0     0 0   my ($kernel, $heap, $session, $args) = @_[KERNEL, HEAP, SESSION, ARG0];
306            
307 0           $args = join(' ',@$args);
308            
309 0           $kernel->call($session->ID => _write_log => 1 => "Message to admin: $args");
310            
311 0           my $ret = $kernel->call($heap->{params}{'Alias'} => notify => 'ftpd_xsen' => { message => $args });
312            
313 0 0         if (!defined $ret) {
314 0           $kernel->yield(send => "453 Not Allowed");
315             }
316             }
317              
318             sub QUIT {
319 0     0 0   my ($kernel, $heap, $session, $args) = @_[KERNEL, HEAP, SESSION, ARG0];
320              
321 0           $kernel->alarm_remove_all( );
322 0           $kernel->yield(send => "221 Goodbye.");
323 0           $heap->{shutdown_on_flush} = 1;
324             }
325              
326             sub USER {
327 0     0 0   my ($kernel, $session, $heap, $username) = @_[KERNEL, SESSION, HEAP, ARG0];
328              
329 0           $username = join(' ',@$username);
330 0           $heap->{username} = $username;
331              
332 0 0         if ($username eq "anonymous") {
333 0           $kernel->yield(send => "331 Guest login ok, send your complete ".
334             "e-mail address as password.");
335             } else {
336 0           $kernel->yield(send => "331 Password required for $username");
337             }
338             }
339              
340             sub PASS {
341 0     0 0   my ($kernel, $session, $heap, $password) = @_[KERNEL, SESSION, HEAP, ARG0];
342              
343 0           $password = join(' ',@$password);
344 0           my @list;
345 0           my $fs = $heap->{filesystem};
346              
347 0 0         if (exists($heap->{username})) {
348 0 0 0       if ($heap->{params}{AnonymousLogin} eq 'deny' && $heap->{username} eq 'anonymous') {
349 0           $kernel->call($heap->{params}{'Alias'} => notify =>
350             'ftpd_incorrect_login' => {
351             session => $session,
352             username => $heap->{username},
353             password => $password,
354             anonymous => 'deny',
355             }
356             );
357 0           $kernel->call($session->ID => _write_log => 1 => "Anonymous login denied.");
358 0           $kernel->yield(send => "530 Login incorrect.");
359 0           $heap->{auth} = 0;
360 0           return;
361             }
362 0 0         if ($fs->login($heap->{username}, $password)) {
363 0           $kernel->call($heap->{params}{'Alias'} => notify =>
364             'ftpd_login' => {
365             session => $session,
366             username => $heap->{username},
367             password => $password,
368             uid => $fs->{uid},
369             gid => $fs->{gid},
370             home => $fs->{home},
371             }
372             );
373 0           $kernel->call($session->ID => _write_log => 1 => "User $heap->{username} logged in.");
374             # MOTD?
375 0           $kernel->yield(send => "230 Logged in.");
376 0           $heap->{auth} = 1;
377 0           $kernel->call($session->ID => "_reset_timeout");
378             } else {
379 0           $kernel->call($heap->{params}{'Alias'} => notify =>
380             'ftpd_incorrect_login' => {
381             session => $session,
382             username => $heap->{username},
383             password => $password,
384             }
385             );
386 0           $kernel->call($session->ID => _write_log => 1 => "Incorrect login");
387 0           $kernel->yield(send => "530 Login incorrect.");
388 0           $heap->{auth} = 0;
389             }
390             } else {
391 0           $kernel->yield(send => "503 Login with USER first.");
392             }
393             }
394              
395             # Not implemented.
396             sub REST {
397 0     0 0   my ($kernel, $session, $heap, $args) = @_[KERNEL, SESSION, HEAP, ARG0];
398            
399 0 0         if ($heap->{auth} == 0) {
400 0           $kernel->yield(send => "530 Not logged in");
401 0           return;
402             }
403            
404 0 0         if ($args->[0] =~ m/^\d+$/) {
405 0           $heap->{rest} = $args->[0];
406 0           $kernel->yield(send => "350 Will attempt to restart at postion $args->[0].");
407             } else {
408            
409             }
410             }
411              
412             # Not implemented.
413             sub TYPE {
414 0     0 0   my ($kernel, $session, $heap, $type) = @_[KERNEL, SESSION, HEAP, ARG0];
415            
416 0 0         if ($heap->{auth} == 0) {
417 0           $kernel->yield(send => "530 Not logged in");
418 0           return;
419             }
420            
421 0           $type = $type->[0];
422            
423 0           $kernel->yield(send => "200 Type set to I.");
424             }
425              
426             # Not implemented.
427             sub SYST {
428 0     0 0   my ($kernel, $session, $heap) = @_[KERNEL, SESSION, HEAP];
429            
430 0 0         if ($heap->{auth} == 0) {
431 0           $kernel->yield(send => "530 Not logged in");
432 0           return;
433             }
434            
435 0           $kernel->yield(send => "215 UNIX Type: L8");
436             }
437              
438             sub ABOR {
439 0     0 0   my ($kernel, $session, $heap) = @_[KERNEL, SESSION, HEAP];
440            
441 0 0         if ($heap->{auth} == 0) {
442 0           $kernel->yield(send => "530 Not logged in");
443 0           return;
444             }
445            
446 0 0         if (defined $heap->{pending_session}) {
447 0           $kernel->post($heap->{pending_session}->ID => 'data_throttle');
448 0           $kernel->post($heap->{pending_session}->ID => '_drop');
449 0           $heap->{abor} = 1;
450             }
451            
452 0           $kernel->yield(send => "200 ABOR successfull");
453             # TODO what do i send?
454             }
455              
456             sub MDTM {
457 0     0 0   my ($kernel, $session, $heap, $fn) = @_[KERNEL, SESSION, HEAP, ARG0];
458            
459 0 0         if ($heap->{auth} == 0) {
460 0           $kernel->yield(send => "530 Not logged in");
461 0           return;
462             }
463            
464 0           $fn = join(' ',@$fn);
465 0           my $fs = $heap->{filesystem};
466 0           my @modtime = $fs->modtime($fs);
467 0 0         if ($modtime[0] == 0) {
468 0           $kernel->yield(send => "550 MDTM $fn: Permission denied.");
469             } else {
470 0           $kernel->yield(send => "213 ".$modtime[1]);
471             }
472             }
473              
474             sub SIZE {
475 0     0 0   my ($kernel, $session, $heap, $fn) = @_[KERNEL, SESSION, HEAP, ARG0];
476            
477 0 0         if ($heap->{auth} == 0) {
478 0           $kernel->yield(send => "530 Not logged in");
479 0           return;
480             }
481            
482 0           $fn = join(' ',@$fn);
483 0           my $fs = $heap->{filesystem};
484 0           my $size = $fs->size($fn);
485 0           $kernel->yield(send => "213 ".$size);
486            
487             # my @modtime = $fs->modtime($fs);
488             # if ($modtime[0] == 0) {
489             # $kernel->yield(send => "550 SIZE $fn: Permission denied.");
490             # } else {
491             # $kernel->yield(send => "213 ".$modtime[1]);
492             # }
493             }
494              
495             sub CHMOD {
496 0     0 0   my ($kernel, $session, $heap, $fn) = @_[KERNEL, SESSION, HEAP, ARG0];
497            
498 0 0         if ($heap->{auth} == 0) {
499 0           $kernel->yield(send => "530 Not logged in");
500 0           return;
501             }
502              
503 0           my $fs = $heap->{filesystem};
504 0           my $mode = shift(@$fn);
505 0           $fn = join(' ',@$fn);
506              
507 0 0         if ($fs->chmod($mode, $fn)) {
508 0           $kernel->yield(send => "200 CHMOD command successful.");
509             } else {
510 0           $kernel->yield(send => "550 CHMOD command unsuccessful");
511             }
512              
513             }
514              
515             sub DELE {
516 0     0 0   my ($kernel, $session, $heap, $fn) = @_[KERNEL, SESSION, HEAP, ARG0];
517            
518 0 0         if ($heap->{auth} == 0) {
519 0           $kernel->yield(send => "530 Not logged in");
520 0           return;
521             }
522            
523 0           $fn = join(' ',@$fn);
524 0           my $fs = $heap->{filesystem};
525            
526 0 0         if ($fs->delete($fn)) {
527 0           $kernel->yield(send => "250 DELE command successful");
528             } else {
529 0           $kernel->yield(send => "550 DELE command unsuccessful");
530             }
531             }
532              
533             sub MKD {
534 0     0 0   my ($kernel, $session, $heap, $fn) = @_[KERNEL, SESSION, HEAP, ARG0];
535            
536 0 0         if ($heap->{auth} == 0) {
537 0           $kernel->yield(send => "530 Not logged in");
538 0           return;
539             }
540            
541 0           $fn = join(' ',@$fn);
542 0           my $fs = $heap->{filesystem};
543            
544 0           my $ret = $fs->mkdir($fn);
545            
546 0 0         if ($ret == 1) {
    0          
547 0           $fn =~ s/"/""/g; # doublequoting
548 0           $kernel->yield(send => "257 \"$fn\" directory created");
549             } elsif ($ret == 2) {
550 0           $fn =~ s/"/""/g; # doublequoting
551 0           $kernel->yield(send => "521 \"$fn\" directory already exists");
552             } else {
553 0           $kernel->yield(send => "550 MKDIR $fn: Permission denied.");
554             }
555            
556             }
557              
558             sub XMKD {
559 0     0 0   my ($kernel, $session, $heap, $fn) = @_[KERNEL, SESSION, HEAP, ARG0];
560            
561 0           $kernel->call($session->ID => MKD => splice(@_,ARG0));
562              
563             # if ($heap->{auth} == 0) {
564             # $kernel->yield(send => "530 Not logged in");
565             # return;
566             # }
567             #
568             # $fn = join(' ',@$fn);
569             # my $fs = $heap->{filesystem};
570             #
571             # my $ret = $fs->mkdir($fn);
572             # if ($ret == 1) {
573             # $fn =~ s/"/""/g; # doublequoting
574             # $kernel->yield(send => "257 \"$fn\" directory created");
575             # } elsif ($ret == 2) {
576             # $fn =~ s/"/""/g; # doublequoting
577             # $kernel->yield(send => "521 \"$fn\" directory already exists");
578             # } else {
579             # $kernel->yield(send => "550 MKDIR $fn: Permission denied.");
580             # }
581             }
582              
583             sub RMD {
584 0     0 0   my ($kernel, $session, $heap, $fn) = @_[KERNEL, SESSION, HEAP, ARG0];
585            
586 0 0         if ($heap->{auth} == 0) {
587 0           $kernel->yield(send => "530 Not logged in");
588 0           return;
589             }
590            
591 0           $fn = join(' ',@$fn);
592 0           my $fs = $heap->{filesystem};
593              
594 0 0         if ($fs->rmdir($fn)) {
595 0           $kernel->yield(send => "250 RMD command successful");
596             } else {
597 0           $kernel->yield(send => "550 RMD $fn: Permission denied");
598             }
599             }
600              
601             sub XRMD {
602 0     0 0   my ($kernel, $session, $heap, $fn) = @_[KERNEL, SESSION, HEAP, ARG0];
603            
604 0           $kernel->call($session->ID => RMD => splice(@_,ARG0));
605            
606             # if ($heap->{auth} == 0) {
607             # $kernel->yield(send => "530 Not logged in");
608             # return;
609             # }
610             #
611             #
612             # $fn = join(' ',@$fn);
613             # my $fs = $heap->{filesystem};
614             #
615             # if ($fs->rmdir($fs->cwd().$fn)) {
616             # $kernel->yield(send => "250 RMD command successful");
617             # } else {
618             # $kernel->yield(send => "550 RMD $fn: Permission denied");
619             # }
620             }
621              
622             sub CDUP {
623 0     0 0   my ($kernel, $session, $heap, $fn) = @_[KERNEL, SESSION, HEAP, ARG0];
624            
625 0 0         if ($heap->{auth} == 0) {
626 0           $kernel->yield(send => "530 Not logged in");
627 0           return;
628             }
629            
630 0           $fn = join(' ',@$fn);
631 0           my $fs = $heap->{filesystem};
632            
633 0 0         if ($fs->chdir('..')) {
634 0           $kernel->yield(send => '257 "'.$fs->cwd().'" is current directory.');
635             } else {
636 0           $kernel->yield(send => "550 ..: No such file or directory.");
637             }
638              
639             }
640              
641             sub CWD {
642 0     0 0   my ($kernel, $session, $heap, $fn) = @_[KERNEL, SESSION, HEAP, ARG0];
643            
644 0 0         if ($heap->{auth} == 0) {
645 0           $kernel->yield(send => "530 Not logged in");
646 0           return;
647             }
648            
649 0           $fn = join(' ',@$fn);
650 0           my $fs = $heap->{filesystem};
651            
652 0 0         if ($fs->chdir($fn)) {
653 0           $kernel->yield(send => '257 "'.$fs->cwd().'" is current directory.');
654             } else {
655 0           $kernel->yield(send => "550 $fn: No such file or directory.");
656             }
657            
658             }
659              
660             sub PWD {
661 0     0 0   my ($kernel, $session, $heap, $fn) = @_[KERNEL, SESSION, HEAP, ARG0];
662            
663 0 0         if ($heap->{auth} == 0) {
664 0           $kernel->yield(send => "530 Not logged in");
665             } else {
666 0           $fn = join(' ',@$fn);
667 0           my $fs = $heap->{filesystem};
668              
669 0           $kernel->yield(send => '257 "'.$fs->cwd().'" is current directory.');
670             }
671             }
672              
673             sub PORT {
674 0     0 0   my ($kernel, $session, $heap, $data_port) = @_[KERNEL, SESSION, HEAP, ARG0];
675              
676 0 0         if ($heap->{auth} == 0) {
677 0           $kernel->yield(send => "530 Not logged in");
678 0           return;
679             }
680            
681 0           $heap->{last_port_cmd} = $data_port->[0];
682 0           $kernel->yield(send => "200 PORT command successful.");
683              
684 0           $heap->{pasv} = 0;
685             }
686              
687             sub PASV {
688 0     0 0   my ($kernel, $session, $heap, $data_port) = @_[KERNEL, SESSION, HEAP, ARG0];
689            
690 0 0         if ($heap->{auth} == 0) {
691 0           $kernel->yield(send => "530 Not logged in");
692 0           return;
693             }
694            
695 0           my $p1 = int ((int rand(65430)) / 256)+1025;
696 0           my $p2 = (int rand(100))+1;
697 0           $p1 -= $p2;
698 0           $p1 &= 0xFF;
699              
700 0           POE::Component::Server::FTP::DataSession->new($heap->{params},{
701             fs => $heap->{filesystem},
702             port1 => $p1,
703             port2 => $p2,
704             rest => $heap->{rest},
705             });
706              
707 0           $heap->{pasv} = 1;
708 0           my $ip = $heap->{params}{ListenIP};
709 0           $ip =~ s/\./,/g;
710 0           $kernel->yield(send => "227 Entering Passive Mode. ($ip,$p1,$p2)");
711             }
712              
713             sub LIST {
714 0     0 0   my ($kernel, $session, $heap, $dirfile) = @_[KERNEL, SESSION, HEAP, ARG0];
715              
716 0 0         if ($heap->{auth} == 0) {
717 0           $kernel->yield(send => "530 Not logged in");
718 0           return;
719             }
720              
721 0           $dirfile = join(' ',@$dirfile);
722              
723 0           $kernel->yield(send => "150 Opening ASCII mode data connection for /bin/ls.");
724              
725 0 0 0       if (defined $heap->{pending_session} && $heap->{pasv} == 1) {
726 0           $kernel->post($heap->{pending_session}->ID => start_LIST => $dirfile);
727             } else {
728 0           POE::Component::Server::FTP::DataSession->new($heap->{params},{
729             fs => $heap->{filesystem},
730             data_port => $heap->{last_port_cmd},
731             cmd => 'LIST',
732             opt => $dirfile,
733             pasv => $heap->{pasv},
734             });
735             }
736             }
737              
738             sub NLST {
739 0     0 0   my ($kernel, $session, $heap, $dirfile) = @_[KERNEL, SESSION, HEAP, ARG0];
740              
741 0 0         if ($heap->{auth} == 0) {
742 0           $kernel->yield(send => "530 Not logged in");
743 0           return;
744             }
745              
746 0           $dirfile = join(' ',@$dirfile);
747              
748 0           $kernel->yield(send => "150 Opening ASCII mode data connection for /bin/ls.");
749              
750 0 0 0       if (defined $heap->{pending_session} && $heap->{pasv} == 1) {
751 0           $kernel->post($heap->{pending_session}->ID => start_NLST => $dirfile);
752             } else {
753 0           POE::Component::Server::FTP::DataSession->new($heap->{params},{
754             fs => $heap->{filesystem},
755             data_port => $heap->{last_port_cmd},
756             cmd => 'NLST',
757             opt => $dirfile,
758             });
759             }
760             }
761              
762             sub STOR {
763 0     0 0   my ($kernel, $session, $heap, $filename) = @_[KERNEL, SESSION, HEAP, ARG0];
764            
765 0 0         if ($heap->{auth} == 0) {
766 0           $kernel->yield(send => "530 Not logged in");
767 0           return;
768             }
769            
770 0           my $fs = $heap->{filesystem};
771 0           $filename = join(' ',@$filename);
772 0           my $fh;
773              
774 0 0         if ($fh = $fs->open_write($filename)) {
775 0           $kernel->yield(send => "150 Opening BINARY mode data connection for $filename.");
776              
777 0 0 0       if (defined $heap->{pending_session} && $heap->{pasv} == 1) {
778 0           $kernel->post($heap->{pending_session}->ID => start_STOR => $fh,
779             {
780             rest => $heap->{rest},
781             filename => $filename,
782             });
783             } else {
784 0           POE::Component::Server::FTP::DataSession->new($heap->{params},{
785             fs => $fs,
786             data_port => $heap->{last_port_cmd},
787             cmd => 'STOR',
788             opt => $fh,
789             rest => $heap->{rest},
790             filename => $filename,
791             });
792             }
793              
794             } else {
795 0           $kernel->yield(send => "553 Permission denied: $filename.");
796             }
797             }
798              
799             sub APPE {
800 0     0 0   my ($kernel, $session, $heap, $filename) = @_[KERNEL, SESSION, HEAP, ARG0];
801            
802 0 0         if ($heap->{auth} == 0) {
803 0           $kernel->yield(send => "530 Not logged in");
804 0           return;
805             }
806            
807 0           my $fs = $heap->{filesystem};
808 0           $filename = join(' ',@$filename);
809 0           my $fh;
810              
811             # the ,1 flag is for append
812 0 0         if ($fh = $fs->open_write($filename,1)) {
813 0           $kernel->yield(send => "150 Opening BINARY mode data connection for $filename.");
814              
815 0 0 0       if (defined $heap->{pending_session} && $heap->{pasv} == 1) {
816 0           $kernel->post($heap->{pending_session}->ID => start_STOR => $fh,
817             {
818             filename => $filename,
819             });
820             } else {
821 0           POE::Component::Server::FTP::DataSession->new($heap->{params},{
822             fs => $fs,
823             data_port => $heap->{last_port_cmd},
824             cmd => 'STOR',
825             opt => $fh,
826             filename => $filename,
827             });
828             }
829              
830             } else {
831 0           $kernel->yield(send => "553 Permission denied: $filename.");
832             }
833             }
834              
835             sub RETR {
836 0     0 0   my ($kernel, $session, $heap, $filename) = @_[KERNEL, SESSION, HEAP, ARG0];
837            
838 0 0         if ($heap->{auth} == 0) {
839 0           $kernel->yield(send => "530 Not logged in");
840 0           return;
841             }
842            
843 0           $filename = join(' ',@$filename);
844 0           my $fs = $heap->{filesystem};
845 0           my $fh;
846              
847 0 0         if ($fh = $fs->open_read($filename)) {
848 0           $kernel->yield(send => "150 Opening BINARY mode data connection for $filename.");
849 0 0 0       if (defined $heap->{pending_session} && $heap->{pasv} == 1) {
850 0           $kernel->post($heap->{pending_session}->ID => start_RETR => $fh,
851             {
852             rest => $heap->{rest},
853             filename => $filename,
854             });
855             } else {
856 0           POE::Component::Server::FTP::DataSession->new($heap->{params},{
857             fs => $fs,
858             data_port => $heap->{last_port_cmd},
859             cmd => 'RETR',
860             opt => $fh,
861             rest => $heap->{rest},
862             filename => $filename,
863             });
864             }
865             } else {
866 0           $kernel->yield(send => "550 No such file or directory: $filename.");
867             }
868             }
869              
870             sub _default {
871 0     0     my ($kernel, $heap, $session, $cmd, $args) = @_[KERNEL, HEAP, SESSION, ARG0, ARG1];
872              
873 0 0         if ($cmd =~ m/^_/) {
874 0           $kernel->call($session->ID => _write_log => 4 => "NonHandled Event: $cmd(".join(", ", @$args).")");
875             } else {
876 0           $kernel->call($session->ID => _write_log => 4 => "UNSUPPORTED COMMAND: $cmd(".join(", ", @$args).")");
877              
878 0           $kernel->yield(send => "500 '$cmd': command not understood");
879             }
880            
881 0           return 0;
882             }
883              
884             sub _reset_timeout {
885 0     0     my ($kernel,$heap) = @_[KERNEL, HEAP];
886            
887 0 0         if (defined $heap->{time_out}) {
888 0           $kernel->delay_adjust( $heap->{time_out}, $heap->{params}{'TimeOut'} );
889             }
890             }
891              
892             sub _write_log {
893 0     0     my ($kernel, $session, $heap, $sender, $verbose, $msg) = @_[KERNEL, SESSION, HEAP, SENDER, ARG0, ARG1];
894 0 0         if ($verbose <= $heap->{params}{'LogLevel'}) {
895             # if we're not forked, then pass the logging off to the
896             # main session
897             #if ($heap->{params}{_main_pid} == $$) {
898 0 0         $kernel->call($heap->{params}{'Alias'} => _write_log => { type => (($sender->ID == $session->ID) ? 'C' : 'D'), msg => $msg, v => $verbose, sid => $sender->ID });
899             #} else {
900             #my $datetime = localtime();
901             #my $type = ($sender->ID == $session->ID) ? 'C' : 'D';
902             #print STDERR "[$datetime][$type".$sender->ID."] $msg\n";
903             #}
904             }
905             }
906              
907             1;