1
0
mirror of https://github.com/moparisthebest/curl synced 2024-12-21 23:58:49 -05:00
curl/tests/ftpserver.pl
Daniel Stenberg 265bb99382 test case 126 added, this uses RETRWEIRDO that makes the FTP server send two
responses at once, to excerise the part of curl to make sure it can cache
(parts of) responses properly.
2001-12-03 13:46:56 +00:00

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);
}