diff options
Diffstat (limited to 'Build/source/libs/curl/tests/ftpserver.pl')
-rw-r--r-- | Build/source/libs/curl/tests/ftpserver.pl | 502 |
1 files changed, 502 insertions, 0 deletions
diff --git a/Build/source/libs/curl/tests/ftpserver.pl b/Build/source/libs/curl/tests/ftpserver.pl new file mode 100644 index 00000000000..084639a9cdb --- /dev/null +++ b/Build/source/libs/curl/tests/ftpserver.pl @@ -0,0 +1,502 @@ +#!/usr/bin/perl +# +# $Id: ftpserver.pl,v 1.25 2001/12/03 13:46:56 bagder Exp $ +# This is the FTP server designed for the curl test suite. +# +# It is meant to exercise curl, it is not meant to be a fully working +# or even very standard compliant server. +# +# You may optionally specify port on the command line, otherwise it'll +# default to port 8921. +# + +use Socket; +use Carp; +use FileHandle; + +use strict; + +require "getpart.pm"; + +open(FTPLOG, ">log/ftpd.log") || + print STDERR "failed to open log file, runs without logging\n"; + +sub logmsg { print FTPLOG "$$: "; print FTPLOG @_; } + +sub ftpmsg { print INPUT @_; } + +my $verbose=0; # set to 1 for debugging +my $retrweirdo=0; + +my $port = 8921; # just a default +do { + if($ARGV[0] eq "-v") { + $verbose=1; + } + elsif($ARGV[0] =~ /^(\d+)$/) { + $port = $1; + } +} while(shift @ARGV); + +my $proto = getprotobyname('tcp') || 6; + +socket(Server, PF_INET, SOCK_STREAM, $proto)|| die "socket: $!"; +setsockopt(Server, SOL_SOCKET, SO_REUSEADDR, + pack("l", 1)) || die "setsockopt: $!"; +bind(Server, sockaddr_in($port, INADDR_ANY))|| die "bind: $!"; +listen(Server,SOMAXCONN) || die "listen: $!"; + +#print "FTP server started on port $port\n"; + +open(PID, ">.ftp.pid"); +print PID $$; +close(PID); + +my $waitedpid = 0; +my $paddr; + +sub REAPER { + $waitedpid = wait; + $SIG{CHLD} = \&REAPER; # loathe sysV + logmsg "reaped $waitedpid" . ($? ? " with exit $?\n" : "\n"); +} + +# USER is ok in fresh state +my %commandok = ( + 'USER' => 'fresh', + 'PASS' => 'passwd', + 'PASV' => 'loggedin|twosock', + 'EPSV' => 'loggedin|twosock', + 'PORT' => 'loggedin|twosock', + 'TYPE' => 'loggedin|twosock', + 'LIST' => 'twosock', + 'NLST' => 'twosock', + 'RETR' => 'twosock', + 'STOR' => 'twosock', + 'APPE' => 'twosock', + 'REST' => 'twosock', + 'CWD' => 'loggedin|twosock', + 'SYST' => 'loggedin', + 'SIZE' => 'loggedin|twosock', + 'PWD' => 'loggedin|twosock', + 'QUIT' => 'loggedin|twosock', + 'DELE' => 'loggedin|twosock' + ); + +# 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 + 'PASV' => 'twosock', # PASV goes to twosock + 'EPSV' => 'twosock', # EPSV goes to twosock + ); + +# this text is shown before the function specified below is run +my %displaytext = ('USER' => '331 We are happy you popped in!', + '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', + 'NLST' => '150 here comes a directory', + 'CWD' => '250 CWD command successful.', + 'SYST' => '215 UNIX Type: L8', # just fake something + 'QUIT' => '221 bye bye baby', # just reply something + 'PWD' => '257 "/nowhere/anywhere" is current directory', + 'REST' => '350 Yeah yeah we set it there for you', + 'DELE' => '200 OK OK OK whatever you say' + ); + +# callback functions for certain commands +my %commandfunc = ( 'PORT' => \&PORT_command, + 'LIST' => \&LIST_command, + 'NLST' => \&NLST_command, + 'PASV' => \&PASV_command, + 'EPSV' => \&PASV_command, + 'RETR' => \&RETR_command, + 'SIZE' => \&SIZE_command, + 'REST' => \&REST_command, + 'STOR' => \&STOR_command, + 'APPE' => \&STOR_command, # append looks like upload + ); + +my $rest=0; +sub REST_command { + $rest = $_[0]; + logmsg "Set REST position to $rest\n" +} + +sub LIST_command { + # print "150 ASCII data connection for /bin/ls (193.15.23.1,59196) (0 bytes)\r\n"; + +# this is a built-in fake-dir ;-) +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"); + + logmsg "$$: pass data to child pid\n"; + for(@ftpdir) { + print SOCK $_; + } + close(SOCK); + logmsg "$$: done passing data to child pid\n"; + + print "226 ASCII transfer complete\r\n"; + return 0; +} + +sub NLST_command { + my @ftpdir=("file", "with space", "fake", "..", " ..", "funny", "README"); + for(@ftpdir) { + print SOCK "$_\r\n"; + } + close(SOCK); + print "226 ASCII transfer complete\r\n"; + return 0; +} + +sub SIZE_command { + my $testno = $_[0]; + + loadtest("data/test$testno"); + + logmsg "SIZE number $testno\n"; + + my @data = getpart("reply", "size"); + + my $size = $data[0]; + + if($size) { + print "213 $size\r\n"; + logmsg "SIZE $testno returned $size\n"; + } + else { + $size=0; + @data = getpart("reply", "data"); + for(@data) { + $size += length($_); + } + if($size) { + print "213 $size\r\n"; + logmsg "SIZE $testno returned $size\n"; + } + else { + print "550 $testno: No such file or directory.\r\n"; + logmsg "SIZE $testno: no such file\n"; + } + } + return 0; +} + +sub RETR_command { + my $testno = $_[0]; + + logmsg "RETR test number $testno\n"; + + if($testno =~ /^verifiedserver$/) { + # this is the secret command that verifies that this actually is + # the curl test server + print "150 Binary junk (10 bytes).\r\n"; + print SOCK "WE ROOLZ\r\n"; + close(SOCK); + print "226 File transfer complete\r\n"; + return 0; + } + + loadtest("data/test$testno"); + + my @data = getpart("reply", "data"); + + my $size=0; + for(@data) { + $size += length($_); + } + + if($size) { + + if($rest) { + # move read pointer forward + $size -= $rest; + logmsg "REST $rest was removed from size, makes $size left\n"; + $rest = 0; # reset REST offset again + } + if($retrweirdo) { + print "150 Binary data connection for $testno () ($size bytes).\r\n", + "226 File transfer complete\r\n"; + logmsg "150+226 in one shot!\n"; + + for(@data) { + my $send = $_; + print SOCK $send; + } + close(SOCK); + $retrweirdo=0; # switch off the weirdo again! + } + else { + print "150 Binary data connection for $testno () ($size bytes).\r\n"; + logmsg "150 Binary data connection for $testno ($size bytes).\n"; + + for(@data) { + my $send = $_; + print SOCK $send; + } + close(SOCK); + + print "226 File transfer complete\r\n"; + } + } + else { + print "550 $testno: No such file or directory.\r\n"; + logmsg "550 $testno: no such file\n"; + } + return 0; +} + +sub STOR_command { + my $testno=$_[0]; + + logmsg "STOR test number $testno\n"; + + my $filename = "log/upload.$testno"; + + print "125 Gimme gimme gimme!\r\n"; + + open(FILE, ">$filename") || + return 0; # failed to open output + + my $line; + my $ulsize=0; + while (defined($line = <SOCK>)) { + $ulsize += length($line); + print FILE $line; + } + close(FILE); + close(SOCK); + + logmsg "received $ulsize bytes upload\n"; + + print "226 File transfer complete\r\n"; + return 0; +} + +my $pasvport=9000; +sub PASV_command { + my ($arg, $cmd)=@_; + + socket(Server2, PF_INET, SOCK_STREAM, $proto) || die "socket: $!"; + setsockopt(Server2, SOL_SOCKET, SO_REUSEADDR, + pack("l", 1)) || die "setsockopt: $!"; + + my $ok=0; + + $pasvport++; # don't reuse the previous + for(1 .. 10) { + if($pasvport > 65535) { + $pasvport = 1025; + } + if(bind(Server2, sockaddr_in($pasvport, INADDR_ANY))) { + $ok=1; + last; + } + $pasvport+= 3; # try another port please + } + if(!$ok) { + print "500 no free ports!\r\n"; + logmsg "couldn't find free port\n"; + return 0; + } + listen(Server2,SOMAXCONN) || die "listen: $!"; + + if($cmd ne "EPSV") { + # PASV reply + logmsg "replying to a $cmd command\n"; + printf("227 Entering Passive Mode (127,0,0,1,%d,%d)\n", + ($pasvport/256), ($pasvport%256)); + } + else { + # EPSV reply + logmsg "replying to a $cmd command\n"; + printf("229 Entering Passive Mode (|||%d|)\n", $pasvport); + } + + my $paddr = accept(SOCK, Server2); + my($iport,$iaddr) = sockaddr_in($paddr); + my $name = gethostbyaddr($iaddr,AF_INET); + + close(Server2); # close the listener when its served its purpose! + + logmsg "$$: data connection from $name [", inet_ntoa($iaddr), "] at port $iport\n"; + + return; +} + + +sub PORT_command { + my $arg = $_[0]; + + if($arg !~ /(\d+),(\d+),(\d+),(\d+),(\d+),(\d+)/) { + logmsg "bad PORT-line: $arg\n"; + print "500 silly you, go away\r\n"; + return 0; + } + my $iaddr = inet_aton("$1.$2.$3.$4"); + + my $port = ($5<<8)+$6; + + if(!$port || $port > 65535) { + print STDERR "very illegal PORT number: $port\n"; + return 1; + } + + my $paddr = sockaddr_in($port, $iaddr); + my $proto = getprotobyname('tcp') || 6; + + socket(SOCK, PF_INET, SOCK_STREAM, $proto) || die "major failure"; + connect(SOCK, $paddr) || return 1; + + return \&SOCK; +} + +$SIG{CHLD} = \&REAPER; + +my %customreply; +my %delayreply; +sub customize { + undef %customreply; + open(CUSTOM, "<log/ftpserver.cmd") || + return 1; + + logmsg "FTPD: Getting commands from log/ftpserver.cmd\n"; + + while(<CUSTOM>) { + if($_ =~ /REPLY ([A-Z]+) (.*)/) { + $customreply{$1}=$2; + } + elsif($_ =~ /DELAY ([A-Z]+) (\d*)/) { + $delayreply{$1}=$2; + } + elsif($_ =~ /RETRWEIRDO/) { + print "instructed to use RETRWEIRDO\n"; + $retrweirdo=1; + } + } + close(CUSTOM); +} + +my @welcome=( + '220- _ _ ____ _ '."\r\n", + '220- ___| | | | _ \| | '."\r\n", + '220- / __| | | | |_) | | '."\r\n", + '220- | (__| |_| | _ <| |___ '."\r\n", + '220 \___|\___/|_| \_\_____|'."\r\n"); + +for ( $waitedpid = 0; + ($paddr = accept(Client,Server)) || $waitedpid; + $waitedpid = 0, close Client) +{ + next if $waitedpid and not $paddr; + my($port,$iaddr) = sockaddr_in($paddr); + my $name = gethostbyaddr($iaddr,AF_INET); + + # flush data: + $| = 1; + + logmsg "connection from $name [", inet_ntoa($iaddr), "] at port $port\n"; + + open(STDIN, "<&Client") || die "can't dup client to stdin"; + open(STDOUT, ">&Client") || die "can't dup client to stdout"; + + open(INPUT, ">log/server.input") || + logmsg "failed to open log/server.input\n"; + + FTPLOG->autoflush(1); + INPUT->autoflush(1); + + &customize(); # read test control instructions + + print @welcome; + if($verbose) { + print STDERR "OUT:\n"; + print STDERR @welcome; + } + my $state="fresh"; + + while(1) { + + last unless defined ($_ = <STDIN>); + + ftpmsg $_; + + # Remove trailing CRLF. + s/[\n\r]+$//; + + unless (m/^([A-Z]{3,4})\s?(.*)/i) { + print "500 '$_': command not understood.\r\n"; + next; + } + my $FTPCMD=$1; + my $FTPARG=$2; + my $full=$_; + + logmsg "GOT: ($1) $_\n"; + + if($verbose) { + print STDERR "IN: $full\n"; + } + + my $ok = $commandok{$FTPCMD}; + if($ok !~ /$state/) { + print "500 $FTPCMD not OK in state: $state!\r\n"; + next; + } + + my $newstate=$statechange{$FTPCMD}; + if($newstate eq "") { + # remain in the same state + } + else { + $state = $newstate; + } + + my $delay = $delayreply{$FTPCMD}; + if($delay) { + # just go sleep this many seconds! + sleep($delay); + } + + my $text; + $text = $customreply{$FTPCMD}; + my $fake = $text; + if($text eq "") { + $text = $displaytext{$FTPCMD}; + } + else { + logmsg "$FTPCMD made to send '$text'\n"; + } + if($text) { + print "$text\r\n"; + } + + if($fake eq "") { + # only perform this if we're not faking a reply + # see if the new state is a function caller. + my $func = $commandfunc{$FTPCMD}; + if($func) { + # it is! + \&$func($FTPARG, $FTPCMD); + } + } + + logmsg "set to state $state\n"; + + } # while(1) + close(Client); + close(Client2); +} |