mirror of
https://github.com/curl/curl.git
synced 2024-11-27 05:50:21 +08:00
2fbbddbe85
Introduced in the initial gopher commits, there was added logic to do GOPHER test serving in the pingpong server but as it resembles HTTP much more than FTP or SMTP, the gopher testing has been moved over to instead use the sws (HTTP) server. This change simply removes unused code.
1575 lines
42 KiB
Perl
Executable File
1575 lines
42 KiB
Perl
Executable File
#!/usr/bin/env perl
|
|
#***************************************************************************
|
|
# _ _ ____ _
|
|
# Project ___| | | | _ \| |
|
|
# / __| | | | |_) | |
|
|
# | (__| |_| | _ <| |___
|
|
# \___|\___/|_| \_\_____|
|
|
#
|
|
# Copyright (C) 1998 - 2010, 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.
|
|
#
|
|
###########################################################################
|
|
|
|
# This is a server designed for the curl test suite.
|
|
#
|
|
# In December 2009 we started remaking the server to support more protocols
|
|
# that are similar in spirit. Like POP3, IMAP and SMTP in addition to the FTP
|
|
# it already supported since a long time. Note that it still only supports one
|
|
# protocol per invoke. You need to start mulitple servers to support multiple
|
|
# protocols simultaneously.
|
|
#
|
|
# 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.
|
|
#
|
|
|
|
BEGIN {
|
|
@INC=(@INC, $ENV{'srcdir'}, '.');
|
|
# sub second timestamping needs Time::HiRes
|
|
eval {
|
|
no warnings "all";
|
|
require Time::HiRes;
|
|
import Time::HiRes qw( gettimeofday );
|
|
}
|
|
}
|
|
|
|
use strict;
|
|
use warnings;
|
|
use IPC::Open2;
|
|
|
|
require "getpart.pm";
|
|
require "ftp.pm";
|
|
require "directories.pm";
|
|
|
|
use serverhelp qw(
|
|
servername_str
|
|
server_pidfilename
|
|
server_logfilename
|
|
mainsockf_pidfilename
|
|
mainsockf_logfilename
|
|
datasockf_pidfilename
|
|
datasockf_logfilename
|
|
);
|
|
|
|
#**********************************************************************
|
|
# global vars...
|
|
#
|
|
my $verbose = 0; # set to 1 for debugging
|
|
my $idstr = ""; # server instance string
|
|
my $idnum = 1; # server instance number
|
|
my $ipvnum = 4; # server IPv number (4 or 6)
|
|
my $proto = 'ftp'; # default server protocol
|
|
my $srcdir; # directory where ftpserver.pl is located
|
|
my $srvrname; # server name for presentation purposes
|
|
my $grok_eprt;
|
|
|
|
my $path = '.';
|
|
my $logdir = $path .'/log';
|
|
|
|
#**********************************************************************
|
|
# global vars used for server address and primary listener port
|
|
#
|
|
my $port = 8921; # default primary listener port
|
|
my $listenaddr = '127.0.0.1'; # default address for listener port
|
|
|
|
#**********************************************************************
|
|
# global vars used for file names
|
|
#
|
|
my $pidfile; # server pid file name
|
|
my $logfile; # server log file name
|
|
my $mainsockf_pidfile; # pid file for primary connection sockfilt process
|
|
my $mainsockf_logfile; # log file for primary connection sockfilt process
|
|
my $datasockf_pidfile; # pid file for secondary connection sockfilt process
|
|
my $datasockf_logfile; # log file for secondary connection sockfilt process
|
|
|
|
#**********************************************************************
|
|
# global vars used for server logs advisor read lock handling
|
|
#
|
|
my $SERVERLOGS_LOCK = 'log/serverlogs.lock';
|
|
my $serverlogslocked = 0;
|
|
|
|
#**********************************************************************
|
|
# global vars used for child processes PID tracking
|
|
#
|
|
my $sfpid; # PID for primary connection sockfilt process
|
|
my $slavepid; # PID for secondary connection sockfilt process
|
|
|
|
#**********************************************************************
|
|
# global typeglob filehandle vars to read/write from/to sockfilters
|
|
#
|
|
local *SFREAD; # used to read from primary connection
|
|
local *SFWRITE; # used to write to primary connection
|
|
local *DREAD; # used to read from secondary connection
|
|
local *DWRITE; # used to write to secondary connection
|
|
|
|
#**********************************************************************
|
|
# global vars which depend on server protocol selection
|
|
#
|
|
my %commandfunc; # protocol command specific function callbacks
|
|
my %displaytext; # text returned to client before callback runs
|
|
my @welcome; # text returned to client upon connection
|
|
|
|
#**********************************************************************
|
|
# global vars customized for each test from the server commands file
|
|
#
|
|
my $ctrldelay; # set if server should throttle ctrl stream
|
|
my $datadelay; # set if server should throttle data stream
|
|
my $retrweirdo; # set if ftp server should use RETRWEIRDO
|
|
my $retrnosize; # set if ftp server should use RETRNOSIZE
|
|
my $pasvbadip; # set if ftp server should use PASVBADIP
|
|
my $nosave; # set if ftp server should not save uploaded data
|
|
my %customreply; #
|
|
my %customcount; #
|
|
my %delayreply; #
|
|
|
|
#**********************************************************************
|
|
# global variables for to test ftp wildcardmatching or other test that
|
|
# need flexible LIST responses.. and corresponding files.
|
|
# $ftptargetdir is keeping the fake "name" of LIST directory.
|
|
my $ftplistparserstate;
|
|
my $ftptargetdir;
|
|
|
|
#**********************************************************************
|
|
# global vars used for signal handling
|
|
#
|
|
my $got_exit_signal = 0; # set if program should finish execution ASAP
|
|
my $exit_signal; # first signal handled in exit_signal_handler
|
|
|
|
#**********************************************************************
|
|
# exit_signal_handler will be triggered to indicate that the program
|
|
# should finish its execution in a controlled way as soon as possible.
|
|
# For now, program will also terminate from within this handler.
|
|
#
|
|
sub exit_signal_handler {
|
|
my $signame = shift;
|
|
# For now, simply mimic old behavior.
|
|
killsockfilters($proto, $ipvnum, $idnum, $verbose);
|
|
unlink($pidfile);
|
|
if($serverlogslocked) {
|
|
$serverlogslocked = 0;
|
|
clear_advisor_read_lock($SERVERLOGS_LOCK);
|
|
}
|
|
exit;
|
|
}
|
|
|
|
#**********************************************************************
|
|
# logmsg is general message logging subroutine for our test servers.
|
|
#
|
|
sub logmsg {
|
|
my $now;
|
|
# sub second timestamping needs Time::HiRes
|
|
if($Time::HiRes::VERSION) {
|
|
my ($seconds, $usec) = gettimeofday();
|
|
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
|
|
localtime($seconds);
|
|
$now = sprintf("%02d:%02d:%02d.%06d ", $hour, $min, $sec, $usec);
|
|
}
|
|
else {
|
|
my $seconds = time();
|
|
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
|
|
localtime($seconds);
|
|
$now = sprintf("%02d:%02d:%02d ", $hour, $min, $sec);
|
|
}
|
|
if(open(LOGFILEFH, ">>$logfile")) {
|
|
print LOGFILEFH $now;
|
|
print LOGFILEFH @_;
|
|
close(LOGFILEFH);
|
|
}
|
|
}
|
|
|
|
sub ftpmsg {
|
|
# append to the server.input file
|
|
open(INPUT, ">>log/server$idstr.input") ||
|
|
logmsg "failed to open log/server$idstr.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
|
|
}
|
|
|
|
|
|
sub sysread_or_die {
|
|
my $FH = shift;
|
|
my $scalar = shift;
|
|
my $length = shift;
|
|
my $fcaller;
|
|
my $lcaller;
|
|
my $result;
|
|
|
|
$result = sysread($$FH, $$scalar, $length);
|
|
|
|
if(not defined $result) {
|
|
($fcaller, $lcaller) = (caller)[1,2];
|
|
logmsg "Failed to read input\n";
|
|
logmsg "Error: $srvrname server, sysread error: $!\n";
|
|
logmsg "Exited from sysread_or_die() at $fcaller " .
|
|
"line $lcaller. $srvrname server, sysread error: $!\n";
|
|
killsockfilters($proto, $ipvnum, $idnum, $verbose);
|
|
unlink($pidfile);
|
|
if($serverlogslocked) {
|
|
$serverlogslocked = 0;
|
|
clear_advisor_read_lock($SERVERLOGS_LOCK);
|
|
}
|
|
exit;
|
|
}
|
|
elsif($result == 0) {
|
|
($fcaller, $lcaller) = (caller)[1,2];
|
|
logmsg "Failed to read input\n";
|
|
logmsg "Error: $srvrname server, read zero\n";
|
|
logmsg "Exited from sysread_or_die() at $fcaller " .
|
|
"line $lcaller. $srvrname server, read zero\n";
|
|
killsockfilters($proto, $ipvnum, $idnum, $verbose);
|
|
unlink($pidfile);
|
|
if($serverlogslocked) {
|
|
$serverlogslocked = 0;
|
|
clear_advisor_read_lock($SERVERLOGS_LOCK);
|
|
}
|
|
exit;
|
|
}
|
|
|
|
return $result;
|
|
}
|
|
|
|
sub startsf {
|
|
my $mainsockfcmd = "./server/sockfilt " .
|
|
"--ipv$ipvnum --port $port " .
|
|
"--pidfile \"$mainsockf_pidfile\" " .
|
|
"--logfile \"$mainsockf_logfile\"";
|
|
$sfpid = open2(*SFREAD, *SFWRITE, $mainsockfcmd);
|
|
|
|
print STDERR "$mainsockfcmd\n" if($verbose);
|
|
|
|
print SFWRITE "PING\n";
|
|
my $pong;
|
|
sysread_or_die(\*SFREAD, \$pong, 5);
|
|
|
|
if($pong !~ /^PONG/) {
|
|
logmsg "Failed sockfilt command: $mainsockfcmd\n";
|
|
killsockfilters($proto, $ipvnum, $idnum, $verbose);
|
|
unlink($pidfile);
|
|
if($serverlogslocked) {
|
|
$serverlogslocked = 0;
|
|
clear_advisor_read_lock($SERVERLOGS_LOCK);
|
|
}
|
|
die "Failed to start sockfilt!";
|
|
}
|
|
}
|
|
|
|
|
|
sub sockfilt {
|
|
my $l;
|
|
foreach $l (@_) {
|
|
printf SFWRITE "DATA\n%04x\n", length($l);
|
|
print SFWRITE $l;
|
|
}
|
|
}
|
|
|
|
|
|
sub sockfiltsecondary {
|
|
my $l;
|
|
foreach $l (@_) {
|
|
printf DWRITE "DATA\n%04x\n", length($l);
|
|
print DWRITE $l;
|
|
}
|
|
}
|
|
|
|
|
|
# Send data to the client on the control stream, which happens to be plain
|
|
# stdout.
|
|
|
|
sub sendcontrol {
|
|
if(!$ctrldelay) {
|
|
# 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 (@_) {
|
|
if(!$datadelay) {
|
|
# spit it all out at once
|
|
sockfiltsecondary $l;
|
|
}
|
|
else {
|
|
# pause between each byte
|
|
for (split(//,$l)) {
|
|
sockfiltsecondary $_;
|
|
select(undef, undef, undef, 0.01);
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
#**********************************************************************
|
|
# protocolsetup initializes the 'displaytext' and 'commandfunc' hashes
|
|
# for the given protocol. References to protocol command callbacks are
|
|
# stored in 'commandfunc' hash, and text which will be returned to the
|
|
# client before the command callback runs is stored in 'displaytext'.
|
|
#
|
|
sub protocolsetup {
|
|
my $proto = $_[0];
|
|
|
|
if($proto eq 'ftp') {
|
|
%commandfunc = (
|
|
'PORT' => \&PORT_ftp,
|
|
'EPRT' => \&PORT_ftp,
|
|
'LIST' => \&LIST_ftp,
|
|
'NLST' => \&NLST_ftp,
|
|
'PASV' => \&PASV_ftp,
|
|
'CWD' => \&CWD_ftp,
|
|
'PWD' => \&PWD_ftp,
|
|
'EPSV' => \&PASV_ftp,
|
|
'RETR' => \&RETR_ftp,
|
|
'SIZE' => \&SIZE_ftp,
|
|
'REST' => \&REST_ftp,
|
|
'STOR' => \&STOR_ftp,
|
|
'APPE' => \&STOR_ftp, # append looks like upload
|
|
'MDTM' => \&MDTM_ftp,
|
|
);
|
|
%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
|
|
'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.',
|
|
'PBSZ' => '500 PBSZ not implemented',
|
|
'PROT' => '500 PROT not implemented',
|
|
);
|
|
@welcome = (
|
|
'220- _ _ ____ _ '."\r\n",
|
|
'220- ___| | | | _ \| | '."\r\n",
|
|
'220- / __| | | | |_) | | '."\r\n",
|
|
'220- | (__| |_| | _ <| |___ '."\r\n",
|
|
'220 \___|\___/|_| \_\_____|'."\r\n"
|
|
);
|
|
}
|
|
elsif($proto eq 'pop3') {
|
|
%commandfunc = (
|
|
'RETR' => \&RETR_pop3,
|
|
);
|
|
%displaytext = (
|
|
'USER' => '+OK We are happy you popped in!',
|
|
'PASS' => '+OK Access granted',
|
|
'QUIT' => '+OK byebye',
|
|
);
|
|
@welcome = (
|
|
' _ _ ____ _ '."\r\n",
|
|
' ___| | | | _ \| | '."\r\n",
|
|
' / __| | | | |_) | | '."\r\n",
|
|
' | (__| |_| | _ <| |___ '."\r\n",
|
|
' \___|\___/|_| \_\_____|'."\r\n",
|
|
'+OK cURL POP3 server ready to serve'."\r\n"
|
|
);
|
|
}
|
|
elsif($proto eq 'imap') {
|
|
%commandfunc = (
|
|
'FETCH' => \&FETCH_imap,
|
|
'SELECT' => \&SELECT_imap,
|
|
);
|
|
%displaytext = (
|
|
'LOGIN' => ' OK We are happy you popped in!',
|
|
'SELECT' => ' OK selection done',
|
|
'LOGOUT' => ' OK thanks for the fish',
|
|
);
|
|
@welcome = (
|
|
' _ _ ____ _ '."\r\n",
|
|
' ___| | | | _ \| | '."\r\n",
|
|
' / __| | | | |_) | | '."\r\n",
|
|
' | (__| |_| | _ <| |___ '."\r\n",
|
|
' \___|\___/|_| \_\_____|'."\r\n",
|
|
'* OK cURL IMAP server ready to serve'."\r\n"
|
|
);
|
|
}
|
|
elsif($proto eq 'smtp') {
|
|
%commandfunc = (
|
|
'DATA' => \&DATA_smtp,
|
|
'RCPT' => \&RCPT_smtp,
|
|
);
|
|
%displaytext = (
|
|
'EHLO' => '230 We are happy you popped in!',
|
|
'MAIL' => '200 Note taken',
|
|
'RCPT' => '200 Receivers accepted',
|
|
'QUIT' => '200 byebye',
|
|
);
|
|
@welcome = (
|
|
'220- _ _ ____ _ '."\r\n",
|
|
'220- ___| | | | _ \| | '."\r\n",
|
|
'220- / __| | | | |_) | | '."\r\n",
|
|
'220- | (__| |_| | _ <| |___ '."\r\n",
|
|
'220 \___|\___/|_| \_\_____|'."\r\n"
|
|
);
|
|
}
|
|
}
|
|
|
|
sub close_dataconn {
|
|
my ($closed)=@_; # non-zero if already disconnected
|
|
|
|
my $datapid = processexists($datasockf_pidfile);
|
|
|
|
if(!$closed) {
|
|
logmsg "* disconnect data connection\n";
|
|
if($datapid > 0) {
|
|
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 $datapid)\n";
|
|
if($datapid > 0) {
|
|
print DWRITE "QUIT\n";
|
|
waitpid($datapid, 0);
|
|
unlink($datasockf_pidfile) if(-f $datasockf_pidfile);
|
|
}
|
|
}
|
|
|
|
################
|
|
################ SMTP commands
|
|
################
|
|
|
|
# what set by "RCPT"
|
|
my $smtp_rcpt;
|
|
|
|
sub DATA_smtp {
|
|
my $testno;
|
|
|
|
if($smtp_rcpt =~ /^TO:(.*)/) {
|
|
$testno = $1;
|
|
}
|
|
else {
|
|
return; # failure
|
|
}
|
|
|
|
if($testno eq "<verifiedserver>") {
|
|
sendcontrol "554 WE ROOLZ: $$\r\n";
|
|
return 0; # don't wait for data now
|
|
}
|
|
else {
|
|
$testno =~ s/^([^0-9]*)([0-9]+).*/$2/;
|
|
sendcontrol "354 Show me the mail\r\n";
|
|
}
|
|
|
|
logmsg "===> rcpt $testno was $smtp_rcpt\n";
|
|
|
|
my $filename = "log/upload.$testno";
|
|
|
|
logmsg "Store test number $testno in $filename\n";
|
|
|
|
open(FILE, ">$filename") ||
|
|
return 0; # failed to open output
|
|
|
|
my $line;
|
|
my $ulsize=0;
|
|
my $disc=0;
|
|
my $raw;
|
|
while (5 == (sysread \*SFREAD, $line, 5)) {
|
|
if($line eq "DATA\n") {
|
|
my $i;
|
|
my $eob;
|
|
sysread \*SFREAD, $i, 5;
|
|
|
|
my $size = 0;
|
|
if($i =~ /^([0-9a-fA-F]{4})\n/) {
|
|
$size = hex($1);
|
|
}
|
|
|
|
sysread \*SFREAD, $line, $size;
|
|
|
|
$ulsize += $size;
|
|
print FILE $line if(!$nosave);
|
|
|
|
$raw .= $line;
|
|
if($raw =~ /\x0d\x0a\x2e\x0d\x0a/) {
|
|
# end of data marker!
|
|
$eob = 1;
|
|
}
|
|
logmsg "> Appending $size bytes to file\n";
|
|
if($eob) {
|
|
logmsg "Found SMTP EOB marker\n";
|
|
last;
|
|
}
|
|
}
|
|
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);
|
|
sendcontrol "250 OK, data received!\r\n";
|
|
logmsg "received $ulsize bytes upload\n";
|
|
|
|
}
|
|
|
|
sub RCPT_smtp {
|
|
my ($args) = @_;
|
|
|
|
$smtp_rcpt = $args;
|
|
}
|
|
|
|
################
|
|
################ IMAP commands
|
|
################
|
|
|
|
# global to allow the command functions to read it
|
|
my $cmdid;
|
|
|
|
# what was picked by SELECT
|
|
my $selected;
|
|
|
|
sub SELECT_imap {
|
|
my ($testno) = @_;
|
|
my @data;
|
|
my $size;
|
|
|
|
logmsg "SELECT_imap got test $testno\n";
|
|
|
|
$selected = $testno;
|
|
|
|
return 0;
|
|
}
|
|
|
|
|
|
sub FETCH_imap {
|
|
my ($testno) = @_;
|
|
my @data;
|
|
my $size;
|
|
|
|
logmsg "FETCH_imap got test $testno\n";
|
|
|
|
$testno = $selected;
|
|
|
|
if($testno =~ /^verifiedserver$/) {
|
|
# this is the secret command that verifies that this actually is
|
|
# the curl test server
|
|
my $response = "WE ROOLZ: $$\r\n";
|
|
if($verbose) {
|
|
print STDERR "FTPD: We returned proof we are the test server\n";
|
|
}
|
|
$data[0] = $response;
|
|
logmsg "return proof we are we\n";
|
|
}
|
|
else {
|
|
logmsg "retrieve a mail\n";
|
|
|
|
$testno =~ s/^([^0-9]*)//;
|
|
my $testpart = "";
|
|
if ($testno > 10000) {
|
|
$testpart = $testno % 10000;
|
|
$testno = int($testno / 10000);
|
|
}
|
|
|
|
# send mail content
|
|
loadtest("$srcdir/data/test$testno");
|
|
|
|
@data = getpart("reply", "data$testpart");
|
|
}
|
|
|
|
for (@data) {
|
|
$size += length($_);
|
|
}
|
|
|
|
sendcontrol "* FETCH starts {$size}\r\n";
|
|
|
|
for my $d (@data) {
|
|
sendcontrol $d;
|
|
}
|
|
|
|
sendcontrol "$cmdid OK FETCH completed\r\n";
|
|
|
|
return 0;
|
|
}
|
|
|
|
################
|
|
################ POP3 commands
|
|
################
|
|
|
|
sub RETR_pop3 {
|
|
my ($testno) = @_;
|
|
my @data;
|
|
|
|
if($testno =~ /^verifiedserver$/) {
|
|
# this is the secret command that verifies that this actually is
|
|
# the curl test server
|
|
my $response = "WE ROOLZ: $$\r\n";
|
|
if($verbose) {
|
|
print STDERR "FTPD: We returned proof we are the test server\n";
|
|
}
|
|
$data[0] = $response;
|
|
logmsg "return proof we are we\n";
|
|
}
|
|
else {
|
|
logmsg "retrieve a mail\n";
|
|
|
|
$testno =~ s/^([^0-9]*)//;
|
|
my $testpart = "";
|
|
if ($testno > 10000) {
|
|
$testpart = $testno % 10000;
|
|
$testno = int($testno / 10000);
|
|
}
|
|
|
|
# send mail content
|
|
loadtest("$srcdir/data/test$testno");
|
|
|
|
@data = getpart("reply", "data$testpart");
|
|
}
|
|
|
|
sendcontrol "+OK Mail transfer starts\r\n";
|
|
|
|
for my $d (@data) {
|
|
sendcontrol $d;
|
|
}
|
|
|
|
# end with the magic 5-byte end of mail marker
|
|
sendcontrol "\r\n.\r\n";
|
|
|
|
return 0;
|
|
}
|
|
|
|
################
|
|
################ FTP commands
|
|
################
|
|
my $rest=0;
|
|
sub REST_ftp {
|
|
$rest = $_[0];
|
|
logmsg "Set REST position to $rest\n"
|
|
}
|
|
|
|
sub switch_directory_goto {
|
|
my $target_dir = $_;
|
|
|
|
if(!$ftptargetdir) {
|
|
$ftptargetdir = "/";
|
|
}
|
|
|
|
if($target_dir eq "") {
|
|
$ftptargetdir = "/";
|
|
}
|
|
elsif($target_dir eq "..") {
|
|
if($ftptargetdir eq "/") {
|
|
$ftptargetdir = "/";
|
|
}
|
|
else {
|
|
$ftptargetdir =~ s/[[:alnum:]]+\/$//;
|
|
}
|
|
}
|
|
else {
|
|
$ftptargetdir .= $target_dir . "/";
|
|
}
|
|
}
|
|
|
|
sub switch_directory {
|
|
my $target_dir = $_[0];
|
|
|
|
if($target_dir eq "/") {
|
|
$ftptargetdir = "/";
|
|
}
|
|
else {
|
|
my @dirs = split("/", $target_dir);
|
|
for(@dirs) {
|
|
switch_directory_goto($_);
|
|
}
|
|
}
|
|
}
|
|
|
|
sub CWD_ftp {
|
|
my ($folder, $fullcommand) = $_[0];
|
|
switch_directory($folder);
|
|
if($ftptargetdir =~ /^\/fully_simulated/) {
|
|
$ftplistparserstate = "enabled";
|
|
}
|
|
else {
|
|
undef $ftplistparserstate;
|
|
}
|
|
}
|
|
|
|
sub PWD_ftp {
|
|
my $mydir;
|
|
$mydir = $ftptargetdir ? $ftptargetdir : "/";
|
|
|
|
if($mydir ne "/") {
|
|
$mydir =~ s/\/$//;
|
|
}
|
|
sendcontrol "257 \"$mydir\" is current directory\r\n";
|
|
}
|
|
|
|
sub LIST_ftp {
|
|
# 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");
|
|
|
|
if($ftplistparserstate) {
|
|
@ftpdir = ftp_contentlist($ftptargetdir);
|
|
}
|
|
|
|
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_ftp {
|
|
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_ftp {
|
|
my $testno = $_[0];
|
|
my $testpart = "";
|
|
if ($testno > 10000) {
|
|
$testpart = $testno % 10000;
|
|
$testno = int($testno / 10000);
|
|
}
|
|
|
|
loadtest("$srcdir/data/test$testno");
|
|
|
|
my @data = getpart("reply", "mdtm");
|
|
|
|
my $reply = $data[0];
|
|
chomp $reply if($reply);
|
|
|
|
if($reply && ($reply =~ /^[+-]?\d+$/) && ($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_ftp {
|
|
my $testno = $_[0];
|
|
if($ftplistparserstate) {
|
|
my $size = wildcard_filesize($ftptargetdir, $testno);
|
|
if($size == -1) {
|
|
sendcontrol "550 $testno: No such file or directory.\r\n";
|
|
}
|
|
else {
|
|
sendcontrol "213 $size\r\n";
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
if($testno =~ /^verifiedserver$/) {
|
|
my $response = "WE ROOLZ: $$\r\n";
|
|
my $size = length($response);
|
|
sendcontrol "213 $size\r\n";
|
|
return 0;
|
|
}
|
|
|
|
if($testno =~ /(\d+)\/?$/) {
|
|
$testno = $1;
|
|
}
|
|
else {
|
|
print STDERR "SIZE_ftp: invalid test number: $testno\n";
|
|
return 1;
|
|
}
|
|
|
|
my $testpart = "";
|
|
if($testno > 10000) {
|
|
$testpart = $testno % 10000;
|
|
$testno = int($testno / 10000);
|
|
}
|
|
|
|
loadtest("$srcdir/data/test$testno");
|
|
|
|
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$testpart");
|
|
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_ftp {
|
|
my ($testno) = @_;
|
|
|
|
if($ftplistparserstate) {
|
|
my @content = wildcard_getfile($ftptargetdir, $testno);
|
|
if($content[0] == -1) {
|
|
#file not found
|
|
}
|
|
else {
|
|
my $size = length $content[1];
|
|
sendcontrol "150 Binary data connection for $testno ($size bytes).\r\n",
|
|
senddata $content[1];
|
|
close_dataconn(0);
|
|
sendcontrol "226 File transfer complete\r\n";
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
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]*)//;
|
|
my $testpart = "";
|
|
if ($testno > 10000) {
|
|
$testpart = $testno % 10000;
|
|
$testno = int($testno / 10000);
|
|
}
|
|
|
|
loadtest("$srcdir/data/test$testno");
|
|
|
|
my @data = getpart("reply", "data$testpart");
|
|
|
|
my $size=0;
|
|
for(@data) {
|
|
$size += length($_);
|
|
}
|
|
|
|
my %hash = getpartattr("reply", "data$testpart");
|
|
|
|
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_ftp {
|
|
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;
|
|
|
|
my $size = 0;
|
|
if($i =~ /^([0-9a-fA-F]{4})\n/) {
|
|
$size = hex($1);
|
|
}
|
|
|
|
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_ftp {
|
|
my ($arg, $cmd)=@_;
|
|
my $pasvport;
|
|
|
|
# kill previous data connection sockfilt when alive
|
|
killsockfilters($proto, $ipvnum, $idnum, $verbose, 'data');
|
|
|
|
# We fire up a new sockfilt to do the data transfer for us.
|
|
my $datasockfcmd = "./server/sockfilt " .
|
|
"--ipv$ipvnum --port 0 " .
|
|
"--pidfile \"$datasockf_pidfile\" " .
|
|
"--logfile \"$datasockf_logfile\"";
|
|
$slavepid = open2(\*DREAD, \*DWRITE, $datasockfcmd);
|
|
|
|
print DWRITE "PING\n";
|
|
my $pong;
|
|
sysread_or_die(\*DREAD, \$pong, 5);
|
|
|
|
if($pong !~ /^PONG/) {
|
|
logmsg "failed to run sockfilt for data connection\n";
|
|
killsockfilters($proto, $ipvnum, $idnum, $verbose, 'data');
|
|
sendcontrol "500 no free ports!\r\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_or_die(\*DREAD, \$i, 5);
|
|
|
|
# READ the response size
|
|
sysread_or_die(\*DREAD, \$i, 5);
|
|
|
|
my $size = 0;
|
|
if($i =~ /^([0-9a-fA-F]{4})\n/) {
|
|
$size = hex($1);
|
|
}
|
|
|
|
# READ the response data
|
|
sysread_or_die(\*DREAD, \$i, $size);
|
|
|
|
# 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=$listenaddr;
|
|
$p =~ s/\./,/g;
|
|
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 ($datadelay?20:10);
|
|
|
|
# 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
|
|
logmsg "$srvrname server timed out awaiting data connection ".
|
|
"on port $pasvport\n";
|
|
logmsg "accept failed or connection not even attempted\n";
|
|
killsockfilters($proto, $ipvnum, $idnum, $verbose, 'data');
|
|
return;
|
|
}
|
|
else {
|
|
logmsg "data connection setup on port $pasvport\n";
|
|
}
|
|
|
|
return;
|
|
}
|
|
|
|
# Support both PORT and EPRT here. Consider LPRT too.
|
|
|
|
sub PORT_ftp {
|
|
my ($arg, $cmd) = @_;
|
|
my $port;
|
|
my $addr;
|
|
|
|
# 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;
|
|
$addr = "$1.$2.$3.$4";
|
|
}
|
|
# 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;
|
|
$addr = $2;
|
|
}
|
|
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 transfer for us.
|
|
my $datasockfcmd = "./server/sockfilt " .
|
|
"--ipv$ipvnum --connect $port --addr \"$addr\" " .
|
|
"--pidfile \"$datasockf_pidfile\" " .
|
|
"--logfile \"$datasockf_logfile\"";
|
|
$slavepid = open2(\*DREAD, \*DWRITE, $datasockfcmd);
|
|
|
|
print STDERR "$datasockfcmd\n" if($verbose);
|
|
|
|
print DWRITE "PING\n";
|
|
my $pong;
|
|
sysread_or_die(\*DREAD, \$pong, 5);
|
|
|
|
if($pong !~ /^PONG/) {
|
|
logmsg "Failed sockfilt for data connection\n";
|
|
killsockfilters($proto, $ipvnum, $idnum, $verbose, 'data');
|
|
}
|
|
|
|
logmsg "====> Client DATA connect to port $port\n";
|
|
|
|
return;
|
|
}
|
|
|
|
#**********************************************************************
|
|
# customize configures test server operation for each curl test, reading
|
|
# configuration commands/parameters from server commands file each time
|
|
# a new client control connection is established with the test server.
|
|
# On success returns 1, otherwise zero.
|
|
#
|
|
sub customize {
|
|
$ctrldelay = 0; # default is no throttling of the ctrl stream
|
|
$datadelay = 0; # default is no throttling of the data stream
|
|
$retrweirdo = 0; # default is no use of RETRWEIRDO
|
|
$retrnosize = 0; # default is no use of RETRNOSIZE
|
|
$pasvbadip = 0; # default is no use of PASVBADIP
|
|
$nosave = 0; # default is to actually save uploaded data to file
|
|
%customreply = (); #
|
|
%customcount = (); #
|
|
%delayreply = (); #
|
|
|
|
open(CUSTOM, "<log/ftpserver.cmd") ||
|
|
return 1;
|
|
|
|
logmsg "FTPD: Getting commands from log/ftpserver.cmd\n";
|
|
|
|
while(<CUSTOM>) {
|
|
if($_ =~ /REPLY ([A-Za-z0-9+\/=]+) (.*)/) {
|
|
$customreply{$1}=eval "qq{$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/) {
|
|
$ctrldelay=1;
|
|
$datadelay=1;
|
|
logmsg "FTPD: send response with 0.01 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);
|
|
}
|
|
|
|
#----------------------------------------------------------------------
|
|
#----------------------------------------------------------------------
|
|
#--------------------------- END OF SUBS ----------------------------
|
|
#----------------------------------------------------------------------
|
|
#----------------------------------------------------------------------
|
|
|
|
#**********************************************************************
|
|
# Parse command line options
|
|
#
|
|
# Options:
|
|
#
|
|
# --verbose # verbose
|
|
# --srcdir # source directory
|
|
# --id # server instance number
|
|
# --proto # server protocol
|
|
# --pidfile # server pid file
|
|
# --logfile # server log file
|
|
# --ipv4 # server IP version 4
|
|
# --ipv6 # server IP version 6
|
|
# --port # server listener port
|
|
# --addr # server address for listener port binding
|
|
#
|
|
while(@ARGV) {
|
|
if($ARGV[0] eq '--verbose') {
|
|
$verbose = 1;
|
|
}
|
|
elsif($ARGV[0] eq '--srcdir') {
|
|
if($ARGV[1]) {
|
|
$srcdir = $ARGV[1];
|
|
shift @ARGV;
|
|
}
|
|
}
|
|
elsif($ARGV[0] eq '--id') {
|
|
if($ARGV[1] && ($ARGV[1] =~ /^(\d+)$/)) {
|
|
$idnum = $1 if($1 > 0);
|
|
shift @ARGV;
|
|
}
|
|
}
|
|
elsif($ARGV[0] eq '--proto') {
|
|
if($ARGV[1] && ($ARGV[1] =~ /^(ftp|imap|pop3|smtp)$/)) {
|
|
$proto = $1;
|
|
shift @ARGV;
|
|
}
|
|
else {
|
|
die "unsupported protocol $ARGV[1]";
|
|
}
|
|
}
|
|
elsif($ARGV[0] eq '--pidfile') {
|
|
if($ARGV[1]) {
|
|
$pidfile = $ARGV[1];
|
|
shift @ARGV;
|
|
}
|
|
}
|
|
elsif($ARGV[0] eq '--logfile') {
|
|
if($ARGV[1]) {
|
|
$logfile = $ARGV[1];
|
|
shift @ARGV;
|
|
}
|
|
}
|
|
elsif($ARGV[0] eq '--ipv4') {
|
|
$ipvnum = 4;
|
|
$listenaddr = '127.0.0.1' if($listenaddr eq '::1');
|
|
$grok_eprt = 0;
|
|
}
|
|
elsif($ARGV[0] eq '--ipv6') {
|
|
$ipvnum = 6;
|
|
$listenaddr = '::1' if($listenaddr eq '127.0.0.1');
|
|
$grok_eprt = 1;
|
|
}
|
|
elsif($ARGV[0] eq '--port') {
|
|
if($ARGV[1] && ($ARGV[1] =~ /^(\d+)$/)) {
|
|
$port = $1 if($1 > 1024);
|
|
shift @ARGV;
|
|
}
|
|
}
|
|
elsif($ARGV[0] eq '--addr') {
|
|
if($ARGV[1]) {
|
|
my $tmpstr = $ARGV[1];
|
|
if($tmpstr =~ /^(\d\d?\d?)\.(\d\d?\d?)\.(\d\d?\d?)\.(\d\d?\d?)$/) {
|
|
$listenaddr = "$1.$2.$3.$4" if($ipvnum == 4);
|
|
}
|
|
elsif($ipvnum == 6) {
|
|
$listenaddr = $tmpstr;
|
|
$listenaddr =~ s/^\[(.*)\]$/$1/;
|
|
}
|
|
shift @ARGV;
|
|
}
|
|
}
|
|
else {
|
|
print STDERR "\nWarning: ftpserver.pl unknown parameter: $ARGV[0]\n";
|
|
}
|
|
shift @ARGV;
|
|
}
|
|
|
|
#***************************************************************************
|
|
# Initialize command line option dependant variables
|
|
#
|
|
|
|
if(!$srcdir) {
|
|
$srcdir = $ENV{'srcdir'} || '.';
|
|
}
|
|
if(!$pidfile) {
|
|
$pidfile = "$path/". server_pidfilename($proto, $ipvnum, $idnum);
|
|
}
|
|
if(!$logfile) {
|
|
$logfile = server_logfilename($logdir, $proto, $ipvnum, $idnum);
|
|
}
|
|
|
|
$mainsockf_pidfile = "$path/".
|
|
mainsockf_pidfilename($proto, $ipvnum, $idnum);
|
|
$mainsockf_logfile =
|
|
mainsockf_logfilename($logdir, $proto, $ipvnum, $idnum);
|
|
|
|
if($proto eq 'ftp') {
|
|
$datasockf_pidfile = "$path/".
|
|
datasockf_pidfilename($proto, $ipvnum, $idnum);
|
|
$datasockf_logfile =
|
|
datasockf_logfilename($logdir, $proto, $ipvnum, $idnum);
|
|
}
|
|
|
|
$srvrname = servername_str($proto, $ipvnum, $idnum);
|
|
|
|
$idstr = "$idnum" if($idnum > 1);
|
|
|
|
protocolsetup($proto);
|
|
|
|
$SIG{INT} = \&exit_signal_handler;
|
|
$SIG{TERM} = \&exit_signal_handler;
|
|
|
|
startsf();
|
|
|
|
logmsg sprintf("%s server listens on port IPv${ipvnum}/${port}\n", uc($proto));
|
|
|
|
open(PID, ">$pidfile");
|
|
print PID $$."\n";
|
|
close(PID);
|
|
|
|
logmsg("logged pid $$ in $pidfile\n");
|
|
|
|
|
|
while(1) {
|
|
#
|
|
# We read 'sockfilt' commands.
|
|
#
|
|
my $input;
|
|
|
|
logmsg "Awaiting input\n";
|
|
sysread_or_die(\*SFREAD, \$input, 5);
|
|
|
|
if($input !~ /^CNCT/) {
|
|
# we wait for a connected client
|
|
logmsg "sockfilt said: $input";
|
|
next;
|
|
}
|
|
logmsg "====> Client connect\n";
|
|
|
|
set_advisor_read_lock($SERVERLOGS_LOCK);
|
|
$serverlogslocked = 1;
|
|
|
|
# flush data:
|
|
$| = 1;
|
|
|
|
killsockfilters($proto, $ipvnum, $idnum, $verbose, 'data');
|
|
|
|
&customize(); # read test control instructions
|
|
|
|
sendcontrol @welcome;
|
|
|
|
#remove global variables from last connection
|
|
if($ftplistparserstate) {
|
|
undef $ftplistparserstate;
|
|
}
|
|
if($ftptargetdir) {
|
|
undef $ftptargetdir;
|
|
}
|
|
|
|
if($verbose) {
|
|
for(@welcome) {
|
|
print STDERR "OUT: $_";
|
|
}
|
|
}
|
|
|
|
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_or_die(\*SFREAD, \$i, 5);
|
|
|
|
if($i !~ /^DATA/) {
|
|
logmsg "sockfilt said $i";
|
|
if($i =~ /^DISC/) {
|
|
# disconnect
|
|
last;
|
|
}
|
|
next;
|
|
}
|
|
|
|
# SIZE of data
|
|
sysread_or_die(\*SFREAD, \$i, 5);
|
|
|
|
my $size = 0;
|
|
if($i =~ /^([0-9a-fA-F]{4})\n/) {
|
|
$size = hex($1);
|
|
}
|
|
|
|
# data
|
|
sysread SFREAD, $_, $size;
|
|
|
|
ftpmsg $_;
|
|
|
|
# Remove trailing CRLF.
|
|
s/[\n\r]+$//;
|
|
|
|
my $FTPCMD;
|
|
my $FTPARG;
|
|
my $full=$_;
|
|
if($proto eq "imap") {
|
|
# IMAP is different with its identifier first on the command line
|
|
unless (m/^([^ ]+) ([^ ]+) (.*)/ ||
|
|
m/^([^ ]+) ([^ ]+)/) {
|
|
sendcontrol "$1 '$_': command not understood.\r\n";
|
|
last;
|
|
}
|
|
$cmdid=$1; # set the global variable
|
|
$FTPCMD=$2;
|
|
$FTPARG=$3;
|
|
}
|
|
elsif (m/^([A-Z]{3,4})(\s(.*))?$/i) {
|
|
$FTPCMD=$1;
|
|
$FTPARG=$3;
|
|
}
|
|
elsif($proto eq "smtp" && m/^[A-Z0-9+\/]{0,512}={0,2}$/i) {
|
|
# SMTP long "commands" are base64 authentication data.
|
|
$FTPCMD=$_;
|
|
$FTPARG="";
|
|
}
|
|
else {
|
|
sendcontrol "500 '$_': command not understood.\r\n";
|
|
last;
|
|
}
|
|
|
|
logmsg "< \"$full\"\n";
|
|
|
|
if($verbose) {
|
|
print STDERR "IN: $full\n";
|
|
}
|
|
|
|
my $delay = $delayreply{$FTPCMD};
|
|
if($delay) {
|
|
# just go sleep this many seconds!
|
|
logmsg("Sleep for $delay seconds\n");
|
|
my $twentieths = $delay * 20;
|
|
while($twentieths--) {
|
|
select(undef, undef, undef, 0.05) unless($got_exit_signal);
|
|
}
|
|
}
|
|
|
|
my $text;
|
|
$text = $customreply{$FTPCMD};
|
|
my $fake = $text;
|
|
|
|
if($text && ($text ne "")) {
|
|
if($customcount{$FTPCMD} && (!--$customcount{$FTPCMD})) {
|
|
# used enough number of times, now blank the customreply
|
|
$customreply{$FTPCMD}="";
|
|
}
|
|
}
|
|
else {
|
|
$text = $displaytext{$FTPCMD};
|
|
}
|
|
my $check;
|
|
if($text && ($text ne "")) {
|
|
if($cmdid && ($cmdid ne "")) {
|
|
sendcontrol "$cmdid$text\r\n";
|
|
}
|
|
else {
|
|
sendcontrol "$text\r\n";
|
|
}
|
|
}
|
|
else {
|
|
$check=1; # no response yet
|
|
}
|
|
|
|
unless($fake && ($fake ne "")) {
|
|
# only perform this if we're not faking a reply
|
|
my $func = $commandfunc{$FTPCMD};
|
|
if($func) {
|
|
&$func($FTPARG, $FTPCMD);
|
|
$check=0; # taken care of
|
|
}
|
|
}
|
|
|
|
if($check) {
|
|
logmsg "$FTPCMD wasn't handled!\n";
|
|
sendcontrol "500 $FTPCMD is not dealt with!\r\n";
|
|
}
|
|
|
|
} # while(1)
|
|
logmsg "====> Client disconnected\n";
|
|
|
|
if($serverlogslocked) {
|
|
$serverlogslocked = 0;
|
|
clear_advisor_read_lock($SERVERLOGS_LOCK);
|
|
}
|
|
}
|
|
|
|
killsockfilters($proto, $ipvnum, $idnum, $verbose);
|
|
unlink($pidfile);
|
|
if($serverlogslocked) {
|
|
$serverlogslocked = 0;
|
|
clear_advisor_read_lock($SERVERLOGS_LOCK);
|
|
}
|
|
|
|
exit;
|