| #!/usr/bin/env perl |
| #*************************************************************************** |
| # _ _ ____ _ |
| # Project ___| | | | _ \| | |
| # / __| | | | |_) | | |
| # | (__| |_| | _ <| |___ |
| # \___|\___/|_| \_\_____| |
| # |
| # Copyright (C) 1998 - 2010, Daniel Stenberg, <daniel@haxx.se>, et al. |
| # |
| # This software is licensed as described in the file COPYING, which |
| # you should have received as part of this distribution. The terms |
| # are also available at http://curl.haxx.se/docs/copyright.html. |
| # |
| # You may opt to use, copy, modify, merge, publish, distribute and/or sell |
| # copies of the Software, and permit persons to whom the Software is |
| # furnished to do so, under the terms of the COPYING file. |
| # |
| # This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY |
| # KIND, either express or implied. |
| # |
| ########################################################################### |
| |
| # This is a server designed for the curl test suite. |
| # |
| # In December 2009 we started remaking the server to support more protocols |
| # that are similar in spirit. Like POP3, IMAP and SMTP in addition to the FTP |
| # it already supported since a long time. Note that it still only supports one |
| # protocol per invoke. You need to start multiple servers to support multiple |
| # protocols simultaneously. |
| # |
| # It is meant to exercise curl, it is not meant to be a fully working |
| # or even very standard compliant server. |
| # |
| # You may optionally specify port on the command line, otherwise it'll |
| # default to port 8921. |
| # |
| # All socket/network/TCP related stuff is done by the 'sockfilt' program. |
| # |
| |
| BEGIN { |
| @INC=(@INC, $ENV{'srcdir'}, '.'); |
| # sub second timestamping needs Time::HiRes |
| eval { |
| no warnings "all"; |
| require Time::HiRes; |
| import Time::HiRes qw( gettimeofday ); |
| } |
| } |
| |
| use strict; |
| use warnings; |
| use IPC::Open2; |
| |
| require "getpart.pm"; |
| require "ftp.pm"; |
| require "directories.pm"; |
| |
| use serverhelp qw( |
| servername_str |
| server_pidfilename |
| server_logfilename |
| mainsockf_pidfilename |
| mainsockf_logfilename |
| datasockf_pidfilename |
| datasockf_logfilename |
| ); |
| |
| #********************************************************************** |
| # global vars... |
| # |
| my $verbose = 0; # set to 1 for debugging |
| my $idstr = ""; # server instance string |
| my $idnum = 1; # server instance number |
| my $ipvnum = 4; # server IPv number (4 or 6) |
| my $proto = 'ftp'; # default server protocol |
| my $srcdir; # directory where ftpserver.pl is located |
| my $srvrname; # server name for presentation purposes |
| my $grok_eprt; |
| |
| my $path = '.'; |
| my $logdir = $path .'/log'; |
| |
| #********************************************************************** |
| # global vars used for server address and primary listener port |
| # |
| my $port = 8921; # default primary listener port |
| my $listenaddr = '127.0.0.1'; # default address for listener port |
| |
| #********************************************************************** |
| # global vars used for file names |
| # |
| my $pidfile; # server pid file name |
| my $logfile; # server log file name |
| my $mainsockf_pidfile; # pid file for primary connection sockfilt process |
| my $mainsockf_logfile; # log file for primary connection sockfilt process |
| my $datasockf_pidfile; # pid file for secondary connection sockfilt process |
| my $datasockf_logfile; # log file for secondary connection sockfilt process |
| |
| #********************************************************************** |
| # global vars used for server logs advisor read lock handling |
| # |
| my $SERVERLOGS_LOCK = 'log/serverlogs.lock'; |
| my $serverlogslocked = 0; |
| |
| #********************************************************************** |
| # global vars used for child processes PID tracking |
| # |
| my $sfpid; # PID for primary connection sockfilt process |
| my $slavepid; # PID for secondary connection sockfilt process |
| |
| #********************************************************************** |
| # global typeglob filehandle vars to read/write from/to sockfilters |
| # |
| local *SFREAD; # used to read from primary connection |
| local *SFWRITE; # used to write to primary connection |
| local *DREAD; # used to read from secondary connection |
| local *DWRITE; # used to write to secondary connection |
| |
| #********************************************************************** |
| # global vars which depend on server protocol selection |
| # |
| my %commandfunc; # protocol command specific function callbacks |
| my %displaytext; # text returned to client before callback runs |
| my @welcome; # text returned to client upon connection |
| |
| #********************************************************************** |
| # global vars customized for each test from the server commands file |
| # |
| my $ctrldelay; # set if server should throttle ctrl stream |
| my $datadelay; # set if server should throttle data stream |
| my $retrweirdo; # set if ftp server should use RETRWEIRDO |
| my $retrnosize; # set if ftp server should use RETRNOSIZE |
| my $pasvbadip; # set if ftp server should use PASVBADIP |
| my $nosave; # set if ftp server should not save uploaded data |
| my %customreply; # |
| my %customcount; # |
| my %delayreply; # |
| |
| #********************************************************************** |
| # global variables for to test ftp wildcardmatching or other test that |
| # need flexible LIST responses.. and corresponding files. |
| # $ftptargetdir is keeping the fake "name" of LIST directory. |
| my $ftplistparserstate; |
| my $ftptargetdir; |
| |
| #********************************************************************** |
| # global vars used for signal handling |
| # |
| my $got_exit_signal = 0; # set if program should finish execution ASAP |
| my $exit_signal; # first signal handled in exit_signal_handler |
| |
| #********************************************************************** |
| # exit_signal_handler will be triggered to indicate that the program |
| # should finish its execution in a controlled way as soon as possible. |
| # For now, program will also terminate from within this handler. |
| # |
| sub exit_signal_handler { |
| my $signame = shift; |
| # For now, simply mimic old behavior. |
| killsockfilters($proto, $ipvnum, $idnum, $verbose); |
| unlink($pidfile); |
| if($serverlogslocked) { |
| $serverlogslocked = 0; |
| clear_advisor_read_lock($SERVERLOGS_LOCK); |
| } |
| exit; |
| } |
| |
| #********************************************************************** |
| # logmsg is general message logging subroutine for our test servers. |
| # |
| sub logmsg { |
| my $now; |
| # sub second timestamping needs Time::HiRes |
| if($Time::HiRes::VERSION) { |
| my ($seconds, $usec) = gettimeofday(); |
| my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = |
| localtime($seconds); |
| $now = sprintf("%02d:%02d:%02d.%06d ", $hour, $min, $sec, $usec); |
| } |
| else { |
| my $seconds = time(); |
| my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = |
| localtime($seconds); |
| $now = sprintf("%02d:%02d:%02d ", $hour, $min, $sec); |
| } |
| if(open(LOGFILEFH, ">>$logfile")) { |
| print LOGFILEFH $now; |
| print LOGFILEFH @_; |
| close(LOGFILEFH); |
| } |
| } |
| |
| sub ftpmsg { |
| # append to the server.input file |
| open(INPUT, ">>log/server$idstr.input") || |
| logmsg "failed to open log/server$idstr.input\n"; |
| |
| print INPUT @_; |
| close(INPUT); |
| |
| # use this, open->print->close system only to make the file |
| # open as little as possible, to make the test suite run |
| # better on windows/cygwin |
| } |
| |
| |
| sub sysread_or_die { |
| my $FH = shift; |
| my $scalar = shift; |
| my $length = shift; |
| my $fcaller; |
| my $lcaller; |
| my $result; |
| |
| $result = sysread($$FH, $$scalar, $length); |
| |
| if(not defined $result) { |
| ($fcaller, $lcaller) = (caller)[1,2]; |
| logmsg "Failed to read input\n"; |
| logmsg "Error: $srvrname server, sysread error: $!\n"; |
| logmsg "Exited from sysread_or_die() at $fcaller " . |
| "line $lcaller. $srvrname server, sysread error: $!\n"; |
| killsockfilters($proto, $ipvnum, $idnum, $verbose); |
| unlink($pidfile); |
| if($serverlogslocked) { |
| $serverlogslocked = 0; |
| clear_advisor_read_lock($SERVERLOGS_LOCK); |
| } |
| exit; |
| } |
| elsif($result == 0) { |
| ($fcaller, $lcaller) = (caller)[1,2]; |
| logmsg "Failed to read input\n"; |
| logmsg "Error: $srvrname server, read zero\n"; |
| logmsg "Exited from sysread_or_die() at $fcaller " . |
| "line $lcaller. $srvrname server, read zero\n"; |
| killsockfilters($proto, $ipvnum, $idnum, $verbose); |
| unlink($pidfile); |
| if($serverlogslocked) { |
| $serverlogslocked = 0; |
| clear_advisor_read_lock($SERVERLOGS_LOCK); |
| } |
| exit; |
| } |
| |
| return $result; |
| } |
| |
| sub startsf { |
| my $mainsockfcmd = "./server/sockfilt " . |
| "--ipv$ipvnum --port $port " . |
| "--pidfile \"$mainsockf_pidfile\" " . |
| "--logfile \"$mainsockf_logfile\""; |
| $sfpid = open2(*SFREAD, *SFWRITE, $mainsockfcmd); |
| |
| print STDERR "$mainsockfcmd\n" if($verbose); |
| |
| print SFWRITE "PING\n"; |
| my $pong; |
| sysread_or_die(\*SFREAD, \$pong, 5); |
| |
| if($pong !~ /^PONG/) { |
| logmsg "Failed sockfilt command: $mainsockfcmd\n"; |
| killsockfilters($proto, $ipvnum, $idnum, $verbose); |
| unlink($pidfile); |
| if($serverlogslocked) { |
| $serverlogslocked = 0; |
| clear_advisor_read_lock($SERVERLOGS_LOCK); |
| } |
| die "Failed to start sockfilt!"; |
| } |
| } |
| |
| |
| sub sockfilt { |
| my $l; |
| foreach $l (@_) { |
| printf SFWRITE "DATA\n%04x\n", length($l); |
| print SFWRITE $l; |
| } |
| } |
| |
| |
| sub sockfiltsecondary { |
| my $l; |
| foreach $l (@_) { |
| printf DWRITE "DATA\n%04x\n", length($l); |
| print DWRITE $l; |
| } |
| } |
| |
| |
| # Send data to the client on the control stream, which happens to be plain |
| # stdout. |
| |
| sub sendcontrol { |
| if(!$ctrldelay) { |
| # spit it all out at once |
| sockfilt @_; |
| } |
| else { |
| my $a = join("", @_); |
| my @a = split("", $a); |
| |
| for(@a) { |
| sockfilt $_; |
| select(undef, undef, undef, 0.01); |
| } |
| } |
| my $log; |
| foreach $log (@_) { |
| my $l = $log; |
| $l =~ s/[\r\n]//g; |
| logmsg "> \"$l\"\n"; |
| } |
| } |
| |
| # Send data to the client on the data stream |
| |
| sub senddata { |
| my $l; |
| foreach $l (@_) { |
| if(!$datadelay) { |
| # spit it all out at once |
| sockfiltsecondary $l; |
| } |
| else { |
| # pause between each byte |
| for (split(//,$l)) { |
| sockfiltsecondary $_; |
| select(undef, undef, undef, 0.01); |
| } |
| } |
| } |
| } |
| |
| #********************************************************************** |
| # protocolsetup initializes the 'displaytext' and 'commandfunc' hashes |
| # for the given protocol. References to protocol command callbacks are |
| # stored in 'commandfunc' hash, and text which will be returned to the |
| # client before the command callback runs is stored in 'displaytext'. |
| # |
| sub protocolsetup { |
| my $proto = $_[0]; |
| |
| if($proto eq 'ftp') { |
| %commandfunc = ( |
| 'PORT' => \&PORT_ftp, |
| 'EPRT' => \&PORT_ftp, |
| 'LIST' => \&LIST_ftp, |
| 'NLST' => \&NLST_ftp, |
| 'PASV' => \&PASV_ftp, |
| 'CWD' => \&CWD_ftp, |
| 'PWD' => \&PWD_ftp, |
| 'EPSV' => \&PASV_ftp, |
| 'RETR' => \&RETR_ftp, |
| 'SIZE' => \&SIZE_ftp, |
| 'REST' => \&REST_ftp, |
| 'STOR' => \&STOR_ftp, |
| 'APPE' => \&STOR_ftp, # append looks like upload |
| 'MDTM' => \&MDTM_ftp, |
| ); |
| %displaytext = ( |
| 'USER' => '331 We are happy you popped in!', |
| 'PASS' => '230 Welcome you silly person', |
| 'PORT' => '200 You said PORT - I say FINE', |
| 'TYPE' => '200 I modify TYPE as you wanted', |
| 'LIST' => '150 here comes a directory', |
| 'NLST' => '150 here comes a directory', |
| 'CWD' => '250 CWD command successful.', |
| 'SYST' => '215 UNIX Type: L8', # just fake something |
| 'QUIT' => '221 bye bye baby', # just reply something |
| 'MKD' => '257 Created your requested directory', |
| 'REST' => '350 Yeah yeah we set it there for you', |
| 'DELE' => '200 OK OK OK whatever you say', |
| 'RNFR' => '350 Received your order. Please provide more', |
| 'RNTO' => '250 Ok, thanks. File renaming completed.', |
| 'NOOP' => '200 Yes, I\'m very good at doing nothing.', |
| 'PBSZ' => '500 PBSZ not implemented', |
| 'PROT' => '500 PROT not implemented', |
| ); |
| @welcome = ( |
| '220- _ _ ____ _ '."\r\n", |
| '220- ___| | | | _ \| | '."\r\n", |
| '220- / __| | | | |_) | | '."\r\n", |
| '220- | (__| |_| | _ <| |___ '."\r\n", |
| '220 \___|\___/|_| \_\_____|'."\r\n" |
| ); |
| } |
| elsif($proto eq 'pop3') { |
| %commandfunc = ( |
| 'RETR' => \&RETR_pop3, |
| ); |
| %displaytext = ( |
| 'USER' => '+OK We are happy you popped in!', |
| 'PASS' => '+OK Access granted', |
| 'QUIT' => '+OK byebye', |
| ); |
| @welcome = ( |
| ' _ _ ____ _ '."\r\n", |
| ' ___| | | | _ \| | '."\r\n", |
| ' / __| | | | |_) | | '."\r\n", |
| ' | (__| |_| | _ <| |___ '."\r\n", |
| ' \___|\___/|_| \_\_____|'."\r\n", |
| '+OK cURL POP3 server ready to serve'."\r\n" |
| ); |
| } |
| elsif($proto eq 'imap') { |
| %commandfunc = ( |
| 'FETCH' => \&FETCH_imap, |
| 'SELECT' => \&SELECT_imap, |
| ); |
| %displaytext = ( |
| 'LOGIN' => ' OK We are happy you popped in!', |
| 'SELECT' => ' OK selection done', |
| 'LOGOUT' => ' OK thanks for the fish', |
| ); |
| @welcome = ( |
| ' _ _ ____ _ '."\r\n", |
| ' ___| | | | _ \| | '."\r\n", |
| ' / __| | | | |_) | | '."\r\n", |
| ' | (__| |_| | _ <| |___ '."\r\n", |
| ' \___|\___/|_| \_\_____|'."\r\n", |
| '* OK cURL IMAP server ready to serve'."\r\n" |
| ); |
| } |
| elsif($proto eq 'smtp') { |
| %commandfunc = ( |
| 'DATA' => \&DATA_smtp, |
| 'RCPT' => \&RCPT_smtp, |
| ); |
| %displaytext = ( |
| 'EHLO' => '230 We are happy you popped in!', |
| 'MAIL' => '200 Note taken', |
| 'RCPT' => '200 Receivers accepted', |
| 'QUIT' => '200 byebye', |
| ); |
| @welcome = ( |
| '220- _ _ ____ _ '."\r\n", |
| '220- ___| | | | _ \| | '."\r\n", |
| '220- / __| | | | |_) | | '."\r\n", |
| '220- | (__| |_| | _ <| |___ '."\r\n", |
| '220 \___|\___/|_| \_\_____|'."\r\n" |
| ); |
| } |
| } |
| |
| sub close_dataconn { |
| my ($closed)=@_; # non-zero if already disconnected |
| |
| my $datapid = processexists($datasockf_pidfile); |
| |
| if(!$closed) { |
| logmsg "* disconnect data connection\n"; |
| if($datapid > 0) { |
| print DWRITE "DISC\n"; |
| my $i; |
| sysread DREAD, $i, 5; |
| } |
| } |
| else { |
| logmsg "data connection already disconnected\n"; |
| } |
| logmsg "=====> Closed data connection\n"; |
| |
| logmsg "* quit sockfilt for data (pid $datapid)\n"; |
| if($datapid > 0) { |
| print DWRITE "QUIT\n"; |
| waitpid($datapid, 0); |
| unlink($datasockf_pidfile) if(-f $datasockf_pidfile); |
| } |
| } |
| |
| ################ |
| ################ SMTP commands |
| ################ |
| |
| # what set by "RCPT" |
| my $smtp_rcpt; |
| |
| sub DATA_smtp { |
| my $testno; |
| |
| if($smtp_rcpt =~ /^TO:(.*)/) { |
| $testno = $1; |
| } |
| else { |
| return; # failure |
| } |
| |
| if($testno eq "<verifiedserver>") { |
| sendcontrol "554 WE ROOLZ: $$\r\n"; |
| return 0; # don't wait for data now |
| } |
| else { |
| $testno =~ s/^([^0-9]*)([0-9]+).*/$2/; |
| sendcontrol "354 Show me the mail\r\n"; |
| } |
| |
| logmsg "===> rcpt $testno was $smtp_rcpt\n"; |
| |
| my $filename = "log/upload.$testno"; |
| |
| logmsg "Store test number $testno in $filename\n"; |
| |
| open(FILE, ">$filename") || |
| return 0; # failed to open output |
| |
| my $line; |
| my $ulsize=0; |
| my $disc=0; |
| my $raw; |
| while (5 == (sysread \*SFREAD, $line, 5)) { |
| if($line eq "DATA\n") { |
| my $i; |
| my $eob; |
| sysread \*SFREAD, $i, 5; |
| |
| my $size = 0; |
| if($i =~ /^([0-9a-fA-F]{4})\n/) { |
| $size = hex($1); |
| } |
| |
| sysread \*SFREAD, $line, $size; |
| |
| $ulsize += $size; |
| print FILE $line if(!$nosave); |
| |
| $raw .= $line; |
| if($raw =~ /\x0d\x0a\x2e\x0d\x0a/) { |
| # end of data marker! |
| $eob = 1; |
| } |
| logmsg "> Appending $size bytes to file\n"; |
| if($eob) { |
| logmsg "Found SMTP EOB marker\n"; |
| last; |
| } |
| } |
| elsif($line eq "DISC\n") { |
| # disconnect! |
| $disc=1; |
| last; |
| } |
| else { |
| logmsg "No support for: $line"; |
| last; |
| } |
| } |
| if($nosave) { |
| print FILE "$ulsize bytes would've been stored here\n"; |
| } |
| close(FILE); |
| sendcontrol "250 OK, data received!\r\n"; |
| logmsg "received $ulsize bytes upload\n"; |
| |
| } |
| |
| sub RCPT_smtp { |
| my ($args) = @_; |
| |
| $smtp_rcpt = $args; |
| } |
| |
| ################ |
| ################ IMAP commands |
| ################ |
| |
| # global to allow the command functions to read it |
| my $cmdid; |
| |
| # what was picked by SELECT |
| my $selected; |
| |
| sub SELECT_imap { |
| my ($testno) = @_; |
| my @data; |
| my $size; |
| |
| logmsg "SELECT_imap got test $testno\n"; |
| |
| $selected = $testno; |
| |
| return 0; |
| } |
| |
| |
| sub FETCH_imap { |
| my ($testno) = @_; |
| my @data; |
| my $size; |
| |
| logmsg "FETCH_imap got test $testno\n"; |
| |
| $testno = $selected; |
| |
| if($testno =~ /^verifiedserver$/) { |
| # this is the secret command that verifies that this actually is |
| # the curl test server |
| my $response = "WE ROOLZ: $$\r\n"; |
| if($verbose) { |
| print STDERR "FTPD: We returned proof we are the test server\n"; |
| } |
| $data[0] = $response; |
| logmsg "return proof we are we\n"; |
| } |
| else { |
| logmsg "retrieve a mail\n"; |
| |
| $testno =~ s/^([^0-9]*)//; |
| my $testpart = ""; |
| if ($testno > 10000) { |
| $testpart = $testno % 10000; |
| $testno = int($testno / 10000); |
| } |
| |
| # send mail content |
| loadtest("$srcdir/data/test$testno"); |
| |
| @data = getpart("reply", "data$testpart"); |
| } |
| |
| for (@data) { |
| $size += length($_); |
| } |
| |
| sendcontrol "* FETCH starts {$size}\r\n"; |
| |
| for my $d (@data) { |
| sendcontrol $d; |
| } |
| |
| sendcontrol "$cmdid OK FETCH completed\r\n"; |
| |
| return 0; |
| } |
| |
| ################ |
| ################ POP3 commands |
| ################ |
| |
| sub RETR_pop3 { |
| my ($testno) = @_; |
| my @data; |
| |
| if($testno =~ /^verifiedserver$/) { |
| # this is the secret command that verifies that this actually is |
| # the curl test server |
| my $response = "WE ROOLZ: $$\r\n"; |
| if($verbose) { |
| print STDERR "FTPD: We returned proof we are the test server\n"; |
| } |
| $data[0] = $response; |
| logmsg "return proof we are we\n"; |
| } |
| else { |
| logmsg "retrieve a mail\n"; |
| |
| $testno =~ s/^([^0-9]*)//; |
| my $testpart = ""; |
| if ($testno > 10000) { |
| $testpart = $testno % 10000; |
| $testno = int($testno / 10000); |
| } |
| |
| # send mail content |
| loadtest("$srcdir/data/test$testno"); |
| |
| @data = getpart("reply", "data$testpart"); |
| } |
| |
| sendcontrol "+OK Mail transfer starts\r\n"; |
| |
| for my $d (@data) { |
| sendcontrol $d; |
| } |
| |
| # end with the magic 5-byte end of mail marker |
| sendcontrol "\r\n.\r\n"; |
| |
| return 0; |
| } |
| |
| ################ |
| ################ FTP commands |
| ################ |
| my $rest=0; |
| sub REST_ftp { |
| $rest = $_[0]; |
| logmsg "Set REST position to $rest\n" |
| } |
| |
| sub switch_directory_goto { |
| my $target_dir = $_; |
| |
| if(!$ftptargetdir) { |
| $ftptargetdir = "/"; |
| } |
| |
| if($target_dir eq "") { |
| $ftptargetdir = "/"; |
| } |
| elsif($target_dir eq "..") { |
| if($ftptargetdir eq "/") { |
| $ftptargetdir = "/"; |
| } |
| else { |
| $ftptargetdir =~ s/[[:alnum:]]+\/$//; |
| } |
| } |
| else { |
| $ftptargetdir .= $target_dir . "/"; |
| } |
| } |
| |
| sub switch_directory { |
| my $target_dir = $_[0]; |
| |
| if($target_dir eq "/") { |
| $ftptargetdir = "/"; |
| } |
| else { |
| my @dirs = split("/", $target_dir); |
| for(@dirs) { |
| switch_directory_goto($_); |
| } |
| } |
| } |
| |
| sub CWD_ftp { |
| my ($folder, $fullcommand) = $_[0]; |
| switch_directory($folder); |
| if($ftptargetdir =~ /^\/fully_simulated/) { |
| $ftplistparserstate = "enabled"; |
| } |
| else { |
| undef $ftplistparserstate; |
| } |
| } |
| |
| sub PWD_ftp { |
| my $mydir; |
| $mydir = $ftptargetdir ? $ftptargetdir : "/"; |
| |
| if($mydir ne "/") { |
| $mydir =~ s/\/$//; |
| } |
| sendcontrol "257 \"$mydir\" is current directory\r\n"; |
| } |
| |
| sub LIST_ftp { |
| # print "150 ASCII data connection for /bin/ls (193.15.23.1,59196) (0 bytes)\r\n"; |
| |
| # this is a built-in fake-dir ;-) |
| my @ftpdir=("total 20\r\n", |
| "drwxr-xr-x 8 98 98 512 Oct 22 13:06 .\r\n", |
| "drwxr-xr-x 8 98 98 512 Oct 22 13:06 ..\r\n", |
| "drwxr-xr-x 2 98 98 512 May 2 1996 .NeXT\r\n", |
| "-r--r--r-- 1 0 1 35 Jul 16 1996 README\r\n", |
| "lrwxrwxrwx 1 0 1 7 Dec 9 1999 bin -> usr/bin\r\n", |
| "dr-xr-xr-x 2 0 1 512 Oct 1 1997 dev\r\n", |
| "drwxrwxrwx 2 98 98 512 May 29 16:04 download.html\r\n", |
| "dr-xr-xr-x 2 0 1 512 Nov 30 1995 etc\r\n", |
| "drwxrwxrwx 2 98 1 512 Oct 30 14:33 pub\r\n", |
| "dr-xr-xr-x 5 0 1 512 Oct 1 1997 usr\r\n"); |
| |
| if($ftplistparserstate) { |
| @ftpdir = ftp_contentlist($ftptargetdir); |
| } |
| |
| logmsg "pass LIST data on data connection\n"; |
| for(@ftpdir) { |
| senddata $_; |
| } |
| close_dataconn(0); |
| sendcontrol "226 ASCII transfer complete\r\n"; |
| return 0; |
| } |
| |
| sub NLST_ftp { |
| my @ftpdir=("file", "with space", "fake", "..", " ..", "funny", "README"); |
| logmsg "pass NLST data on data connection\n"; |
| for(@ftpdir) { |
| senddata "$_\r\n"; |
| } |
| close_dataconn(0); |
| sendcontrol "226 ASCII transfer complete\r\n"; |
| return 0; |
| } |
| |
| sub MDTM_ftp { |
| my $testno = $_[0]; |
| my $testpart = ""; |
| if ($testno > 10000) { |
| $testpart = $testno % 10000; |
| $testno = int($testno / 10000); |
| } |
| |
| loadtest("$srcdir/data/test$testno"); |
| |
| my @data = getpart("reply", "mdtm"); |
| |
| my $reply = $data[0]; |
| chomp $reply if($reply); |
| |
| if($reply && ($reply =~ /^[+-]?\d+$/) && ($reply < 0)) { |
| sendcontrol "550 $testno: no such file.\r\n"; |
| } |
| elsif($reply) { |
| sendcontrol "$reply\r\n"; |
| } |
| else { |
| sendcontrol "500 MDTM: no such command.\r\n"; |
| } |
| return 0; |
| } |
| |
| sub SIZE_ftp { |
| my $testno = $_[0]; |
| if($ftplistparserstate) { |
| my $size = wildcard_filesize($ftptargetdir, $testno); |
| if($size == -1) { |
| sendcontrol "550 $testno: No such file or directory.\r\n"; |
| } |
| else { |
| sendcontrol "213 $size\r\n"; |
| } |
| return 0; |
| } |
| |
| if($testno =~ /^verifiedserver$/) { |
| my $response = "WE ROOLZ: $$\r\n"; |
| my $size = length($response); |
| sendcontrol "213 $size\r\n"; |
| return 0; |
| } |
| |
| if($testno =~ /(\d+)\/?$/) { |
| $testno = $1; |
| } |
| else { |
| print STDERR "SIZE_ftp: invalid test number: $testno\n"; |
| return 1; |
| } |
| |
| my $testpart = ""; |
| if($testno > 10000) { |
| $testpart = $testno % 10000; |
| $testno = int($testno / 10000); |
| } |
| |
| loadtest("$srcdir/data/test$testno"); |
| |
| my @data = getpart("reply", "size"); |
| |
| my $size = $data[0]; |
| |
| if($size) { |
| if($size > -1) { |
| sendcontrol "213 $size\r\n"; |
| } |
| else { |
| sendcontrol "550 $testno: No such file or directory.\r\n"; |
| } |
| } |
| else { |
| $size=0; |
| @data = getpart("reply", "data$testpart"); |
| for(@data) { |
| $size += length($_); |
| } |
| if($size) { |
| sendcontrol "213 $size\r\n"; |
| } |
| else { |
| sendcontrol "550 $testno: No such file or directory.\r\n"; |
| } |
| } |
| return 0; |
| } |
| |
| sub RETR_ftp { |
| my ($testno) = @_; |
| |
| if($ftplistparserstate) { |
| my @content = wildcard_getfile($ftptargetdir, $testno); |
| if($content[0] == -1) { |
| #file not found |
| } |
| else { |
| my $size = length $content[1]; |
| sendcontrol "150 Binary data connection for $testno ($size bytes).\r\n", |
| senddata $content[1]; |
| close_dataconn(0); |
| sendcontrol "226 File transfer complete\r\n"; |
| } |
| return 0; |
| } |
| |
| if($testno =~ /^verifiedserver$/) { |
| # this is the secret command that verifies that this actually is |
| # the curl test server |
| my $response = "WE ROOLZ: $$\r\n"; |
| my $len = length($response); |
| sendcontrol "150 Binary junk ($len bytes).\r\n"; |
| senddata "WE ROOLZ: $$\r\n"; |
| close_dataconn(0); |
| sendcontrol "226 File transfer complete\r\n"; |
| if($verbose) { |
| print STDERR "FTPD: We returned proof we are the test server\n"; |
| } |
| return 0; |
| } |
| |
| $testno =~ s/^([^0-9]*)//; |
| my $testpart = ""; |
| if ($testno > 10000) { |
| $testpart = $testno % 10000; |
| $testno = int($testno / 10000); |
| } |
| |
| loadtest("$srcdir/data/test$testno"); |
| |
| my @data = getpart("reply", "data$testpart"); |
| |
| my $size=0; |
| for(@data) { |
| $size += length($_); |
| } |
| |
| my %hash = getpartattr("reply", "data$testpart"); |
| |
| if($size || $hash{'sendzero'}) { |
| |
| if($rest) { |
| # move read pointer forward |
| $size -= $rest; |
| logmsg "REST $rest was removed from size, makes $size left\n"; |
| $rest = 0; # reset REST offset again |
| } |
| if($retrweirdo) { |
| sendcontrol "150 Binary data connection for $testno () ($size bytes).\r\n", |
| "226 File transfer complete\r\n"; |
| |
| for(@data) { |
| my $send = $_; |
| senddata $send; |
| } |
| close_dataconn(0); |
| $retrweirdo=0; # switch off the weirdo again! |
| } |
| else { |
| my $sz = "($size bytes)"; |
| if($retrnosize) { |
| $sz = "size?"; |
| } |
| |
| sendcontrol "150 Binary data connection for $testno () $sz.\r\n"; |
| |
| for(@data) { |
| my $send = $_; |
| senddata $send; |
| } |
| close_dataconn(0); |
| sendcontrol "226 File transfer complete\r\n"; |
| } |
| } |
| else { |
| sendcontrol "550 $testno: No such file or directory.\r\n"; |
| } |
| return 0; |
| } |
| |
| sub STOR_ftp { |
| my $testno=$_[0]; |
| |
| my $filename = "log/upload.$testno"; |
| |
| logmsg "STOR test number $testno in $filename\n"; |
| |
| sendcontrol "125 Gimme gimme gimme!\r\n"; |
| |
| open(FILE, ">$filename") || |
| return 0; # failed to open output |
| |
| my $line; |
| my $ulsize=0; |
| my $disc=0; |
| while (5 == (sysread DREAD, $line, 5)) { |
| if($line eq "DATA\n") { |
| my $i; |
| sysread DREAD, $i, 5; |
| |
| my $size = 0; |
| if($i =~ /^([0-9a-fA-F]{4})\n/) { |
| $size = hex($1); |
| } |
| |
| sysread DREAD, $line, $size; |
| |
| #print STDERR " GOT: $size bytes\n"; |
| |
| $ulsize += $size; |
| print FILE $line if(!$nosave); |
| logmsg "> Appending $size bytes to file\n"; |
| } |
| elsif($line eq "DISC\n") { |
| # disconnect! |
| $disc=1; |
| last; |
| } |
| else { |
| logmsg "No support for: $line"; |
| last; |
| } |
| } |
| if($nosave) { |
| print FILE "$ulsize bytes would've been stored here\n"; |
| } |
| close(FILE); |
| close_dataconn($disc); |
| logmsg "received $ulsize bytes upload\n"; |
| sendcontrol "226 File transfer complete\r\n"; |
| return 0; |
| } |
| |
| sub PASV_ftp { |
| my ($arg, $cmd)=@_; |
| my $pasvport; |
| |
| # kill previous data connection sockfilt when alive |
| killsockfilters($proto, $ipvnum, $idnum, $verbose, 'data'); |
| |
| # We fire up a new sockfilt to do the data transfer for us. |
| my $datasockfcmd = "./server/sockfilt " . |
| "--ipv$ipvnum --port 0 " . |
| "--pidfile \"$datasockf_pidfile\" " . |
| "--logfile \"$datasockf_logfile\""; |
| $slavepid = open2(\*DREAD, \*DWRITE, $datasockfcmd); |
| |
| print DWRITE "PING\n"; |
| my $pong; |
| sysread_or_die(\*DREAD, \$pong, 5); |
| |
| if($pong !~ /^PONG/) { |
| logmsg "failed to run sockfilt for data connection\n"; |
| killsockfilters($proto, $ipvnum, $idnum, $verbose, 'data'); |
| sendcontrol "500 no free ports!\r\n"; |
| return 0; |
| } |
| |
| logmsg "Run sockfilt for data on pid $slavepid\n"; |
| |
| # Find out what port we listen on |
| my $i; |
| print DWRITE "PORT\n"; |
| |
| # READ the response code |
| sysread_or_die(\*DREAD, \$i, 5); |
| |
| # READ the response size |
| sysread_or_die(\*DREAD, \$i, 5); |
| |
| my $size = 0; |
| if($i =~ /^([0-9a-fA-F]{4})\n/) { |
| $size = hex($1); |
| } |
| |
| # READ the response data |
| sysread_or_die(\*DREAD, \$i, $size); |
| |
| # The data is in the format |
| # IPvX/NNN |
| |
| if($i =~ /IPv(\d)\/(\d+)/) { |
| # FIX: deal with IP protocol version |
| $pasvport = $2; |
| } |
| |
| if($cmd ne "EPSV") { |
| # PASV reply |
| my $p=$listenaddr; |
| $p =~ s/\./,/g; |
| if($pasvbadip) { |
| $p="1,2,3,4"; |
| } |
| sendcontrol sprintf("227 Entering Passive Mode ($p,%d,%d)\n", |
| ($pasvport/256), ($pasvport%256)); |
| } |
| else { |
| # EPSV reply |
| sendcontrol sprintf("229 Entering Passive Mode (|||%d|)\n", $pasvport); |
| } |
| |
| eval { |
| local $SIG{ALRM} = sub { die "alarm\n" }; |
| |
| # assume swift operations unless explicitly slow |
| alarm ($datadelay?20:10); |
| |
| # Wait for 'CNCT' |
| my $input; |
| |
| while(sysread(DREAD, $input, 5)) { |
| |
| if($input !~ /^CNCT/) { |
| # we wait for a connected client |
| logmsg "Odd, we got $input from client\n"; |
| next; |
| } |
| logmsg "====> Client DATA connect\n"; |
| last; |
| } |
| alarm 0; |
| }; |
| if ($@) { |
| # timed out |
| logmsg "$srvrname server timed out awaiting data connection ". |
| "on port $pasvport\n"; |
| logmsg "accept failed or connection not even attempted\n"; |
| killsockfilters($proto, $ipvnum, $idnum, $verbose, 'data'); |
| return; |
| } |
| else { |
| logmsg "data connection setup on port $pasvport\n"; |
| } |
| |
| return; |
| } |
| |
| # Support both PORT and EPRT here. Consider LPRT too. |
| |
| sub PORT_ftp { |
| my ($arg, $cmd) = @_; |
| my $port; |
| my $addr; |
| |
| # We always ignore the given IP and use localhost. |
| |
| if($cmd eq "PORT") { |
| if($arg !~ /(\d+),(\d+),(\d+),(\d+),(\d+),(\d+)/) { |
| logmsg "bad PORT-line: $arg\n"; |
| sendcontrol "500 silly you, go away\r\n"; |
| return 0; |
| } |
| $port = ($5<<8)+$6; |
| $addr = "$1.$2.$3.$4"; |
| } |
| # EPRT |2|::1|49706| |
| elsif(($cmd eq "EPRT") && ($grok_eprt)) { |
| if($arg !~ /(\d+)\|([^\|]+)\|(\d+)/) { |
| sendcontrol "500 silly you, go away\r\n"; |
| return 0; |
| } |
| sendcontrol "200 Thanks for dropping by. We contact you later\r\n"; |
| $port = $3; |
| $addr = $2; |
| } |
| else { |
| sendcontrol "500 we don't like $cmd now\r\n"; |
| return 0; |
| } |
| |
| if(!$port || $port > 65535) { |
| print STDERR "very illegal PORT number: $port\n"; |
| return 1; |
| } |
| |
| # We fire up a new sockfilt to do the data transfer for us. |
| my $datasockfcmd = "./server/sockfilt " . |
| "--ipv$ipvnum --connect $port --addr \"$addr\" " . |
| "--pidfile \"$datasockf_pidfile\" " . |
| "--logfile \"$datasockf_logfile\""; |
| $slavepid = open2(\*DREAD, \*DWRITE, $datasockfcmd); |
| |
| print STDERR "$datasockfcmd\n" if($verbose); |
| |
| print DWRITE "PING\n"; |
| my $pong; |
| sysread_or_die(\*DREAD, \$pong, 5); |
| |
| if($pong !~ /^PONG/) { |
| logmsg "Failed sockfilt for data connection\n"; |
| killsockfilters($proto, $ipvnum, $idnum, $verbose, 'data'); |
| } |
| |
| logmsg "====> Client DATA connect to port $port\n"; |
| |
| return; |
| } |
| |
| #********************************************************************** |
| # customize configures test server operation for each curl test, reading |
| # configuration commands/parameters from server commands file each time |
| # a new client control connection is established with the test server. |
| # On success returns 1, otherwise zero. |
| # |
| sub customize { |
| $ctrldelay = 0; # default is no throttling of the ctrl stream |
| $datadelay = 0; # default is no throttling of the data stream |
| $retrweirdo = 0; # default is no use of RETRWEIRDO |
| $retrnosize = 0; # default is no use of RETRNOSIZE |
| $pasvbadip = 0; # default is no use of PASVBADIP |
| $nosave = 0; # default is to actually save uploaded data to file |
| %customreply = (); # |
| %customcount = (); # |
| %delayreply = (); # |
| |
| open(CUSTOM, "<log/ftpserver.cmd") || |
| return 1; |
| |
| logmsg "FTPD: Getting commands from log/ftpserver.cmd\n"; |
| |
| while(<CUSTOM>) { |
| if($_ =~ /REPLY ([A-Za-z0-9+\/=]+) (.*)/) { |
| $customreply{$1}=eval "qq{$2}"; |
| logmsg "FTPD: set custom reply for $1\n"; |
| } |
| if($_ =~ /COUNT ([A-Z]+) (.*)/) { |
| # we blank the customreply for this command when having |
| # been used this number of times |
| $customcount{$1}=$2; |
| logmsg "FTPD: blank custom reply for $1 after $2 uses\n"; |
| } |
| elsif($_ =~ /DELAY ([A-Z]+) (\d*)/) { |
| $delayreply{$1}=$2; |
| logmsg "FTPD: delay reply for $1 with $2 seconds\n"; |
| } |
| elsif($_ =~ /SLOWDOWN/) { |
| $ctrldelay=1; |
| $datadelay=1; |
| logmsg "FTPD: send response with 0.01 sec delay between each byte\n"; |
| } |
| elsif($_ =~ /RETRWEIRDO/) { |
| logmsg "FTPD: instructed to use RETRWEIRDO\n"; |
| $retrweirdo=1; |
| } |
| elsif($_ =~ /RETRNOSIZE/) { |
| logmsg "FTPD: instructed to use RETRNOSIZE\n"; |
| $retrnosize=1; |
| } |
| elsif($_ =~ /PASVBADIP/) { |
| logmsg "FTPD: instructed to use PASVBADIP\n"; |
| $pasvbadip=1; |
| } |
| elsif($_ =~ /NOSAVE/) { |
| # don't actually store the file we upload - to be used when |
| # uploading insanely huge amounts |
| $nosave = 1; |
| logmsg "FTPD: NOSAVE prevents saving of uploaded data\n"; |
| } |
| } |
| close(CUSTOM); |
| } |
| |
| #---------------------------------------------------------------------- |
| #---------------------------------------------------------------------- |
| #--------------------------- END OF SUBS ---------------------------- |
| #---------------------------------------------------------------------- |
| #---------------------------------------------------------------------- |
| |
| #********************************************************************** |
| # Parse command line options |
| # |
| # Options: |
| # |
| # --verbose # verbose |
| # --srcdir # source directory |
| # --id # server instance number |
| # --proto # server protocol |
| # --pidfile # server pid file |
| # --logfile # server log file |
| # --ipv4 # server IP version 4 |
| # --ipv6 # server IP version 6 |
| # --port # server listener port |
| # --addr # server address for listener port binding |
| # |
| while(@ARGV) { |
| if($ARGV[0] eq '--verbose') { |
| $verbose = 1; |
| } |
| elsif($ARGV[0] eq '--srcdir') { |
| if($ARGV[1]) { |
| $srcdir = $ARGV[1]; |
| shift @ARGV; |
| } |
| } |
| elsif($ARGV[0] eq '--id') { |
| if($ARGV[1] && ($ARGV[1] =~ /^(\d+)$/)) { |
| $idnum = $1 if($1 > 0); |
| shift @ARGV; |
| } |
| } |
| elsif($ARGV[0] eq '--proto') { |
| if($ARGV[1] && ($ARGV[1] =~ /^(ftp|imap|pop3|smtp)$/)) { |
| $proto = $1; |
| shift @ARGV; |
| } |
| else { |
| die "unsupported protocol $ARGV[1]"; |
| } |
| } |
| elsif($ARGV[0] eq '--pidfile') { |
| if($ARGV[1]) { |
| $pidfile = $ARGV[1]; |
| shift @ARGV; |
| } |
| } |
| elsif($ARGV[0] eq '--logfile') { |
| if($ARGV[1]) { |
| $logfile = $ARGV[1]; |
| shift @ARGV; |
| } |
| } |
| elsif($ARGV[0] eq '--ipv4') { |
| $ipvnum = 4; |
| $listenaddr = '127.0.0.1' if($listenaddr eq '::1'); |
| $grok_eprt = 0; |
| } |
| elsif($ARGV[0] eq '--ipv6') { |
| $ipvnum = 6; |
| $listenaddr = '::1' if($listenaddr eq '127.0.0.1'); |
| $grok_eprt = 1; |
| } |
| elsif($ARGV[0] eq '--port') { |
| if($ARGV[1] && ($ARGV[1] =~ /^(\d+)$/)) { |
| $port = $1 if($1 > 1024); |
| shift @ARGV; |
| } |
| } |
| elsif($ARGV[0] eq '--addr') { |
| if($ARGV[1]) { |
| my $tmpstr = $ARGV[1]; |
| if($tmpstr =~ /^(\d\d?\d?)\.(\d\d?\d?)\.(\d\d?\d?)\.(\d\d?\d?)$/) { |
| $listenaddr = "$1.$2.$3.$4" if($ipvnum == 4); |
| } |
| elsif($ipvnum == 6) { |
| $listenaddr = $tmpstr; |
| $listenaddr =~ s/^\[(.*)\]$/$1/; |
| } |
| shift @ARGV; |
| } |
| } |
| else { |
| print STDERR "\nWarning: ftpserver.pl unknown parameter: $ARGV[0]\n"; |
| } |
| shift @ARGV; |
| } |
| |
| #*************************************************************************** |
| # Initialize command line option dependant variables |
| # |
| |
| if(!$srcdir) { |
| $srcdir = $ENV{'srcdir'} || '.'; |
| } |
| if(!$pidfile) { |
| $pidfile = "$path/". server_pidfilename($proto, $ipvnum, $idnum); |
| } |
| if(!$logfile) { |
| $logfile = server_logfilename($logdir, $proto, $ipvnum, $idnum); |
| } |
| |
| $mainsockf_pidfile = "$path/". |
| mainsockf_pidfilename($proto, $ipvnum, $idnum); |
| $mainsockf_logfile = |
| mainsockf_logfilename($logdir, $proto, $ipvnum, $idnum); |
| |
| if($proto eq 'ftp') { |
| $datasockf_pidfile = "$path/". |
| datasockf_pidfilename($proto, $ipvnum, $idnum); |
| $datasockf_logfile = |
| datasockf_logfilename($logdir, $proto, $ipvnum, $idnum); |
| } |
| |
| $srvrname = servername_str($proto, $ipvnum, $idnum); |
| |
| $idstr = "$idnum" if($idnum > 1); |
| |
| protocolsetup($proto); |
| |
| $SIG{INT} = \&exit_signal_handler; |
| $SIG{TERM} = \&exit_signal_handler; |
| |
| startsf(); |
| |
| logmsg sprintf("%s server listens on port IPv${ipvnum}/${port}\n", uc($proto)); |
| |
| open(PID, ">$pidfile"); |
| print PID $$."\n"; |
| close(PID); |
| |
| logmsg("logged pid $$ in $pidfile\n"); |
| |
| |
| while(1) { |
| # |
| # We read 'sockfilt' commands. |
| # |
| my $input; |
| |
| logmsg "Awaiting input\n"; |
| sysread_or_die(\*SFREAD, \$input, 5); |
| |
| if($input !~ /^CNCT/) { |
| # we wait for a connected client |
| logmsg "sockfilt said: $input"; |
| next; |
| } |
| logmsg "====> Client connect\n"; |
| |
| set_advisor_read_lock($SERVERLOGS_LOCK); |
| $serverlogslocked = 1; |
| |
| # flush data: |
| $| = 1; |
| |
| killsockfilters($proto, $ipvnum, $idnum, $verbose, 'data'); |
| |
| &customize(); # read test control instructions |
| |
| sendcontrol @welcome; |
| |
| #remove global variables from last connection |
| if($ftplistparserstate) { |
| undef $ftplistparserstate; |
| } |
| if($ftptargetdir) { |
| undef $ftptargetdir; |
| } |
| |
| if($verbose) { |
| for(@welcome) { |
| print STDERR "OUT: $_"; |
| } |
| } |
| |
| while(1) { |
| my $i; |
| |
| # Now we expect to read DATA\n[hex size]\n[prot], where the [prot] |
| # part only is FTP lingo. |
| |
| # COMMAND |
| sysread_or_die(\*SFREAD, \$i, 5); |
| |
| if($i !~ /^DATA/) { |
| logmsg "sockfilt said $i"; |
| if($i =~ /^DISC/) { |
| # disconnect |
| last; |
| } |
| next; |
| } |
| |
| # SIZE of data |
| sysread_or_die(\*SFREAD, \$i, 5); |
| |
| my $size = 0; |
| if($i =~ /^([0-9a-fA-F]{4})\n/) { |
| $size = hex($1); |
| } |
| |
| # data |
| sysread SFREAD, $_, $size; |
| |
| ftpmsg $_; |
| |
| # Remove trailing CRLF. |
| s/[\n\r]+$//; |
| |
| my $FTPCMD; |
| my $FTPARG; |
| my $full=$_; |
| if($proto eq "imap") { |
| # IMAP is different with its identifier first on the command line |
| unless (m/^([^ ]+) ([^ ]+) (.*)/ || |
| m/^([^ ]+) ([^ ]+)/) { |
| sendcontrol "$1 '$_': command not understood.\r\n"; |
| last; |
| } |
| $cmdid=$1; # set the global variable |
| $FTPCMD=$2; |
| $FTPARG=$3; |
| } |
| elsif (m/^([A-Z]{3,4})(\s(.*))?$/i) { |
| $FTPCMD=$1; |
| $FTPARG=$3; |
| } |
| elsif($proto eq "smtp" && m/^[A-Z0-9+\/]{0,512}={0,2}$/i) { |
| # SMTP long "commands" are base64 authentication data. |
| $FTPCMD=$_; |
| $FTPARG=""; |
| } |
| else { |
| sendcontrol "500 '$_': command not understood.\r\n"; |
| last; |
| } |
| |
| logmsg "< \"$full\"\n"; |
| |
| if($verbose) { |
| print STDERR "IN: $full\n"; |
| } |
| |
| my $delay = $delayreply{$FTPCMD}; |
| if($delay) { |
| # just go sleep this many seconds! |
| logmsg("Sleep for $delay seconds\n"); |
| my $twentieths = $delay * 20; |
| while($twentieths--) { |
| select(undef, undef, undef, 0.05) unless($got_exit_signal); |
| } |
| } |
| |
| my $text; |
| $text = $customreply{$FTPCMD}; |
| my $fake = $text; |
| |
| if($text && ($text ne "")) { |
| if($customcount{$FTPCMD} && (!--$customcount{$FTPCMD})) { |
| # used enough number of times, now blank the customreply |
| $customreply{$FTPCMD}=""; |
| } |
| } |
| else { |
| $text = $displaytext{$FTPCMD}; |
| } |
| my $check; |
| if($text && ($text ne "")) { |
| if($cmdid && ($cmdid ne "")) { |
| sendcontrol "$cmdid$text\r\n"; |
| } |
| else { |
| sendcontrol "$text\r\n"; |
| } |
| } |
| else { |
| $check=1; # no response yet |
| } |
| |
| unless($fake && ($fake ne "")) { |
| # only perform this if we're not faking a reply |
| my $func = $commandfunc{$FTPCMD}; |
| if($func) { |
| &$func($FTPARG, $FTPCMD); |
| $check=0; # taken care of |
| } |
| } |
| |
| if($check) { |
| logmsg "$FTPCMD wasn't handled!\n"; |
| sendcontrol "500 $FTPCMD is not dealt with!\r\n"; |
| } |
| |
| } # while(1) |
| logmsg "====> Client disconnected\n"; |
| |
| if($serverlogslocked) { |
| $serverlogslocked = 0; |
| clear_advisor_read_lock($SERVERLOGS_LOCK); |
| } |
| } |
| |
| killsockfilters($proto, $ipvnum, $idnum, $verbose); |
| unlink($pidfile); |
| if($serverlogslocked) { |
| $serverlogslocked = 0; |
| clear_advisor_read_lock($SERVERLOGS_LOCK); |
| } |
| |
| exit; |