BEGIN {
push(@INC, $ENV{'srcdir'}) if(defined $ENV{'srcdir'});
push(@INC, ".");
eval {
no warnings "all";
require Time::HiRes;
import Time::HiRes qw( gettimeofday );
}
}
use strict;
use warnings;
use IPC::Open2;
use Digest::MD5;
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
);
my $verbose = 0; my $idstr = ""; my $idnum = 1; my $ipvnum = 4; my $proto = 'ftp'; my $srcdir; my $srvrname; my $cwd_testno; my $path = '.';
my $logdir = $path .'/log';
my $port = 8921; my $listenaddr = '127.0.0.1';
my $pidfile; my $logfile; my $mainsockf_pidfile; my $mainsockf_logfile; my $datasockf_pidfile; my $datasockf_logfile;
my $SERVERLOGS_LOCK = 'log/serverlogs.lock';
my $serverlogslocked = 0;
my $sfpid; my $slavepid;
local *SFREAD; local *SFWRITE; local *DREAD; local *DWRITE;
my $sockfilt_timeout = 5;
my %commandfunc; my %displaytext;
my $ctrldelay; my $datadelay; my $retrweirdo; my $retrnosize; my $pasvbadip; my $nosave; my $nodataconn; my $nodataconn425; my $nodataconn421; my $nodataconn150; my @capabilities; my @auth_mechs; my %fulltextreply; my %commandreply; my %customcount; my %delayreply;
my $ftplistparserstate;
my $ftptargetdir="";
my $datasockf_state = 'STOPPED'; my $datasockf_mode = 'none'; my $datasockf_runs = 'no'; my $datasockf_conn = 'no';
my $got_exit_signal = 0; my $exit_signal;
my $TEXT_PASSWORD = "secret";
my $POP3_TIMESTAMP = "<1972.987654321\@curl>";
sub exit_signal_handler {
my $signame = shift;
killsockfilters($proto, $ipvnum, $idnum, $verbose);
unlink($pidfile);
if($serverlogslocked) {
$serverlogslocked = 0;
clear_advisor_read_lock($SERVERLOGS_LOCK);
}
exit;
}
sub logmsg {
my $now;
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 {
open(INPUT, ">>log/server$idstr.input") ||
logmsg "failed to open log/server$idstr.input\n";
print INPUT @_;
close(INPUT);
}
sub eXsysread {
my $FH = shift;
my $scalar = shift;
my $nbytes = shift;
my $timeout = shift; 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) {
$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;
}
sub read_mainsockf {
my $scalar = shift;
my $nbytes = shift;
my $timeout = shift; 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;
}
sub read_datasockf {
my $scalar = shift;
my $nbytes = shift;
my $timeout = shift; 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;
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 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;
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;
}
}
sub sendcontrol {
if(!$ctrldelay) {
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/[CR]/g;
$l =~ s/\n/[LF]/g;
logmsg "> \"$l\"\n";
}
}
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) {
sockfiltsecondary $l;
}
else {
for (split(//,$l)) {
sockfiltsecondary $_;
select(undef, undef, undef, 0.01);
}
}
}
}
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, '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', 'QUIT' => '221 bye bye baby', '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' => join("",
'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 = (
'welcome' => join("",
' _ _ ____ _ '."\r\n",
' ___| | | | _ \| | '."\r\n",
' / __| | | | |_) | | '."\r\n",
' | (__| |_| | _ {| |___ '."\r\n",
' \___|\___/|_| \_\_____|'."\r\n",
'+OK curl POP3 server ready to serve '."\r\n")
);
}
elsif($proto eq 'imap') {
%commandfunc = (
'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 = (
'welcome' => join("",
' _ _ ____ _ '."\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,
'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 = (
'welcome' => join("",
'220- _ _ ____ _ '."\r\n",
'220- ___| | | | _ \| | '."\r\n",
'220- / __| | | | |_) | | '."\r\n",
'220- | (__| |_| | _ {| |___ '."\r\n",
'220 \___|\___/|_| \_\_____|'."\r\n")
);
}
}
sub close_dataconn {
my ($closed)=@_;
my $datapid = processexists($datasockf_pidfile);
logmsg "=====> Closing $datasockf_mode DATA connection...\n";
if(!$closed) {
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 "Server knows $datasockf_mode DATA connection is already ".
"disconnected\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');
}
my $smtp_type;
my $smtp_client;
sub EHLO_smtp {
my ($client) = @_;
my @data;
if(!$client) {
$client = "[127.0.0.1]";
}
$smtp_type = "ESMTP";
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";
}
}
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";
}
}
$smtp_client = $client;
return 0;
}
sub HELO_smtp {
my ($client) = @_;
if(!$client) {
$client = "[127.0.0.1]";
}
$smtp_type = "SMTP";
sendcontrol "250 $smtp_type pingpong test server Hello $client\r\n";
$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 {
my $from;
my $size;
my @elements = split(/ /, $args);
for my $e (@elements) {
if($e =~ /^FROM:(.*)$/) {
$from = $1;
}
elsif($e =~ /^SIZE=(\d+)$/) {
$size = $1;
}
}
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;
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";
}
}
}
return 0;
}
sub RCPT_smtp {
my ($args) = @_;
logmsg "RCPT_smtp got $args\n";
if($args !~ /^TO:(.*)/) {
sendcontrol "501 Unrecognized parameter\r\n";
}
else {
my $to = $1;
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";
}
}
return 0;
}
sub DATA_smtp {
my ($args) = @_;
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";
my $testno = $smtp_client;
my $filename = "log/upload.$testno";
logmsg "Store test number $testno in $filename\n";
open(FILE, ">$filename") ||
return 0;
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);
}
read_mainsockf(\$line, $size);
$ulsize += $size;
print FILE $line if(!$nosave);
$raw .= $line;
if($raw =~ /(?:^|\x0d\x0a)\x2e\x0d\x0a/) {
$eob = 1;
}
logmsg "> Appending $size bytes to file\n";
if($eob) {
logmsg "Found SMTP EOB marker\n";
last;
}
}
elsif($line eq "DISC\n") {
$disc=1;
last;
}
else {
logmsg "No support for: $line";
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) = @_;
if($args) {
logmsg "HELP_smtp got $args\n";
}
if($smtp_client eq "verifiedserver") {
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 {
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;
}
my @deleted;
my $cmdid;
my $selected;
sub fix_imap_params {
foreach (@_) {
$_ = $1 if /^"(.*)"$/;
}
}
sub CAPABILITY_imap {
if((!@capabilities) && (!@auth_mechs)) {
sendcontrol "$cmdid BAD Command\r\n";
}
else {
my $data;
$data = "* CAPABILITY IMAP4";
for my $c (@capabilities) {
$data .= " $c";
}
for my $am (@auth_mechs) {
$data .= " AUTH=$am";
}
$data .= " pingpong test server\r\n";
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";
}
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 {
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") {
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";
@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;
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") {
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) {
sendcontrol "* 172 EXISTS\r\n";
}
else {
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 (substr($command, 0, 5) eq "FETCH"){
my $func = $commandfunc{"FETCH"};
if($func) {
&$func($args, $command);
}
}
elsif (($command ne "COPY") &&
($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;
}
my $username;
sub CAPA_pop3 {
my @list = ();
my $mechs;
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 = ();
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";
for my $d (@data) {
sendcontrol $d;
}
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 ($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 = ();
push @data, "+OK List of supported mechanisms follows\r\n";
for my $am (@auth_mechs) {
push @data, "$am\r\n";
}
for my $d (@data) {
sendcontrol $d;
}
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";
sendcontrol "+OK Login successful\r\n";
return 0;
}
sub RETR_pop3 {
my ($msgid) = @_;
my @data;
if($msgid =~ /^verifiedserver$/) {
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";
@data = getreplydata($msgid);
}
sendcontrol "+OK Mail transfer starts\r\n";
for my $d (@data) {
sendcontrol $d;
}
sendcontrol ".\r\n";
return 0;
}
sub LIST_pop3 {
my @data = (
"1 100\r\n",
"2 4294967400\r\n", "3 200\r\n",
);
logmsg "retrieve a message list\n";
sendcontrol "+OK Listing starts\r\n";
for my $d (@data) {
sendcontrol $d;
}
sendcontrol ".\r\n";
return 0;
}
sub DELE_pop3 {
my ($msgid) = @_;
logmsg "DELE_pop3 got $msgid\n";
if (!$msgid) {
sendcontrol "-ERR Protocol error\r\n";
}
else {
push (@deleted, $msgid);
sendcontrol "+OK\r\n";
}
return 0;
}
sub STAT_pop3 {
my ($args) = @_;
if ($args) {
sendcontrol "-ERR Protocol error\r\n";
}
else {
sendcontrol "+OK 3 4294967800\r\n";
}
return 0;
}
sub NOOP_pop3 {
my ($args) = @_;
if ($args) {
sendcontrol "-ERR Protocol error\r\n";
}
else {
sendcontrol "+OK\r\n";
}
return 0;
}
sub UIDL_pop3 {
my @data = (
"1 1\r\n",
"2 2\r\n",
"3 4\r\n", );
if (!grep /^UIDL$/, @capabilities) {
sendcontrol "-ERR Unrecognized command\r\n";
}
else {
logmsg "retrieve a message UID list\n";
sendcontrol "+OK Listing starts\r\n";
for my $d (@data) {
sendcontrol $d;
}
sendcontrol ".\r\n";
}
return 0;
}
sub TOP_pop3 {
my ($args) = @_;
my ($msgid, $lines) = split(/ /, $args, 2);
logmsg "TOP_pop3 got $args\n";
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";
}
my @data = getreplydata($msgid);
sendcontrol "+OK Mail transfer starts\r\n";
for my $d (@data) {
sendcontrol $d;
}
sendcontrol ".\r\n";
}
return 0;
}
sub RSET_pop3 {
my ($args) = @_;
if ($args) {
sendcontrol "-ERR Protocol error\r\n";
}
else {
if (@deleted) {
logmsg "resetting @deleted message(s)\n";
@deleted = ();
}
sendcontrol "+OK\r\n";
}
return 0;
}
sub QUIT_pop3 {
if(@deleted) {
logmsg "deleting @deleted message(s)\n";
@deleted = ();
}
sendcontrol "+OK curl POP3 server signing off\r\n";
return 0;
}
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 =~ /^test-(\d+)/) {
$cwd_testno = $1;
}
elsif($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 {
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($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";
}
else {
}
return 0;
}
if($ftplistparserstate) {
@ftpdir = ftp_contentlist($ftptargetdir);
}
logmsg "pass LIST data on data connection\n";
if($cwd_testno) {
loadtest("$srcdir/data/test$cwd_testno");
my @data = getpart("reply", "data");
for(@data) {
my $send = $_;
$send =~ s/\r\n/\n/g;
$send =~ s/\n/\r\n/g;
logmsg "send $send as data\n";
senddata $send;
}
$cwd_testno = 0; }
else {
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");
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";
}
else {
}
return 0;
}
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($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";
}
else {
}
return 0;
}
if($ftplistparserstate) {
my @content = wildcard_getfile($ftptargetdir, $testno);
if($content[0] == -1) {
}
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$/) {
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) {
$size -= $rest;
logmsg "REST $rest was removed from size, makes $size left\n";
$rest = 0; }
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; }
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";
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";
}
else {
}
return 0;
}
logmsg "STOR test number $testno in $filename\n";
sendcontrol "125 Gimme gimme gimme!\r\n";
open(FILE, ">$filename") ||
return 0;
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);
}
read_datasockf(\$line, $size);
$ulsize += $size;
print FILE $line if(!$nosave);
logmsg "> Appending $size bytes to file\n";
}
elsif($line eq "DISC\n") {
$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;
my $bindonly = ($nodataconn) ? '--bindonly' : '';
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";
my $datasockfcmd = "./server/sockfilt " .
"--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 =~ /^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;
}
logmsg "DATA sockfilt for passive data channel started (pid $slavepid)\n";
my $i;
print DWRITE "PORT\n";
sysread_or_die(\*DREAD, \$i, 5);
sysread_or_die(\*DREAD, \$i, 5);
my $size = 0;
if($i =~ /^([0-9a-fA-F]{4})\n/) {
$size = hex($1);
}
read_datasockf(\$i, $size);
if($i =~ /IPv(\d)\/(\d+)/) {
$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") {
my $p=$listenaddr;
$p =~ s/\./,/g;
if($pasvbadip) {
$p="1,2,3,4";
}
sendcontrol sprintf("227 Entering Passive Mode ($p,%d,%d)\n",
int($pasvport/256), int($pasvport%256));
}
else {
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" };
alarm ($datadelay?20:10);
my $input;
while(sysread(DREAD, $input, 5)) {
if($input !~ /^CNCT/) {
logmsg "Odd, we got $input from client\n";
next;
}
logmsg "Client connects to port $pasvport\n";
last;
}
alarm 0;
};
if ($@) {
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 "====> Client established passive DATA connection ".
"on port $pasvport\n";
}
return;
}
sub PORT_ftp {
my ($arg, $cmd) = @_;
my $port;
my $addr;
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";
if($cmd eq "PORT") {
if($arg !~ /(\d+),(\d+),(\d+),(\d+),(\d+),(\d+)/) {
logmsg "DATA sockfilt for active data channel not started ".
"(bad PORT-line: $arg)\n";
sendcontrol "500 silly you, go away\r\n";
return;
}
$port = ($5<<8)+$6;
$addr = "$1.$2.$3.$4";
}
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;
}
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;
}
if(!$port || $port > 65535) {
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";
my $datasockfcmd = "./server/sockfilt " .
"--ipv$ipvnum --connect $port --addr \"$addr\" " .
"--pidfile \"$datasockf_pidfile\" " .
"--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 =~ /^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');
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');
return;
}
logmsg "DATA sockfilt for active data channel started (pid $slavepid)\n";
logmsg "====> Active DATA channel connected to client port $port\n";
return;
}
sub datasockf_state {
my $state = $_[0];
if($state eq 'STOPPED') {
$datasockf_state = $state;
$datasockf_mode = 'none';
$datasockf_runs = 'no';
$datasockf_conn = 'no';
}
elsif($state eq 'PASSIVE') {
$datasockf_state = $state;
$datasockf_mode = 'passive';
$datasockf_runs = 'yes';
$datasockf_conn = 'yes';
}
elsif($state eq 'ACTIVE') {
$datasockf_state = $state;
$datasockf_mode = 'active';
$datasockf_runs = 'yes';
$datasockf_conn = 'yes';
}
elsif($state eq 'PASSIVE_NODATACONN') {
$datasockf_state = $state;
$datasockf_mode = 'passive';
$datasockf_runs = 'yes';
$datasockf_conn = 'no';
}
elsif($state eq 'ACTIVE_NODATACONN') {
$datasockf_state = $state;
$datasockf_mode = 'active';
$datasockf_runs = 'no';
$datasockf_conn = 'no';
}
else {
die "Internal error. Unknown datasockf state: $state!";
}
}
sub nodataconn_str {
my $str;
$str = 'NODATACONN' if($nodataconn);
$str = 'NODATACONN425' if($nodataconn425);
$str = 'NODATACONN421' if($nodataconn421);
$str = 'NODATACONN150' if($nodataconn150);
return "$str";
}
sub customize {
$ctrldelay = 0; $datadelay = 0; $retrweirdo = 0; $retrnosize = 0; $pasvbadip = 0; $nosave = 0; $nodataconn = 0; $nodataconn425 = 0; $nodataconn421 = 0; $nodataconn150 = 0; @capabilities = (); @auth_mechs = (); %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-Z]+ [A-Za-z0-9+-\/=\*. ]+)\" (.*)/) {
$fulltextreply{$1}=eval "qq{$2}";
logmsg "FTPD: set custom reply for $1\n";
}
elsif($_ =~ /REPLY(LF|) ([A-Za-z0-9+\/=\*]*) (.*)/) {
$commandreply{$2}=eval "qq{$3}";
if($1 ne "LF") {
$commandreply{$2}.="\r\n";
}
else {
$commandreply{$2}.="\n";
}
if($2 eq "") {
logmsg "FTPD: set custom reply for empty command\n";
}
else {
logmsg "FTPD: set custom reply for $2 command\n";
}
}
elsif($_ =~ /COUNT ([A-Z]+) (.*)/) {
$customcount{$1}=$2;
logmsg "FTPD: blank custom reply for $1 command 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($_ =~ /NODATACONN425/) {
logmsg "FTPD: instructed to use NODATACONN425\n";
$nodataconn425=1;
$nodataconn=1;
}
elsif($_ =~ /NODATACONN421/) {
logmsg "FTPD: instructed to use NODATACONN421\n";
$nodataconn421=1;
$nodataconn=1;
}
elsif($_ =~ /NODATACONN150/) {
logmsg "FTPD: instructed to use NODATACONN150\n";
$nodataconn150=1;
$nodataconn=1;
}
elsif($_ =~ /NODATACONN/) {
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/) {
$nosave = 1;
logmsg "FTPD: NOSAVE prevents saving of uploaded data\n";
}
}
close(CUSTOM);
}
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');
}
elsif($ARGV[0] eq '--ipv6') {
$ipvnum = 6;
$listenaddr = '::1' if($listenaddr eq '127.0.0.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;
}
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) {
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');
my $input;
logmsg "Awaiting input\n";
sysread_or_die(\*SFREAD, \$input, 5);
if($input !~ /^CNCT/) {
logmsg "MAIN sockfilt said: $input";
next;
}
logmsg "====> Client connect\n";
set_advisor_read_lock($SERVERLOGS_LOCK);
$serverlogslocked = 1;
$| = 1;
&customize();
my $welcome = $commandreply{"welcome"};
if(!$welcome) {
$welcome = $displaytext{"welcome"};
}
else {
$commandreply{"welcome"}="";
if($welcome !~ /\r\n\z/) {
$welcome .= "\r\n";
}
}
sendcontrol $welcome;
if($ftplistparserstate) {
undef $ftplistparserstate;
}
if($ftptargetdir) {
$ftptargetdir = "";
}
if($verbose) {
print STDERR "OUT: $welcome";
}
my $full = "";
while(1) {
my $i;
sysread_or_die(\*SFREAD, \$i, 5);
if($i !~ /^DATA/) {
logmsg "MAIN sockfilt said $i";
if($i =~ /^DISC/) {
last;
}
next;
}
sysread_or_die(\*SFREAD, \$i, 5);
my $size = 0;
if($i =~ /^([0-9a-fA-F]{4})\n/) {
$size = hex($1);
}
read_mainsockf(\$input, $size);
ftpmsg $input;
$full .= $input;
next unless($full =~ /\r\n$/);
$full =~ s/[\n\r]+$//;
my $FTPCMD;
my $FTPARG;
if($proto eq "imap") {
if(($full =~ /^([^ ]+) ([^ ]+) (.*)/) ||
($full =~ /^([^ ]+) ([^ ]+)/)) {
$cmdid=$1; $FTPCMD=$2;
$FTPARG=$3;
}
elsif($full =~ /^\*$/) {
$FTPCMD="*";
$FTPARG="";
}
elsif($full =~ /^[A-Z0-9+\/]*={0,2}$/i) {
$FTPCMD=$full;
$FTPARG="";
}
else {
sendcontrol "$full BAD Command\r\n";
last;
}
}
elsif($full =~ /^([A-Z]{3,4})(\s(.*))?$/i) {
$FTPCMD=$1;
$FTPARG=$3;
}
elsif($proto eq "pop3") {
if($full =~ /^\*$/) {
$FTPCMD="*";
$FTPARG="";
}
elsif($full =~ /^[A-Z0-9+\/]*={0,2}$/i) {
$FTPCMD=$full;
$FTPARG="";
}
else {
sendcontrol "-ERR Unrecognized command\r\n";
last;
}
}
elsif($proto eq "smtp") {
if($full =~ /^\*$/) {
$FTPCMD="*";
$FTPARG="";
}
elsif($full =~ /^[A-Z0-9+\/]{0,512}={0,2}$/i) {
$FTPCMD=$full;
$FTPARG="";
}
else {
sendcontrol "500 Unrecognized command\r\n";
last;
}
}
else {
sendcontrol "500 Unrecognized command\r\n";
last;
}
logmsg "< \"$full\"\n";
if($verbose) {
print STDERR "IN: $full\n";
}
$full = "";
my $delay = $delayreply{$FTPCMD};
if($delay) {
logmsg("Sleep for $delay seconds\n");
my $twentieths = $delay * 20;
while($twentieths--) {
select(undef, undef, undef, 0.05) unless($got_exit_signal);
}
}
my $check = 1;
my $fulltext = $FTPARG ? $FTPCMD . " " . $FTPARG : $FTPCMD;
my $text = $fulltextreply{$fulltext};
if($text && ($text ne "")) {
sendcontrol "$text\r\n";
$check = 0;
}
else {
$text = $commandreply{$FTPCMD};
if($text && ($text ne "")) {
if($customcount{$FTPCMD} && (!--$customcount{$FTPCMD})) {
$commandreply{$FTPCMD}="";
}
sendcontrol $text;
$check = 0;
}
else {
$text = $displaytext{$FTPCMD};
if($text && ($text ne "")) {
if($proto eq 'imap') {
sendcontrol "$cmdid $text\r\n";
}
else {
sendcontrol "$text\r\n";
}
$check = 0;
}
my $func = $commandfunc{uc($FTPCMD)};
if($func) {
&$func($FTPARG, $FTPCMD);
$check = 0;
}
}
}
if($check) {
logmsg "$FTPCMD wasn't handled!\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";
}
}
} 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;