# | (__| |_| | _ <| |___
# \___|\___/|_| \_\_____|
#
-# Copyright (C) 1998 - 2010, Daniel Stenberg, <daniel@haxx.se>, et al.
+# Copyright (C) 1998 - 2014, 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
#
BEGIN {
- @INC=(@INC, $ENV{'srcdir'}, '.');
+ push(@INC, $ENV{'srcdir'}) if(defined $ENV{'srcdir'});
+ push(@INC, ".");
# sub second timestamping needs Time::HiRes
eval {
no warnings "all";
use strict;
use warnings;
use IPC::Open2;
+use Digest::MD5;
require "getpart.pm";
require "ftp.pm";
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 $cwd_testno; # test case numbers extracted from CWD command
my $path = '.';
my $logdir = $path .'/log';
local *DREAD; # used to read from secondary connection
local *DWRITE; # used to write to secondary connection
+my $sockfilt_timeout = 5; # default timeout for sockfilter eXsysreads
+
#**********************************************************************
# 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
+my %commandfunc; # protocol command specific function callbacks
+my %displaytext; # text returned to client before callback runs
#**********************************************************************
# 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; #
+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 $nodataconn; # set if ftp srvr doesn't establish or accepts data channel
+my $nodataconn425; # set if ftp srvr doesn't establish data ch and replies 425
+my $nodataconn421; # set if ftp srvr doesn't establish data ch and replies 421
+my $nodataconn150; # set if ftp srvr doesn't establish data ch and replies 150
+my @capabilities; # set if server supports capability commands
+my @auth_mechs; # set if server supports authentication commands
+my %fulltextreply; #
+my %commandreply; #
+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;
+my $ftptargetdir="";
+
+#**********************************************************************
+# global variables used when running a ftp server to keep state info
+# relative to the secondary or data sockfilt process. Values of these
+# variables should only be modified using datasockf_state() sub, given
+# that they are closely related and relationship is a bit awkward.
+#
+my $datasockf_state = 'STOPPED'; # see datasockf_state() sub
+my $datasockf_mode = 'none'; # ['none','active','passive']
+my $datasockf_runs = 'no'; # ['no','yes']
+my $datasockf_conn = 'no'; # ['no','yes']
#**********************************************************************
# global vars used for signal handling
my $exit_signal; # first signal handled in exit_signal_handler
#**********************************************************************
+# Mail related definitions
+#
+my $TEXT_USERNAME = "user";
+my $TEXT_PASSWORD = "secret";
+my $POP3_TIMESTAMP = "<1972.987654321\@curl>";
+
+#**********************************************************************
# 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.
# better on windows/cygwin
}
+#**********************************************************************
+# eXsysread is a wrapper around perl's sysread() function. This will
+# repeat the call to sysread() until it has actually read the complete
+# number of requested bytes or an unrecoverable condition occurs.
+# On success returns a positive value, the number of bytes requested.
+# On failure or timeout returns zero.
+#
+sub eXsysread {
+ my $FH = shift;
+ my $scalar = shift;
+ my $nbytes = shift;
+ my $timeout = shift; # A zero timeout disables eXsysread() time limit
+ #
+ my $time_limited = 0;
+ my $timeout_rest = 0;
+ my $start_time = 0;
+ my $nread = 0;
+ my $rc;
+
+ $$scalar = "";
+
+ if((not defined $nbytes) || ($nbytes < 1)) {
+ logmsg "Error: eXsysread() failure: " .
+ "length argument must be positive\n";
+ return 0;
+ }
+ if((not defined $timeout) || ($timeout < 0)) {
+ logmsg "Error: eXsysread() failure: " .
+ "timeout argument must be zero or positive\n";
+ return 0;
+ }
+ if($timeout > 0) {
+ # caller sets eXsysread() time limit
+ $time_limited = 1;
+ $timeout_rest = $timeout;
+ $start_time = int(time());
+ }
+
+ while($nread < $nbytes) {
+ if($time_limited) {
+ eval {
+ local $SIG{ALRM} = sub { die "alarm\n"; };
+ alarm $timeout_rest;
+ $rc = sysread($FH, $$scalar, $nbytes - $nread, $nread);
+ alarm 0;
+ };
+ $timeout_rest = $timeout - (int(time()) - $start_time);
+ if($timeout_rest < 1) {
+ logmsg "Error: eXsysread() failure: timed out\n";
+ return 0;
+ }
+ }
+ else {
+ $rc = sysread($FH, $$scalar, $nbytes - $nread, $nread);
+ }
+ if($got_exit_signal) {
+ logmsg "Error: eXsysread() failure: signalled to die\n";
+ return 0;
+ }
+ if(not defined $rc) {
+ if($!{EINTR}) {
+ logmsg "Warning: retrying sysread() interrupted system call\n";
+ next;
+ }
+ if($!{EAGAIN}) {
+ logmsg "Warning: retrying sysread() due to EAGAIN\n";
+ next;
+ }
+ if($!{EWOULDBLOCK}) {
+ logmsg "Warning: retrying sysread() due to EWOULDBLOCK\n";
+ next;
+ }
+ logmsg "Error: sysread() failure: $!\n";
+ return 0;
+ }
+ if($rc < 0) {
+ logmsg "Error: sysread() failure: returned negative value $rc\n";
+ return 0;
+ }
+ if($rc == 0) {
+ logmsg "Error: sysread() failure: read zero bytes\n";
+ return 0;
+ }
+ $nread += $rc;
+ }
+ return $nread;
+}
+
+#**********************************************************************
+# read_mainsockf attempts to read the given amount of output from the
+# sockfilter which is in use for the main or primary connection. This
+# reads untranslated sockfilt lingo which may hold data read from the
+# main or primary socket. On success returns 1, otherwise zero.
+#
+sub read_mainsockf {
+ my $scalar = shift;
+ my $nbytes = shift;
+ my $timeout = shift; # Optional argument, if zero blocks indefinitively
+ my $FH = \*SFREAD;
+
+ if(not defined $timeout) {
+ $timeout = $sockfilt_timeout + ($nbytes >> 12);
+ }
+ if(eXsysread($FH, $scalar, $nbytes, $timeout) != $nbytes) {
+ my ($fcaller, $lcaller) = (caller)[1,2];
+ logmsg "Error: read_mainsockf() failure at $fcaller " .
+ "line $lcaller. Due to eXsysread() failure\n";
+ return 0;
+ }
+ return 1;
+}
+
+#**********************************************************************
+# read_datasockf attempts to read the given amount of output from the
+# sockfilter which is in use for the data or secondary connection. This
+# reads untranslated sockfilt lingo which may hold data read from the
+# data or secondary socket. On success returns 1, otherwise zero.
+#
+sub read_datasockf {
+ my $scalar = shift;
+ my $nbytes = shift;
+ my $timeout = shift; # Optional argument, if zero blocks indefinitively
+ my $FH = \*DREAD;
+
+ if(not defined $timeout) {
+ $timeout = $sockfilt_timeout + ($nbytes >> 12);
+ }
+ if(eXsysread($FH, $scalar, $nbytes, $timeout) != $nbytes) {
+ my ($fcaller, $lcaller) = (caller)[1,2];
+ logmsg "Error: read_datasockf() failure at $fcaller " .
+ "line $lcaller. Due to eXsysread() failure\n";
+ return 0;
+ }
+ return 1;
+}
sub sysread_or_die {
my $FH = shift;
}
}
+#**********************************************************************
+# Returns the given test's reply data
+#
+sub getreplydata {
+ my ($testno) = @_;
+ my $testpart = "";
+
+ $testno =~ s/^([^0-9]*)//;
+ if($testno > 10000) {
+ $testpart = $testno % 10000;
+ $testno = int($testno / 10000);
+ }
+
+ loadtest("$srcdir/data/test$testno");
+
+ my @data = getpart("reply", "data$testpart");
+ if((!@data) && ($testpart ne "")) {
+ @data = getpart("reply", "data");
+ }
+
+ return @data;
+}
sub sockfilt {
my $l;
}
}
-
sub sockfiltsecondary {
my $l;
foreach $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
my $log;
foreach $log (@_) {
my $l = $log;
- $l =~ s/[\r\n]//g;
+ $l =~ s/\r/[CR]/g;
+ $l =~ s/\n/[LF]/g;
logmsg "> \"$l\"\n";
}
}
-# Send data to the client on the data stream
-
+#**********************************************************************
+# Send data to the FTP client on the data stream when data connection
+# is actually established. Given that this sub should only be called
+# when a data connection is supposed to be established, calling this
+# without a data connection is an indication of weak logic somewhere.
+#
sub senddata {
my $l;
+ if($datasockf_conn eq 'no') {
+ logmsg "WARNING: Detected data sending attempt without DATA channel\n";
+ foreach $l (@_) {
+ logmsg "WARNING: Data swallowed: $l\n"
+ }
+ return;
+ }
+
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);
- }
- }
+ 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);
+ }
+ }
}
}
'NOOP' => '200 Yes, I\'m very good at doing nothing.',
'PBSZ' => '500 PBSZ not implemented',
'PROT' => '500 PROT not implemented',
- );
- @welcome = (
+ 'welcome' => join("",
'220- _ _ ____ _ '."\r\n",
'220- ___| | | | _ \| | '."\r\n",
'220- / __| | | | |_) | | '."\r\n",
- '220- | (__| |_| | _ <| |___ '."\r\n",
- '220 \___|\___/|_| \_\_____|'."\r\n"
+ '220- | (__| |_| | _ {| |___ '."\r\n",
+ '220 \___|\___/|_| \_\_____|'."\r\n")
);
}
elsif($proto eq 'pop3') {
%commandfunc = (
+ 'APOP' => \&APOP_pop3,
+ 'AUTH' => \&AUTH_pop3,
+ 'CAPA' => \&CAPA_pop3,
+ 'DELE' => \&DELE_pop3,
+ 'LIST' => \&LIST_pop3,
+ 'NOOP' => \&NOOP_pop3,
+ 'PASS' => \&PASS_pop3,
+ 'QUIT' => \&QUIT_pop3,
'RETR' => \&RETR_pop3,
+ 'RSET' => \&RSET_pop3,
+ 'STAT' => \&STAT_pop3,
+ 'TOP' => \&TOP_pop3,
+ 'UIDL' => \&UIDL_pop3,
+ 'USER' => \&USER_pop3,
);
%displaytext = (
- 'USER' => '+OK We are happy you popped in!',
- 'PASS' => '+OK Access granted',
- 'QUIT' => '+OK byebye',
- );
- @welcome = (
+ 'welcome' => join("",
' _ _ ____ _ '."\r\n",
' ___| | | | _ \| | '."\r\n",
' / __| | | | |_) | | '."\r\n",
- ' | (__| |_| | _ <| |___ '."\r\n",
+ ' | (__| |_| | _ {| |___ '."\r\n",
' \___|\___/|_| \_\_____|'."\r\n",
- '+OK cURL POP3 server ready to serve'."\r\n"
+ '+OK cURL POP3 server ready to serve '."\r\n")
);
}
elsif($proto eq 'imap') {
%commandfunc = (
- 'FETCH' => \&FETCH_imap,
- 'SELECT' => \&SELECT_imap,
+ 'APPEND' => \&APPEND_imap,
+ 'CAPABILITY' => \&CAPABILITY_imap,
+ 'CHECK' => \&CHECK_imap,
+ 'CLOSE' => \&CLOSE_imap,
+ 'COPY' => \©_imap,
+ 'CREATE' => \&CREATE_imap,
+ 'DELETE' => \&DELETE_imap,
+ 'EXAMINE' => \&EXAMINE_imap,
+ 'EXPUNGE' => \&EXPUNGE_imap,
+ 'FETCH' => \&FETCH_imap,
+ 'LIST' => \&LIST_imap,
+ 'LSUB' => \&LSUB_imap,
+ 'LOGIN' => \&LOGIN_imap,
+ 'LOGOUT' => \&LOGOUT_imap,
+ 'NOOP' => \&NOOP_imap,
+ 'RENAME' => \&RENAME_imap,
+ 'SEARCH' => \&SEARCH_imap,
+ 'SELECT' => \&SELECT_imap,
+ 'STATUS' => \&STATUS_imap,
+ 'STORE' => \&STORE_imap,
+ 'UID' => \&UID_imap,
);
%displaytext = (
- 'LOGIN' => ' OK We are happy you popped in!',
- 'SELECT' => ' OK selection done',
- 'LOGOUT' => ' OK thanks for the fish',
- );
- @welcome = (
+ 'welcome' => join("",
' _ _ ____ _ '."\r\n",
' ___| | | | _ \| | '."\r\n",
' / __| | | | |_) | | '."\r\n",
- ' | (__| |_| | _ <| |___ '."\r\n",
+ ' | (__| |_| | _ {| |___ '."\r\n",
' \___|\___/|_| \_\_____|'."\r\n",
- '* OK cURL IMAP server ready to serve'."\r\n"
+ '* OK cURL IMAP server ready to serve'."\r\n")
);
}
elsif($proto eq 'smtp') {
%commandfunc = (
'DATA' => \&DATA_smtp,
+ 'EHLO' => \&EHLO_smtp,
+ 'EXPN' => \&EXPN_smtp,
+ 'HELO' => \&HELO_smtp,
+ 'HELP' => \&HELP_smtp,
+ 'MAIL' => \&MAIL_smtp,
+ 'NOOP' => \&NOOP_smtp,
+ 'RSET' => \&RSET_smtp,
'RCPT' => \&RCPT_smtp,
+ 'VRFY' => \&VRFY_smtp,
+ 'QUIT' => \&QUIT_smtp,
);
%displaytext = (
- 'EHLO' => '230 We are happy you popped in!',
- 'MAIL' => '200 Note taken',
- 'RCPT' => '200 Receivers accepted',
- 'QUIT' => '200 byebye',
- );
- @welcome = (
+ 'welcome' => join("",
'220- _ _ ____ _ '."\r\n",
'220- ___| | | | _ \| | '."\r\n",
'220- / __| | | | |_) | | '."\r\n",
- '220- | (__| |_| | _ <| |___ '."\r\n",
- '220 \___|\___/|_| \_\_____|'."\r\n"
+ '220- | (__| |_| | _ {| |___ '."\r\n",
+ '220 \___|\___/|_| \_\_____|'."\r\n")
);
}
}
my $datapid = processexists($datasockf_pidfile);
+ logmsg "=====> Closing $datasockf_mode DATA connection...\n";
+
if(!$closed) {
- logmsg "* disconnect data connection\n";
if($datapid > 0) {
+ logmsg "Server disconnects $datasockf_mode DATA connection\n";
print DWRITE "DISC\n";
my $i;
sysread DREAD, $i, 5;
}
+ else {
+ logmsg "Server finds $datasockf_mode DATA connection already ".
+ "disconnected\n";
+ }
}
else {
- logmsg "data connection already disconnected\n";
+ logmsg "Server knows $datasockf_mode DATA connection is 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);
+ logmsg "DATA sockfilt for $datasockf_mode data channel quits ".
+ "(pid $datapid)\n";
}
+ else {
+ logmsg "DATA sockfilt for $datasockf_mode data channel already ".
+ "dead\n";
+ }
+
+ logmsg "=====> Closed $datasockf_mode DATA connection\n";
+
+ datasockf_state('STOPPED');
}
################
################ SMTP commands
################
-# what set by "RCPT"
-my $smtp_rcpt;
+# The type of server (SMTP or ESMTP)
+my $smtp_type;
-sub DATA_smtp {
- my $testno;
+# The client (which normally contains the test number)
+my $smtp_client;
- if($smtp_rcpt =~ /^TO:(.*)/) {
- $testno = $1;
+sub EHLO_smtp {
+ my ($client) = @_;
+ my @data;
+
+ # TODO: Get the IP address of the client connection to use in the
+ # EHLO response when the client doesn't specify one but for now use
+ # 127.0.0.1
+ if(!$client) {
+ $client = "[127.0.0.1]";
+ }
+
+ # Set the server type to ESMTP
+ $smtp_type = "ESMTP";
+
+ # Calculate the EHLO response
+ push @data, "$smtp_type pingpong test server Hello $client";
+
+ if((@capabilities) || (@auth_mechs)) {
+ my $mechs;
+
+ for my $c (@capabilities) {
+ push @data, $c;
+ }
+
+ for my $am (@auth_mechs) {
+ if(!$mechs) {
+ $mechs = "$am";
+ }
+ else {
+ $mechs .= " $am";
+ }
+ }
+
+ if($mechs) {
+ push @data, "AUTH $mechs";
+ }
+ }
+
+ # Send the EHLO response
+ for(my $i = 0; $i < @data; $i++) {
+ my $d = $data[$i];
+
+ if($i < @data - 1) {
+ sendcontrol "250-$d\r\n";
+ }
+ else {
+ sendcontrol "250 $d\r\n";
+ }
+ }
+
+ # Store the client (as it may contain the test number)
+ $smtp_client = $client;
+
+ return 0;
+}
+
+sub HELO_smtp {
+ my ($client) = @_;
+
+ # TODO: Get the IP address of the client connection to use in the HELO
+ # response when the client doesn't specify one but for now use 127.0.0.1
+ if(!$client) {
+ $client = "[127.0.0.1]";
+ }
+
+ # Set the server type to SMTP
+ $smtp_type = "SMTP";
+
+ # Send the HELO response
+ sendcontrol "250 $smtp_type pingpong test server Hello $client\r\n";
+
+ # Store the client (as it may contain the test number)
+ $smtp_client = $client;
+
+ return 0;
+}
+
+sub MAIL_smtp {
+ my ($args) = @_;
+
+ logmsg "MAIL_smtp got $args\n";
+
+ if (!$args) {
+ sendcontrol "501 Unrecognized parameter\r\n";
}
else {
- return; # failure
+ my $from;
+ my $size;
+ my @elements = split(/ /, $args);
+
+ # Get the FROM and SIZE parameters
+ for my $e (@elements) {
+ if($e =~ /^FROM:(.*)$/) {
+ $from = $1;
+ }
+ elsif($e =~ /^SIZE=(\d+)$/) {
+ $size = $1;
+ }
+ }
+
+ # Validate the from address (only <> and a valid email address inside
+ # <> are allowed, such as <user@example.com>)
+ if ((!$from) || (($from ne "<>") && ($from !~
+ /^<([a-zA-Z0-9._%+-]+)\@([a-zA-Z0-9.-]+).([a-zA-Z]{2,4})>$/))) {
+ sendcontrol "501 Invalid address\r\n";
+ }
+ else {
+ my @found;
+ my $valid = 1;
+
+ # Check the capabilities for SIZE and if the specified size is
+ # greater than the message size then reject it
+ if (@found = grep /^SIZE (\d+)$/, @capabilities) {
+ if ($found[0] =~ /^SIZE (\d+)$/) {
+ if ($size > $1) {
+ $valid = 0;
+ }
+ }
+ }
+
+ if(!$valid) {
+ sendcontrol "552 Message size too large\r\n";
+ }
+ else {
+ sendcontrol "250 Sender OK\r\n";
+ }
+ }
}
- if($testno eq "<verifiedserver>") {
- sendcontrol "554 WE ROOLZ: $$\r\n";
- return 0; # don't wait for data now
+ return 0;
+}
+
+sub RCPT_smtp {
+ my ($args) = @_;
+
+ logmsg "RCPT_smtp got $args\n";
+
+ # Get the TO parameter
+ if($args !~ /^TO:(.*)/) {
+ sendcontrol "501 Unrecognized parameter\r\n";
}
else {
- $testno =~ s/^([^0-9]*)([0-9]+).*/$2/;
- sendcontrol "354 Show me the mail\r\n";
+ my $to = $1;
+
+ # Validate the to address (only a valid email address inside <> is
+ # allowed, such as <user@example.com>)
+ if ($to !~
+ /^<([a-zA-Z0-9._%+-]+)\@([a-zA-Z0-9.-]+).([a-zA-Z]{2,4})>$/) {
+ sendcontrol "501 Invalid address\r\n";
+ }
+ else {
+ sendcontrol "250 Recipient OK\r\n";
+ }
}
- logmsg "===> rcpt $testno was $smtp_rcpt\n";
+ return 0;
+}
- my $filename = "log/upload.$testno";
+sub DATA_smtp {
+ my ($args) = @_;
- logmsg "Store test number $testno in $filename\n";
+ if ($args) {
+ sendcontrol "501 Unrecognized parameter\r\n";
+ }
+ elsif ($smtp_client !~ /^(\d*)$/) {
+ sendcontrol "501 Invalid arguments\r\n";
+ }
+ else {
+ sendcontrol "354 Show me the mail\r\n";
- open(FILE, ">$filename") ||
- return 0; # failed to open output
+ my $testno = $smtp_client;
+ my $filename = "log/upload.$testno";
- 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;
+ logmsg "Store test number $testno in $filename\n";
- my $size = 0;
- if($i =~ /^([0-9a-fA-F]{4})\n/) {
- $size = hex($1);
- }
+ open(FILE, ">$filename") ||
+ return 0; # failed to open output
- sysread \*SFREAD, $line, $size;
+ 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;
- $ulsize += $size;
- print FILE $line if(!$nosave);
+ my $size = 0;
+ if($i =~ /^([0-9a-fA-F]{4})\n/) {
+ $size = hex($1);
+ }
+
+ read_mainsockf(\$line, $size);
- $raw .= $line;
- if($raw =~ /\x0d\x0a\x2e\x0d\x0a/) {
- # end of data marker!
- $eob = 1;
+ $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;
+ }
}
- logmsg "> Appending $size bytes to file\n";
- if($eob) {
- logmsg "Found SMTP EOB marker\n";
+ elsif($line eq "DISC\n") {
+ # disconnect!
+ $disc=1;
+ last;
+ }
+ else {
+ logmsg "No support for: $line";
last;
}
}
- elsif($line eq "DISC\n") {
- # disconnect!
- $disc=1;
- last;
+
+ if($nosave) {
+ print FILE "$ulsize bytes would've been stored here\n";
+ }
+
+ close(FILE);
+
+ logmsg "received $ulsize bytes upload\n";
+
+ sendcontrol "250 OK, data received!\r\n";
+ }
+
+ return 0;
+}
+
+sub NOOP_smtp {
+ my ($args) = @_;
+
+ if($args) {
+ sendcontrol "501 Unrecognized parameter\r\n";
+ }
+ else {
+ sendcontrol "250 OK\r\n";
+ }
+
+ return 0;
+}
+
+sub RSET_smtp {
+ my ($args) = @_;
+
+ if($args) {
+ sendcontrol "501 Unrecognized parameter\r\n";
+ }
+ else {
+ sendcontrol "250 Resetting\r\n";
+ }
+
+ return 0;
+}
+
+sub HELP_smtp {
+ my ($args) = @_;
+
+ # One argument is optional
+ if($args) {
+ logmsg "HELP_smtp got $args\n";
+ }
+
+ if($smtp_client eq "verifiedserver") {
+ # This is the secret command that verifies that this actually is
+ # the curl test server
+ sendcontrol "214 WE ROOLZ: $$\r\n";
+
+ if($verbose) {
+ print STDERR "FTPD: We returned proof we are the test server\n";
+ }
+
+ logmsg "return proof we are we\n";
+ }
+ else {
+ sendcontrol "214-This server supports the following commands:\r\n";
+
+ if(@auth_mechs) {
+ sendcontrol "214 HELO EHLO RCPT DATA RSET MAIL VRFY EXPN QUIT HELP AUTH\r\n";
}
else {
- logmsg "No support for: $line";
- last;
+ sendcontrol "214 HELO EHLO RCPT DATA RSET MAIL VRFY EXPN QUIT HELP\r\n";
+ }
+ }
+
+ return 0;
+}
+
+sub VRFY_smtp {
+ my ($args) = @_;
+ my ($username, $address) = split(/ /, $args, 2);
+
+ logmsg "VRFY_smtp got $args\n";
+
+ if($username eq "") {
+ sendcontrol "501 Unrecognized parameter\r\n";
+ }
+ else {
+ my @data = getreplydata($smtp_client);
+
+ for my $d (@data) {
+ sendcontrol $d;
+ }
+ }
+
+ return 0;
+}
+
+sub EXPN_smtp {
+ my ($list_name) = @_;
+
+ logmsg "EXPN_smtp got $list_name\n";
+
+ if(!$list_name) {
+ sendcontrol "501 Unrecognized parameter\r\n";
+ }
+ else {
+ my @data = getreplydata($smtp_client);
+
+ for my $d (@data) {
+ sendcontrol $d;
+ }
+ }
+
+ return 0;
+}
+
+sub QUIT_smtp {
+ sendcontrol "221 cURL $smtp_type server signing off\r\n";
+
+ return 0;
+}
+
+# What was deleted by IMAP STORE / POP3 DELE commands
+my @deleted;
+
+################
+################ IMAP commands
+################
+
+# global to allow the command functions to read it
+my $cmdid;
+
+# what was picked by SELECT
+my $selected;
+
+# Any IMAP parameter can come in escaped and in double quotes.
+# This function is dumb (so far) and just removes the quotes if present.
+sub fix_imap_params {
+ foreach (@_) {
+ $_ = $1 if /^"(.*)"$/;
+ }
+}
+
+sub CAPABILITY_imap {
+ if((!@capabilities) && (!@auth_mechs)) {
+ sendcontrol "$cmdid BAD Command\r\n";
+ }
+ else {
+ my $data;
+
+ # Calculate the CAPABILITY response
+ $data = "* CAPABILITY IMAP4";
+
+ for my $c (@capabilities) {
+ $data .= " $c";
+ }
+
+ for my $am (@auth_mechs) {
+ $data .= " AUTH=$am";
+ }
+
+ $data .= " pingpong test server\r\n";
+
+ # Send the CAPABILITY response
+ sendcontrol $data;
+ sendcontrol "$cmdid OK CAPABILITY completed\r\n";
+ }
+
+ return 0;
+}
+
+sub LOGIN_imap {
+ my ($args) = @_;
+ my ($user, $password) = split(/ /, $args, 2);
+ fix_imap_params($user, $password);
+
+ logmsg "LOGIN_imap got $args\n";
+
+ if ($user eq "") {
+ sendcontrol "$cmdid BAD Command Argument\r\n";
+ }
+ elsif (($user ne $TEXT_USERNAME) || ($password ne $TEXT_PASSWORD)) {
+ sendcontrol "$cmdid NO LOGIN failed\r\n";
+ }
+ else {
+ sendcontrol "$cmdid OK LOGIN completed\r\n";
+ }
+
+ return 0;
+}
+
+sub SELECT_imap {
+ my ($mailbox) = @_;
+ fix_imap_params($mailbox);
+
+ logmsg "SELECT_imap got test $mailbox\n";
+
+ if($mailbox eq "") {
+ sendcontrol "$cmdid BAD Command Argument\r\n";
+ }
+ else {
+ # Example from RFC 3501, 6.3.1. SELECT Command
+ sendcontrol "* 172 EXISTS\r\n";
+ sendcontrol "* 1 RECENT\r\n";
+ sendcontrol "* OK [UNSEEN 12] Message 12 is first unseen\r\n";
+ sendcontrol "* OK [UIDVALIDITY 3857529045] UIDs valid\r\n";
+ sendcontrol "* OK [UIDNEXT 4392] Predicted next UID\r\n";
+ sendcontrol "* FLAGS (\\Answered \\Flagged \\Deleted \\Seen \\Draft)\r\n";
+ sendcontrol "* OK [PERMANENTFLAGS (\\Deleted \\Seen \\*)] Limited\r\n";
+ sendcontrol "$cmdid OK [READ-WRITE] SELECT completed\r\n";
+
+ $selected = $mailbox;
+ }
+
+ return 0;
+}
+
+sub FETCH_imap {
+ my ($args) = @_;
+ my ($uid, $how) = split(/ /, $args, 2);
+ fix_imap_params($uid, $how);
+
+ logmsg "FETCH_imap got $args\n";
+
+ if ($selected eq "") {
+ sendcontrol "$cmdid BAD Command received in Invalid state\r\n";
+ }
+ else {
+ my @data;
+ my $size;
+
+ if($selected eq "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 {
+ # send mail content
+ logmsg "retrieve a mail\n";
+
+ @data = getreplydata($selected);
+ }
+
+ for (@data) {
+ $size += length($_);
+ }
+
+ sendcontrol "* $uid FETCH ($how {$size}\r\n";
+
+ for my $d (@data) {
+ sendcontrol $d;
+ }
+
+ sendcontrol ")\r\n";
+ sendcontrol "$cmdid OK FETCH completed\r\n";
+ }
+
+ return 0;
+}
+
+sub APPEND_imap {
+ my ($args) = @_;
+
+ logmsg "APPEND_imap got $args\r\n";
+
+ $args =~ /^([^ ]+) [^{]*\{(\d+)\}$/;
+ my ($mailbox, $size) = ($1, $2);
+ fix_imap_params($mailbox);
+
+ if($mailbox eq "") {
+ sendcontrol "$cmdid BAD Command Argument\r\n";
+ }
+ else {
+ sendcontrol "+ Ready for literal data\r\n";
+
+ my $testno = $mailbox;
+ my $filename = "log/upload.$testno";
+
+ logmsg "Store test number $testno in $filename\n";
+
+ open(FILE, ">$filename") ||
+ return 0; # failed to open output
+
+ my $received = 0;
+ my $line;
+ while(5 == (sysread \*SFREAD, $line, 5)) {
+ if($line eq "DATA\n") {
+ sysread \*SFREAD, $line, 5;
+
+ my $chunksize = 0;
+ if($line =~ /^([0-9a-fA-F]{4})\n/) {
+ $chunksize = hex($1);
+ }
+
+ read_mainsockf(\$line, $chunksize);
+
+ my $left = $size - $received;
+ my $datasize = ($left > $chunksize) ? $chunksize : $left;
+
+ if($datasize > 0) {
+ logmsg "> Appending $datasize bytes to file\n";
+ print FILE substr($line, 0, $datasize) if(!$nosave);
+ $line = substr($line, $datasize);
+
+ $received += $datasize;
+ if($received == $size) {
+ logmsg "Received all data, waiting for final CRLF.\n";
+ }
+ }
+
+ if($received == $size && $line eq "\r\n") {
+ last;
+ }
+ }
+ elsif($line eq "DISC\n") {
+ logmsg "Unexpected disconnect!\n";
+ last;
+ }
+ else {
+ logmsg "No support for: $line";
+ last;
+ }
+ }
+
+ if($nosave) {
+ print FILE "$size bytes would've been stored here\n";
+ }
+
+ close(FILE);
+
+ logmsg "received $size bytes upload\n";
+
+ sendcontrol "$cmdid OK APPEND completed\r\n";
+ }
+
+ return 0;
+}
+
+sub STORE_imap {
+ my ($args) = @_;
+ my ($uid, $what, $value) = split(/ /, $args, 3);
+ fix_imap_params($uid);
+
+ logmsg "STORE_imap got $args\n";
+
+ if ($selected eq "") {
+ sendcontrol "$cmdid BAD Command received in Invalid state\r\n";
+ }
+ elsif (($uid eq "") || ($what ne "+Flags") || ($value eq "")) {
+ sendcontrol "$cmdid BAD Command Argument\r\n";
+ }
+ else {
+ if($value eq "\\Deleted") {
+ push(@deleted, $uid);
+ }
+
+ sendcontrol "* $uid FETCH (FLAGS (\\Seen $value))\r\n";
+ sendcontrol "$cmdid OK STORE completed\r\n";
+ }
+
+ return 0;
+}
+
+sub LIST_imap {
+ my ($args) = @_;
+ my ($reference, $mailbox) = split(/ /, $args, 2);
+ fix_imap_params($reference, $mailbox);
+
+ logmsg "LIST_imap got $args\n";
+
+ if ($reference eq "") {
+ sendcontrol "$cmdid BAD Command Argument\r\n";
+ }
+ elsif ($reference eq "verifiedserver") {
+ # this is the secret command that verifies that this actually is
+ # the curl test server
+ sendcontrol "* LIST () \"/\" \"WE ROOLZ: $$\"\r\n";
+ sendcontrol "$cmdid OK LIST Completed\r\n";
+
+ if($verbose) {
+ print STDERR "FTPD: We returned proof we are the test server\n";
+ }
+
+ logmsg "return proof we are we\n";
+ }
+ else {
+ my @data = getreplydata($reference);
+
+ for my $d (@data) {
+ sendcontrol $d;
+ }
+
+ sendcontrol "$cmdid OK LIST Completed\r\n";
+ }
+
+ return 0;
+}
+
+sub LSUB_imap {
+ my ($args) = @_;
+ my ($reference, $mailbox) = split(/ /, $args, 2);
+ fix_imap_params($reference, $mailbox);
+
+ logmsg "LSUB_imap got $args\n";
+
+ if ($reference eq "") {
+ sendcontrol "$cmdid BAD Command Argument\r\n";
+ }
+ else {
+ my @data = getreplydata($reference);
+
+ for my $d (@data) {
+ sendcontrol $d;
+ }
+
+ sendcontrol "$cmdid OK LSUB Completed\r\n";
+ }
+
+ return 0;
+}
+
+sub EXAMINE_imap {
+ my ($mailbox) = @_;
+ fix_imap_params($mailbox);
+
+ logmsg "EXAMINE_imap got $mailbox\n";
+
+ if ($mailbox eq "") {
+ sendcontrol "$cmdid BAD Command Argument\r\n";
+ }
+ else {
+ my @data = getreplydata($mailbox);
+
+ for my $d (@data) {
+ sendcontrol $d;
+ }
+
+ sendcontrol "$cmdid OK [READ-ONLY] EXAMINE completed\r\n";
+ }
+
+ return 0;
+}
+
+sub STATUS_imap {
+ my ($args) = @_;
+ my ($mailbox, $what) = split(/ /, $args, 2);
+ fix_imap_params($mailbox);
+
+ logmsg "STATUS_imap got $args\n";
+
+ if ($mailbox eq "") {
+ sendcontrol "$cmdid BAD Command Argument\r\n";
+ }
+ else {
+ my @data = getreplydata($mailbox);
+
+ for my $d (@data) {
+ sendcontrol $d;
+ }
+
+ sendcontrol "$cmdid OK STATUS completed\r\n";
+ }
+
+ return 0;
+}
+
+sub SEARCH_imap {
+ my ($what) = @_;
+ fix_imap_params($what);
+
+ logmsg "SEARCH_imap got $what\n";
+
+ if ($selected eq "") {
+ sendcontrol "$cmdid BAD Command received in Invalid state\r\n";
+ }
+ elsif ($what eq "") {
+ sendcontrol "$cmdid BAD Command Argument\r\n";
+ }
+ else {
+ my @data = getreplydata($selected);
+
+ for my $d (@data) {
+ sendcontrol $d;
+ }
+
+ sendcontrol "$cmdid OK SEARCH completed\r\n";
+ }
+
+ return 0;
+}
+
+sub CREATE_imap {
+ my ($args) = @_;
+ fix_imap_params($args);
+
+ logmsg "CREATE_imap got $args\n";
+
+ if ($args eq "") {
+ sendcontrol "$cmdid BAD Command Argument\r\n";
+ }
+ else {
+ sendcontrol "$cmdid OK CREATE completed\r\n";
+ }
+
+ return 0;
+}
+
+sub DELETE_imap {
+ my ($args) = @_;
+ fix_imap_params($args);
+
+ logmsg "DELETE_imap got $args\n";
+
+ if ($args eq "") {
+ sendcontrol "$cmdid BAD Command Argument\r\n";
+ }
+ else {
+ sendcontrol "$cmdid OK DELETE completed\r\n";
+ }
+
+ return 0;
+}
+
+sub RENAME_imap {
+ my ($args) = @_;
+ my ($from_mailbox, $to_mailbox) = split(/ /, $args, 2);
+ fix_imap_params($from_mailbox, $to_mailbox);
+
+ logmsg "RENAME_imap got $args\n";
+
+ if (($from_mailbox eq "") || ($to_mailbox eq "")) {
+ sendcontrol "$cmdid BAD Command Argument\r\n";
+ }
+ else {
+ sendcontrol "$cmdid OK RENAME completed\r\n";
+ }
+
+ return 0;
+}
+
+sub CHECK_imap {
+ if ($selected eq "") {
+ sendcontrol "$cmdid BAD Command received in Invalid state\r\n";
+ }
+ else {
+ sendcontrol "$cmdid OK CHECK completed\r\n";
+ }
+
+ return 0;
+}
+
+sub CLOSE_imap {
+ if ($selected eq "") {
+ sendcontrol "$cmdid BAD Command received in Invalid state\r\n";
+ }
+ elsif (!@deleted) {
+ sendcontrol "$cmdid BAD Command Argument\r\n";
+ }
+ else {
+ sendcontrol "$cmdid OK CLOSE completed\r\n";
+
+ @deleted = ();
+ }
+
+ return 0;
+}
+
+sub EXPUNGE_imap {
+ if ($selected eq "") {
+ sendcontrol "$cmdid BAD Command received in Invalid state\r\n";
+ }
+ else {
+ if (!@deleted) {
+ # Report the number of existing messages as per the SELECT
+ # command
+ sendcontrol "* 172 EXISTS\r\n";
+ }
+ else {
+ # Report the message UIDs being deleted
+ for my $d (@deleted) {
+ sendcontrol "* $d EXPUNGE\r\n";
+ }
+
+ @deleted = ();
+ }
+
+ sendcontrol "$cmdid OK EXPUNGE completed\r\n";
+ }
+
+ return 0;
+}
+
+sub COPY_imap {
+ my ($args) = @_;
+ my ($uid, $mailbox) = split(/ /, $args, 2);
+ fix_imap_params($uid, $mailbox);
+
+ logmsg "COPY_imap got $args\n";
+
+ if (($uid eq "") || ($mailbox eq "")) {
+ sendcontrol "$cmdid BAD Command Argument\r\n";
+ }
+ else {
+ sendcontrol "$cmdid OK COPY completed\r\n";
+ }
+
+ return 0;
+}
+
+sub UID_imap {
+ my ($args) = @_;
+ my ($command) = split(/ /, $args, 1);
+ fix_imap_params($command);
+
+ logmsg "UID_imap got $args\n";
+
+ if ($selected eq "") {
+ sendcontrol "$cmdid BAD Command received in Invalid state\r\n";
+ }
+ elsif (($command ne "COPY") && ($command ne "FETCH") &&
+ ($command ne "STORE") && ($command ne "SEARCH")) {
+ sendcontrol "$cmdid BAD Command Argument\r\n";
+ }
+ else {
+ my @data = getreplydata($selected);
+
+ for my $d (@data) {
+ sendcontrol $d;
+ }
+
+ sendcontrol "$cmdid OK $command completed\r\n";
+ }
+
+ return 0;
+}
+
+sub NOOP_imap {
+ my ($args) = @_;
+ my @data = (
+ "* 22 EXPUNGE\r\n",
+ "* 23 EXISTS\r\n",
+ "* 3 RECENT\r\n",
+ "* 14 FETCH (FLAGS (\\Seen \\Deleted))\r\n",
+ );
+
+ if ($args) {
+ sendcontrol "$cmdid BAD Command Argument\r\n";
+ }
+ else {
+ for my $d (@data) {
+ sendcontrol $d;
+ }
+
+ sendcontrol "$cmdid OK NOOP completed\r\n";
+ }
+
+ return 0;
+}
+
+sub LOGOUT_imap {
+ sendcontrol "* BYE cURL IMAP server signing off\r\n";
+ sendcontrol "$cmdid OK LOGOUT completed\r\n";
+
+ return 0;
+}
+
+################
+################ POP3 commands
+################
+
+# Who is attempting to log in
+my $username;
+
+sub CAPA_pop3 {
+ my @list = ();
+ my $mechs;
+
+ # Calculate the capability list based on the specified capabilities
+ # (except APOP) and any authentication mechanisms
+ for my $c (@capabilities) {
+ push @list, "$c\r\n" unless $c eq "APOP";
+ }
+
+ for my $am (@auth_mechs) {
+ if(!$mechs) {
+ $mechs = "$am";
+ }
+ else {
+ $mechs .= " $am";
+ }
+ }
+
+ if($mechs) {
+ push @list, "SASL $mechs\r\n";
+ }
+
+ if(!@list) {
+ sendcontrol "-ERR Unrecognized command\r\n";
+ }
+ else {
+ my @data = ();
+
+ # Calculate the CAPA response
+ push @data, "+OK List of capabilities follows\r\n";
+
+ for my $l (@list) {
+ push @data, "$l\r\n";
+ }
+
+ push @data, "IMPLEMENTATION POP3 pingpong test server\r\n";
+
+ # Send the CAPA response
+ for my $d (@data) {
+ sendcontrol $d;
+ }
+
+ # End with the magic 3-byte end of listing marker
+ sendcontrol ".\r\n";
+ }
+
+ return 0;
+}
+
+sub APOP_pop3 {
+ my ($args) = @_;
+ my ($user, $secret) = split(/ /, $args, 2);
+
+ if (!grep /^APOP$/, @capabilities) {
+ sendcontrol "-ERR Unrecognized command\r\n";
+ }
+ elsif (($user eq "") || ($secret eq "")) {
+ sendcontrol "-ERR Protocol error\r\n";
+ }
+ else {
+ my $digest = Digest::MD5::md5_hex($POP3_TIMESTAMP, $TEXT_PASSWORD);
+
+ if (($user ne $TEXT_USERNAME) || ($secret ne $digest)) {
+ sendcontrol "-ERR Login failure\r\n";
+ }
+ else {
+ sendcontrol "+OK Login successful\r\n";
+ }
+ }
+
+ return 0;
+}
+
+sub AUTH_pop3 {
+ if(!@auth_mechs) {
+ sendcontrol "-ERR Unrecognized command\r\n";
+ }
+ else {
+ my @data = ();
+
+ # Calculate the AUTH response
+ push @data, "+OK List of supported mechanisms follows\r\n";
+
+ for my $am (@auth_mechs) {
+ push @data, "$am\r\n";
+ }
+
+ # Send the AUTH response
+ for my $d (@data) {
+ sendcontrol $d;
+ }
+
+ # End with the magic 3-byte end of listing marker
+ sendcontrol ".\r\n";
+ }
+
+ return 0;
+}
+
+sub USER_pop3 {
+ my ($user) = @_;
+
+ logmsg "USER_pop3 got $user\n";
+
+ if (!$user) {
+ sendcontrol "-ERR Protocol error\r\n";
+ }
+ else {
+ $username = $user;
+
+ sendcontrol "+OK\r\n";
+ }
+
+ return 0;
+}
+
+sub PASS_pop3 {
+ my ($password) = @_;
+
+ logmsg "PASS_pop3 got $password\n";
+
+ if (($username ne $TEXT_USERNAME) || ($password ne $TEXT_PASSWORD)) {
+ sendcontrol "-ERR Login failure\r\n";
+ }
+ else {
+ sendcontrol "+OK Login successful\r\n";
+ }
+
+ return 0;
+}
+
+sub RETR_pop3 {
+ my ($msgid) = @_;
+ my @data;
+
+ if($msgid =~ /^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";
}
- if($nosave) {
- print FILE "$ulsize bytes would've been stored here\n";
+ else {
+ # send mail content
+ logmsg "retrieve a mail\n";
+
+ @data = getreplydata($msgid);
+ }
+
+ sendcontrol "+OK Mail transfer starts\r\n";
+
+ for my $d (@data) {
+ sendcontrol $d;
}
- close(FILE);
- sendcontrol "250 OK, data received!\r\n";
- logmsg "received $ulsize bytes upload\n";
+ # end with the magic 3-byte end of mail marker, assumes that the
+ # mail body ends with a CRLF!
+ sendcontrol ".\r\n";
+
+ return 0;
}
-sub RCPT_smtp {
- my ($args) = @_;
+sub LIST_pop3 {
+ # This is a built-in fake-message list
+ my @data = (
+ "1 100\r\n",
+ "2 4294967400\r\n", # > 4 GB
+ "3 200\r\n",
+ );
+
+ logmsg "retrieve a message list\n";
+
+ sendcontrol "+OK Listing starts\r\n";
+
+ for my $d (@data) {
+ sendcontrol $d;
+ }
+
+ # End with the magic 3-byte end of listing marker
+ sendcontrol ".\r\n";
- $smtp_rcpt = $args;
+ return 0;
}
-################
-################ IMAP commands
-################
+sub DELE_pop3 {
+ my ($msgid) = @_;
-# global to allow the command functions to read it
-my $cmdid;
+ logmsg "DELE_pop3 got $msgid\n";
-# what was picked by SELECT
-my $selected;
+ if (!$msgid) {
+ sendcontrol "-ERR Protocol error\r\n";
+ }
+ else {
+ push (@deleted, $msgid);
-sub SELECT_imap {
- my ($testno) = @_;
- my @data;
- my $size;
+ sendcontrol "+OK\r\n";
+ }
+
+ return 0;
+}
+
+sub STAT_pop3 {
+ my ($args) = @_;
+
+ if ($args) {
+ sendcontrol "-ERR Protocol error\r\n";
+ }
+ else {
+ # Send statistics for the built-in fake message list as
+ # detailed in the LIST_pop3 function above
+ sendcontrol "+OK 3 4294967800\r\n";
+ }
+
+ return 0;
+}
- logmsg "SELECT_imap got test $testno\n";
+sub NOOP_pop3 {
+ my ($args) = @_;
- $selected = $testno;
+ if ($args) {
+ sendcontrol "-ERR Protocol error\r\n";
+ }
+ else {
+ sendcontrol "+OK\r\n";
+ }
return 0;
}
+sub UIDL_pop3 {
+ # This is a built-in fake-message UID list
+ my @data = (
+ "1 1\r\n",
+ "2 2\r\n",
+ "3 4\r\n", # Note that UID 3 is a simulated "deleted" message
+ );
-sub FETCH_imap {
- my ($testno) = @_;
- my @data;
- my $size;
+ if (!grep /^UIDL$/, @capabilities) {
+ sendcontrol "-ERR Unrecognized command\r\n";
+ }
+ else {
+ logmsg "retrieve a message UID list\n";
- logmsg "FETCH_imap got test $testno\n";
+ sendcontrol "+OK Listing starts\r\n";
- $testno = $selected;
+ for my $d (@data) {
+ sendcontrol $d;
+ }
+
+ # End with the magic 3-byte end of listing marker
+ sendcontrol ".\r\n";
+ }
- 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";
+ return 0;
+}
- $testno =~ s/^([^0-9]*)//;
- my $testpart = "";
- if ($testno > 10000) {
- $testpart = $testno % 10000;
- $testno = int($testno / 10000);
- }
+sub TOP_pop3 {
+ my ($args) = @_;
+ my ($msgid, $lines) = split(/ /, $args, 2);
- # send mail content
- loadtest("$srcdir/data/test$testno");
+ logmsg "TOP_pop3 got $args\n";
- @data = getpart("reply", "data$testpart");
- }
+ if (!grep /^TOP$/, @capabilities) {
+ sendcontrol "-ERR Unrecognized command\r\n";
+ }
+ elsif (($msgid eq "") || ($lines eq "")) {
+ sendcontrol "-ERR Protocol error\r\n";
+ }
+ else {
+ if ($lines == "0") {
+ logmsg "retrieve header of mail\n";
+ }
+ else {
+ logmsg "retrieve top $lines lines of mail\n";
+ }
- for (@data) {
- $size += length($_);
- }
+ my @data = getreplydata($msgid);
- sendcontrol "* FETCH starts {$size}\r\n";
+ sendcontrol "+OK Mail transfer starts\r\n";
- for my $d (@data) {
- sendcontrol $d;
- }
+ # Send mail content
+ for my $d (@data) {
+ sendcontrol $d;
+ }
- sendcontrol "$cmdid OK FETCH completed\r\n";
+ # End with the magic 3-byte end of mail marker, assumes that the
+ # mail body ends with a CRLF!
+ sendcontrol ".\r\n";
+ }
- return 0;
+ return 0;
}
-################
-################ POP3 commands
-################
-
-sub RETR_pop3 {
- my ($testno) = @_;
- my @data;
+sub RSET_pop3 {
+ my ($args) = @_;
- 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";
+ if ($args) {
+ sendcontrol "-ERR Protocol error\r\n";
+ }
+ else {
+ if (@deleted) {
+ logmsg "resetting @deleted message(s)\n";
- $testno =~ s/^([^0-9]*)//;
- my $testpart = "";
- if ($testno > 10000) {
- $testpart = $testno % 10000;
- $testno = int($testno / 10000);
- }
+ @deleted = ();
+ }
- # send mail content
- loadtest("$srcdir/data/test$testno");
+ sendcontrol "+OK\r\n";
+ }
- @data = getpart("reply", "data$testpart");
- }
+ return 0;
+}
- sendcontrol "+OK Mail transfer starts\r\n";
+sub QUIT_pop3 {
+ if(@deleted) {
+ logmsg "deleting @deleted message(s)\n";
- for my $d (@data) {
- sendcontrol $d;
- }
+ @deleted = ();
+ }
- # end with the magic 5-byte end of mail marker
- sendcontrol "\r\n.\r\n";
+ sendcontrol "+OK cURL POP3 server signing off\r\n";
- return 0;
+ return 0;
}
################
sub switch_directory {
my $target_dir = $_[0];
- if($target_dir eq "/") {
+ if($target_dir =~ /^test-(\d+)/) {
+ $cwd_testno = $1;
+ }
+ elsif($target_dir eq "/") {
$ftptargetdir = "/";
}
else {
}
sub LIST_ftp {
- # print "150 ASCII data connection for /bin/ls (193.15.23.1,59196) (0 bytes)\r\n";
+ # 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",
"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($datasockf_conn eq 'no') {
+ if($nodataconn425) {
+ sendcontrol "150 Opening data connection\r\n";
+ sendcontrol "425 Can't open data connection\r\n";
+ }
+ elsif($nodataconn421) {
+ sendcontrol "150 Opening data connection\r\n";
+ sendcontrol "421 Connection timed out\r\n";
+ }
+ elsif($nodataconn150) {
+ sendcontrol "150 Opening data connection\r\n";
+ # client shall timeout
+ }
+ else {
+ # client shall timeout
+ }
+ return 0;
+ }
+
if($ftplistparserstate) {
@ftpdir = ftp_contentlist($ftptargetdir);
}
logmsg "pass LIST data on data connection\n";
- for(@ftpdir) {
- senddata $_;
+
+ if($cwd_testno) {
+ loadtest("$srcdir/data/test$cwd_testno");
+
+ my @data = getpart("reply", "data");
+ for(@data) {
+ my $send = $_;
+ # convert all \n to \r\n for ASCII transfer
+ $send =~ s/\r\n/\n/g;
+ $send =~ s/\n/\r\n/g;
+ logmsg "send $send as data\n";
+ senddata $send;
+ }
+ $cwd_testno = 0; # forget it again
+ }
+ else {
+ # old hard-coded style
+ for(@ftpdir) {
+ senddata $_;
+ }
}
close_dataconn(0);
sendcontrol "226 ASCII transfer complete\r\n";
sub NLST_ftp {
my @ftpdir=("file", "with space", "fake", "..", " ..", "funny", "README");
+
+ if($datasockf_conn eq 'no') {
+ if($nodataconn425) {
+ sendcontrol "150 Opening data connection\r\n";
+ sendcontrol "425 Can't open data connection\r\n";
+ }
+ elsif($nodataconn421) {
+ sendcontrol "150 Opening data connection\r\n";
+ sendcontrol "421 Connection timed out\r\n";
+ }
+ elsif($nodataconn150) {
+ sendcontrol "150 Opening data connection\r\n";
+ # client shall timeout
+ }
+ else {
+ # client shall timeout
+ }
+ return 0;
+ }
+
logmsg "pass NLST data on data connection\n";
for(@ftpdir) {
senddata "$_\r\n";
sub RETR_ftp {
my ($testno) = @_;
+ if($datasockf_conn eq 'no') {
+ if($nodataconn425) {
+ sendcontrol "150 Opening data connection\r\n";
+ sendcontrol "425 Can't open data connection\r\n";
+ }
+ elsif($nodataconn421) {
+ sendcontrol "150 Opening data connection\r\n";
+ sendcontrol "421 Connection timed out\r\n";
+ }
+ elsif($nodataconn150) {
+ sendcontrol "150 Opening data connection\r\n";
+ # client shall timeout
+ }
+ else {
+ # client shall timeout
+ }
+ return 0;
+ }
+
if($ftplistparserstate) {
my @content = wildcard_getfile($ftptargetdir, $testno);
if($content[0] == -1) {
my $filename = "log/upload.$testno";
+ if($datasockf_conn eq 'no') {
+ if($nodataconn425) {
+ sendcontrol "150 Opening data connection\r\n";
+ sendcontrol "425 Can't open data connection\r\n";
+ }
+ elsif($nodataconn421) {
+ sendcontrol "150 Opening data connection\r\n";
+ sendcontrol "421 Connection timed out\r\n";
+ }
+ elsif($nodataconn150) {
+ sendcontrol "150 Opening data connection\r\n";
+ # client shall timeout
+ }
+ else {
+ # client shall timeout
+ }
+ return 0;
+ }
+
logmsg "STOR test number $testno in $filename\n";
sendcontrol "125 Gimme gimme gimme!\r\n";
$size = hex($1);
}
- sysread DREAD, $line, $size;
+ read_datasockf(\$line, $size);
#print STDERR " GOT: $size bytes\n";
sub PASV_ftp {
my ($arg, $cmd)=@_;
my $pasvport;
+ my $bindonly = ($nodataconn) ? '--bindonly' : '';
# kill previous data connection sockfilt when alive
- killsockfilters($proto, $ipvnum, $idnum, $verbose, 'data');
+ if($datasockf_runs eq 'yes') {
+ killsockfilters($proto, $ipvnum, $idnum, $verbose, 'data');
+ logmsg "DATA sockfilt for $datasockf_mode data channel killed\n";
+ }
+ datasockf_state('STOPPED');
+
+ logmsg "====> Passive DATA channel requested by client\n";
+
+ logmsg "DATA sockfilt for passive data channel starting...\n";
# We fire up a new sockfilt to do the data transfer for us.
my $datasockfcmd = "./server/sockfilt " .
- "--ipv$ipvnum --port 0 " .
+ "--ipv$ipvnum $bindonly --port 0 " .
"--pidfile \"$datasockf_pidfile\" " .
"--logfile \"$datasockf_logfile\"";
$slavepid = open2(\*DREAD, \*DWRITE, $datasockfcmd);
+ if($nodataconn) {
+ datasockf_state('PASSIVE_NODATACONN');
+ }
+ else {
+ datasockf_state('PASSIVE');
+ }
+
+ print STDERR "$datasockfcmd\n" if($verbose);
+
print DWRITE "PING\n";
my $pong;
sysread_or_die(\*DREAD, \$pong, 5);
- if($pong !~ /^PONG/) {
- logmsg "failed to run sockfilt for data connection\n";
+ if($pong =~ /^FAIL/) {
+ logmsg "DATA sockfilt said: FAIL\n";
+ logmsg "DATA sockfilt for passive data channel failed\n";
+ logmsg "DATA sockfilt not running\n";
+ datasockf_state('STOPPED');
+ sendcontrol "500 no free ports!\r\n";
+ return;
+ }
+ elsif($pong !~ /^PONG/) {
+ logmsg "DATA sockfilt unexpected response: $pong\n";
+ logmsg "DATA sockfilt for passive data channel failed\n";
+ logmsg "DATA sockfilt killed now\n";
killsockfilters($proto, $ipvnum, $idnum, $verbose, 'data');
+ logmsg "DATA sockfilt not running\n";
+ datasockf_state('STOPPED');
sendcontrol "500 no free ports!\r\n";
- return 0;
+ return;
}
- logmsg "Run sockfilt for data on pid $slavepid\n";
+ logmsg "DATA sockfilt for passive data channel started (pid $slavepid)\n";
- # Find out what port we listen on
+ # Find out on what port we listen on or have bound
my $i;
print DWRITE "PORT\n";
}
# READ the response data
- sysread_or_die(\*DREAD, \$i, $size);
+ read_datasockf(\$i, $size);
# The data is in the format
# IPvX/NNN
$pasvport = $2;
}
+ if(!$pasvport) {
+ logmsg "DATA sockfilt unknown listener port\n";
+ logmsg "DATA sockfilt for passive data channel failed\n";
+ logmsg "DATA sockfilt killed now\n";
+ killsockfilters($proto, $ipvnum, $idnum, $verbose, 'data');
+ logmsg "DATA sockfilt not running\n";
+ datasockf_state('STOPPED');
+ sendcontrol "500 no free ports!\r\n";
+ return;
+ }
+
+ if($nodataconn) {
+ my $str = nodataconn_str();
+ logmsg "DATA sockfilt for passive data channel ($str) bound on port ".
+ "$pasvport\n";
+ }
+ else {
+ logmsg "DATA sockfilt for passive data channel listens on port ".
+ "$pasvport\n";
+ }
+
if($cmd ne "EPSV") {
# PASV reply
my $p=$listenaddr;
$p="1,2,3,4";
}
sendcontrol sprintf("227 Entering Passive Mode ($p,%d,%d)\n",
- ($pasvport/256), ($pasvport%256));
+ int($pasvport/256), int($pasvport%256));
}
else {
# EPSV reply
sendcontrol sprintf("229 Entering Passive Mode (|||%d|)\n", $pasvport);
}
+ logmsg "Client has been notified that DATA conn ".
+ "will be accepted on port $pasvport\n";
+
+ if($nodataconn) {
+ my $str = nodataconn_str();
+ logmsg "====> Client fooled ($str)\n";
+ return;
+ }
+
eval {
local $SIG{ALRM} = sub { die "alarm\n" };
# Wait for 'CNCT'
my $input;
+ # FIX: Monitor ctrl conn for disconnect
+
while(sysread(DREAD, $input, 5)) {
if($input !~ /^CNCT/) {
logmsg "Odd, we got $input from client\n";
next;
}
- logmsg "====> Client DATA connect\n";
+ logmsg "Client connects to port $pasvport\n";
last;
}
alarm 0;
logmsg "$srvrname server timed out awaiting data connection ".
"on port $pasvport\n";
logmsg "accept failed or connection not even attempted\n";
+ logmsg "DATA sockfilt killed now\n";
killsockfilters($proto, $ipvnum, $idnum, $verbose, 'data');
+ logmsg "DATA sockfilt not running\n";
+ datasockf_state('STOPPED');
return;
}
else {
- logmsg "data connection setup on port $pasvport\n";
+ logmsg "====> Client established passive DATA connection ".
+ "on port $pasvport\n";
}
return;
}
-# Support both PORT and EPRT here. Consider LPRT too.
+#
+# Support both PORT and EPRT here.
+#
sub PORT_ftp {
my ($arg, $cmd) = @_;
my $port;
my $addr;
+ # kill previous data connection sockfilt when alive
+ if($datasockf_runs eq 'yes') {
+ killsockfilters($proto, $ipvnum, $idnum, $verbose, 'data');
+ logmsg "DATA sockfilt for $datasockf_mode data channel killed\n";
+ }
+ datasockf_state('STOPPED');
+
+ logmsg "====> Active DATA channel requested by client\n";
+
# 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";
+ logmsg "DATA sockfilt for active data channel not started ".
+ "(bad PORT-line: $arg)\n";
sendcontrol "500 silly you, go away\r\n";
- return 0;
+ return;
}
$port = ($5<<8)+$6;
$addr = "$1.$2.$3.$4";
}
# EPRT |2|::1|49706|
- elsif(($cmd eq "EPRT") && ($grok_eprt)) {
+ elsif($cmd eq "EPRT") {
if($arg !~ /(\d+)\|([^\|]+)\|(\d+)/) {
+ logmsg "DATA sockfilt for active data channel not started ".
+ "(bad EPRT-line: $arg)\n";
sendcontrol "500 silly you, go away\r\n";
- return 0;
+ return;
}
sendcontrol "200 Thanks for dropping by. We contact you later\r\n";
$port = $3;
$addr = $2;
}
else {
+ logmsg "DATA sockfilt for active data channel not started ".
+ "(invalid command: $cmd)\n";
sendcontrol "500 we don't like $cmd now\r\n";
- return 0;
+ return;
}
if(!$port || $port > 65535) {
- print STDERR "very illegal PORT number: $port\n";
- return 1;
+ logmsg "DATA sockfilt for active data channel not started ".
+ "(illegal PORT number: $port)\n";
+ return;
+ }
+
+ if($nodataconn) {
+ my $str = nodataconn_str();
+ logmsg "DATA sockfilt for active data channel not started ($str)\n";
+ datasockf_state('ACTIVE_NODATACONN');
+ logmsg "====> Active DATA channel not established\n";
+ return;
}
+ logmsg "DATA sockfilt for active data channel starting...\n";
+
# We fire up a new sockfilt to do the data transfer for us.
my $datasockfcmd = "./server/sockfilt " .
"--ipv$ipvnum --connect $port --addr \"$addr\" " .
"--logfile \"$datasockf_logfile\"";
$slavepid = open2(\*DREAD, \*DWRITE, $datasockfcmd);
+ datasockf_state('ACTIVE');
+
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";
+ if($pong =~ /^FAIL/) {
+ logmsg "DATA sockfilt said: FAIL\n";
+ logmsg "DATA sockfilt for active data channel failed\n";
+ logmsg "DATA sockfilt not running\n";
+ datasockf_state('STOPPED');
+ # client shall timeout awaiting connection from server
+ return;
+ }
+ elsif($pong !~ /^PONG/) {
+ logmsg "DATA sockfilt unexpected response: $pong\n";
+ logmsg "DATA sockfilt for active data channel failed\n";
+ logmsg "DATA sockfilt killed now\n";
killsockfilters($proto, $ipvnum, $idnum, $verbose, 'data');
+ logmsg "DATA sockfilt not running\n";
+ datasockf_state('STOPPED');
+ # client shall timeout awaiting connection from server
+ return;
}
- logmsg "====> Client DATA connect to port $port\n";
+ logmsg "DATA sockfilt for active data channel started (pid $slavepid)\n";
+
+ logmsg "====> Active DATA channel connected to client port $port\n";
return;
}
#**********************************************************************
+# datasockf_state is used to change variables that keep state info
+# relative to the FTP secondary or data sockfilt process as soon as
+# one of the five possible stable states is reached. Variables that
+# are modified by this sub may be checked independently but should
+# not be changed except by calling this sub.
+#
+sub datasockf_state {
+ my $state = $_[0];
+
+ if($state eq 'STOPPED') {
+ # Data sockfilter initial state, not running,
+ # not connected and not used.
+ $datasockf_state = $state;
+ $datasockf_mode = 'none';
+ $datasockf_runs = 'no';
+ $datasockf_conn = 'no';
+ }
+ elsif($state eq 'PASSIVE') {
+ # Data sockfilter accepted connection from client.
+ $datasockf_state = $state;
+ $datasockf_mode = 'passive';
+ $datasockf_runs = 'yes';
+ $datasockf_conn = 'yes';
+ }
+ elsif($state eq 'ACTIVE') {
+ # Data sockfilter has connected to client.
+ $datasockf_state = $state;
+ $datasockf_mode = 'active';
+ $datasockf_runs = 'yes';
+ $datasockf_conn = 'yes';
+ }
+ elsif($state eq 'PASSIVE_NODATACONN') {
+ # Data sockfilter bound port without listening,
+ # client won't be able to establish data connection.
+ $datasockf_state = $state;
+ $datasockf_mode = 'passive';
+ $datasockf_runs = 'yes';
+ $datasockf_conn = 'no';
+ }
+ elsif($state eq 'ACTIVE_NODATACONN') {
+ # Data sockfilter does not even run,
+ # client awaits data connection from server in vain.
+ $datasockf_state = $state;
+ $datasockf_mode = 'active';
+ $datasockf_runs = 'no';
+ $datasockf_conn = 'no';
+ }
+ else {
+ die "Internal error. Unknown datasockf state: $state!";
+ }
+}
+
+#**********************************************************************
+# nodataconn_str returns string of efective nodataconn command. Notice
+# that $nodataconn may be set alone or in addition to a $nodataconnXXX.
+#
+sub nodataconn_str {
+ my $str;
+ # order matters
+ $str = 'NODATACONN' if($nodataconn);
+ $str = 'NODATACONN425' if($nodataconn425);
+ $str = 'NODATACONN421' if($nodataconn421);
+ $str = 'NODATACONN150' if($nodataconn150);
+ return "$str";
+}
+
+#**********************************************************************
# 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 = (); #
+ $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
+ $nodataconn = 0; # default is to establish or accept data channel
+ $nodataconn425 = 0; # default is to not send 425 without data channel
+ $nodataconn421 = 0; # default is to not send 421 without data channel
+ $nodataconn150 = 0; # default is to not send 150 without data channel
+ @capabilities = (); # default is to not support capability commands
+ @auth_mechs = (); # default is to not support authentication commands
+ %fulltextreply = ();#
+ %commandreply = (); #
+ %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}";
+ if($_ =~ /REPLY \"([A-Z]+ [A-Za-z0-9+-\/=\*. ]+)\" (.*)/) {
+ $fulltextreply{$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
+ elsif($_ =~ /REPLY ([A-Za-z0-9+\/=\*]*) (.*)/) {
+ $commandreply{$1}=eval "qq{$2}";
+ if($1 eq "") {
+ logmsg "FTPD: set custom reply for empty command\n";
+ }
+ else {
+ logmsg "FTPD: set custom reply for $1 command\n";
+ }
+ }
+ elsif($_ =~ /COUNT ([A-Z]+) (.*)/) {
+ # we blank the custom reply 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";
+ logmsg "FTPD: blank custom reply for $1 command after $2 uses\n";
}
elsif($_ =~ /DELAY ([A-Z]+) (\d*)/) {
$delayreply{$1}=$2;
logmsg "FTPD: instructed to use PASVBADIP\n";
$pasvbadip=1;
}
+ elsif($_ =~ /NODATACONN425/) {
+ # applies to both active and passive FTP modes
+ logmsg "FTPD: instructed to use NODATACONN425\n";
+ $nodataconn425=1;
+ $nodataconn=1;
+ }
+ elsif($_ =~ /NODATACONN421/) {
+ # applies to both active and passive FTP modes
+ logmsg "FTPD: instructed to use NODATACONN421\n";
+ $nodataconn421=1;
+ $nodataconn=1;
+ }
+ elsif($_ =~ /NODATACONN150/) {
+ # applies to both active and passive FTP modes
+ logmsg "FTPD: instructed to use NODATACONN150\n";
+ $nodataconn150=1;
+ $nodataconn=1;
+ }
+ elsif($_ =~ /NODATACONN/) {
+ # applies to both active and passive FTP modes
+ logmsg "FTPD: instructed to use NODATACONN\n";
+ $nodataconn=1;
+ }
+ elsif($_ =~ /CAPA (.*)/) {
+ logmsg "FTPD: instructed to support CAPABILITY command\n";
+ @capabilities = split(/ (?!(?:[^" ]|[^"] [^"])+")/, $1);
+ foreach (@capabilities) {
+ $_ = $1 if /^"(.*)"$/;
+ }
+ }
+ elsif($_ =~ /AUTH (.*)/) {
+ logmsg "FTPD: instructed to support AUTHENTICATION command\n";
+ @auth_mechs = split(/ /, $1);
+ }
elsif($_ =~ /NOSAVE/) {
# don't actually store the file we upload - to be used when
# uploading insanely huge amounts
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+)$/)) {
while(1) {
+
+ # kill previous data connection sockfilt when alive
+ if($datasockf_runs eq 'yes') {
+ killsockfilters($proto, $ipvnum, $idnum, $verbose, 'data');
+ logmsg "DATA sockfilt for $datasockf_mode data channel killed now\n";
+ }
+ datasockf_state('STOPPED');
+
#
# We read 'sockfilt' commands.
#
if($input !~ /^CNCT/) {
# we wait for a connected client
- logmsg "sockfilt said: $input";
+ logmsg "MAIN sockfilt said: $input";
next;
}
logmsg "====> Client connect\n";
# flush data:
$| = 1;
- killsockfilters($proto, $ipvnum, $idnum, $verbose, 'data');
-
&customize(); # read test control instructions
- sendcontrol @welcome;
+ my $welcome = $commandreply{"welcome"};
+ if(!$welcome) {
+ $welcome = $displaytext{"welcome"};
+ }
+ else {
+ # clear it after use
+ $commandreply{"welcome"}="";
+ if($welcome !~ /\r\n\z/) {
+ $welcome .= "\r\n";
+ }
+ }
+ sendcontrol $welcome;
#remove global variables from last connection
if($ftplistparserstate) {
}
if($verbose) {
- for(@welcome) {
- print STDERR "OUT: $_";
- }
+ print STDERR "OUT: $welcome";
}
+ my $full = "";
+
while(1) {
my $i;
sysread_or_die(\*SFREAD, \$i, 5);
if($i !~ /^DATA/) {
- logmsg "sockfilt said $i";
+ logmsg "MAIN sockfilt said $i";
if($i =~ /^DISC/) {
# disconnect
last;
}
# data
- sysread SFREAD, $_, $size;
+ read_mainsockf(\$input, $size);
+
+ ftpmsg $input;
+
+ $full .= $input;
- ftpmsg $_;
+ # Loop until command completion
+ next unless($full =~ /\r\n$/);
# Remove trailing CRLF.
- s/[\n\r]+$//;
+ $full =~ 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";
+ if(($full =~ /^([^ ]+) ([^ ]+) (.*)/) ||
+ ($full =~ /^([^ ]+) ([^ ]+)/)) {
+ $cmdid=$1; # set the global variable
+ $FTPCMD=$2;
+ $FTPARG=$3;
+ }
+ # IMAP authentication cancellation
+ elsif($full =~ /^\*$/) {
+ # Command id has already been set
+ $FTPCMD="*";
+ $FTPARG="";
+ }
+ # IMAP long "commands" are base64 authentication data
+ elsif($full =~ /^[A-Z0-9+\/]*={0,2}$/i) {
+ # Command id has already been set
+ $FTPCMD=$full;
+ $FTPARG="";
+ }
+ else {
+ sendcontrol "$full BAD Command\r\n";
last;
}
- $cmdid=$1; # set the global variable
- $FTPCMD=$2;
- $FTPARG=$3;
}
- elsif (m/^([A-Z]{3,4})(\s(.*))?$/i) {
+ elsif($full =~ /^([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="";
+ elsif($proto eq "pop3") {
+ # POP3 authentication cancellation
+ if($full =~ /^\*$/) {
+ $FTPCMD="*";
+ $FTPARG="";
+ }
+ # POP3 long "commands" are base64 authentication data
+ elsif($full =~ /^[A-Z0-9+\/]*={0,2}$/i) {
+ $FTPCMD=$full;
+ $FTPARG="";
+ }
+ else {
+ sendcontrol "-ERR Unrecognized command\r\n";
+ last;
+ }
+ }
+ elsif($proto eq "smtp") {
+ # SMTP authentication cancellation
+ if($full =~ /^\*$/) {
+ $FTPCMD="*";
+ $FTPARG="";
+ }
+ # SMTP long "commands" are base64 authentication data
+ elsif($full =~ /^[A-Z0-9+\/]{0,512}={0,2}$/i) {
+ $FTPCMD=$full;
+ $FTPARG="";
+ }
+ else {
+ sendcontrol "500 Unrecognized command\r\n";
+ last;
+ }
}
else {
- sendcontrol "500 '$_': command not understood.\r\n";
+ sendcontrol "500 Unrecognized command\r\n";
last;
}
print STDERR "IN: $full\n";
}
+ $full = "";
+
my $delay = $delayreply{$FTPCMD};
if($delay) {
# just go sleep this many seconds!
}
}
- my $text;
- $text = $customreply{$FTPCMD};
- my $fake = $text;
+ my $check = 1; # no response yet
+ # See if there is a custom reply for the full text
+ my $fulltext = $FTPARG ? $FTPCMD . " " . $FTPARG : $FTPCMD;
+ my $text = $fulltextreply{$fulltext};
if($text && ($text ne "")) {
- if($customcount{$FTPCMD} && (!--$customcount{$FTPCMD})) {
- # used enough number of times, now blank the customreply
- $customreply{$FTPCMD}="";
- }
+ sendcontrol "$text\r\n";
+ $check = 0;
}
else {
- $text = $displaytext{$FTPCMD};
- }
- my $check;
- if($text && ($text ne "")) {
- if($cmdid && ($cmdid ne "")) {
- sendcontrol "$cmdid$text\r\n";
- }
- else {
+ # See if there is a custom reply for the command
+ $text = $commandreply{$FTPCMD};
+ if($text && ($text ne "")) {
+ if($customcount{$FTPCMD} && (!--$customcount{$FTPCMD})) {
+ # used enough times so blank the custom command reply
+ $commandreply{$FTPCMD}="";
+ }
+
sendcontrol "$text\r\n";
+ $check = 0;
}
- }
- 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
+ else {
+ # See if there is any display text for the command
+ $text = $displaytext{$FTPCMD};
+ if($text && ($text ne "")) {
+ if($proto eq 'imap') {
+ sendcontrol "$cmdid $text\r\n";
+ }
+ else {
+ sendcontrol "$text\r\n";
+ }
+
+ $check = 0;
+ }
+
+ # only perform this if we're not faking a reply
+ my $func = $commandfunc{$FTPCMD};
+ if($func) {
+ &$func($FTPARG, $FTPCMD);
+ $check = 0;
+ }
}
}
if($check) {
logmsg "$FTPCMD wasn't handled!\n";
- sendcontrol "500 $FTPCMD is not dealt with!\r\n";
+ if($proto eq 'pop3') {
+ sendcontrol "-ERR $FTPCMD is not dealt with!\r\n";
+ }
+ elsif($proto eq 'imap') {
+ sendcontrol "$cmdid BAD $FTPCMD is not dealt with!\r\n";
+ }
+ else {
+ sendcontrol "500 $FTPCMD is not dealt with!\r\n";
+ }
}
} # while(1)
projects / external / curl.git / blobdiff