this is now a working ftp server, both PASV and PORT run fine, LIST works,

RETR and STORE don't

1 files changed, 139 insertions, 46 deletions

diff --git a/tests/ftpserver.pl b/tests/ftpserver.pl
index 082459869..b9efbb130 100644
--- a/tests/ftpserver.pl
+++ b/tests/ftpserver.pl
@@ -6,8 +6,11 @@ use FileHandle;
 use strict;
 
 sub spawn;  # forward declaration
-sub logmsg { #print "$0 $$: @_ at ", scalar localtime, "\n"
- }
+
+open(FTPLOG, ">log/ftpd.log") ||
+    print STDERR "failed to open log file, runs without logging\n";
+
+sub logmsg { print FTPLOG @_; }
 
 my $verbose=0; # set to 1 for debugging
 
@@ -23,7 +26,6 @@ do {
 
 my $proto = getprotobyname('tcp') || 6;
 
-my $protocol;
 my $ftp_sendfile=""; # set to a file name when the file should be sent
 
 socket(Server, PF_INET, SOCK_STREAM, $proto)|| die "socket: $!";
@@ -32,7 +34,7 @@ setsockopt(Server, SOL_SOCKET, SO_REUSEADDR,
 bind(Server, sockaddr_in($port, INADDR_ANY))|| die "bind: $!";
 listen(Server,SOMAXCONN) || die "listen: $!";
 
-print "$protocol server started on port $port\n";
+print "FTP server started on port $port\n";
 
 open(PID, ">.ftpserver.pid");
 print PID $$;
@@ -44,13 +46,13 @@ my $paddr;
 sub REAPER {
     $waitedpid = wait;
     $SIG{CHLD} = \&REAPER;  # loathe sysV
-    logmsg "reaped $waitedpid" . ($? ? " with exit $?" : '');
+  #  logmsg "reaped $waitedpid" . ($? ? " with exit $?" : '');
 }
 
 # USER is ok in fresh state
 my %commandok = ( "USER" => "fresh",
                   "PASS" => "passwd",
-                  # "PASV" => "loggedin", we can't handle PASV yet
+                  "PASV" => "loggedin",
                   "PORT" => "loggedin",
                   "TYPE" => "loggedin|twosock",
                   "LIST" => "twosock",
@@ -59,43 +61,140 @@ my %commandok = ( "USER" => "fresh",
 # initially, we're in 'fresh' state
 my %statechange = ( 'USER' => 'passwd',    # USER goes to passwd state
                     'PASS' => 'loggedin',  # PASS goes to loggedin state
-                    'PORT' => 'twosock',    # PORT goes to twosock
+                    'PORT' => 'twosock',   # PORT goes to twosock
+                    'PASV' => 'twosock',   # PASV goes to twosock
                     );
 
 my %displaytext = ('USER' => '331 We are happy you popped in!', # output FTP line
                    'PASS' => '230 Welcome you silly person',
                    'PORT' => '200 You said PORT - I say FINE',
                    'TYPE' => '200 I modify TYPE as you wanted',
-                   'LIST' => '150 Here comes a directory your way',
+                   'LIST' => '150 ASCII data connection for /bin/ls (193.15.23.1,59196) (0 bytes)', #150 Here comes a directory your way',
                    );
 
+# callback functions for certain commands
 my %commandfunc = ( 'PORT', \&PORT_command,
-                    'LIST', \&LIST_command);
+                    'LIST', \&LIST_command,
+                    'PASV', \&PASV_command);
+
+my $pid;
+
+my @ftpdir=("total 20\r\n",
+"drwxr-xr-x   8 98       98           512 Oct 22 13:06 .\r\n",
+"drwxr-xr-x   8 98       98           512 Oct 22 13:06 ..\r\n",
+"drwxr-xr-x   2 98       98           512 May  2  1996 .NeXT\r\n",
+"-r--r--r--   1 0        1             35 Jul 16  1996 README\r\n",
+"lrwxrwxrwx   1 0        1              7 Dec  9  1999 bin -> usr/bin\r\n",
+"dr-xr-xr-x   2 0        1            512 Oct  1  1997 dev\r\n",
+"drwxrwxrwx   2 98       98           512 May 29 16:04 download.html\r\n",
+"dr-xr-xr-x   2 0        1            512 Nov 30  1995 etc\r\n",
+"drwxrwxrwx   2 98       1            512 Oct 30 14:33 pub\r\n",
+"dr-xr-xr-x   5 0        1            512 Oct  1  1997 usr\r\n");
+
 
 sub LIST_command {
-    $ftp_sendfile="ftptest"; # send this now
+  #  print "150 ASCII data connection for /bin/ls (193.15.23.1,59196) (0 bytes)\r\n";
+
+    for(@ftpdir) {
+        print KID_TO_WRITE $_;
+        # print STDERR "PASS: $_";
+    }
+    close(KID_TO_WRITE);
+
+    print "226 ASCII transfer complete\r\n";
     return 0;
 }
 
+# < 220 pm1 FTP server (SunOS 5.7) ready.
+# > USER anonymous
+# < 331 Guest login ok, send ident as password.
+# > PASS curl_by_daniel@haxx.se
+# < 230 Guest login ok, access restrictions apply.
+# * We have successfully logged in
+# * Connected to 127.0.0.1 (127.0.0.1)
+# > PASV
+# < 227 Entering Passive Mode (127,0,0,1,210,112)
+# * Connecting to localhost (127.0.0.1) port 53872
+# * Connected the data stream!
+# > TYPE A
+# < 200 Type set to A.
+# > LIST
+# < 150 ASCII data connection for /bin/ls (127.0.0.1,53873) (0 bytes).
+#
+
+sub PASV_command {
+    $pid = open(KID_TO_WRITE, "|-");
+    $SIG{ALRM} = sub { die "whoops, pipe broke" };
+
+    if(0 == $pid) {
+        # the child process runs the child function
+    }
+    else {
+        # parent continues
+ #       print STDERR "parent after fork!\n";
+        return; # continue please
+    }
+
+    my $port = 10000;
+    socket(Server2, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
+    setsockopt(Server2, SOL_SOCKET, SO_REUSEADDR,
+               pack("l", 1)) || die "setsockopt: $!";
+    while($port < 11000) {
+        if(bind(Server2, sockaddr_in($port, INADDR_ANY))) {
+            last;
+        }
+        $port++; # try next port please
+    }
+    listen(Server2,SOMAXCONN) || die "listen: $!";
+
+    printf("227 Entering Passive Mode (127,0,0,1,%d,%d)\n",
+           ($port/256), ($port%256));
+
+    my $waitedpid;
+    my $paddr;
+
+    $paddr = accept(Client2, Server2);
+    my($port,$iaddr) = sockaddr_in($paddr);
+    my $name = gethostbyaddr($iaddr,AF_INET);
+
+    logmsg "connection from $name [", inet_ntoa($iaddr), "] at port $port\n";
+
+    open(STDOUT, ">&Client2")   || die "can't dup client to stdout";
+
+ #   print STDERR "#### CONN\n";
+
+    while(<STDIN>) {
+        print $_;
+   #     print STDERR "SEND: $_";
+    }
+    close(SOCK);
+
+    close(Client2);
+
+    exit;
+
+}
+
 sub PORT_command {
     my $arg = $_[0];
-    print STDERR "fooo: $arg\n";
+ #   print STDERR "fooo: $arg\n";
 
-    # "193,15,23,1,172,201"
+    $pid = open(KID_TO_WRITE, "|-");
+    $SIG{ALRM} = sub { die "whoops, pipe broke" };
 
-    my $pid;
-    if (!defined($pid = fork)) {
-        logmsg "cannot fork: $!";
-        return 1;
-    } elsif ($pid) {
-        logmsg "begat $pid";
-        print STDERR "dasdasd a\n";
-        return 0;
+    if(0 == $pid) {
+        # the child process runs the child function
     }
-    # else I'm the child -- go spawn
+    else {
+        # parent continues
+  #      print STDERR "parent after fork!\n";
+        return; # continue please
+    }
+
+   # open(STDOUT, ">&Client")   || die "can't dup client to stdout";
 
     if($arg !~ /(\d+),(\d+),(\d+),(\d+),(\d+),(\d+)/) {
-        print STDERR "bad PORT-line: $arg\n";
+        logmsg "bad PORT-line: $arg\n";
         print "314 silly you, go away\r\n";
         return 1;
     }
@@ -104,32 +203,24 @@ sub PORT_command {
     my $proto   = getprotobyname('tcp') || 6;
 
     socket(SOCK, PF_INET, SOCK_STREAM, $proto) || die "major failure";
-    print STDERR "socket()\n";
+ #   print STDERR "socket()\n";
 
     connect(SOCK, $paddr)    || return 1;
-    print STDERR "connect()\n";
-
-    my $line;
-
-    while($ftp_sendfile eq "") {
-        sleep 1;
-    }
-    open(SEND, "<$ftp_sendfile") ||
-        print STDERR "couldn't open file to send";
+ #    print STDERR "connect()\n";
 
     #while (defined($line = <SOCK>)) {
     #print STDERR $line;
     #}
-    while(<SEND>) {
-        print $_;
+ #   print STDERR "sending stdin to client\n";
+    while(<STDIN>) {
+        print SOCK $_;
+ #       print STDERR "SEND: $_";
     }
-    close(SEND);
     close(SOCK);
 
-    $ftp_sendfile="";
-
-    print STDERR "close()\n";
+  #  print STDERR "close(SOCK)\n";
 
+    exit; # we're a chiuld process who dies!
 }
 
 $SIG{CHLD} = \&REAPER;
@@ -142,7 +233,7 @@ for ( $waitedpid = 0;
     my($port,$iaddr) = sockaddr_in($paddr);
     my $name = gethostbyaddr($iaddr,AF_INET);
 
-    logmsg "connection from $name [", inet_ntoa($iaddr), "] at port $port";
+    logmsg "connection from $name [", inet_ntoa($iaddr), "] at port $port\n";
 
     # this code is forked and run
     spawn sub {
@@ -187,7 +278,7 @@ for ( $waitedpid = 0;
             my $FTPARG=$2;
             my $full=$_;
                  
-            print STDERR "GOT: ($1) $_\n";
+            logmsg "GOT: ($1) $_\n";
 
             my $ok = $commandok{$FTPCMD};
             if($ok !~ /$state/) {
@@ -205,18 +296,20 @@ for ( $waitedpid = 0;
                 $state = $newstate;
             }
 
+            my $text = $displaytext{$FTPCMD};
+            if($text) {
+                print "$text\r\n";
+            }
+
             # see if the new state is a function caller.
             my $func = $commandfunc{$FTPCMD};
             if($func) {
                 # it is!
                 \&$func($FTPARG);
-                print STDERR "MOOOOOOOOO\n";
             }
 
-            print STDERR "gone to state $state\n";
+            logmsg "gone to state $state\n";
 
-            my $text = $displaytext{$FTPCMD};
-            print "$text\r\n";
         }
         exit;
         #   print "Hello there, $name, it's now ", scalar localtime, "\r\n";
@@ -235,10 +328,10 @@ sub spawn {
 
     my $pid;
     if (!defined($pid = fork)) {
-        logmsg "cannot fork: $!";
+        logmsg "cannot fork: $!\n";
         return;
     } elsif ($pid) {
-        logmsg "begat $pid";
+        logmsg "begat $pid\n";
         return; # I'm the parent
     }
     # else I'm the child -- go spawn