mirror of
https://github.com/moparisthebest/curl
synced 2024-08-13 17:03:50 -04:00
74ddbd8a3b
server holds not only its two main pids, but also the pidfile of the test server and the 'slavepidfiles' for ftp* servers. This allows a better control when stopping servers. Now from runtests.pl when test servers are stopped they are signalled in sequence TERM, INT and KILL allowing time in between for them to die. This will give us a chance of gracefully stopping test servers, which we didn't have when we were killing them in first instance.
874 lines
23 KiB
Perl
874 lines
23 KiB
Perl
#!/usr/bin/env perl
|
|
#***************************************************************************
|
|
# _ _ ____ _
|
|
# Project ___| | | | _ \| |
|
|
# / __| | | | |_) | |
|
|
# | (__| |_| | _ <| |___
|
|
# \___|\___/|_| \_\_____|
|
|
#
|
|
# Copyright (C) 1998 - 2006, Daniel Stenberg, <daniel@haxx.se>, et al.
|
|
#
|
|
# This software is licensed as described in the file COPYING, which
|
|
# you should have received as part of this distribution. The terms
|
|
# are also available at http://curl.haxx.se/docs/copyright.html.
|
|
#
|
|
# You may opt to use, copy, modify, merge, publish, distribute and/or sell
|
|
# copies of the Software, and permit persons to whom the Software is
|
|
# furnished to do so, under the terms of the COPYING file.
|
|
#
|
|
# This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY
|
|
# KIND, either express or implied.
|
|
#
|
|
# $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.
|
|
#
|
|
# All socket/network/TCP related stuff is done by the 'sockfilt' program.
|
|
#
|
|
|
|
use strict;
|
|
use IPC::Open2;
|
|
#use Time::HiRes qw( gettimeofday ); # not available in perl 5.6
|
|
|
|
require "getpart.pm";
|
|
require "ftp.pm";
|
|
|
|
|
|
my $ftpdnum="";
|
|
|
|
# open and close each time to allow removal at any time
|
|
sub logmsg {
|
|
# if later than perl 5.6 is used
|
|
# my ($seconds, $microseconds) = gettimeofday;
|
|
my $seconds = time();
|
|
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
|
|
localtime($seconds);
|
|
open(FTPLOG, ">>log/ftpd$ftpdnum.log");
|
|
printf FTPLOG ("%02d:%02d:%02d ", $hour, $min, $sec);
|
|
print FTPLOG @_;
|
|
close(FTPLOG);
|
|
}
|
|
|
|
sub ftpmsg {
|
|
# append to the server.input file
|
|
open(INPUT, ">>log/server$ftpdnum.input") ||
|
|
logmsg "failed to open log/server$ftpdnum.input\n";
|
|
|
|
print INPUT @_;
|
|
close(INPUT);
|
|
|
|
# use this, open->print->close system only to make the file
|
|
# open as little as possible, to make the test suite run
|
|
# better on windows/cygwin
|
|
}
|
|
|
|
my $verbose=0; # set to 1 for debugging
|
|
my $pasvbadip=0;
|
|
my $retrweirdo=0;
|
|
my $retrnosize=0;
|
|
my $srcdir=".";
|
|
my $nosave=0;
|
|
my $controldelay=0; # set to 1 to delay the control connect data sending to
|
|
# test that curl deals with that nicely
|
|
my $slavepid; # for the DATA connection sockfilt slave process
|
|
my $ipv6;
|
|
my $ext; # append to log/pid file names
|
|
my $grok_eprt;
|
|
my $port = 8921; # just a default
|
|
my $pidfile = ".ftpd.pid"; # a default, use --pidfile
|
|
|
|
do {
|
|
if($ARGV[0] eq "-v") {
|
|
$verbose=1;
|
|
}
|
|
elsif($ARGV[0] eq "-s") {
|
|
$srcdir=$ARGV[1];
|
|
shift @ARGV;
|
|
}
|
|
elsif($ARGV[0] eq "--id") {
|
|
$ftpdnum=$ARGV[1];
|
|
shift @ARGV;
|
|
}
|
|
elsif($ARGV[0] eq "--pidfile") {
|
|
$pidfile=$ARGV[1];
|
|
shift @ARGV;
|
|
}
|
|
elsif($ARGV[0] eq "--ipv6") {
|
|
$ipv6="--ipv6";
|
|
$ext="ipv6";
|
|
$grok_eprt = 1;
|
|
}
|
|
elsif($ARGV[0] eq "--port") {
|
|
$port = $ARGV[1];
|
|
shift @ARGV;
|
|
}
|
|
} while(shift @ARGV);
|
|
|
|
sub catch_zap {
|
|
my $signame = shift;
|
|
print STDERR "ftpserver.pl received SIG$signame, exiting\n";
|
|
ftpkillslaves();
|
|
die "Somebody sent me a SIG$signame";
|
|
}
|
|
$SIG{INT} = \&catch_zap;
|
|
$SIG{KILL} = \&catch_zap;
|
|
|
|
my $sfpid;
|
|
|
|
local(*SFREAD, *SFWRITE);
|
|
|
|
|
|
sub startsf {
|
|
my $cmd="./server/sockfilt --port $port --logfile log/sockctrl$ftpdnum$ext.log --pidfile .sockfilt$ftpdnum$ext.pid $ipv6";
|
|
$sfpid = open2(*SFREAD, *SFWRITE, $cmd);
|
|
|
|
print STDERR "$cmd\n" if($verbose);
|
|
|
|
print SFWRITE "PING\n";
|
|
my $pong;
|
|
sysread SFREAD, $pong, 5;
|
|
|
|
if($pong !~ /^PONG/) {
|
|
logmsg "Failed sockfilt command: $cmd\n";
|
|
kill(9, $sfpid);
|
|
die "Failed to start sockfilt!";
|
|
}
|
|
}
|
|
|
|
# remove the file here so that if startsf() fails, it is very noticable
|
|
unlink($pidfile);
|
|
|
|
startsf();
|
|
|
|
logmsg sprintf("FTP server listens on port IPv%d/$port\n", $ipv6?6:4);
|
|
open(PID, ">$pidfile");
|
|
print PID $$."\n";
|
|
close(PID);
|
|
|
|
logmsg("logged pid $$ in $pidfile\n");
|
|
|
|
sub sockfilt {
|
|
my $l;
|
|
foreach $l (@_) {
|
|
printf SFWRITE "DATA\n%04x\n", length($l);
|
|
print SFWRITE $l;
|
|
}
|
|
}
|
|
|
|
|
|
# Send data to the client on the control stream, which happens to be plain
|
|
# stdout.
|
|
|
|
sub sendcontrol {
|
|
if(!$controldelay) {
|
|
# spit it all out at once
|
|
sockfilt @_;
|
|
}
|
|
else {
|
|
my $a = join("", @_);
|
|
my @a = split("", $a);
|
|
|
|
for(@a) {
|
|
sockfilt $_;
|
|
select(undef, undef, undef, 0.01);
|
|
}
|
|
}
|
|
my $log;
|
|
foreach $log (@_) {
|
|
my $l = $log;
|
|
$l =~ s/[\r\n]//g;
|
|
logmsg "> \"$l\"\n";
|
|
}
|
|
}
|
|
|
|
# Send data to the client on the data stream
|
|
|
|
sub senddata {
|
|
my $l;
|
|
foreach $l (@_) {
|
|
printf DWRITE "DATA\n%04x\n", length($l);
|
|
print DWRITE $l;
|
|
}
|
|
}
|
|
|
|
# USER is ok in fresh state
|
|
my %commandok = (
|
|
'USER' => 'fresh|passwd',
|
|
'PASS' => 'passwd',
|
|
'PASV' => 'loggedin|twosock',
|
|
'EPSV' => 'loggedin|twosock',
|
|
'PORT' => 'loggedin|twosock',
|
|
'EPRT' => 'loggedin|twosock',
|
|
'TYPE' => 'loggedin|twosock',
|
|
'LIST' => 'twosock',
|
|
'NLST' => 'twosock',
|
|
'RETR' => 'twosock',
|
|
'STOR' => 'twosock',
|
|
'APPE' => 'twosock',
|
|
'REST' => 'twosock',
|
|
'ACCT' => 'loggedin',
|
|
'CWD' => 'loggedin|twosock',
|
|
'SYST' => 'loggedin',
|
|
'SIZE' => 'loggedin|twosock',
|
|
'PWD' => 'loggedin|twosock',
|
|
'MKD' => 'loggedin|twosock',
|
|
'QUIT' => 'loggedin|twosock',
|
|
'RNFR' => 'loggedin|twosock',
|
|
'RNTO' => 'loggedin|twosock',
|
|
'DELE' => 'loggedin|twosock',
|
|
'MDTM' => 'loggedin|twosock',
|
|
'NOOP' => '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
|
|
'EPRT' => 'twosock', # EPRT 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',
|
|
'MKD' => '257 Created your requested directory',
|
|
'REST' => '350 Yeah yeah we set it there for you',
|
|
'DELE' => '200 OK OK OK whatever you say',
|
|
'RNFR' => '350 Received your order. Please provide more',
|
|
'RNTO' => '250 Ok, thanks. File renaming completed.',
|
|
'NOOP' => '200 Yes, I\'m very good at doing nothing.',
|
|
);
|
|
|
|
# callback functions for certain commands
|
|
my %commandfunc = ( 'PORT' => \&PORT_command,
|
|
'EPRT' => \&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
|
|
'MDTM' => \&MDTM_command,
|
|
);
|
|
|
|
|
|
sub close_dataconn {
|
|
my ($closed)=@_; # non-zero if already disconnected
|
|
|
|
if(!$closed) {
|
|
logmsg "* disconnect data connection\n";
|
|
print DWRITE "DISC\n";
|
|
my $i;
|
|
sysread DREAD, $i, 5;
|
|
}
|
|
else {
|
|
logmsg "data connection already disconnected\n";
|
|
}
|
|
logmsg "=====> Closed data connection\n";
|
|
|
|
logmsg "* quit sockfilt for data (pid $slavepid)\n";
|
|
print DWRITE "QUIT\n";
|
|
waitpid $slavepid, 0;
|
|
$slavepid=0;
|
|
}
|
|
|
|
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 LIST data on data connection\n";
|
|
for(@ftpdir) {
|
|
senddata $_;
|
|
}
|
|
close_dataconn(0);
|
|
sendcontrol "226 ASCII transfer complete\r\n";
|
|
return 0;
|
|
}
|
|
|
|
sub NLST_command {
|
|
my @ftpdir=("file", "with space", "fake", "..", " ..", "funny", "README");
|
|
logmsg "pass NLST data on data connection\n";
|
|
for(@ftpdir) {
|
|
senddata "$_\r\n";
|
|
}
|
|
close_dataconn(0);
|
|
sendcontrol "226 ASCII transfer complete\r\n";
|
|
return 0;
|
|
}
|
|
|
|
sub MDTM_command {
|
|
my $testno = $_[0];
|
|
|
|
loadtest("$srcdir/data/test$testno");
|
|
|
|
my @data = getpart("reply", "mdtm");
|
|
|
|
my $reply = $data[0];
|
|
chomp $reply;
|
|
|
|
if($reply <0) {
|
|
sendcontrol "550 $testno: no such file.\r\n";
|
|
}
|
|
elsif($reply) {
|
|
sendcontrol "$reply\r\n";
|
|
}
|
|
else {
|
|
sendcontrol "500 MDTM: no such command.\r\n";
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
sub SIZE_command {
|
|
my $testno = $_[0];
|
|
|
|
loadtest("$srcdir/data/test$testno");
|
|
|
|
if($testno eq "verifiedserver") {
|
|
my $response = "WE ROOLZ: $$\r\n";
|
|
my $size = length($response);
|
|
sendcontrol "213 $size\r\n";
|
|
return 0;
|
|
}
|
|
|
|
my @data = getpart("reply", "size");
|
|
|
|
my $size = $data[0];
|
|
|
|
if($size) {
|
|
if($size > -1) {
|
|
sendcontrol "213 $size\r\n";
|
|
}
|
|
else {
|
|
sendcontrol "550 $testno: No such file or directory.\r\n";
|
|
}
|
|
}
|
|
else {
|
|
$size=0;
|
|
@data = getpart("reply", "data");
|
|
for(@data) {
|
|
$size += length($_);
|
|
}
|
|
if($size) {
|
|
sendcontrol "213 $size\r\n";
|
|
}
|
|
else {
|
|
sendcontrol "550 $testno: No such file or directory.\r\n";
|
|
}
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
sub RETR_command {
|
|
my ($testno) = @_;
|
|
|
|
if($testno =~ /^verifiedserver$/) {
|
|
# this is the secret command that verifies that this actually is
|
|
# the curl test server
|
|
my $response = "WE ROOLZ: $$\r\n";
|
|
my $len = length($response);
|
|
sendcontrol "150 Binary junk ($len bytes).\r\n";
|
|
senddata "WE ROOLZ: $$\r\n";
|
|
close_dataconn(0);
|
|
sendcontrol "226 File transfer complete\r\n";
|
|
if($verbose) {
|
|
print STDERR "FTPD: We returned proof we are the test server\n";
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
$testno =~ s/^([^0-9]*)//;
|
|
|
|
loadtest("$srcdir/data/test$testno");
|
|
|
|
my @data = getpart("reply", "data");
|
|
|
|
my $size=0;
|
|
for(@data) {
|
|
$size += length($_);
|
|
}
|
|
|
|
my %hash = getpartattr("reply", "data");
|
|
|
|
if($size || $hash{'sendzero'}) {
|
|
|
|
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) {
|
|
sendcontrol "150 Binary data connection for $testno () ($size bytes).\r\n",
|
|
"226 File transfer complete\r\n";
|
|
|
|
for(@data) {
|
|
my $send = $_;
|
|
senddata $send;
|
|
}
|
|
close_dataconn(0);
|
|
$retrweirdo=0; # switch off the weirdo again!
|
|
}
|
|
else {
|
|
my $sz = "($size bytes)";
|
|
if($retrnosize) {
|
|
$sz = "size?";
|
|
}
|
|
|
|
sendcontrol "150 Binary data connection for $testno () $sz.\r\n";
|
|
|
|
for(@data) {
|
|
my $send = $_;
|
|
senddata $send;
|
|
}
|
|
close_dataconn(0);
|
|
sendcontrol "226 File transfer complete\r\n";
|
|
}
|
|
}
|
|
else {
|
|
sendcontrol "550 $testno: No such file or directory.\r\n";
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
sub STOR_command {
|
|
my $testno=$_[0];
|
|
|
|
my $filename = "log/upload.$testno";
|
|
|
|
logmsg "STOR test number $testno in $filename\n";
|
|
|
|
sendcontrol "125 Gimme gimme gimme!\r\n";
|
|
|
|
open(FILE, ">$filename") ||
|
|
return 0; # failed to open output
|
|
|
|
my $line;
|
|
my $ulsize=0;
|
|
my $disc=0;
|
|
while (5 == (sysread DREAD, $line, 5)) {
|
|
if($line eq "DATA\n") {
|
|
my $i;
|
|
sysread DREAD, $i, 5;
|
|
|
|
#print STDERR " GOT: $i";
|
|
|
|
my $size = hex($i);
|
|
sysread DREAD, $line, $size;
|
|
|
|
#print STDERR " GOT: $size bytes\n";
|
|
|
|
$ulsize += $size;
|
|
print FILE $line if(!$nosave);
|
|
logmsg "> Appending $size bytes to file\n";
|
|
}
|
|
elsif($line eq "DISC\n") {
|
|
# disconnect!
|
|
$disc=1;
|
|
last;
|
|
}
|
|
else {
|
|
logmsg "No support for: $line";
|
|
last;
|
|
}
|
|
}
|
|
if($nosave) {
|
|
print FILE "$ulsize bytes would've been stored here\n";
|
|
}
|
|
close(FILE);
|
|
close_dataconn($disc);
|
|
logmsg "received $ulsize bytes upload\n";
|
|
sendcontrol "226 File transfer complete\r\n";
|
|
return 0;
|
|
}
|
|
|
|
sub PASV_command {
|
|
my ($arg, $cmd)=@_;
|
|
my $pasvport;
|
|
my $pidf=".sockdata$ftpdnum$ext.pid";
|
|
|
|
my $prev = checkalivepidfile($pidf);
|
|
if($prev > 0) {
|
|
print "kill existing server: $prev\n" if($verbose);
|
|
kill(9, $prev);
|
|
}
|
|
|
|
# We fire up a new sockfilt to do the data tranfer for us.
|
|
$slavepid = open2(\*DREAD, \*DWRITE,
|
|
"./server/sockfilt --port 0 --logfile log/sockdata$ftpdnum$ext.log --pidfile $pidf $ipv6");
|
|
|
|
print DWRITE "PING\n";
|
|
my $pong;
|
|
|
|
sysread(DREAD, $pong, 5) || die;
|
|
|
|
if($pong !~ /^PONG/) {
|
|
kill(9, $slavepid);
|
|
sendcontrol "500 no free ports!\r\n";
|
|
logmsg "failed to run sockfilt for data connection\n";
|
|
return 0;
|
|
}
|
|
|
|
logmsg "Run sockfilt for data on pid $slavepid\n";
|
|
|
|
# Find out what port we listen on
|
|
my $i;
|
|
print DWRITE "PORT\n";
|
|
|
|
# READ the response code
|
|
sysread(DREAD, $i, 5) || die;
|
|
|
|
# READ the response size
|
|
sysread(DREAD, $i, 5) || die;
|
|
|
|
my $size = hex($i);
|
|
|
|
# READ the response data
|
|
sysread(DREAD, $i, $size) || die;
|
|
|
|
# The data is in the format
|
|
# IPvX/NNN
|
|
|
|
if($i =~ /IPv(\d)\/(\d+)/) {
|
|
# FIX: deal with IP protocol version
|
|
$pasvport = $2;
|
|
}
|
|
|
|
if($cmd ne "EPSV") {
|
|
# PASV reply
|
|
my $p="127,0,0,1";
|
|
if($pasvbadip) {
|
|
$p="1,2,3,4";
|
|
}
|
|
sendcontrol sprintf("227 Entering Passive Mode ($p,%d,%d)\n",
|
|
($pasvport/256), ($pasvport%256));
|
|
}
|
|
else {
|
|
# EPSV reply
|
|
sendcontrol sprintf("229 Entering Passive Mode (|||%d|)\n", $pasvport);
|
|
}
|
|
|
|
eval {
|
|
local $SIG{ALRM} = sub { die "alarm\n" };
|
|
|
|
# assume swift operations unless explicitly slow
|
|
alarm ($controldelay?20:5);
|
|
|
|
# Wait for 'CNCT'
|
|
my $input;
|
|
|
|
while(sysread(DREAD, $input, 5)) {
|
|
|
|
if($input !~ /^CNCT/) {
|
|
# we wait for a connected client
|
|
logmsg "Odd, we got $input from client\n";
|
|
next;
|
|
}
|
|
logmsg "====> Client DATA connect\n";
|
|
last;
|
|
}
|
|
alarm 0;
|
|
};
|
|
if ($@) {
|
|
# timed out
|
|
|
|
print DWRITE "QUIT\n";
|
|
waitpid $slavepid, 0;
|
|
logmsg "accept failed\n";
|
|
$slavepid=0;
|
|
return;
|
|
}
|
|
else {
|
|
logmsg "data connection setup on port $pasvport\n";
|
|
}
|
|
|
|
return;
|
|
}
|
|
|
|
# Support both PORT and EPRT here. Consider LPRT too.
|
|
|
|
sub PORT_command {
|
|
my ($arg, $cmd) = @_;
|
|
my $port;
|
|
|
|
# We always ignore the given IP and use localhost.
|
|
|
|
if($cmd eq "PORT") {
|
|
if($arg !~ /(\d+),(\d+),(\d+),(\d+),(\d+),(\d+)/) {
|
|
logmsg "bad PORT-line: $arg\n";
|
|
sendcontrol "500 silly you, go away\r\n";
|
|
return 0;
|
|
}
|
|
$port = ($5<<8)+$6;
|
|
}
|
|
# EPRT |2|::1|49706|
|
|
elsif(($cmd eq "EPRT") && ($grok_eprt)) {
|
|
if($arg !~ /(\d+)\|([^\|]+)\|(\d+)/) {
|
|
sendcontrol "500 silly you, go away\r\n";
|
|
return 0;
|
|
}
|
|
sendcontrol "200 Thanks for dropping by. We contact you later\r\n";
|
|
$port = $3;
|
|
}
|
|
else {
|
|
sendcontrol "500 we don't like $cmd now\r\n";
|
|
return 0;
|
|
}
|
|
|
|
if(!$port || $port > 65535) {
|
|
print STDERR "very illegal PORT number: $port\n";
|
|
return 1;
|
|
}
|
|
|
|
# We fire up a new sockfilt to do the data tranfer for us.
|
|
# FIX: make it use IPv6 if need be
|
|
$slavepid = open2(\*DREAD, \*DWRITE,
|
|
"./server/sockfilt --connect $port --logfile log/sockdata$ftpdnum$ext.log --pidfile .sockdata$ftpdnum$ext.pid $ipv6");
|
|
|
|
print DWRITE "PING\n";
|
|
my $pong;
|
|
sysread DREAD, $pong, 5;
|
|
|
|
if($pong !~ /^PONG/) {
|
|
logmsg "Failed sockfilt for data connection\n";
|
|
kill(9, $slavepid);
|
|
}
|
|
|
|
logmsg "====> Client DATA connect to port $port\n";
|
|
|
|
return;
|
|
}
|
|
|
|
my %customreply;
|
|
my %customcount;
|
|
my %delayreply;
|
|
sub customize {
|
|
undef %customreply;
|
|
|
|
$nosave = 0; # default is to save as normal
|
|
$controldelay = 0; # default is no delaying the responses
|
|
|
|
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;
|
|
logmsg "FTPD: set custom reply for $1\n";
|
|
}
|
|
if($_ =~ /COUNT ([A-Z]+) (.*)/) {
|
|
# we blank the customreply for this command when having
|
|
# been used this number of times
|
|
$customcount{$1}=$2;
|
|
logmsg "FTPD: blank custom reply for $1 after $2 uses\n";
|
|
}
|
|
elsif($_ =~ /DELAY ([A-Z]+) (\d*)/) {
|
|
$delayreply{$1}=$2;
|
|
logmsg "FTPD: delay reply for $1 with $2 seconds\n";
|
|
}
|
|
elsif($_ =~ /SLOWDOWN/) {
|
|
$controldelay=1;
|
|
logmsg "FTPD: send response with 0.1 sec delay between each byte\n";
|
|
}
|
|
elsif($_ =~ /RETRWEIRDO/) {
|
|
logmsg "FTPD: instructed to use RETRWEIRDO\n";
|
|
$retrweirdo=1;
|
|
}
|
|
elsif($_ =~ /RETRNOSIZE/) {
|
|
logmsg "FTPD: instructed to use RETRNOSIZE\n";
|
|
$retrnosize=1;
|
|
}
|
|
elsif($_ =~ /PASVBADIP/) {
|
|
logmsg "FTPD: instructed to use PASVBADIP\n";
|
|
$pasvbadip=1;
|
|
}
|
|
elsif($_ =~ /NOSAVE/) {
|
|
# don't actually store the file we upload - to be used when
|
|
# uploading insanely huge amounts
|
|
$nosave = 1;
|
|
logmsg "FTPD: NOSAVE prevents saving of uploaded data\n";
|
|
}
|
|
}
|
|
close(CUSTOM);
|
|
}
|
|
|
|
my @welcome=(
|
|
'220- _ _ ____ _ '."\r\n",
|
|
'220- ___| | | | _ \| | '."\r\n",
|
|
'220- / __| | | | |_) | | '."\r\n",
|
|
'220- | (__| |_| | _ <| |___ '."\r\n",
|
|
'220 \___|\___/|_| \_\_____|'."\r\n");
|
|
|
|
|
|
while(1) {
|
|
#
|
|
# We read 'sockfilt' commands.
|
|
#
|
|
my $input;
|
|
|
|
logmsg "Awaiting input\n";
|
|
sysread(SFREAD, $input, 5) || die "ftp$ftpdnum$ext read zero";
|
|
|
|
if($input !~ /^CNCT/) {
|
|
# we wait for a connected client
|
|
logmsg "sockfilt said: $input";
|
|
next;
|
|
}
|
|
logmsg "====> Client connect\n";
|
|
|
|
# flush data:
|
|
$| = 1;
|
|
|
|
kill(9, $slavepid) if($slavepid);
|
|
$slavepid=0;
|
|
|
|
&customize(); # read test control instructions
|
|
|
|
sendcontrol @welcome;
|
|
if($verbose) {
|
|
for(@welcome) {
|
|
print STDERR "OUT: $_";
|
|
}
|
|
}
|
|
my $state="fresh";
|
|
|
|
while(1) {
|
|
my $i;
|
|
|
|
# Now we expect to read DATA\n[hex size]\n[prot], where the [prot]
|
|
# part only is FTP lingo.
|
|
|
|
# COMMAND
|
|
sysread(SFREAD, $i, 5) || die "ftp$ftpdnum$ext read zero";
|
|
|
|
if($i !~ /^DATA/) {
|
|
logmsg "sockfilt said $i";
|
|
if($i =~ /^DISC/) {
|
|
# disconnect
|
|
last;
|
|
}
|
|
next;
|
|
}
|
|
|
|
# SIZE of data
|
|
sysread(SFREAD, $i, 5) || die;
|
|
my $size = hex($i);
|
|
|
|
# data
|
|
sysread SFREAD, $_, $size;
|
|
|
|
ftpmsg $_;
|
|
|
|
# Remove trailing CRLF.
|
|
s/[\n\r]+$//;
|
|
|
|
unless (m/^([A-Z]{3,4})\s?(.*)/i) {
|
|
sendcontrol "500 '$_': command not understood.\r\n";
|
|
last;
|
|
}
|
|
my $FTPCMD=$1;
|
|
my $FTPARG=$2;
|
|
my $full=$_;
|
|
|
|
logmsg "< \"$full\"\n";
|
|
|
|
if($verbose) {
|
|
print STDERR "IN: $full\n";
|
|
}
|
|
|
|
my $ok = $commandok{$FTPCMD};
|
|
if($ok !~ /$state/) {
|
|
sendcontrol "500 $FTPCMD not OK in state: $state!\r\n";
|
|
next;
|
|
}
|
|
|
|
my $newstate=$statechange{$FTPCMD};
|
|
if($newstate eq "") {
|
|
# remain in the same state
|
|
}
|
|
else {
|
|
|
|
if($state != $newstate) {
|
|
logmsg "switch to state $state\n";
|
|
}
|
|
$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 {
|
|
if($customcount{$FTPCMD} && (!--$customcount{$FTPCMD})) {
|
|
# used enough number of times, now blank the customreply
|
|
$customreply{$FTPCMD}="";
|
|
}
|
|
}
|
|
if($text) {
|
|
sendcontrol "$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);
|
|
}
|
|
}
|
|
|
|
} # while(1)
|
|
logmsg "====> Client disconnected\n";
|
|
}
|
|
|
|
print SFWRITE "QUIT\n";
|
|
waitpid $sfpid, 0;
|
|
exit;
|