265bb99382
responses at once, to excerise the part of curl to make sure it can cache (parts of) responses properly.
503 lines
13 KiB
Perl
503 lines
13 KiB
Perl
#!/usr/bin/perl
|
|
#
|
|
# $Id$
|
|
# 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);
|
|
}
|