Annotation of embedaddon/curl/tests/ftpserver.pl, revision 1.1
1.1 ! misho 1: #!/usr/bin/env perl
! 2: #***************************************************************************
! 3: # _ _ ____ _
! 4: # Project ___| | | | _ \| |
! 5: # / __| | | | |_) | |
! 6: # | (__| |_| | _ <| |___
! 7: # \___|\___/|_| \_\_____|
! 8: #
! 9: # Copyright (C) 1998 - 2020, Daniel Stenberg, <daniel@haxx.se>, et al.
! 10: #
! 11: # This software is licensed as described in the file COPYING, which
! 12: # you should have received as part of this distribution. The terms
! 13: # are also available at https://curl.haxx.se/docs/copyright.html.
! 14: #
! 15: # You may opt to use, copy, modify, merge, publish, distribute and/or sell
! 16: # copies of the Software, and permit persons to whom the Software is
! 17: # furnished to do so, under the terms of the COPYING file.
! 18: #
! 19: # This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY
! 20: # KIND, either express or implied.
! 21: #
! 22: ###########################################################################
! 23:
! 24: # This is a server designed for the curl test suite.
! 25: #
! 26: # In December 2009 we started remaking the server to support more protocols
! 27: # that are similar in spirit. Like POP3, IMAP and SMTP in addition to the FTP
! 28: # it already supported since a long time. Note that it still only supports one
! 29: # protocol per invoke. You need to start multiple servers to support multiple
! 30: # protocols simultaneously.
! 31: #
! 32: # It is meant to exercise curl, it is not meant to be a fully working
! 33: # or even very standard compliant server.
! 34: #
! 35: # You may optionally specify port on the command line, otherwise it'll
! 36: # default to port 8921.
! 37: #
! 38: # All socket/network/TCP related stuff is done by the 'sockfilt' program.
! 39: #
! 40:
! 41: BEGIN {
! 42: push(@INC, $ENV{'srcdir'}) if(defined $ENV{'srcdir'});
! 43: push(@INC, ".");
! 44: # sub second timestamping needs Time::HiRes
! 45: eval {
! 46: no warnings "all";
! 47: require Time::HiRes;
! 48: import Time::HiRes qw( gettimeofday );
! 49: }
! 50: }
! 51:
! 52: use strict;
! 53: use warnings;
! 54: use IPC::Open2;
! 55: use Digest::MD5;
! 56:
! 57: require "getpart.pm";
! 58: require "ftp.pm";
! 59: require "directories.pm";
! 60:
! 61: use serverhelp qw(
! 62: servername_str
! 63: server_pidfilename
! 64: server_logfilename
! 65: mainsockf_pidfilename
! 66: mainsockf_logfilename
! 67: datasockf_pidfilename
! 68: datasockf_logfilename
! 69: );
! 70:
! 71: use sshhelp qw(
! 72: exe_ext
! 73: );
! 74:
! 75: #**********************************************************************
! 76: # global vars...
! 77: #
! 78: my $verbose = 0; # set to 1 for debugging
! 79: my $idstr = ""; # server instance string
! 80: my $idnum = 1; # server instance number
! 81: my $ipvnum = 4; # server IPv number (4 or 6)
! 82: my $proto = 'ftp'; # default server protocol
! 83: my $srcdir; # directory where ftpserver.pl is located
! 84: my $srvrname; # server name for presentation purposes
! 85: my $cwd_testno; # test case numbers extracted from CWD command
! 86: my $path = '.';
! 87: my $logdir = $path .'/log';
! 88:
! 89: #**********************************************************************
! 90: # global vars used for server address and primary listener port
! 91: #
! 92: my $port = 8921; # default primary listener port
! 93: my $listenaddr = '127.0.0.1'; # default address for listener port
! 94:
! 95: #**********************************************************************
! 96: # global vars used for file names
! 97: #
! 98: my $pidfile; # server pid file name
! 99: my $portfile=".ftpserver.port"; # server port file name
! 100: my $logfile; # server log file name
! 101: my $mainsockf_pidfile; # pid file for primary connection sockfilt process
! 102: my $mainsockf_logfile; # log file for primary connection sockfilt process
! 103: my $datasockf_pidfile; # pid file for secondary connection sockfilt process
! 104: my $datasockf_logfile; # log file for secondary connection sockfilt process
! 105:
! 106: #**********************************************************************
! 107: # global vars used for server logs advisor read lock handling
! 108: #
! 109: my $SERVERLOGS_LOCK = 'log/serverlogs.lock';
! 110: my $serverlogslocked = 0;
! 111:
! 112: #**********************************************************************
! 113: # global vars used for child processes PID tracking
! 114: #
! 115: my $sfpid; # PID for primary connection sockfilt process
! 116: my $slavepid; # PID for secondary connection sockfilt process
! 117:
! 118: #**********************************************************************
! 119: # global typeglob filehandle vars to read/write from/to sockfilters
! 120: #
! 121: local *SFREAD; # used to read from primary connection
! 122: local *SFWRITE; # used to write to primary connection
! 123: local *DREAD; # used to read from secondary connection
! 124: local *DWRITE; # used to write to secondary connection
! 125:
! 126: my $sockfilt_timeout = 5; # default timeout for sockfilter eXsysreads
! 127:
! 128: #**********************************************************************
! 129: # global vars which depend on server protocol selection
! 130: #
! 131: my %commandfunc; # protocol command specific function callbacks
! 132: my %displaytext; # text returned to client before callback runs
! 133:
! 134: #**********************************************************************
! 135: # global vars customized for each test from the server commands file
! 136: #
! 137: my $ctrldelay; # set if server should throttle ctrl stream
! 138: my $datadelay; # set if server should throttle data stream
! 139: my $retrweirdo; # set if ftp server should use RETRWEIRDO
! 140: my $retrnosize; # set if ftp server should use RETRNOSIZE
! 141: my $pasvbadip; # set if ftp server should use PASVBADIP
! 142: my $nosave; # set if ftp server should not save uploaded data
! 143: my $nodataconn; # set if ftp srvr doesn't establish or accepts data channel
! 144: my $nodataconn425; # set if ftp srvr doesn't establish data ch and replies 425
! 145: my $nodataconn421; # set if ftp srvr doesn't establish data ch and replies 421
! 146: my $nodataconn150; # set if ftp srvr doesn't establish data ch and replies 150
! 147: my @capabilities; # set if server supports capability commands
! 148: my @auth_mechs; # set if server supports authentication commands
! 149: my %fulltextreply; #
! 150: my %commandreply; #
! 151: my %customcount; #
! 152: my %delayreply; #
! 153:
! 154: #**********************************************************************
! 155: # global variables for to test ftp wildcardmatching or other test that
! 156: # need flexible LIST responses.. and corresponding files.
! 157: # $ftptargetdir is keeping the fake "name" of LIST directory.
! 158: #
! 159: my $ftplistparserstate;
! 160: my $ftptargetdir="";
! 161:
! 162: #**********************************************************************
! 163: # global variables used when running a ftp server to keep state info
! 164: # relative to the secondary or data sockfilt process. Values of these
! 165: # variables should only be modified using datasockf_state() sub, given
! 166: # that they are closely related and relationship is a bit awkward.
! 167: #
! 168: my $datasockf_state = 'STOPPED'; # see datasockf_state() sub
! 169: my $datasockf_mode = 'none'; # ['none','active','passive']
! 170: my $datasockf_runs = 'no'; # ['no','yes']
! 171: my $datasockf_conn = 'no'; # ['no','yes']
! 172:
! 173: #**********************************************************************
! 174: # global vars used for signal handling
! 175: #
! 176: my $got_exit_signal = 0; # set if program should finish execution ASAP
! 177: my $exit_signal; # first signal handled in exit_signal_handler
! 178:
! 179: #**********************************************************************
! 180: # Mail related definitions
! 181: #
! 182: my $TEXT_PASSWORD = "secret";
! 183: my $POP3_TIMESTAMP = "<1972.987654321\@curl>";
! 184:
! 185: #**********************************************************************
! 186: # exit_signal_handler will be triggered to indicate that the program
! 187: # should finish its execution in a controlled way as soon as possible.
! 188: # For now, program will also terminate from within this handler.
! 189: #
! 190: sub exit_signal_handler {
! 191: my $signame = shift;
! 192: # For now, simply mimic old behavior.
! 193: killsockfilters($proto, $ipvnum, $idnum, $verbose);
! 194: unlink($pidfile);
! 195: unlink($portfile);
! 196: if($serverlogslocked) {
! 197: $serverlogslocked = 0;
! 198: clear_advisor_read_lock($SERVERLOGS_LOCK);
! 199: }
! 200: exit;
! 201: }
! 202:
! 203: #**********************************************************************
! 204: # logmsg is general message logging subroutine for our test servers.
! 205: #
! 206: sub logmsg {
! 207: my $now;
! 208: # sub second timestamping needs Time::HiRes
! 209: if($Time::HiRes::VERSION) {
! 210: my ($seconds, $usec) = gettimeofday();
! 211: my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
! 212: localtime($seconds);
! 213: $now = sprintf("%02d:%02d:%02d.%06d ", $hour, $min, $sec, $usec);
! 214: }
! 215: else {
! 216: my $seconds = time();
! 217: my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
! 218: localtime($seconds);
! 219: $now = sprintf("%02d:%02d:%02d ", $hour, $min, $sec);
! 220: }
! 221: if(open(LOGFILEFH, ">>$logfile")) {
! 222: print LOGFILEFH $now;
! 223: print LOGFILEFH @_;
! 224: close(LOGFILEFH);
! 225: }
! 226: }
! 227:
! 228: sub ftpmsg {
! 229: # append to the server.input file
! 230: open(INPUT, ">>log/server$idstr.input") ||
! 231: logmsg "failed to open log/server$idstr.input\n";
! 232:
! 233: print INPUT @_;
! 234: close(INPUT);
! 235:
! 236: # use this, open->print->close system only to make the file
! 237: # open as little as possible, to make the test suite run
! 238: # better on windows/cygwin
! 239: }
! 240:
! 241: #**********************************************************************
! 242: # eXsysread is a wrapper around perl's sysread() function. This will
! 243: # repeat the call to sysread() until it has actually read the complete
! 244: # number of requested bytes or an unrecoverable condition occurs.
! 245: # On success returns a positive value, the number of bytes requested.
! 246: # On failure or timeout returns zero.
! 247: #
! 248: sub eXsysread {
! 249: my $FH = shift;
! 250: my $scalar = shift;
! 251: my $nbytes = shift;
! 252: my $timeout = shift; # A zero timeout disables eXsysread() time limit
! 253: #
! 254: my $time_limited = 0;
! 255: my $timeout_rest = 0;
! 256: my $start_time = 0;
! 257: my $nread = 0;
! 258: my $rc;
! 259:
! 260: $$scalar = "";
! 261:
! 262: if((not defined $nbytes) || ($nbytes < 1)) {
! 263: logmsg "Error: eXsysread() failure: " .
! 264: "length argument must be positive\n";
! 265: return 0;
! 266: }
! 267: if((not defined $timeout) || ($timeout < 0)) {
! 268: logmsg "Error: eXsysread() failure: " .
! 269: "timeout argument must be zero or positive\n";
! 270: return 0;
! 271: }
! 272: if($timeout > 0) {
! 273: # caller sets eXsysread() time limit
! 274: $time_limited = 1;
! 275: $timeout_rest = $timeout;
! 276: $start_time = int(time());
! 277: }
! 278:
! 279: while($nread < $nbytes) {
! 280: if($time_limited) {
! 281: eval {
! 282: local $SIG{ALRM} = sub { die "alarm\n"; };
! 283: alarm $timeout_rest;
! 284: $rc = sysread($FH, $$scalar, $nbytes - $nread, $nread);
! 285: alarm 0;
! 286: };
! 287: $timeout_rest = $timeout - (int(time()) - $start_time);
! 288: if($timeout_rest < 1) {
! 289: logmsg "Error: eXsysread() failure: timed out\n";
! 290: return 0;
! 291: }
! 292: }
! 293: else {
! 294: $rc = sysread($FH, $$scalar, $nbytes - $nread, $nread);
! 295: }
! 296: if($got_exit_signal) {
! 297: logmsg "Error: eXsysread() failure: signalled to die\n";
! 298: return 0;
! 299: }
! 300: if(not defined $rc) {
! 301: if($!{EINTR}) {
! 302: logmsg "Warning: retrying sysread() interrupted system call\n";
! 303: next;
! 304: }
! 305: if($!{EAGAIN}) {
! 306: logmsg "Warning: retrying sysread() due to EAGAIN\n";
! 307: next;
! 308: }
! 309: if($!{EWOULDBLOCK}) {
! 310: logmsg "Warning: retrying sysread() due to EWOULDBLOCK\n";
! 311: next;
! 312: }
! 313: logmsg "Error: sysread() failure: $!\n";
! 314: return 0;
! 315: }
! 316: if($rc < 0) {
! 317: logmsg "Error: sysread() failure: returned negative value $rc\n";
! 318: return 0;
! 319: }
! 320: if($rc == 0) {
! 321: logmsg "Error: sysread() failure: read zero bytes\n";
! 322: return 0;
! 323: }
! 324: $nread += $rc;
! 325: }
! 326: return $nread;
! 327: }
! 328:
! 329: #**********************************************************************
! 330: # read_mainsockf attempts to read the given amount of output from the
! 331: # sockfilter which is in use for the main or primary connection. This
! 332: # reads untranslated sockfilt lingo which may hold data read from the
! 333: # main or primary socket. On success returns 1, otherwise zero.
! 334: #
! 335: sub read_mainsockf {
! 336: my $scalar = shift;
! 337: my $nbytes = shift;
! 338: my $timeout = shift; # Optional argument, if zero blocks indefinitely
! 339: my $FH = \*SFREAD;
! 340:
! 341: if(not defined $timeout) {
! 342: $timeout = $sockfilt_timeout + ($nbytes >> 12);
! 343: }
! 344: if(eXsysread($FH, $scalar, $nbytes, $timeout) != $nbytes) {
! 345: my ($fcaller, $lcaller) = (caller)[1,2];
! 346: logmsg "Error: read_mainsockf() failure at $fcaller " .
! 347: "line $lcaller. Due to eXsysread() failure\n";
! 348: return 0;
! 349: }
! 350: return 1;
! 351: }
! 352:
! 353: #**********************************************************************
! 354: # read_datasockf attempts to read the given amount of output from the
! 355: # sockfilter which is in use for the data or secondary connection. This
! 356: # reads untranslated sockfilt lingo which may hold data read from the
! 357: # data or secondary socket. On success returns 1, otherwise zero.
! 358: #
! 359: sub read_datasockf {
! 360: my $scalar = shift;
! 361: my $nbytes = shift;
! 362: my $timeout = shift; # Optional argument, if zero blocks indefinitely
! 363: my $FH = \*DREAD;
! 364:
! 365: if(not defined $timeout) {
! 366: $timeout = $sockfilt_timeout + ($nbytes >> 12);
! 367: }
! 368: if(eXsysread($FH, $scalar, $nbytes, $timeout) != $nbytes) {
! 369: my ($fcaller, $lcaller) = (caller)[1,2];
! 370: logmsg "Error: read_datasockf() failure at $fcaller " .
! 371: "line $lcaller. Due to eXsysread() failure\n";
! 372: return 0;
! 373: }
! 374: return 1;
! 375: }
! 376:
! 377: sub sysread_or_die {
! 378: my $FH = shift;
! 379: my $scalar = shift;
! 380: my $length = shift;
! 381: my $fcaller;
! 382: my $lcaller;
! 383: my $result;
! 384:
! 385: $result = sysread($$FH, $$scalar, $length);
! 386:
! 387: if(not defined $result) {
! 388: ($fcaller, $lcaller) = (caller)[1,2];
! 389: logmsg "Failed to read input\n";
! 390: logmsg "Error: $srvrname server, sysread error: $!\n";
! 391: logmsg "Exited from sysread_or_die() at $fcaller " .
! 392: "line $lcaller. $srvrname server, sysread error: $!\n";
! 393: killsockfilters($proto, $ipvnum, $idnum, $verbose);
! 394: unlink($pidfile);
! 395: unlink($portfile);
! 396: if($serverlogslocked) {
! 397: $serverlogslocked = 0;
! 398: clear_advisor_read_lock($SERVERLOGS_LOCK);
! 399: }
! 400: exit;
! 401: }
! 402: elsif($result == 0) {
! 403: ($fcaller, $lcaller) = (caller)[1,2];
! 404: logmsg "Failed to read input\n";
! 405: logmsg "Error: $srvrname server, read zero\n";
! 406: logmsg "Exited from sysread_or_die() at $fcaller " .
! 407: "line $lcaller. $srvrname server, read zero\n";
! 408: killsockfilters($proto, $ipvnum, $idnum, $verbose);
! 409: unlink($pidfile);
! 410: unlink($portfile);
! 411: if($serverlogslocked) {
! 412: $serverlogslocked = 0;
! 413: clear_advisor_read_lock($SERVERLOGS_LOCK);
! 414: }
! 415: exit;
! 416: }
! 417:
! 418: return $result;
! 419: }
! 420:
! 421: sub startsf {
! 422: my $mainsockfcmd = "./server/sockfilt".exe_ext('SRV')." " .
! 423: "--ipv$ipvnum --port $port " .
! 424: "--pidfile \"$mainsockf_pidfile\" " .
! 425: "--portfile \"$portfile\" " .
! 426: "--logfile \"$mainsockf_logfile\"";
! 427: $sfpid = open2(*SFREAD, *SFWRITE, $mainsockfcmd);
! 428:
! 429: print STDERR "$mainsockfcmd\n" if($verbose);
! 430:
! 431: print SFWRITE "PING\n";
! 432: my $pong;
! 433: sysread_or_die(\*SFREAD, \$pong, 5);
! 434:
! 435: if($pong !~ /^PONG/) {
! 436: logmsg "Failed sockfilt command: $mainsockfcmd\n";
! 437: killsockfilters($proto, $ipvnum, $idnum, $verbose);
! 438: unlink($pidfile);
! 439: unlink($portfile);
! 440: if($serverlogslocked) {
! 441: $serverlogslocked = 0;
! 442: clear_advisor_read_lock($SERVERLOGS_LOCK);
! 443: }
! 444: die "Failed to start sockfilt!";
! 445: }
! 446: }
! 447:
! 448: #**********************************************************************
! 449: # Returns the given test's reply data
! 450: #
! 451: sub getreplydata {
! 452: my ($testno) = @_;
! 453: my $testpart = "";
! 454:
! 455: $testno =~ s/^([^0-9]*)//;
! 456: if($testno > 10000) {
! 457: $testpart = $testno % 10000;
! 458: $testno = int($testno / 10000);
! 459: }
! 460:
! 461: loadtest("$srcdir/data/test$testno");
! 462:
! 463: my @data = getpart("reply", "data$testpart");
! 464: if((!@data) && ($testpart ne "")) {
! 465: @data = getpart("reply", "data");
! 466: }
! 467:
! 468: return @data;
! 469: }
! 470:
! 471: sub sockfilt {
! 472: my $l;
! 473: foreach $l (@_) {
! 474: printf SFWRITE "DATA\n%04x\n", length($l);
! 475: print SFWRITE $l;
! 476: }
! 477: }
! 478:
! 479: sub sockfiltsecondary {
! 480: my $l;
! 481: foreach $l (@_) {
! 482: printf DWRITE "DATA\n%04x\n", length($l);
! 483: print DWRITE $l;
! 484: }
! 485: }
! 486:
! 487: #**********************************************************************
! 488: # Send data to the client on the control stream, which happens to be plain
! 489: # stdout.
! 490: #
! 491: sub sendcontrol {
! 492: if(!$ctrldelay) {
! 493: # spit it all out at once
! 494: sockfilt @_;
! 495: }
! 496: else {
! 497: my $a = join("", @_);
! 498: my @a = split("", $a);
! 499:
! 500: for(@a) {
! 501: sockfilt $_;
! 502: portable_sleep(0.01);
! 503: }
! 504: }
! 505: my $log;
! 506: foreach $log (@_) {
! 507: my $l = $log;
! 508: $l =~ s/\r/[CR]/g;
! 509: $l =~ s/\n/[LF]/g;
! 510: logmsg "> \"$l\"\n";
! 511: }
! 512: }
! 513:
! 514: #**********************************************************************
! 515: # Send data to the FTP client on the data stream when data connection
! 516: # is actually established. Given that this sub should only be called
! 517: # when a data connection is supposed to be established, calling this
! 518: # without a data connection is an indication of weak logic somewhere.
! 519: #
! 520: sub senddata {
! 521: my $l;
! 522: if($datasockf_conn eq 'no') {
! 523: logmsg "WARNING: Detected data sending attempt without DATA channel\n";
! 524: foreach $l (@_) {
! 525: logmsg "WARNING: Data swallowed: $l\n"
! 526: }
! 527: return;
! 528: }
! 529:
! 530: foreach $l (@_) {
! 531: if(!$datadelay) {
! 532: # spit it all out at once
! 533: sockfiltsecondary $l;
! 534: }
! 535: else {
! 536: # pause between each byte
! 537: for (split(//,$l)) {
! 538: sockfiltsecondary $_;
! 539: portable_sleep(0.01);
! 540: }
! 541: }
! 542: }
! 543: }
! 544:
! 545: #**********************************************************************
! 546: # protocolsetup initializes the 'displaytext' and 'commandfunc' hashes
! 547: # for the given protocol. References to protocol command callbacks are
! 548: # stored in 'commandfunc' hash, and text which will be returned to the
! 549: # client before the command callback runs is stored in 'displaytext'.
! 550: #
! 551: sub protocolsetup {
! 552: my $proto = $_[0];
! 553:
! 554: if($proto eq 'ftp') {
! 555: %commandfunc = (
! 556: 'PORT' => \&PORT_ftp,
! 557: 'EPRT' => \&PORT_ftp,
! 558: 'LIST' => \&LIST_ftp,
! 559: 'NLST' => \&NLST_ftp,
! 560: 'PASV' => \&PASV_ftp,
! 561: 'CWD' => \&CWD_ftp,
! 562: 'PWD' => \&PWD_ftp,
! 563: 'EPSV' => \&PASV_ftp,
! 564: 'RETR' => \&RETR_ftp,
! 565: 'SIZE' => \&SIZE_ftp,
! 566: 'REST' => \&REST_ftp,
! 567: 'STOR' => \&STOR_ftp,
! 568: 'APPE' => \&STOR_ftp, # append looks like upload
! 569: 'MDTM' => \&MDTM_ftp,
! 570: );
! 571: %displaytext = (
! 572: 'USER' => '331 We are happy you popped in!',
! 573: 'PASS' => '230 Welcome you silly person',
! 574: 'PORT' => '200 You said PORT - I say FINE',
! 575: 'TYPE' => '200 I modify TYPE as you wanted',
! 576: 'LIST' => '150 here comes a directory',
! 577: 'NLST' => '150 here comes a directory',
! 578: 'CWD' => '250 CWD command successful.',
! 579: 'SYST' => '215 UNIX Type: L8', # just fake something
! 580: 'QUIT' => '221 bye bye baby', # just reply something
! 581: 'MKD' => '257 Created your requested directory',
! 582: 'REST' => '350 Yeah yeah we set it there for you',
! 583: 'DELE' => '200 OK OK OK whatever you say',
! 584: 'RNFR' => '350 Received your order. Please provide more',
! 585: 'RNTO' => '250 Ok, thanks. File renaming completed.',
! 586: 'NOOP' => '200 Yes, I\'m very good at doing nothing.',
! 587: 'PBSZ' => '500 PBSZ not implemented',
! 588: 'PROT' => '500 PROT not implemented',
! 589: 'welcome' => join("",
! 590: '220- _ _ ____ _ '."\r\n",
! 591: '220- ___| | | | _ \| | '."\r\n",
! 592: '220- / __| | | | |_) | | '."\r\n",
! 593: '220- | (__| |_| | _ {| |___ '."\r\n",
! 594: '220 \___|\___/|_| \_\_____|'."\r\n")
! 595: );
! 596: }
! 597: elsif($proto eq 'pop3') {
! 598: %commandfunc = (
! 599: 'APOP' => \&APOP_pop3,
! 600: 'AUTH' => \&AUTH_pop3,
! 601: 'CAPA' => \&CAPA_pop3,
! 602: 'DELE' => \&DELE_pop3,
! 603: 'LIST' => \&LIST_pop3,
! 604: 'NOOP' => \&NOOP_pop3,
! 605: 'PASS' => \&PASS_pop3,
! 606: 'QUIT' => \&QUIT_pop3,
! 607: 'RETR' => \&RETR_pop3,
! 608: 'RSET' => \&RSET_pop3,
! 609: 'STAT' => \&STAT_pop3,
! 610: 'TOP' => \&TOP_pop3,
! 611: 'UIDL' => \&UIDL_pop3,
! 612: 'USER' => \&USER_pop3,
! 613: );
! 614: %displaytext = (
! 615: 'welcome' => join("",
! 616: ' _ _ ____ _ '."\r\n",
! 617: ' ___| | | | _ \| | '."\r\n",
! 618: ' / __| | | | |_) | | '."\r\n",
! 619: ' | (__| |_| | _ {| |___ '."\r\n",
! 620: ' \___|\___/|_| \_\_____|'."\r\n",
! 621: '+OK curl POP3 server ready to serve '."\r\n")
! 622: );
! 623: }
! 624: elsif($proto eq 'imap') {
! 625: %commandfunc = (
! 626: 'APPEND' => \&APPEND_imap,
! 627: 'CAPABILITY' => \&CAPABILITY_imap,
! 628: 'CHECK' => \&CHECK_imap,
! 629: 'CLOSE' => \&CLOSE_imap,
! 630: 'COPY' => \©_imap,
! 631: 'CREATE' => \&CREATE_imap,
! 632: 'DELETE' => \&DELETE_imap,
! 633: 'EXAMINE' => \&EXAMINE_imap,
! 634: 'EXPUNGE' => \&EXPUNGE_imap,
! 635: 'FETCH' => \&FETCH_imap,
! 636: 'LIST' => \&LIST_imap,
! 637: 'LSUB' => \&LSUB_imap,
! 638: 'LOGIN' => \&LOGIN_imap,
! 639: 'LOGOUT' => \&LOGOUT_imap,
! 640: 'NOOP' => \&NOOP_imap,
! 641: 'RENAME' => \&RENAME_imap,
! 642: 'SEARCH' => \&SEARCH_imap,
! 643: 'SELECT' => \&SELECT_imap,
! 644: 'STATUS' => \&STATUS_imap,
! 645: 'STORE' => \&STORE_imap,
! 646: 'UID' => \&UID_imap,
! 647: );
! 648: %displaytext = (
! 649: 'welcome' => join("",
! 650: ' _ _ ____ _ '."\r\n",
! 651: ' ___| | | | _ \| | '."\r\n",
! 652: ' / __| | | | |_) | | '."\r\n",
! 653: ' | (__| |_| | _ {| |___ '."\r\n",
! 654: ' \___|\___/|_| \_\_____|'."\r\n",
! 655: '* OK curl IMAP server ready to serve'."\r\n")
! 656: );
! 657: }
! 658: elsif($proto eq 'smtp') {
! 659: %commandfunc = (
! 660: 'DATA' => \&DATA_smtp,
! 661: 'EHLO' => \&EHLO_smtp,
! 662: 'EXPN' => \&EXPN_smtp,
! 663: 'HELO' => \&HELO_smtp,
! 664: 'HELP' => \&HELP_smtp,
! 665: 'MAIL' => \&MAIL_smtp,
! 666: 'NOOP' => \&NOOP_smtp,
! 667: 'RSET' => \&RSET_smtp,
! 668: 'RCPT' => \&RCPT_smtp,
! 669: 'VRFY' => \&VRFY_smtp,
! 670: 'QUIT' => \&QUIT_smtp,
! 671: );
! 672: %displaytext = (
! 673: 'welcome' => join("",
! 674: '220- _ _ ____ _ '."\r\n",
! 675: '220- ___| | | | _ \| | '."\r\n",
! 676: '220- / __| | | | |_) | | '."\r\n",
! 677: '220- | (__| |_| | _ {| |___ '."\r\n",
! 678: '220 \___|\___/|_| \_\_____|'."\r\n")
! 679: );
! 680: }
! 681: }
! 682:
! 683: sub close_dataconn {
! 684: my ($closed)=@_; # non-zero if already disconnected
! 685:
! 686: my $datapid = processexists($datasockf_pidfile);
! 687:
! 688: logmsg "=====> Closing $datasockf_mode DATA connection...\n";
! 689:
! 690: if(!$closed) {
! 691: if($datapid > 0) {
! 692: logmsg "Server disconnects $datasockf_mode DATA connection\n";
! 693: print DWRITE "DISC\n";
! 694: my $i;
! 695: sysread DREAD, $i, 5;
! 696: logmsg "Server disconnected $datasockf_mode DATA connection\n";
! 697: }
! 698: else {
! 699: logmsg "Server finds $datasockf_mode DATA connection already ".
! 700: "disconnected\n";
! 701: }
! 702: }
! 703: else {
! 704: logmsg "Server knows $datasockf_mode DATA connection is already ".
! 705: "disconnected\n";
! 706: }
! 707:
! 708: if($datapid > 0) {
! 709: logmsg "DATA sockfilt for $datasockf_mode data channel quits ".
! 710: "(pid $datapid)\n";
! 711: print DWRITE "QUIT\n";
! 712: pidwait($datapid, 0);
! 713: unlink($datasockf_pidfile) if(-f $datasockf_pidfile);
! 714: logmsg "DATA sockfilt for $datasockf_mode data channel quit ".
! 715: "(pid $datapid)\n";
! 716: }
! 717: else {
! 718: logmsg "DATA sockfilt for $datasockf_mode data channel already ".
! 719: "dead\n";
! 720: }
! 721:
! 722: logmsg "=====> Closed $datasockf_mode DATA connection\n";
! 723:
! 724: datasockf_state('STOPPED');
! 725: }
! 726:
! 727: ################
! 728: ################ SMTP commands
! 729: ################
! 730:
! 731: # The type of server (SMTP or ESMTP)
! 732: my $smtp_type;
! 733:
! 734: # The client (which normally contains the test number)
! 735: my $smtp_client;
! 736:
! 737: sub EHLO_smtp {
! 738: my ($client) = @_;
! 739: my @data;
! 740:
! 741: # TODO: Get the IP address of the client connection to use in the
! 742: # EHLO response when the client doesn't specify one but for now use
! 743: # 127.0.0.1
! 744: if(!$client) {
! 745: $client = "[127.0.0.1]";
! 746: }
! 747:
! 748: # Set the server type to ESMTP
! 749: $smtp_type = "ESMTP";
! 750:
! 751: # Calculate the EHLO response
! 752: push @data, "$smtp_type pingpong test server Hello $client";
! 753:
! 754: if((@capabilities) || (@auth_mechs)) {
! 755: my $mechs;
! 756:
! 757: for my $c (@capabilities) {
! 758: push @data, $c;
! 759: }
! 760:
! 761: for my $am (@auth_mechs) {
! 762: if(!$mechs) {
! 763: $mechs = "$am";
! 764: }
! 765: else {
! 766: $mechs .= " $am";
! 767: }
! 768: }
! 769:
! 770: if($mechs) {
! 771: push @data, "AUTH $mechs";
! 772: }
! 773: }
! 774:
! 775: # Send the EHLO response
! 776: for(my $i = 0; $i < @data; $i++) {
! 777: my $d = $data[$i];
! 778:
! 779: if($i < @data - 1) {
! 780: sendcontrol "250-$d\r\n";
! 781: }
! 782: else {
! 783: sendcontrol "250 $d\r\n";
! 784: }
! 785: }
! 786:
! 787: # Store the client (as it may contain the test number)
! 788: $smtp_client = $client;
! 789:
! 790: return 0;
! 791: }
! 792:
! 793: sub HELO_smtp {
! 794: my ($client) = @_;
! 795:
! 796: # TODO: Get the IP address of the client connection to use in the HELO
! 797: # response when the client doesn't specify one but for now use 127.0.0.1
! 798: if(!$client) {
! 799: $client = "[127.0.0.1]";
! 800: }
! 801:
! 802: # Set the server type to SMTP
! 803: $smtp_type = "SMTP";
! 804:
! 805: # Send the HELO response
! 806: sendcontrol "250 $smtp_type pingpong test server Hello $client\r\n";
! 807:
! 808: # Store the client (as it may contain the test number)
! 809: $smtp_client = $client;
! 810:
! 811: return 0;
! 812: }
! 813:
! 814: sub MAIL_smtp {
! 815: my ($args) = @_;
! 816:
! 817: logmsg "MAIL_smtp got $args\n";
! 818:
! 819: if (!$args) {
! 820: sendcontrol "501 Unrecognized parameter\r\n";
! 821: }
! 822: else {
! 823: my $from;
! 824: my $size;
! 825: my $smtputf8 = grep /^SMTPUTF8$/, @capabilities;
! 826: my @elements = split(/ /, $args);
! 827:
! 828: # Get the FROM and SIZE parameters
! 829: for my $e (@elements) {
! 830: if($e =~ /^FROM:(.*)$/) {
! 831: $from = $1;
! 832: }
! 833: elsif($e =~ /^SIZE=(\d+)$/) {
! 834: $size = $1;
! 835: }
! 836: }
! 837:
! 838: # Validate the from address (only <> and a valid email address inside
! 839: # <> are allowed, such as <user@example.com>)
! 840: if (($from eq "<>") ||
! 841: (!$smtputf8 && $from =~
! 842: /^<([a-zA-Z0-9._%+-]+)\@(([a-zA-Z0-9-]+)\.)+([a-zA-Z]{2,4})>$/) ||
! 843: ($smtputf8 && $from =~
! 844: /^<([a-zA-Z0-9\x{80}-\x{ff}._%+-]+)\@(([a-zA-Z0-9\x{80}-\x{ff}-]+)\.)+([a-zA-Z]{2,4})>$/)) {
! 845: my @found;
! 846: my $valid = 1;
! 847:
! 848: # Check the capabilities for SIZE and if the specified size is
! 849: # greater than the message size then reject it
! 850: if (@found = grep /^SIZE (\d+)$/, @capabilities) {
! 851: if ($found[0] =~ /^SIZE (\d+)$/) {
! 852: if ($size > $1) {
! 853: $valid = 0;
! 854: }
! 855: }
! 856: }
! 857:
! 858: if(!$valid) {
! 859: sendcontrol "552 Message size too large\r\n";
! 860: }
! 861: else {
! 862: sendcontrol "250 Sender OK\r\n";
! 863: }
! 864: }
! 865: else {
! 866: sendcontrol "501 Invalid address\r\n";
! 867: }
! 868: }
! 869:
! 870: return 0;
! 871: }
! 872:
! 873: sub RCPT_smtp {
! 874: my ($args) = @_;
! 875:
! 876: logmsg "RCPT_smtp got $args\n";
! 877:
! 878: # Get the TO parameter
! 879: if($args !~ /^TO:(.*)/) {
! 880: sendcontrol "501 Unrecognized parameter\r\n";
! 881: }
! 882: else {
! 883: my $smtputf8 = grep /^SMTPUTF8$/, @capabilities;
! 884: my $to = $1;
! 885:
! 886: # Validate the to address (only a valid email address inside <> is
! 887: # allowed, such as <user@example.com>)
! 888: if ((!$smtputf8 && $to =~
! 889: /^<([a-zA-Z0-9._%+-]+)\@(([a-zA-Z0-9-]+)\.)+([a-zA-Z]{2,4})>$/) ||
! 890: ($smtputf8 && $to =~
! 891: /^<([a-zA-Z0-9\x{80}-\x{ff}._%+-]+)\@(([a-zA-Z0-9\x{80}-\x{ff}-]+)\.)+([a-zA-Z]{2,4})>$/)) {
! 892: sendcontrol "250 Recipient OK\r\n";
! 893: }
! 894: else {
! 895: sendcontrol "501 Invalid address\r\n";
! 896: }
! 897: }
! 898:
! 899: return 0;
! 900: }
! 901:
! 902: sub DATA_smtp {
! 903: my ($args) = @_;
! 904:
! 905: if ($args) {
! 906: sendcontrol "501 Unrecognized parameter\r\n";
! 907: }
! 908: elsif ($smtp_client !~ /^(\d*)$/) {
! 909: sendcontrol "501 Invalid arguments\r\n";
! 910: }
! 911: else {
! 912: sendcontrol "354 Show me the mail\r\n";
! 913:
! 914: my $testno = $smtp_client;
! 915: my $filename = "log/upload.$testno";
! 916:
! 917: logmsg "Store test number $testno in $filename\n";
! 918:
! 919: open(FILE, ">$filename") ||
! 920: return 0; # failed to open output
! 921:
! 922: my $line;
! 923: my $ulsize=0;
! 924: my $disc=0;
! 925: my $raw;
! 926: while (5 == (sysread \*SFREAD, $line, 5)) {
! 927: if($line eq "DATA\n") {
! 928: my $i;
! 929: my $eob;
! 930: sysread \*SFREAD, $i, 5;
! 931:
! 932: my $size = 0;
! 933: if($i =~ /^([0-9a-fA-F]{4})\n/) {
! 934: $size = hex($1);
! 935: }
! 936:
! 937: read_mainsockf(\$line, $size);
! 938:
! 939: $ulsize += $size;
! 940: print FILE $line if(!$nosave);
! 941:
! 942: $raw .= $line;
! 943: if($raw =~ /(?:^|\x0d\x0a)\x2e\x0d\x0a/) {
! 944: # end of data marker!
! 945: $eob = 1;
! 946: }
! 947:
! 948: logmsg "> Appending $size bytes to file\n";
! 949:
! 950: if($eob) {
! 951: logmsg "Found SMTP EOB marker\n";
! 952: last;
! 953: }
! 954: }
! 955: elsif($line eq "DISC\n") {
! 956: # disconnect!
! 957: $disc=1;
! 958: last;
! 959: }
! 960: else {
! 961: logmsg "No support for: $line";
! 962: last;
! 963: }
! 964: }
! 965:
! 966: if($nosave) {
! 967: print FILE "$ulsize bytes would've been stored here\n";
! 968: }
! 969:
! 970: close(FILE);
! 971:
! 972: logmsg "received $ulsize bytes upload\n";
! 973:
! 974: sendcontrol "250 OK, data received!\r\n";
! 975: }
! 976:
! 977: return 0;
! 978: }
! 979:
! 980: sub NOOP_smtp {
! 981: my ($args) = @_;
! 982:
! 983: if($args) {
! 984: sendcontrol "501 Unrecognized parameter\r\n";
! 985: }
! 986: else {
! 987: sendcontrol "250 OK\r\n";
! 988: }
! 989:
! 990: return 0;
! 991: }
! 992:
! 993: sub RSET_smtp {
! 994: my ($args) = @_;
! 995:
! 996: if($args) {
! 997: sendcontrol "501 Unrecognized parameter\r\n";
! 998: }
! 999: else {
! 1000: sendcontrol "250 Resetting\r\n";
! 1001: }
! 1002:
! 1003: return 0;
! 1004: }
! 1005:
! 1006: sub HELP_smtp {
! 1007: my ($args) = @_;
! 1008:
! 1009: # One argument is optional
! 1010: if($args) {
! 1011: logmsg "HELP_smtp got $args\n";
! 1012: }
! 1013:
! 1014: if($smtp_client eq "verifiedserver") {
! 1015: # This is the secret command that verifies that this actually is
! 1016: # the curl test server
! 1017: sendcontrol "214 WE ROOLZ: $$\r\n";
! 1018:
! 1019: if($verbose) {
! 1020: print STDERR "FTPD: We returned proof we are the test server\n";
! 1021: }
! 1022:
! 1023: logmsg "return proof we are we\n";
! 1024: }
! 1025: else {
! 1026: sendcontrol "214-This server supports the following commands:\r\n";
! 1027:
! 1028: if(@auth_mechs) {
! 1029: sendcontrol "214 HELO EHLO RCPT DATA RSET MAIL VRFY EXPN QUIT HELP AUTH\r\n";
! 1030: }
! 1031: else {
! 1032: sendcontrol "214 HELO EHLO RCPT DATA RSET MAIL VRFY EXPN QUIT HELP\r\n";
! 1033: }
! 1034: }
! 1035:
! 1036: return 0;
! 1037: }
! 1038:
! 1039: sub VRFY_smtp {
! 1040: my ($args) = @_;
! 1041: my ($username, $address) = split(/ /, $args, 2);
! 1042:
! 1043: logmsg "VRFY_smtp got $args\n";
! 1044:
! 1045: if($username eq "") {
! 1046: sendcontrol "501 Unrecognized parameter\r\n";
! 1047: }
! 1048: else {
! 1049: my $smtputf8 = grep /^SMTPUTF8$/, @capabilities;
! 1050:
! 1051: # Validate the username (only a valid local or external username is
! 1052: # allowed, such as user or user@example.com)
! 1053: if ((!$smtputf8 && $username =~
! 1054: /^([a-zA-Z0-9._%+-]+)(\@(([a-zA-Z0-9-]+)\.)+([a-zA-Z]{2,4}))?$/) ||
! 1055: ($smtputf8 && $username =~
! 1056: /^([a-zA-Z0-9\x{80}-\x{ff}._%+-]+)(\@(([a-zA-Z0-9\x{80}-\x{ff}-]+)\.)+([a-zA-Z]{2,4}))?$/)) {
! 1057:
! 1058: my @data = getreplydata($smtp_client);
! 1059:
! 1060: if(!@data) {
! 1061: if ($username !~
! 1062: /^([a-zA-Z0-9._%+-]+)\@(([a-zA-Z0-9-]+)\.)+([a-zA-Z]{2,4})$/) {
! 1063: push @data, "250 <$username\@example.com>\r\n"
! 1064: }
! 1065: else {
! 1066: push @data, "250 <$username>\r\n"
! 1067: }
! 1068: }
! 1069:
! 1070: for my $d (@data) {
! 1071: sendcontrol $d;
! 1072: }
! 1073: }
! 1074: else {
! 1075: sendcontrol "501 Invalid address\r\n";
! 1076: }
! 1077: }
! 1078:
! 1079: return 0;
! 1080: }
! 1081:
! 1082: sub EXPN_smtp {
! 1083: my ($list_name) = @_;
! 1084:
! 1085: logmsg "EXPN_smtp got $list_name\n";
! 1086:
! 1087: if(!$list_name) {
! 1088: sendcontrol "501 Unrecognized parameter\r\n";
! 1089: }
! 1090: else {
! 1091: my @data = getreplydata($smtp_client);
! 1092:
! 1093: for my $d (@data) {
! 1094: sendcontrol $d;
! 1095: }
! 1096: }
! 1097:
! 1098: return 0;
! 1099: }
! 1100:
! 1101: sub QUIT_smtp {
! 1102: sendcontrol "221 curl $smtp_type server signing off\r\n";
! 1103:
! 1104: return 0;
! 1105: }
! 1106:
! 1107: # What was deleted by IMAP STORE / POP3 DELE commands
! 1108: my @deleted;
! 1109:
! 1110: ################
! 1111: ################ IMAP commands
! 1112: ################
! 1113:
! 1114: # global to allow the command functions to read it
! 1115: my $cmdid;
! 1116:
! 1117: # what was picked by SELECT
! 1118: my $selected;
! 1119:
! 1120: # Any IMAP parameter can come in escaped and in double quotes.
! 1121: # This function is dumb (so far) and just removes the quotes if present.
! 1122: sub fix_imap_params {
! 1123: foreach (@_) {
! 1124: $_ = $1 if /^"(.*)"$/;
! 1125: }
! 1126: }
! 1127:
! 1128: sub CAPABILITY_imap {
! 1129: if((!@capabilities) && (!@auth_mechs)) {
! 1130: sendcontrol "$cmdid BAD Command\r\n";
! 1131: }
! 1132: else {
! 1133: my $data;
! 1134:
! 1135: # Calculate the CAPABILITY response
! 1136: $data = "* CAPABILITY IMAP4";
! 1137:
! 1138: for my $c (@capabilities) {
! 1139: $data .= " $c";
! 1140: }
! 1141:
! 1142: for my $am (@auth_mechs) {
! 1143: $data .= " AUTH=$am";
! 1144: }
! 1145:
! 1146: $data .= " pingpong test server\r\n";
! 1147:
! 1148: # Send the CAPABILITY response
! 1149: sendcontrol $data;
! 1150: sendcontrol "$cmdid OK CAPABILITY completed\r\n";
! 1151: }
! 1152:
! 1153: return 0;
! 1154: }
! 1155:
! 1156: sub LOGIN_imap {
! 1157: my ($args) = @_;
! 1158: my ($user, $password) = split(/ /, $args, 2);
! 1159: fix_imap_params($user, $password);
! 1160:
! 1161: logmsg "LOGIN_imap got $args\n";
! 1162:
! 1163: if ($user eq "") {
! 1164: sendcontrol "$cmdid BAD Command Argument\r\n";
! 1165: }
! 1166: else {
! 1167: sendcontrol "$cmdid OK LOGIN completed\r\n";
! 1168: }
! 1169:
! 1170: return 0;
! 1171: }
! 1172:
! 1173: sub SELECT_imap {
! 1174: my ($mailbox) = @_;
! 1175: fix_imap_params($mailbox);
! 1176:
! 1177: logmsg "SELECT_imap got test $mailbox\n";
! 1178:
! 1179: if($mailbox eq "") {
! 1180: sendcontrol "$cmdid BAD Command Argument\r\n";
! 1181: }
! 1182: else {
! 1183: # Example from RFC 3501, 6.3.1. SELECT Command
! 1184: sendcontrol "* 172 EXISTS\r\n";
! 1185: sendcontrol "* 1 RECENT\r\n";
! 1186: sendcontrol "* OK [UNSEEN 12] Message 12 is first unseen\r\n";
! 1187: sendcontrol "* OK [UIDVALIDITY 3857529045] UIDs valid\r\n";
! 1188: sendcontrol "* OK [UIDNEXT 4392] Predicted next UID\r\n";
! 1189: sendcontrol "* FLAGS (\\Answered \\Flagged \\Deleted \\Seen \\Draft)\r\n";
! 1190: sendcontrol "* OK [PERMANENTFLAGS (\\Deleted \\Seen \\*)] Limited\r\n";
! 1191: sendcontrol "$cmdid OK [READ-WRITE] SELECT completed\r\n";
! 1192:
! 1193: $selected = $mailbox;
! 1194: }
! 1195:
! 1196: return 0;
! 1197: }
! 1198:
! 1199: sub FETCH_imap {
! 1200: my ($args) = @_;
! 1201: my ($uid, $how) = split(/ /, $args, 2);
! 1202: fix_imap_params($uid, $how);
! 1203:
! 1204: logmsg "FETCH_imap got $args\n";
! 1205:
! 1206: if ($selected eq "") {
! 1207: sendcontrol "$cmdid BAD Command received in Invalid state\r\n";
! 1208: }
! 1209: else {
! 1210: my @data;
! 1211: my $size;
! 1212:
! 1213: if($selected eq "verifiedserver") {
! 1214: # this is the secret command that verifies that this actually is
! 1215: # the curl test server
! 1216: my $response = "WE ROOLZ: $$\r\n";
! 1217: if($verbose) {
! 1218: print STDERR "FTPD: We returned proof we are the test server\n";
! 1219: }
! 1220: $data[0] = $response;
! 1221: logmsg "return proof we are we\n";
! 1222: }
! 1223: else {
! 1224: # send mail content
! 1225: logmsg "retrieve a mail\n";
! 1226:
! 1227: @data = getreplydata($selected);
! 1228: }
! 1229:
! 1230: for (@data) {
! 1231: $size += length($_);
! 1232: }
! 1233:
! 1234: sendcontrol "* $uid FETCH ($how {$size}\r\n";
! 1235:
! 1236: for my $d (@data) {
! 1237: sendcontrol $d;
! 1238: }
! 1239:
! 1240: sendcontrol ")\r\n";
! 1241: sendcontrol "$cmdid OK FETCH completed\r\n";
! 1242: }
! 1243:
! 1244: return 0;
! 1245: }
! 1246:
! 1247: sub APPEND_imap {
! 1248: my ($args) = @_;
! 1249:
! 1250: logmsg "APPEND_imap got $args\r\n";
! 1251:
! 1252: $args =~ /^([^ ]+) [^{]*\{(\d+)\}$/;
! 1253: my ($mailbox, $size) = ($1, $2);
! 1254: fix_imap_params($mailbox);
! 1255:
! 1256: if($mailbox eq "") {
! 1257: sendcontrol "$cmdid BAD Command Argument\r\n";
! 1258: }
! 1259: else {
! 1260: sendcontrol "+ Ready for literal data\r\n";
! 1261:
! 1262: my $testno = $mailbox;
! 1263: my $filename = "log/upload.$testno";
! 1264:
! 1265: logmsg "Store test number $testno in $filename\n";
! 1266:
! 1267: open(FILE, ">$filename") ||
! 1268: return 0; # failed to open output
! 1269:
! 1270: my $received = 0;
! 1271: my $line;
! 1272: while(5 == (sysread \*SFREAD, $line, 5)) {
! 1273: if($line eq "DATA\n") {
! 1274: sysread \*SFREAD, $line, 5;
! 1275:
! 1276: my $chunksize = 0;
! 1277: if($line =~ /^([0-9a-fA-F]{4})\n/) {
! 1278: $chunksize = hex($1);
! 1279: }
! 1280:
! 1281: read_mainsockf(\$line, $chunksize);
! 1282:
! 1283: my $left = $size - $received;
! 1284: my $datasize = ($left > $chunksize) ? $chunksize : $left;
! 1285:
! 1286: if($datasize > 0) {
! 1287: logmsg "> Appending $datasize bytes to file\n";
! 1288: print FILE substr($line, 0, $datasize) if(!$nosave);
! 1289: $line = substr($line, $datasize);
! 1290:
! 1291: $received += $datasize;
! 1292: if($received == $size) {
! 1293: logmsg "Received all data, waiting for final CRLF.\n";
! 1294: }
! 1295: }
! 1296:
! 1297: if($received == $size && $line eq "\r\n") {
! 1298: last;
! 1299: }
! 1300: }
! 1301: elsif($line eq "DISC\n") {
! 1302: logmsg "Unexpected disconnect!\n";
! 1303: last;
! 1304: }
! 1305: else {
! 1306: logmsg "No support for: $line";
! 1307: last;
! 1308: }
! 1309: }
! 1310:
! 1311: if($nosave) {
! 1312: print FILE "$size bytes would've been stored here\n";
! 1313: }
! 1314:
! 1315: close(FILE);
! 1316:
! 1317: logmsg "received $size bytes upload\n";
! 1318:
! 1319: sendcontrol "$cmdid OK APPEND completed\r\n";
! 1320: }
! 1321:
! 1322: return 0;
! 1323: }
! 1324:
! 1325: sub STORE_imap {
! 1326: my ($args) = @_;
! 1327: my ($uid, $what, $value) = split(/ /, $args, 3);
! 1328: fix_imap_params($uid);
! 1329:
! 1330: logmsg "STORE_imap got $args\n";
! 1331:
! 1332: if ($selected eq "") {
! 1333: sendcontrol "$cmdid BAD Command received in Invalid state\r\n";
! 1334: }
! 1335: elsif (($uid eq "") || ($what ne "+Flags") || ($value eq "")) {
! 1336: sendcontrol "$cmdid BAD Command Argument\r\n";
! 1337: }
! 1338: else {
! 1339: if($value eq "\\Deleted") {
! 1340: push(@deleted, $uid);
! 1341: }
! 1342:
! 1343: sendcontrol "* $uid FETCH (FLAGS (\\Seen $value))\r\n";
! 1344: sendcontrol "$cmdid OK STORE completed\r\n";
! 1345: }
! 1346:
! 1347: return 0;
! 1348: }
! 1349:
! 1350: sub LIST_imap {
! 1351: my ($args) = @_;
! 1352: my ($reference, $mailbox) = split(/ /, $args, 2);
! 1353: fix_imap_params($reference, $mailbox);
! 1354:
! 1355: logmsg "LIST_imap got $args\n";
! 1356:
! 1357: if ($reference eq "") {
! 1358: sendcontrol "$cmdid BAD Command Argument\r\n";
! 1359: }
! 1360: elsif ($reference eq "verifiedserver") {
! 1361: # this is the secret command that verifies that this actually is
! 1362: # the curl test server
! 1363: sendcontrol "* LIST () \"/\" \"WE ROOLZ: $$\"\r\n";
! 1364: sendcontrol "$cmdid OK LIST Completed\r\n";
! 1365:
! 1366: if($verbose) {
! 1367: print STDERR "FTPD: We returned proof we are the test server\n";
! 1368: }
! 1369:
! 1370: logmsg "return proof we are we\n";
! 1371: }
! 1372: else {
! 1373: my @data = getreplydata($reference);
! 1374:
! 1375: for my $d (@data) {
! 1376: sendcontrol $d;
! 1377: }
! 1378:
! 1379: sendcontrol "$cmdid OK LIST Completed\r\n";
! 1380: }
! 1381:
! 1382: return 0;
! 1383: }
! 1384:
! 1385: sub LSUB_imap {
! 1386: my ($args) = @_;
! 1387: my ($reference, $mailbox) = split(/ /, $args, 2);
! 1388: fix_imap_params($reference, $mailbox);
! 1389:
! 1390: logmsg "LSUB_imap got $args\n";
! 1391:
! 1392: if ($reference eq "") {
! 1393: sendcontrol "$cmdid BAD Command Argument\r\n";
! 1394: }
! 1395: else {
! 1396: my @data = getreplydata($reference);
! 1397:
! 1398: for my $d (@data) {
! 1399: sendcontrol $d;
! 1400: }
! 1401:
! 1402: sendcontrol "$cmdid OK LSUB Completed\r\n";
! 1403: }
! 1404:
! 1405: return 0;
! 1406: }
! 1407:
! 1408: sub EXAMINE_imap {
! 1409: my ($mailbox) = @_;
! 1410: fix_imap_params($mailbox);
! 1411:
! 1412: logmsg "EXAMINE_imap got $mailbox\n";
! 1413:
! 1414: if ($mailbox eq "") {
! 1415: sendcontrol "$cmdid BAD Command Argument\r\n";
! 1416: }
! 1417: else {
! 1418: my @data = getreplydata($mailbox);
! 1419:
! 1420: for my $d (@data) {
! 1421: sendcontrol $d;
! 1422: }
! 1423:
! 1424: sendcontrol "$cmdid OK [READ-ONLY] EXAMINE completed\r\n";
! 1425: }
! 1426:
! 1427: return 0;
! 1428: }
! 1429:
! 1430: sub STATUS_imap {
! 1431: my ($args) = @_;
! 1432: my ($mailbox, $what) = split(/ /, $args, 2);
! 1433: fix_imap_params($mailbox);
! 1434:
! 1435: logmsg "STATUS_imap got $args\n";
! 1436:
! 1437: if ($mailbox eq "") {
! 1438: sendcontrol "$cmdid BAD Command Argument\r\n";
! 1439: }
! 1440: else {
! 1441: my @data = getreplydata($mailbox);
! 1442:
! 1443: for my $d (@data) {
! 1444: sendcontrol $d;
! 1445: }
! 1446:
! 1447: sendcontrol "$cmdid OK STATUS completed\r\n";
! 1448: }
! 1449:
! 1450: return 0;
! 1451: }
! 1452:
! 1453: sub SEARCH_imap {
! 1454: my ($what) = @_;
! 1455: fix_imap_params($what);
! 1456:
! 1457: logmsg "SEARCH_imap got $what\n";
! 1458:
! 1459: if ($selected eq "") {
! 1460: sendcontrol "$cmdid BAD Command received in Invalid state\r\n";
! 1461: }
! 1462: elsif ($what eq "") {
! 1463: sendcontrol "$cmdid BAD Command Argument\r\n";
! 1464: }
! 1465: else {
! 1466: my @data = getreplydata($selected);
! 1467:
! 1468: for my $d (@data) {
! 1469: sendcontrol $d;
! 1470: }
! 1471:
! 1472: sendcontrol "$cmdid OK SEARCH completed\r\n";
! 1473: }
! 1474:
! 1475: return 0;
! 1476: }
! 1477:
! 1478: sub CREATE_imap {
! 1479: my ($args) = @_;
! 1480: fix_imap_params($args);
! 1481:
! 1482: logmsg "CREATE_imap got $args\n";
! 1483:
! 1484: if ($args eq "") {
! 1485: sendcontrol "$cmdid BAD Command Argument\r\n";
! 1486: }
! 1487: else {
! 1488: sendcontrol "$cmdid OK CREATE completed\r\n";
! 1489: }
! 1490:
! 1491: return 0;
! 1492: }
! 1493:
! 1494: sub DELETE_imap {
! 1495: my ($args) = @_;
! 1496: fix_imap_params($args);
! 1497:
! 1498: logmsg "DELETE_imap got $args\n";
! 1499:
! 1500: if ($args eq "") {
! 1501: sendcontrol "$cmdid BAD Command Argument\r\n";
! 1502: }
! 1503: else {
! 1504: sendcontrol "$cmdid OK DELETE completed\r\n";
! 1505: }
! 1506:
! 1507: return 0;
! 1508: }
! 1509:
! 1510: sub RENAME_imap {
! 1511: my ($args) = @_;
! 1512: my ($from_mailbox, $to_mailbox) = split(/ /, $args, 2);
! 1513: fix_imap_params($from_mailbox, $to_mailbox);
! 1514:
! 1515: logmsg "RENAME_imap got $args\n";
! 1516:
! 1517: if (($from_mailbox eq "") || ($to_mailbox eq "")) {
! 1518: sendcontrol "$cmdid BAD Command Argument\r\n";
! 1519: }
! 1520: else {
! 1521: sendcontrol "$cmdid OK RENAME completed\r\n";
! 1522: }
! 1523:
! 1524: return 0;
! 1525: }
! 1526:
! 1527: sub CHECK_imap {
! 1528: if ($selected eq "") {
! 1529: sendcontrol "$cmdid BAD Command received in Invalid state\r\n";
! 1530: }
! 1531: else {
! 1532: sendcontrol "$cmdid OK CHECK completed\r\n";
! 1533: }
! 1534:
! 1535: return 0;
! 1536: }
! 1537:
! 1538: sub CLOSE_imap {
! 1539: if ($selected eq "") {
! 1540: sendcontrol "$cmdid BAD Command received in Invalid state\r\n";
! 1541: }
! 1542: elsif (!@deleted) {
! 1543: sendcontrol "$cmdid BAD Command Argument\r\n";
! 1544: }
! 1545: else {
! 1546: sendcontrol "$cmdid OK CLOSE completed\r\n";
! 1547:
! 1548: @deleted = ();
! 1549: }
! 1550:
! 1551: return 0;
! 1552: }
! 1553:
! 1554: sub EXPUNGE_imap {
! 1555: if ($selected eq "") {
! 1556: sendcontrol "$cmdid BAD Command received in Invalid state\r\n";
! 1557: }
! 1558: else {
! 1559: if (!@deleted) {
! 1560: # Report the number of existing messages as per the SELECT
! 1561: # command
! 1562: sendcontrol "* 172 EXISTS\r\n";
! 1563: }
! 1564: else {
! 1565: # Report the message UIDs being deleted
! 1566: for my $d (@deleted) {
! 1567: sendcontrol "* $d EXPUNGE\r\n";
! 1568: }
! 1569:
! 1570: @deleted = ();
! 1571: }
! 1572:
! 1573: sendcontrol "$cmdid OK EXPUNGE completed\r\n";
! 1574: }
! 1575:
! 1576: return 0;
! 1577: }
! 1578:
! 1579: sub COPY_imap {
! 1580: my ($args) = @_;
! 1581: my ($uid, $mailbox) = split(/ /, $args, 2);
! 1582: fix_imap_params($uid, $mailbox);
! 1583:
! 1584: logmsg "COPY_imap got $args\n";
! 1585:
! 1586: if (($uid eq "") || ($mailbox eq "")) {
! 1587: sendcontrol "$cmdid BAD Command Argument\r\n";
! 1588: }
! 1589: else {
! 1590: sendcontrol "$cmdid OK COPY completed\r\n";
! 1591: }
! 1592:
! 1593: return 0;
! 1594: }
! 1595:
! 1596: sub UID_imap {
! 1597: my ($args) = @_;
! 1598: my ($command) = split(/ /, $args, 1);
! 1599: fix_imap_params($command);
! 1600:
! 1601: logmsg "UID_imap got $args\n";
! 1602:
! 1603: if ($selected eq "") {
! 1604: sendcontrol "$cmdid BAD Command received in Invalid state\r\n";
! 1605: }
! 1606: elsif (substr($command, 0, 5) eq "FETCH"){
! 1607: my $func = $commandfunc{"FETCH"};
! 1608: if($func) {
! 1609: &$func($args, $command);
! 1610: }
! 1611: }
! 1612: elsif (($command ne "COPY") &&
! 1613: ($command ne "STORE") && ($command ne "SEARCH")) {
! 1614: sendcontrol "$cmdid BAD Command Argument\r\n";
! 1615: }
! 1616: else {
! 1617: my @data = getreplydata($selected);
! 1618:
! 1619: for my $d (@data) {
! 1620: sendcontrol $d;
! 1621: }
! 1622:
! 1623: sendcontrol "$cmdid OK $command completed\r\n";
! 1624: }
! 1625:
! 1626: return 0;
! 1627: }
! 1628:
! 1629: sub NOOP_imap {
! 1630: my ($args) = @_;
! 1631: my @data = (
! 1632: "* 22 EXPUNGE\r\n",
! 1633: "* 23 EXISTS\r\n",
! 1634: "* 3 RECENT\r\n",
! 1635: "* 14 FETCH (FLAGS (\\Seen \\Deleted))\r\n",
! 1636: );
! 1637:
! 1638: if ($args) {
! 1639: sendcontrol "$cmdid BAD Command Argument\r\n";
! 1640: }
! 1641: else {
! 1642: for my $d (@data) {
! 1643: sendcontrol $d;
! 1644: }
! 1645:
! 1646: sendcontrol "$cmdid OK NOOP completed\r\n";
! 1647: }
! 1648:
! 1649: return 0;
! 1650: }
! 1651:
! 1652: sub LOGOUT_imap {
! 1653: sendcontrol "* BYE curl IMAP server signing off\r\n";
! 1654: sendcontrol "$cmdid OK LOGOUT completed\r\n";
! 1655:
! 1656: return 0;
! 1657: }
! 1658:
! 1659: ################
! 1660: ################ POP3 commands
! 1661: ################
! 1662:
! 1663: # Who is attempting to log in
! 1664: my $username;
! 1665:
! 1666: sub CAPA_pop3 {
! 1667: my @list = ();
! 1668: my $mechs;
! 1669:
! 1670: # Calculate the capability list based on the specified capabilities
! 1671: # (except APOP) and any authentication mechanisms
! 1672: for my $c (@capabilities) {
! 1673: push @list, "$c\r\n" unless $c eq "APOP";
! 1674: }
! 1675:
! 1676: for my $am (@auth_mechs) {
! 1677: if(!$mechs) {
! 1678: $mechs = "$am";
! 1679: }
! 1680: else {
! 1681: $mechs .= " $am";
! 1682: }
! 1683: }
! 1684:
! 1685: if($mechs) {
! 1686: push @list, "SASL $mechs\r\n";
! 1687: }
! 1688:
! 1689: if(!@list) {
! 1690: sendcontrol "-ERR Unrecognized command\r\n";
! 1691: }
! 1692: else {
! 1693: my @data = ();
! 1694:
! 1695: # Calculate the CAPA response
! 1696: push @data, "+OK List of capabilities follows\r\n";
! 1697:
! 1698: for my $l (@list) {
! 1699: push @data, "$l\r\n";
! 1700: }
! 1701:
! 1702: push @data, "IMPLEMENTATION POP3 pingpong test server\r\n";
! 1703:
! 1704: # Send the CAPA response
! 1705: for my $d (@data) {
! 1706: sendcontrol $d;
! 1707: }
! 1708:
! 1709: # End with the magic 3-byte end of listing marker
! 1710: sendcontrol ".\r\n";
! 1711: }
! 1712:
! 1713: return 0;
! 1714: }
! 1715:
! 1716: sub APOP_pop3 {
! 1717: my ($args) = @_;
! 1718: my ($user, $secret) = split(/ /, $args, 2);
! 1719:
! 1720: if (!grep /^APOP$/, @capabilities) {
! 1721: sendcontrol "-ERR Unrecognized command\r\n";
! 1722: }
! 1723: elsif (($user eq "") || ($secret eq "")) {
! 1724: sendcontrol "-ERR Protocol error\r\n";
! 1725: }
! 1726: else {
! 1727: my $digest = Digest::MD5::md5_hex($POP3_TIMESTAMP, $TEXT_PASSWORD);
! 1728:
! 1729: if ($secret ne $digest) {
! 1730: sendcontrol "-ERR Login failure\r\n";
! 1731: }
! 1732: else {
! 1733: sendcontrol "+OK Login successful\r\n";
! 1734: }
! 1735: }
! 1736:
! 1737: return 0;
! 1738: }
! 1739:
! 1740: sub AUTH_pop3 {
! 1741: if(!@auth_mechs) {
! 1742: sendcontrol "-ERR Unrecognized command\r\n";
! 1743: }
! 1744: else {
! 1745: my @data = ();
! 1746:
! 1747: # Calculate the AUTH response
! 1748: push @data, "+OK List of supported mechanisms follows\r\n";
! 1749:
! 1750: for my $am (@auth_mechs) {
! 1751: push @data, "$am\r\n";
! 1752: }
! 1753:
! 1754: # Send the AUTH response
! 1755: for my $d (@data) {
! 1756: sendcontrol $d;
! 1757: }
! 1758:
! 1759: # End with the magic 3-byte end of listing marker
! 1760: sendcontrol ".\r\n";
! 1761: }
! 1762:
! 1763: return 0;
! 1764: }
! 1765:
! 1766: sub USER_pop3 {
! 1767: my ($user) = @_;
! 1768:
! 1769: logmsg "USER_pop3 got $user\n";
! 1770:
! 1771: if (!$user) {
! 1772: sendcontrol "-ERR Protocol error\r\n";
! 1773: }
! 1774: else {
! 1775: $username = $user;
! 1776:
! 1777: sendcontrol "+OK\r\n";
! 1778: }
! 1779:
! 1780: return 0;
! 1781: }
! 1782:
! 1783: sub PASS_pop3 {
! 1784: my ($password) = @_;
! 1785:
! 1786: logmsg "PASS_pop3 got $password\n";
! 1787:
! 1788: sendcontrol "+OK Login successful\r\n";
! 1789:
! 1790: return 0;
! 1791: }
! 1792:
! 1793: sub RETR_pop3 {
! 1794: my ($msgid) = @_;
! 1795: my @data;
! 1796:
! 1797: if($msgid =~ /^verifiedserver$/) {
! 1798: # this is the secret command that verifies that this actually is
! 1799: # the curl test server
! 1800: my $response = "WE ROOLZ: $$\r\n";
! 1801: if($verbose) {
! 1802: print STDERR "FTPD: We returned proof we are the test server\n";
! 1803: }
! 1804: $data[0] = $response;
! 1805: logmsg "return proof we are we\n";
! 1806: }
! 1807: else {
! 1808: # send mail content
! 1809: logmsg "retrieve a mail\n";
! 1810:
! 1811: @data = getreplydata($msgid);
! 1812: }
! 1813:
! 1814: sendcontrol "+OK Mail transfer starts\r\n";
! 1815:
! 1816: for my $d (@data) {
! 1817: sendcontrol $d;
! 1818: }
! 1819:
! 1820: # end with the magic 3-byte end of mail marker, assumes that the
! 1821: # mail body ends with a CRLF!
! 1822: sendcontrol ".\r\n";
! 1823:
! 1824: return 0;
! 1825: }
! 1826:
! 1827: sub LIST_pop3 {
! 1828: # This is a built-in fake-message list
! 1829: my @data = (
! 1830: "1 100\r\n",
! 1831: "2 4294967400\r\n", # > 4 GB
! 1832: "3 200\r\n",
! 1833: );
! 1834:
! 1835: logmsg "retrieve a message list\n";
! 1836:
! 1837: sendcontrol "+OK Listing starts\r\n";
! 1838:
! 1839: for my $d (@data) {
! 1840: sendcontrol $d;
! 1841: }
! 1842:
! 1843: # End with the magic 3-byte end of listing marker
! 1844: sendcontrol ".\r\n";
! 1845:
! 1846: return 0;
! 1847: }
! 1848:
! 1849: sub DELE_pop3 {
! 1850: my ($msgid) = @_;
! 1851:
! 1852: logmsg "DELE_pop3 got $msgid\n";
! 1853:
! 1854: if (!$msgid) {
! 1855: sendcontrol "-ERR Protocol error\r\n";
! 1856: }
! 1857: else {
! 1858: push (@deleted, $msgid);
! 1859:
! 1860: sendcontrol "+OK\r\n";
! 1861: }
! 1862:
! 1863: return 0;
! 1864: }
! 1865:
! 1866: sub STAT_pop3 {
! 1867: my ($args) = @_;
! 1868:
! 1869: if ($args) {
! 1870: sendcontrol "-ERR Protocol error\r\n";
! 1871: }
! 1872: else {
! 1873: # Send statistics for the built-in fake message list as
! 1874: # detailed in the LIST_pop3 function above
! 1875: sendcontrol "+OK 3 4294967800\r\n";
! 1876: }
! 1877:
! 1878: return 0;
! 1879: }
! 1880:
! 1881: sub NOOP_pop3 {
! 1882: my ($args) = @_;
! 1883:
! 1884: if ($args) {
! 1885: sendcontrol "-ERR Protocol error\r\n";
! 1886: }
! 1887: else {
! 1888: sendcontrol "+OK\r\n";
! 1889: }
! 1890:
! 1891: return 0;
! 1892: }
! 1893:
! 1894: sub UIDL_pop3 {
! 1895: # This is a built-in fake-message UID list
! 1896: my @data = (
! 1897: "1 1\r\n",
! 1898: "2 2\r\n",
! 1899: "3 4\r\n", # Note that UID 3 is a simulated "deleted" message
! 1900: );
! 1901:
! 1902: if (!grep /^UIDL$/, @capabilities) {
! 1903: sendcontrol "-ERR Unrecognized command\r\n";
! 1904: }
! 1905: else {
! 1906: logmsg "retrieve a message UID list\n";
! 1907:
! 1908: sendcontrol "+OK Listing starts\r\n";
! 1909:
! 1910: for my $d (@data) {
! 1911: sendcontrol $d;
! 1912: }
! 1913:
! 1914: # End with the magic 3-byte end of listing marker
! 1915: sendcontrol ".\r\n";
! 1916: }
! 1917:
! 1918: return 0;
! 1919: }
! 1920:
! 1921: sub TOP_pop3 {
! 1922: my ($args) = @_;
! 1923: my ($msgid, $lines) = split(/ /, $args, 2);
! 1924:
! 1925: logmsg "TOP_pop3 got $args\n";
! 1926:
! 1927: if (!grep /^TOP$/, @capabilities) {
! 1928: sendcontrol "-ERR Unrecognized command\r\n";
! 1929: }
! 1930: elsif (($msgid eq "") || ($lines eq "")) {
! 1931: sendcontrol "-ERR Protocol error\r\n";
! 1932: }
! 1933: else {
! 1934: if ($lines == "0") {
! 1935: logmsg "retrieve header of mail\n";
! 1936: }
! 1937: else {
! 1938: logmsg "retrieve top $lines lines of mail\n";
! 1939: }
! 1940:
! 1941: my @data = getreplydata($msgid);
! 1942:
! 1943: sendcontrol "+OK Mail transfer starts\r\n";
! 1944:
! 1945: # Send mail content
! 1946: for my $d (@data) {
! 1947: sendcontrol $d;
! 1948: }
! 1949:
! 1950: # End with the magic 3-byte end of mail marker, assumes that the
! 1951: # mail body ends with a CRLF!
! 1952: sendcontrol ".\r\n";
! 1953: }
! 1954:
! 1955: return 0;
! 1956: }
! 1957:
! 1958: sub RSET_pop3 {
! 1959: my ($args) = @_;
! 1960:
! 1961: if ($args) {
! 1962: sendcontrol "-ERR Protocol error\r\n";
! 1963: }
! 1964: else {
! 1965: if (@deleted) {
! 1966: logmsg "resetting @deleted message(s)\n";
! 1967:
! 1968: @deleted = ();
! 1969: }
! 1970:
! 1971: sendcontrol "+OK\r\n";
! 1972: }
! 1973:
! 1974: return 0;
! 1975: }
! 1976:
! 1977: sub QUIT_pop3 {
! 1978: if(@deleted) {
! 1979: logmsg "deleting @deleted message(s)\n";
! 1980:
! 1981: @deleted = ();
! 1982: }
! 1983:
! 1984: sendcontrol "+OK curl POP3 server signing off\r\n";
! 1985:
! 1986: return 0;
! 1987: }
! 1988:
! 1989: ################
! 1990: ################ FTP commands
! 1991: ################
! 1992: my $rest=0;
! 1993: sub REST_ftp {
! 1994: $rest = $_[0];
! 1995: logmsg "Set REST position to $rest\n"
! 1996: }
! 1997:
! 1998: sub switch_directory_goto {
! 1999: my $target_dir = $_;
! 2000:
! 2001: if(!$ftptargetdir) {
! 2002: $ftptargetdir = "/";
! 2003: }
! 2004:
! 2005: if($target_dir eq "") {
! 2006: $ftptargetdir = "/";
! 2007: }
! 2008: elsif($target_dir eq "..") {
! 2009: if($ftptargetdir eq "/") {
! 2010: $ftptargetdir = "/";
! 2011: }
! 2012: else {
! 2013: $ftptargetdir =~ s/[[:alnum:]]+\/$//;
! 2014: }
! 2015: }
! 2016: else {
! 2017: $ftptargetdir .= $target_dir . "/";
! 2018: }
! 2019: }
! 2020:
! 2021: sub switch_directory {
! 2022: my $target_dir = $_[0];
! 2023:
! 2024: if($target_dir =~ /^test-(\d+)/) {
! 2025: $cwd_testno = $1;
! 2026: }
! 2027: elsif($target_dir eq "/") {
! 2028: $ftptargetdir = "/";
! 2029: }
! 2030: else {
! 2031: my @dirs = split("/", $target_dir);
! 2032: for(@dirs) {
! 2033: switch_directory_goto($_);
! 2034: }
! 2035: }
! 2036: }
! 2037:
! 2038: sub CWD_ftp {
! 2039: my ($folder, $fullcommand) = $_[0];
! 2040: switch_directory($folder);
! 2041: if($ftptargetdir =~ /^\/fully_simulated/) {
! 2042: $ftplistparserstate = "enabled";
! 2043: }
! 2044: else {
! 2045: undef $ftplistparserstate;
! 2046: }
! 2047: }
! 2048:
! 2049: sub PWD_ftp {
! 2050: my $mydir;
! 2051: $mydir = $ftptargetdir ? $ftptargetdir : "/";
! 2052:
! 2053: if($mydir ne "/") {
! 2054: $mydir =~ s/\/$//;
! 2055: }
! 2056: sendcontrol "257 \"$mydir\" is current directory\r\n";
! 2057: }
! 2058:
! 2059: sub LIST_ftp {
! 2060: # print "150 ASCII data connection for /bin/ls (193.15.23.1,59196) (0 bytes)\r\n";
! 2061:
! 2062: # this is a built-in fake-dir ;-)
! 2063: my @ftpdir=("total 20\r\n",
! 2064: "drwxr-xr-x 8 98 98 512 Oct 22 13:06 .\r\n",
! 2065: "drwxr-xr-x 8 98 98 512 Oct 22 13:06 ..\r\n",
! 2066: "drwxr-xr-x 2 98 98 512 May 2 1996 .NeXT\r\n",
! 2067: "-r--r--r-- 1 0 1 35 Jul 16 1996 README\r\n",
! 2068: "lrwxrwxrwx 1 0 1 7 Dec 9 1999 bin -> usr/bin\r\n",
! 2069: "dr-xr-xr-x 2 0 1 512 Oct 1 1997 dev\r\n",
! 2070: "drwxrwxrwx 2 98 98 512 May 29 16:04 download.html\r\n",
! 2071: "dr-xr-xr-x 2 0 1 512 Nov 30 1995 etc\r\n",
! 2072: "drwxrwxrwx 2 98 1 512 Oct 30 14:33 pub\r\n",
! 2073: "dr-xr-xr-x 5 0 1 512 Oct 1 1997 usr\r\n");
! 2074:
! 2075: if($datasockf_conn eq 'no') {
! 2076: if($nodataconn425) {
! 2077: sendcontrol "150 Opening data connection\r\n";
! 2078: sendcontrol "425 Can't open data connection\r\n";
! 2079: }
! 2080: elsif($nodataconn421) {
! 2081: sendcontrol "150 Opening data connection\r\n";
! 2082: sendcontrol "421 Connection timed out\r\n";
! 2083: }
! 2084: elsif($nodataconn150) {
! 2085: sendcontrol "150 Opening data connection\r\n";
! 2086: # client shall timeout
! 2087: }
! 2088: else {
! 2089: # client shall timeout
! 2090: }
! 2091: return 0;
! 2092: }
! 2093:
! 2094: if($ftplistparserstate) {
! 2095: @ftpdir = ftp_contentlist($ftptargetdir);
! 2096: }
! 2097:
! 2098: logmsg "pass LIST data on data connection\n";
! 2099:
! 2100: if($cwd_testno) {
! 2101: loadtest("$srcdir/data/test$cwd_testno");
! 2102:
! 2103: my @data = getpart("reply", "data");
! 2104: for(@data) {
! 2105: my $send = $_;
! 2106: # convert all \n to \r\n for ASCII transfer
! 2107: $send =~ s/\r\n/\n/g;
! 2108: $send =~ s/\n/\r\n/g;
! 2109: logmsg "send $send as data\n";
! 2110: senddata $send;
! 2111: }
! 2112: $cwd_testno = 0; # forget it again
! 2113: }
! 2114: else {
! 2115: # old hard-coded style
! 2116: for(@ftpdir) {
! 2117: senddata $_;
! 2118: }
! 2119: }
! 2120: close_dataconn(0);
! 2121: sendcontrol "226 ASCII transfer complete\r\n";
! 2122: return 0;
! 2123: }
! 2124:
! 2125: sub NLST_ftp {
! 2126: my @ftpdir=("file", "with space", "fake", "..", " ..", "funny", "README");
! 2127:
! 2128: if($datasockf_conn eq 'no') {
! 2129: if($nodataconn425) {
! 2130: sendcontrol "150 Opening data connection\r\n";
! 2131: sendcontrol "425 Can't open data connection\r\n";
! 2132: }
! 2133: elsif($nodataconn421) {
! 2134: sendcontrol "150 Opening data connection\r\n";
! 2135: sendcontrol "421 Connection timed out\r\n";
! 2136: }
! 2137: elsif($nodataconn150) {
! 2138: sendcontrol "150 Opening data connection\r\n";
! 2139: # client shall timeout
! 2140: }
! 2141: else {
! 2142: # client shall timeout
! 2143: }
! 2144: return 0;
! 2145: }
! 2146:
! 2147: logmsg "pass NLST data on data connection\n";
! 2148: for(@ftpdir) {
! 2149: senddata "$_\r\n";
! 2150: }
! 2151: close_dataconn(0);
! 2152: sendcontrol "226 ASCII transfer complete\r\n";
! 2153: return 0;
! 2154: }
! 2155:
! 2156: sub MDTM_ftp {
! 2157: my $testno = $_[0];
! 2158: my $testpart = "";
! 2159: if ($testno > 10000) {
! 2160: $testpart = $testno % 10000;
! 2161: $testno = int($testno / 10000);
! 2162: }
! 2163:
! 2164: loadtest("$srcdir/data/test$testno");
! 2165:
! 2166: my @data = getpart("reply", "mdtm");
! 2167:
! 2168: my $reply = $data[0];
! 2169: chomp $reply if($reply);
! 2170:
! 2171: if($reply && ($reply =~ /^[+-]?\d+$/) && ($reply < 0)) {
! 2172: sendcontrol "550 $testno: no such file.\r\n";
! 2173: }
! 2174: elsif($reply) {
! 2175: sendcontrol "$reply\r\n";
! 2176: }
! 2177: else {
! 2178: sendcontrol "500 MDTM: no such command.\r\n";
! 2179: }
! 2180: return 0;
! 2181: }
! 2182:
! 2183: sub SIZE_ftp {
! 2184: my $testno = $_[0];
! 2185: if($ftplistparserstate) {
! 2186: my $size = wildcard_filesize($ftptargetdir, $testno);
! 2187: if($size == -1) {
! 2188: sendcontrol "550 $testno: No such file or directory.\r\n";
! 2189: }
! 2190: else {
! 2191: sendcontrol "213 $size\r\n";
! 2192: }
! 2193: return 0;
! 2194: }
! 2195:
! 2196: if($testno =~ /^verifiedserver$/) {
! 2197: my $response = "WE ROOLZ: $$\r\n";
! 2198: my $size = length($response);
! 2199: sendcontrol "213 $size\r\n";
! 2200: return 0;
! 2201: }
! 2202:
! 2203: if($testno =~ /(\d+)\/?$/) {
! 2204: $testno = $1;
! 2205: }
! 2206: else {
! 2207: print STDERR "SIZE_ftp: invalid test number: $testno\n";
! 2208: return 1;
! 2209: }
! 2210:
! 2211: my $testpart = "";
! 2212: if($testno > 10000) {
! 2213: $testpart = $testno % 10000;
! 2214: $testno = int($testno / 10000);
! 2215: }
! 2216:
! 2217: loadtest("$srcdir/data/test$testno");
! 2218:
! 2219: my @data = getpart("reply", "size");
! 2220:
! 2221: my $size = $data[0];
! 2222:
! 2223: if($size) {
! 2224: if($size > -1) {
! 2225: sendcontrol "213 $size\r\n";
! 2226: }
! 2227: else {
! 2228: sendcontrol "550 $testno: No such file or directory.\r\n";
! 2229: }
! 2230: }
! 2231: else {
! 2232: $size=0;
! 2233: @data = getpart("reply", "data$testpart");
! 2234: for(@data) {
! 2235: $size += length($_);
! 2236: }
! 2237: if($size) {
! 2238: sendcontrol "213 $size\r\n";
! 2239: }
! 2240: else {
! 2241: sendcontrol "550 $testno: No such file or directory.\r\n";
! 2242: }
! 2243: }
! 2244: return 0;
! 2245: }
! 2246:
! 2247: sub RETR_ftp {
! 2248: my ($testno) = @_;
! 2249:
! 2250: if($datasockf_conn eq 'no') {
! 2251: if($nodataconn425) {
! 2252: sendcontrol "150 Opening data connection\r\n";
! 2253: sendcontrol "425 Can't open data connection\r\n";
! 2254: }
! 2255: elsif($nodataconn421) {
! 2256: sendcontrol "150 Opening data connection\r\n";
! 2257: sendcontrol "421 Connection timed out\r\n";
! 2258: }
! 2259: elsif($nodataconn150) {
! 2260: sendcontrol "150 Opening data connection\r\n";
! 2261: # client shall timeout
! 2262: }
! 2263: else {
! 2264: # client shall timeout
! 2265: }
! 2266: return 0;
! 2267: }
! 2268:
! 2269: if($ftplistparserstate) {
! 2270: my @content = wildcard_getfile($ftptargetdir, $testno);
! 2271: if($content[0] == -1) {
! 2272: #file not found
! 2273: }
! 2274: else {
! 2275: my $size = length $content[1];
! 2276: sendcontrol "150 Binary data connection for $testno ($size bytes).\r\n",
! 2277: senddata $content[1];
! 2278: close_dataconn(0);
! 2279: sendcontrol "226 File transfer complete\r\n";
! 2280: }
! 2281: return 0;
! 2282: }
! 2283:
! 2284: if($testno =~ /^verifiedserver$/) {
! 2285: # this is the secret command that verifies that this actually is
! 2286: # the curl test server
! 2287: my $response = "WE ROOLZ: $$\r\n";
! 2288: my $len = length($response);
! 2289: sendcontrol "150 Binary junk ($len bytes).\r\n";
! 2290: senddata "WE ROOLZ: $$\r\n";
! 2291: close_dataconn(0);
! 2292: sendcontrol "226 File transfer complete\r\n";
! 2293: if($verbose) {
! 2294: print STDERR "FTPD: We returned proof we are the test server\n";
! 2295: }
! 2296: return 0;
! 2297: }
! 2298:
! 2299: $testno =~ s/^([^0-9]*)//;
! 2300: my $testpart = "";
! 2301: if ($testno > 10000) {
! 2302: $testpart = $testno % 10000;
! 2303: $testno = int($testno / 10000);
! 2304: }
! 2305:
! 2306: loadtest("$srcdir/data/test$testno");
! 2307:
! 2308: my @data = getpart("reply", "data$testpart");
! 2309:
! 2310: my $size=0;
! 2311: for(@data) {
! 2312: $size += length($_);
! 2313: }
! 2314:
! 2315: my %hash = getpartattr("reply", "data$testpart");
! 2316:
! 2317: if($size || $hash{'sendzero'}) {
! 2318:
! 2319: if($rest) {
! 2320: # move read pointer forward
! 2321: $size -= $rest;
! 2322: logmsg "REST $rest was removed from size, makes $size left\n";
! 2323: $rest = 0; # reset REST offset again
! 2324: }
! 2325: if($retrweirdo) {
! 2326: sendcontrol "150 Binary data connection for $testno () ($size bytes).\r\n",
! 2327: "226 File transfer complete\r\n";
! 2328:
! 2329: for(@data) {
! 2330: my $send = $_;
! 2331: senddata $send;
! 2332: }
! 2333: close_dataconn(0);
! 2334: $retrweirdo=0; # switch off the weirdo again!
! 2335: }
! 2336: else {
! 2337: my $sz = "($size bytes)";
! 2338: if($retrnosize) {
! 2339: $sz = "size?";
! 2340: }
! 2341:
! 2342: sendcontrol "150 Binary data connection for $testno () $sz.\r\n";
! 2343:
! 2344: for(@data) {
! 2345: my $send = $_;
! 2346: senddata $send;
! 2347: }
! 2348: close_dataconn(0);
! 2349: sendcontrol "226 File transfer complete\r\n";
! 2350: }
! 2351: }
! 2352: else {
! 2353: sendcontrol "550 $testno: No such file or directory.\r\n";
! 2354: }
! 2355: return 0;
! 2356: }
! 2357:
! 2358: sub STOR_ftp {
! 2359: my $testno=$_[0];
! 2360:
! 2361: my $filename = "log/upload.$testno";
! 2362:
! 2363: if($datasockf_conn eq 'no') {
! 2364: if($nodataconn425) {
! 2365: sendcontrol "150 Opening data connection\r\n";
! 2366: sendcontrol "425 Can't open data connection\r\n";
! 2367: }
! 2368: elsif($nodataconn421) {
! 2369: sendcontrol "150 Opening data connection\r\n";
! 2370: sendcontrol "421 Connection timed out\r\n";
! 2371: }
! 2372: elsif($nodataconn150) {
! 2373: sendcontrol "150 Opening data connection\r\n";
! 2374: # client shall timeout
! 2375: }
! 2376: else {
! 2377: # client shall timeout
! 2378: }
! 2379: return 0;
! 2380: }
! 2381:
! 2382: logmsg "STOR test number $testno in $filename\n";
! 2383:
! 2384: sendcontrol "125 Gimme gimme gimme!\r\n";
! 2385:
! 2386: open(FILE, ">$filename") ||
! 2387: return 0; # failed to open output
! 2388:
! 2389: my $line;
! 2390: my $ulsize=0;
! 2391: my $disc=0;
! 2392: while (5 == (sysread DREAD, $line, 5)) {
! 2393: if($line eq "DATA\n") {
! 2394: my $i;
! 2395: sysread DREAD, $i, 5;
! 2396:
! 2397: my $size = 0;
! 2398: if($i =~ /^([0-9a-fA-F]{4})\n/) {
! 2399: $size = hex($1);
! 2400: }
! 2401:
! 2402: read_datasockf(\$line, $size);
! 2403:
! 2404: #print STDERR " GOT: $size bytes\n";
! 2405:
! 2406: $ulsize += $size;
! 2407: print FILE $line if(!$nosave);
! 2408: logmsg "> Appending $size bytes to file\n";
! 2409: }
! 2410: elsif($line eq "DISC\n") {
! 2411: # disconnect!
! 2412: $disc=1;
! 2413: last;
! 2414: }
! 2415: else {
! 2416: logmsg "No support for: $line";
! 2417: last;
! 2418: }
! 2419: }
! 2420: if($nosave) {
! 2421: print FILE "$ulsize bytes would've been stored here\n";
! 2422: }
! 2423: close(FILE);
! 2424: close_dataconn($disc);
! 2425: logmsg "received $ulsize bytes upload\n";
! 2426: sendcontrol "226 File transfer complete\r\n";
! 2427: return 0;
! 2428: }
! 2429:
! 2430: sub PASV_ftp {
! 2431: my ($arg, $cmd)=@_;
! 2432: my $pasvport;
! 2433: my $bindonly = ($nodataconn) ? '--bindonly' : '';
! 2434:
! 2435: # kill previous data connection sockfilt when alive
! 2436: if($datasockf_runs eq 'yes') {
! 2437: killsockfilters($proto, $ipvnum, $idnum, $verbose, 'data');
! 2438: logmsg "DATA sockfilt for $datasockf_mode data channel killed\n";
! 2439: }
! 2440: datasockf_state('STOPPED');
! 2441:
! 2442: logmsg "====> Passive DATA channel requested by client\n";
! 2443:
! 2444: logmsg "DATA sockfilt for passive data channel starting...\n";
! 2445:
! 2446: # We fire up a new sockfilt to do the data transfer for us.
! 2447: my $datasockfcmd = "./server/sockfilt".exe_ext('SRV')." " .
! 2448: "--ipv$ipvnum $bindonly --port 0 " .
! 2449: "--pidfile \"$datasockf_pidfile\" " .
! 2450: "--logfile \"$datasockf_logfile\"";
! 2451: $slavepid = open2(\*DREAD, \*DWRITE, $datasockfcmd);
! 2452:
! 2453: if($nodataconn) {
! 2454: datasockf_state('PASSIVE_NODATACONN');
! 2455: }
! 2456: else {
! 2457: datasockf_state('PASSIVE');
! 2458: }
! 2459:
! 2460: print STDERR "$datasockfcmd\n" if($verbose);
! 2461:
! 2462: print DWRITE "PING\n";
! 2463: my $pong;
! 2464: sysread_or_die(\*DREAD, \$pong, 5);
! 2465:
! 2466: if($pong =~ /^FAIL/) {
! 2467: logmsg "DATA sockfilt said: FAIL\n";
! 2468: logmsg "DATA sockfilt for passive data channel failed\n";
! 2469: logmsg "DATA sockfilt not running\n";
! 2470: datasockf_state('STOPPED');
! 2471: sendcontrol "500 no free ports!\r\n";
! 2472: return;
! 2473: }
! 2474: elsif($pong !~ /^PONG/) {
! 2475: logmsg "DATA sockfilt unexpected response: $pong\n";
! 2476: logmsg "DATA sockfilt for passive data channel failed\n";
! 2477: logmsg "DATA sockfilt killed now\n";
! 2478: killsockfilters($proto, $ipvnum, $idnum, $verbose, 'data');
! 2479: logmsg "DATA sockfilt not running\n";
! 2480: datasockf_state('STOPPED');
! 2481: sendcontrol "500 no free ports!\r\n";
! 2482: return;
! 2483: }
! 2484:
! 2485: logmsg "DATA sockfilt for passive data channel started (pid $slavepid)\n";
! 2486:
! 2487: # Find out on what port we listen on or have bound
! 2488: my $i;
! 2489: print DWRITE "PORT\n";
! 2490:
! 2491: # READ the response code
! 2492: sysread_or_die(\*DREAD, \$i, 5);
! 2493:
! 2494: # READ the response size
! 2495: sysread_or_die(\*DREAD, \$i, 5);
! 2496:
! 2497: my $size = 0;
! 2498: if($i =~ /^([0-9a-fA-F]{4})\n/) {
! 2499: $size = hex($1);
! 2500: }
! 2501:
! 2502: # READ the response data
! 2503: read_datasockf(\$i, $size);
! 2504:
! 2505: # The data is in the format
! 2506: # IPvX/NNN
! 2507:
! 2508: if($i =~ /IPv(\d)\/(\d+)/) {
! 2509: # FIX: deal with IP protocol version
! 2510: $pasvport = $2;
! 2511: }
! 2512:
! 2513: if(!$pasvport) {
! 2514: logmsg "DATA sockfilt unknown listener port\n";
! 2515: logmsg "DATA sockfilt for passive data channel failed\n";
! 2516: logmsg "DATA sockfilt killed now\n";
! 2517: killsockfilters($proto, $ipvnum, $idnum, $verbose, 'data');
! 2518: logmsg "DATA sockfilt not running\n";
! 2519: datasockf_state('STOPPED');
! 2520: sendcontrol "500 no free ports!\r\n";
! 2521: return;
! 2522: }
! 2523:
! 2524: if($nodataconn) {
! 2525: my $str = nodataconn_str();
! 2526: logmsg "DATA sockfilt for passive data channel ($str) bound on port ".
! 2527: "$pasvport\n";
! 2528: }
! 2529: else {
! 2530: logmsg "DATA sockfilt for passive data channel listens on port ".
! 2531: "$pasvport\n";
! 2532: }
! 2533:
! 2534: if($cmd ne "EPSV") {
! 2535: # PASV reply
! 2536: my $p=$listenaddr;
! 2537: $p =~ s/\./,/g;
! 2538: if($pasvbadip) {
! 2539: $p="1,2,3,4";
! 2540: }
! 2541: sendcontrol sprintf("227 Entering Passive Mode ($p,%d,%d)\n",
! 2542: int($pasvport/256), int($pasvport%256));
! 2543: }
! 2544: else {
! 2545: # EPSV reply
! 2546: sendcontrol sprintf("229 Entering Passive Mode (|||%d|)\n", $pasvport);
! 2547: }
! 2548:
! 2549: logmsg "Client has been notified that DATA conn ".
! 2550: "will be accepted on port $pasvport\n";
! 2551:
! 2552: if($nodataconn) {
! 2553: my $str = nodataconn_str();
! 2554: logmsg "====> Client fooled ($str)\n";
! 2555: return;
! 2556: }
! 2557:
! 2558: eval {
! 2559: local $SIG{ALRM} = sub { die "alarm\n" };
! 2560:
! 2561: # assume swift operations unless explicitly slow
! 2562: alarm ($datadelay?20:10);
! 2563:
! 2564: # Wait for 'CNCT'
! 2565: my $input;
! 2566:
! 2567: # FIX: Monitor ctrl conn for disconnect
! 2568:
! 2569: while(sysread(DREAD, $input, 5)) {
! 2570:
! 2571: if($input !~ /^CNCT/) {
! 2572: # we wait for a connected client
! 2573: logmsg "Odd, we got $input from client\n";
! 2574: next;
! 2575: }
! 2576: logmsg "Client connects to port $pasvport\n";
! 2577: last;
! 2578: }
! 2579: alarm 0;
! 2580: };
! 2581: if ($@) {
! 2582: # timed out
! 2583: logmsg "$srvrname server timed out awaiting data connection ".
! 2584: "on port $pasvport\n";
! 2585: logmsg "accept failed or connection not even attempted\n";
! 2586: logmsg "DATA sockfilt killed now\n";
! 2587: killsockfilters($proto, $ipvnum, $idnum, $verbose, 'data');
! 2588: logmsg "DATA sockfilt not running\n";
! 2589: datasockf_state('STOPPED');
! 2590: return;
! 2591: }
! 2592: else {
! 2593: logmsg "====> Client established passive DATA connection ".
! 2594: "on port $pasvport\n";
! 2595: }
! 2596:
! 2597: return;
! 2598: }
! 2599:
! 2600: #
! 2601: # Support both PORT and EPRT here.
! 2602: #
! 2603:
! 2604: sub PORT_ftp {
! 2605: my ($arg, $cmd) = @_;
! 2606: my $port;
! 2607: my $addr;
! 2608:
! 2609: # kill previous data connection sockfilt when alive
! 2610: if($datasockf_runs eq 'yes') {
! 2611: killsockfilters($proto, $ipvnum, $idnum, $verbose, 'data');
! 2612: logmsg "DATA sockfilt for $datasockf_mode data channel killed\n";
! 2613: }
! 2614: datasockf_state('STOPPED');
! 2615:
! 2616: logmsg "====> Active DATA channel requested by client\n";
! 2617:
! 2618: # We always ignore the given IP and use localhost.
! 2619:
! 2620: if($cmd eq "PORT") {
! 2621: if($arg !~ /(\d+),(\d+),(\d+),(\d+),(\d+),(\d+)/) {
! 2622: logmsg "DATA sockfilt for active data channel not started ".
! 2623: "(bad PORT-line: $arg)\n";
! 2624: sendcontrol "500 silly you, go away\r\n";
! 2625: return;
! 2626: }
! 2627: $port = ($5<<8)+$6;
! 2628: $addr = "$1.$2.$3.$4";
! 2629: }
! 2630: # EPRT |2|::1|49706|
! 2631: elsif($cmd eq "EPRT") {
! 2632: if($arg !~ /(\d+)\|([^\|]+)\|(\d+)/) {
! 2633: logmsg "DATA sockfilt for active data channel not started ".
! 2634: "(bad EPRT-line: $arg)\n";
! 2635: sendcontrol "500 silly you, go away\r\n";
! 2636: return;
! 2637: }
! 2638: sendcontrol "200 Thanks for dropping by. We contact you later\r\n";
! 2639: $port = $3;
! 2640: $addr = $2;
! 2641: }
! 2642: else {
! 2643: logmsg "DATA sockfilt for active data channel not started ".
! 2644: "(invalid command: $cmd)\n";
! 2645: sendcontrol "500 we don't like $cmd now\r\n";
! 2646: return;
! 2647: }
! 2648:
! 2649: if(!$port || $port > 65535) {
! 2650: logmsg "DATA sockfilt for active data channel not started ".
! 2651: "(illegal PORT number: $port)\n";
! 2652: return;
! 2653: }
! 2654:
! 2655: if($nodataconn) {
! 2656: my $str = nodataconn_str();
! 2657: logmsg "DATA sockfilt for active data channel not started ($str)\n";
! 2658: datasockf_state('ACTIVE_NODATACONN');
! 2659: logmsg "====> Active DATA channel not established\n";
! 2660: return;
! 2661: }
! 2662:
! 2663: logmsg "DATA sockfilt for active data channel starting...\n";
! 2664:
! 2665: # We fire up a new sockfilt to do the data transfer for us.
! 2666: my $datasockfcmd = "./server/sockfilt".exe_ext('SRV')." " .
! 2667: "--ipv$ipvnum --connect $port --addr \"$addr\" " .
! 2668: "--pidfile \"$datasockf_pidfile\" " .
! 2669: "--logfile \"$datasockf_logfile\"";
! 2670: $slavepid = open2(\*DREAD, \*DWRITE, $datasockfcmd);
! 2671:
! 2672: datasockf_state('ACTIVE');
! 2673:
! 2674: print STDERR "$datasockfcmd\n" if($verbose);
! 2675:
! 2676: print DWRITE "PING\n";
! 2677: my $pong;
! 2678: sysread_or_die(\*DREAD, \$pong, 5);
! 2679:
! 2680: if($pong =~ /^FAIL/) {
! 2681: logmsg "DATA sockfilt said: FAIL\n";
! 2682: logmsg "DATA sockfilt for active data channel failed\n";
! 2683: logmsg "DATA sockfilt not running\n";
! 2684: datasockf_state('STOPPED');
! 2685: # client shall timeout awaiting connection from server
! 2686: return;
! 2687: }
! 2688: elsif($pong !~ /^PONG/) {
! 2689: logmsg "DATA sockfilt unexpected response: $pong\n";
! 2690: logmsg "DATA sockfilt for active data channel failed\n";
! 2691: logmsg "DATA sockfilt killed now\n";
! 2692: killsockfilters($proto, $ipvnum, $idnum, $verbose, 'data');
! 2693: logmsg "DATA sockfilt not running\n";
! 2694: datasockf_state('STOPPED');
! 2695: # client shall timeout awaiting connection from server
! 2696: return;
! 2697: }
! 2698:
! 2699: logmsg "DATA sockfilt for active data channel started (pid $slavepid)\n";
! 2700:
! 2701: logmsg "====> Active DATA channel connected to client port $port\n";
! 2702:
! 2703: return;
! 2704: }
! 2705:
! 2706: #**********************************************************************
! 2707: # datasockf_state is used to change variables that keep state info
! 2708: # relative to the FTP secondary or data sockfilt process as soon as
! 2709: # one of the five possible stable states is reached. Variables that
! 2710: # are modified by this sub may be checked independently but should
! 2711: # not be changed except by calling this sub.
! 2712: #
! 2713: sub datasockf_state {
! 2714: my $state = $_[0];
! 2715:
! 2716: if($state eq 'STOPPED') {
! 2717: # Data sockfilter initial state, not running,
! 2718: # not connected and not used.
! 2719: $datasockf_state = $state;
! 2720: $datasockf_mode = 'none';
! 2721: $datasockf_runs = 'no';
! 2722: $datasockf_conn = 'no';
! 2723: }
! 2724: elsif($state eq 'PASSIVE') {
! 2725: # Data sockfilter accepted connection from client.
! 2726: $datasockf_state = $state;
! 2727: $datasockf_mode = 'passive';
! 2728: $datasockf_runs = 'yes';
! 2729: $datasockf_conn = 'yes';
! 2730: }
! 2731: elsif($state eq 'ACTIVE') {
! 2732: # Data sockfilter has connected to client.
! 2733: $datasockf_state = $state;
! 2734: $datasockf_mode = 'active';
! 2735: $datasockf_runs = 'yes';
! 2736: $datasockf_conn = 'yes';
! 2737: }
! 2738: elsif($state eq 'PASSIVE_NODATACONN') {
! 2739: # Data sockfilter bound port without listening,
! 2740: # client won't be able to establish data connection.
! 2741: $datasockf_state = $state;
! 2742: $datasockf_mode = 'passive';
! 2743: $datasockf_runs = 'yes';
! 2744: $datasockf_conn = 'no';
! 2745: }
! 2746: elsif($state eq 'ACTIVE_NODATACONN') {
! 2747: # Data sockfilter does not even run,
! 2748: # client awaits data connection from server in vain.
! 2749: $datasockf_state = $state;
! 2750: $datasockf_mode = 'active';
! 2751: $datasockf_runs = 'no';
! 2752: $datasockf_conn = 'no';
! 2753: }
! 2754: else {
! 2755: die "Internal error. Unknown datasockf state: $state!";
! 2756: }
! 2757: }
! 2758:
! 2759: #**********************************************************************
! 2760: # nodataconn_str returns string of effective nodataconn command. Notice
! 2761: # that $nodataconn may be set alone or in addition to a $nodataconnXXX.
! 2762: #
! 2763: sub nodataconn_str {
! 2764: my $str;
! 2765: # order matters
! 2766: $str = 'NODATACONN' if($nodataconn);
! 2767: $str = 'NODATACONN425' if($nodataconn425);
! 2768: $str = 'NODATACONN421' if($nodataconn421);
! 2769: $str = 'NODATACONN150' if($nodataconn150);
! 2770: return "$str";
! 2771: }
! 2772:
! 2773: #**********************************************************************
! 2774: # customize configures test server operation for each curl test, reading
! 2775: # configuration commands/parameters from server commands file each time
! 2776: # a new client control connection is established with the test server.
! 2777: # On success returns 1, otherwise zero.
! 2778: #
! 2779: sub customize {
! 2780: $ctrldelay = 0; # default is no throttling of the ctrl stream
! 2781: $datadelay = 0; # default is no throttling of the data stream
! 2782: $retrweirdo = 0; # default is no use of RETRWEIRDO
! 2783: $retrnosize = 0; # default is no use of RETRNOSIZE
! 2784: $pasvbadip = 0; # default is no use of PASVBADIP
! 2785: $nosave = 0; # default is to actually save uploaded data to file
! 2786: $nodataconn = 0; # default is to establish or accept data channel
! 2787: $nodataconn425 = 0; # default is to not send 425 without data channel
! 2788: $nodataconn421 = 0; # default is to not send 421 without data channel
! 2789: $nodataconn150 = 0; # default is to not send 150 without data channel
! 2790: @capabilities = (); # default is to not support capability commands
! 2791: @auth_mechs = (); # default is to not support authentication commands
! 2792: %fulltextreply = ();#
! 2793: %commandreply = (); #
! 2794: %customcount = (); #
! 2795: %delayreply = (); #
! 2796:
! 2797: open(CUSTOM, "<log/ftpserver.cmd") ||
! 2798: return 1;
! 2799:
! 2800: logmsg "FTPD: Getting commands from log/ftpserver.cmd\n";
! 2801:
! 2802: while(<CUSTOM>) {
! 2803: if($_ =~ /REPLY \"([A-Z]+ [A-Za-z0-9+-\/=\*. ]+)\" (.*)/) {
! 2804: $fulltextreply{$1}=eval "qq{$2}";
! 2805: logmsg "FTPD: set custom reply for $1\n";
! 2806: }
! 2807: elsif($_ =~ /REPLY(LF|) ([A-Za-z0-9+\/=\*]*) (.*)/) {
! 2808: $commandreply{$2}=eval "qq{$3}";
! 2809: if($1 ne "LF") {
! 2810: $commandreply{$2}.="\r\n";
! 2811: }
! 2812: else {
! 2813: $commandreply{$2}.="\n";
! 2814: }
! 2815: if($2 eq "") {
! 2816: logmsg "FTPD: set custom reply for empty command\n";
! 2817: }
! 2818: else {
! 2819: logmsg "FTPD: set custom reply for $2 command\n";
! 2820: }
! 2821: }
! 2822: elsif($_ =~ /COUNT ([A-Z]+) (.*)/) {
! 2823: # we blank the custom reply for this command when having
! 2824: # been used this number of times
! 2825: $customcount{$1}=$2;
! 2826: logmsg "FTPD: blank custom reply for $1 command after $2 uses\n";
! 2827: }
! 2828: elsif($_ =~ /DELAY ([A-Z]+) (\d*)/) {
! 2829: $delayreply{$1}=$2;
! 2830: logmsg "FTPD: delay reply for $1 with $2 seconds\n";
! 2831: }
! 2832: elsif($_ =~ /SLOWDOWN/) {
! 2833: $ctrldelay=1;
! 2834: $datadelay=1;
! 2835: logmsg "FTPD: send response with 0.01 sec delay between each byte\n";
! 2836: }
! 2837: elsif($_ =~ /RETRWEIRDO/) {
! 2838: logmsg "FTPD: instructed to use RETRWEIRDO\n";
! 2839: $retrweirdo=1;
! 2840: }
! 2841: elsif($_ =~ /RETRNOSIZE/) {
! 2842: logmsg "FTPD: instructed to use RETRNOSIZE\n";
! 2843: $retrnosize=1;
! 2844: }
! 2845: elsif($_ =~ /PASVBADIP/) {
! 2846: logmsg "FTPD: instructed to use PASVBADIP\n";
! 2847: $pasvbadip=1;
! 2848: }
! 2849: elsif($_ =~ /NODATACONN425/) {
! 2850: # applies to both active and passive FTP modes
! 2851: logmsg "FTPD: instructed to use NODATACONN425\n";
! 2852: $nodataconn425=1;
! 2853: $nodataconn=1;
! 2854: }
! 2855: elsif($_ =~ /NODATACONN421/) {
! 2856: # applies to both active and passive FTP modes
! 2857: logmsg "FTPD: instructed to use NODATACONN421\n";
! 2858: $nodataconn421=1;
! 2859: $nodataconn=1;
! 2860: }
! 2861: elsif($_ =~ /NODATACONN150/) {
! 2862: # applies to both active and passive FTP modes
! 2863: logmsg "FTPD: instructed to use NODATACONN150\n";
! 2864: $nodataconn150=1;
! 2865: $nodataconn=1;
! 2866: }
! 2867: elsif($_ =~ /NODATACONN/) {
! 2868: # applies to both active and passive FTP modes
! 2869: logmsg "FTPD: instructed to use NODATACONN\n";
! 2870: $nodataconn=1;
! 2871: }
! 2872: elsif($_ =~ /CAPA (.*)/) {
! 2873: logmsg "FTPD: instructed to support CAPABILITY command\n";
! 2874: @capabilities = split(/ (?!(?:[^" ]|[^"] [^"])+")/, $1);
! 2875: foreach (@capabilities) {
! 2876: $_ = $1 if /^"(.*)"$/;
! 2877: }
! 2878: }
! 2879: elsif($_ =~ /AUTH (.*)/) {
! 2880: logmsg "FTPD: instructed to support AUTHENTICATION command\n";
! 2881: @auth_mechs = split(/ /, $1);
! 2882: }
! 2883: elsif($_ =~ /NOSAVE/) {
! 2884: # don't actually store the file we upload - to be used when
! 2885: # uploading insanely huge amounts
! 2886: $nosave = 1;
! 2887: logmsg "FTPD: NOSAVE prevents saving of uploaded data\n";
! 2888: }
! 2889: }
! 2890: close(CUSTOM);
! 2891: }
! 2892:
! 2893: #----------------------------------------------------------------------
! 2894: #----------------------------------------------------------------------
! 2895: #--------------------------- END OF SUBS ----------------------------
! 2896: #----------------------------------------------------------------------
! 2897: #----------------------------------------------------------------------
! 2898:
! 2899: #**********************************************************************
! 2900: # Parse command line options
! 2901: #
! 2902: # Options:
! 2903: #
! 2904: # --verbose # verbose
! 2905: # --srcdir # source directory
! 2906: # --id # server instance number
! 2907: # --proto # server protocol
! 2908: # --pidfile # server pid file
! 2909: # --portfile # server port file
! 2910: # --logfile # server log file
! 2911: # --ipv4 # server IP version 4
! 2912: # --ipv6 # server IP version 6
! 2913: # --port # server listener port
! 2914: # --addr # server address for listener port binding
! 2915: #
! 2916: while(@ARGV) {
! 2917: if($ARGV[0] eq '--verbose') {
! 2918: $verbose = 1;
! 2919: }
! 2920: elsif($ARGV[0] eq '--srcdir') {
! 2921: if($ARGV[1]) {
! 2922: $srcdir = $ARGV[1];
! 2923: shift @ARGV;
! 2924: }
! 2925: }
! 2926: elsif($ARGV[0] eq '--id') {
! 2927: if($ARGV[1] && ($ARGV[1] =~ /^(\d+)$/)) {
! 2928: $idnum = $1 if($1 > 0);
! 2929: shift @ARGV;
! 2930: }
! 2931: }
! 2932: elsif($ARGV[0] eq '--proto') {
! 2933: if($ARGV[1] && ($ARGV[1] =~ /^(ftp|imap|pop3|smtp)$/)) {
! 2934: $proto = $1;
! 2935: shift @ARGV;
! 2936: }
! 2937: else {
! 2938: die "unsupported protocol $ARGV[1]";
! 2939: }
! 2940: }
! 2941: elsif($ARGV[0] eq '--pidfile') {
! 2942: if($ARGV[1]) {
! 2943: $pidfile = $ARGV[1];
! 2944: shift @ARGV;
! 2945: }
! 2946: }
! 2947: elsif($ARGV[0] eq '--portfile') {
! 2948: if($ARGV[1]) {
! 2949: $portfile = $ARGV[1];
! 2950: shift @ARGV;
! 2951: }
! 2952: }
! 2953: elsif($ARGV[0] eq '--logfile') {
! 2954: if($ARGV[1]) {
! 2955: $logfile = $ARGV[1];
! 2956: shift @ARGV;
! 2957: }
! 2958: }
! 2959: elsif($ARGV[0] eq '--ipv4') {
! 2960: $ipvnum = 4;
! 2961: $listenaddr = '127.0.0.1' if($listenaddr eq '::1');
! 2962: }
! 2963: elsif($ARGV[0] eq '--ipv6') {
! 2964: $ipvnum = 6;
! 2965: $listenaddr = '::1' if($listenaddr eq '127.0.0.1');
! 2966: }
! 2967: elsif($ARGV[0] eq '--port') {
! 2968: if($ARGV[1] =~ /^(\d+)$/) {
! 2969: $port = $1;
! 2970: shift @ARGV;
! 2971: }
! 2972: }
! 2973: elsif($ARGV[0] eq '--addr') {
! 2974: if($ARGV[1]) {
! 2975: my $tmpstr = $ARGV[1];
! 2976: if($tmpstr =~ /^(\d\d?\d?)\.(\d\d?\d?)\.(\d\d?\d?)\.(\d\d?\d?)$/) {
! 2977: $listenaddr = "$1.$2.$3.$4" if($ipvnum == 4);
! 2978: }
! 2979: elsif($ipvnum == 6) {
! 2980: $listenaddr = $tmpstr;
! 2981: $listenaddr =~ s/^\[(.*)\]$/$1/;
! 2982: }
! 2983: shift @ARGV;
! 2984: }
! 2985: }
! 2986: else {
! 2987: print STDERR "\nWarning: ftpserver.pl unknown parameter: $ARGV[0]\n";
! 2988: }
! 2989: shift @ARGV;
! 2990: }
! 2991:
! 2992: #***************************************************************************
! 2993: # Initialize command line option dependent variables
! 2994: #
! 2995:
! 2996: if(!$srcdir) {
! 2997: $srcdir = $ENV{'srcdir'} || '.';
! 2998: }
! 2999: if(!$pidfile) {
! 3000: $pidfile = "$path/". server_pidfilename($proto, $ipvnum, $idnum);
! 3001: }
! 3002: if(!$logfile) {
! 3003: $logfile = server_logfilename($logdir, $proto, $ipvnum, $idnum);
! 3004: }
! 3005:
! 3006: $mainsockf_pidfile = "$path/".
! 3007: mainsockf_pidfilename($proto, $ipvnum, $idnum);
! 3008: $mainsockf_logfile =
! 3009: mainsockf_logfilename($logdir, $proto, $ipvnum, $idnum);
! 3010:
! 3011: if($proto eq 'ftp') {
! 3012: $datasockf_pidfile = "$path/".
! 3013: datasockf_pidfilename($proto, $ipvnum, $idnum);
! 3014: $datasockf_logfile =
! 3015: datasockf_logfilename($logdir, $proto, $ipvnum, $idnum);
! 3016: }
! 3017:
! 3018: $srvrname = servername_str($proto, $ipvnum, $idnum);
! 3019:
! 3020: $idstr = "$idnum" if($idnum > 1);
! 3021:
! 3022: protocolsetup($proto);
! 3023:
! 3024: $SIG{INT} = \&exit_signal_handler;
! 3025: $SIG{TERM} = \&exit_signal_handler;
! 3026:
! 3027: startsf();
! 3028:
! 3029: # actual port
! 3030: if($portfile && !$port) {
! 3031: my $aport;
! 3032: open(P, "<$portfile");
! 3033: $aport = <P>;
! 3034: close(P);
! 3035: $port = 0 + $aport;
! 3036: }
! 3037:
! 3038: logmsg sprintf("%s server listens on port IPv${ipvnum}/${port}\n", uc($proto));
! 3039:
! 3040: open(PID, ">$pidfile");
! 3041: print PID $$."\n";
! 3042: close(PID);
! 3043:
! 3044: logmsg("logged pid $$ in $pidfile\n");
! 3045:
! 3046: while(1) {
! 3047:
! 3048: # kill previous data connection sockfilt when alive
! 3049: if($datasockf_runs eq 'yes') {
! 3050: killsockfilters($proto, $ipvnum, $idnum, $verbose, 'data');
! 3051: logmsg "DATA sockfilt for $datasockf_mode data channel killed now\n";
! 3052: }
! 3053: datasockf_state('STOPPED');
! 3054:
! 3055: #
! 3056: # We read 'sockfilt' commands.
! 3057: #
! 3058: my $input;
! 3059:
! 3060: logmsg "Awaiting input\n";
! 3061: sysread_or_die(\*SFREAD, \$input, 5);
! 3062:
! 3063: if($input !~ /^CNCT/) {
! 3064: # we wait for a connected client
! 3065: logmsg "MAIN sockfilt said: $input";
! 3066: next;
! 3067: }
! 3068: logmsg "====> Client connect\n";
! 3069:
! 3070: set_advisor_read_lock($SERVERLOGS_LOCK);
! 3071: $serverlogslocked = 1;
! 3072:
! 3073: # flush data:
! 3074: $| = 1;
! 3075:
! 3076: &customize(); # read test control instructions
! 3077:
! 3078: my $welcome = $commandreply{"welcome"};
! 3079: if(!$welcome) {
! 3080: $welcome = $displaytext{"welcome"};
! 3081: }
! 3082: else {
! 3083: # clear it after use
! 3084: $commandreply{"welcome"}="";
! 3085: if($welcome !~ /\r\n\z/) {
! 3086: $welcome .= "\r\n";
! 3087: }
! 3088: }
! 3089: sendcontrol $welcome;
! 3090:
! 3091: #remove global variables from last connection
! 3092: if($ftplistparserstate) {
! 3093: undef $ftplistparserstate;
! 3094: }
! 3095: if($ftptargetdir) {
! 3096: $ftptargetdir = "";
! 3097: }
! 3098:
! 3099: if($verbose) {
! 3100: print STDERR "OUT: $welcome";
! 3101: }
! 3102:
! 3103: my $full = "";
! 3104:
! 3105: while(1) {
! 3106: my $i;
! 3107:
! 3108: # Now we expect to read DATA\n[hex size]\n[prot], where the [prot]
! 3109: # part only is FTP lingo.
! 3110:
! 3111: # COMMAND
! 3112: sysread_or_die(\*SFREAD, \$i, 5);
! 3113:
! 3114: if($i !~ /^DATA/) {
! 3115: logmsg "MAIN sockfilt said $i";
! 3116: if($i =~ /^DISC/) {
! 3117: # disconnect
! 3118: last;
! 3119: }
! 3120: next;
! 3121: }
! 3122:
! 3123: # SIZE of data
! 3124: sysread_or_die(\*SFREAD, \$i, 5);
! 3125:
! 3126: my $size = 0;
! 3127: if($i =~ /^([0-9a-fA-F]{4})\n/) {
! 3128: $size = hex($1);
! 3129: }
! 3130:
! 3131: # data
! 3132: read_mainsockf(\$input, $size);
! 3133:
! 3134: ftpmsg $input;
! 3135:
! 3136: $full .= $input;
! 3137:
! 3138: # Loop until command completion
! 3139: next unless($full =~ /\r\n$/);
! 3140:
! 3141: # Remove trailing CRLF.
! 3142: $full =~ s/[\n\r]+$//;
! 3143:
! 3144: my $FTPCMD;
! 3145: my $FTPARG;
! 3146: if($proto eq "imap") {
! 3147: # IMAP is different with its identifier first on the command line
! 3148: if(($full =~ /^([^ ]+) ([^ ]+) (.*)/) ||
! 3149: ($full =~ /^([^ ]+) ([^ ]+)/)) {
! 3150: $cmdid=$1; # set the global variable
! 3151: $FTPCMD=$2;
! 3152: $FTPARG=$3;
! 3153: }
! 3154: # IMAP authentication cancellation
! 3155: elsif($full =~ /^\*$/) {
! 3156: # Command id has already been set
! 3157: $FTPCMD="*";
! 3158: $FTPARG="";
! 3159: }
! 3160: # IMAP long "commands" are base64 authentication data
! 3161: elsif($full =~ /^[A-Z0-9+\/]*={0,2}$/i) {
! 3162: # Command id has already been set
! 3163: $FTPCMD=$full;
! 3164: $FTPARG="";
! 3165: }
! 3166: else {
! 3167: sendcontrol "$full BAD Command\r\n";
! 3168: last;
! 3169: }
! 3170: }
! 3171: elsif($full =~ /^([A-Z]{3,4})(\s(.*))?$/i) {
! 3172: $FTPCMD=$1;
! 3173: $FTPARG=$3;
! 3174: }
! 3175: elsif($proto eq "pop3") {
! 3176: # POP3 authentication cancellation
! 3177: if($full =~ /^\*$/) {
! 3178: $FTPCMD="*";
! 3179: $FTPARG="";
! 3180: }
! 3181: # POP3 long "commands" are base64 authentication data
! 3182: elsif($full =~ /^[A-Z0-9+\/]*={0,2}$/i) {
! 3183: $FTPCMD=$full;
! 3184: $FTPARG="";
! 3185: }
! 3186: else {
! 3187: sendcontrol "-ERR Unrecognized command\r\n";
! 3188: last;
! 3189: }
! 3190: }
! 3191: elsif($proto eq "smtp") {
! 3192: # SMTP authentication cancellation
! 3193: if($full =~ /^\*$/) {
! 3194: $FTPCMD="*";
! 3195: $FTPARG="";
! 3196: }
! 3197: # SMTP long "commands" are base64 authentication data
! 3198: elsif($full =~ /^[A-Z0-9+\/]{0,512}={0,2}$/i) {
! 3199: $FTPCMD=$full;
! 3200: $FTPARG="";
! 3201: }
! 3202: else {
! 3203: sendcontrol "500 Unrecognized command\r\n";
! 3204: last;
! 3205: }
! 3206: }
! 3207: else {
! 3208: sendcontrol "500 Unrecognized command\r\n";
! 3209: last;
! 3210: }
! 3211:
! 3212: logmsg "< \"$full\"\n";
! 3213:
! 3214: if($verbose) {
! 3215: print STDERR "IN: $full\n";
! 3216: }
! 3217:
! 3218: $full = "";
! 3219:
! 3220: my $delay = $delayreply{$FTPCMD};
! 3221: if($delay) {
! 3222: # just go sleep this many seconds!
! 3223: logmsg("Sleep for $delay seconds\n");
! 3224: my $twentieths = $delay * 20;
! 3225: while($twentieths--) {
! 3226: portable_sleep(0.05) unless($got_exit_signal);
! 3227: }
! 3228: }
! 3229:
! 3230: my $check = 1; # no response yet
! 3231:
! 3232: # See if there is a custom reply for the full text
! 3233: my $fulltext = $FTPARG ? $FTPCMD . " " . $FTPARG : $FTPCMD;
! 3234: my $text = $fulltextreply{$fulltext};
! 3235: if($text && ($text ne "")) {
! 3236: sendcontrol "$text\r\n";
! 3237: $check = 0;
! 3238: }
! 3239: else {
! 3240: # See if there is a custom reply for the command
! 3241: $text = $commandreply{$FTPCMD};
! 3242: if($text && ($text ne "")) {
! 3243: if($customcount{$FTPCMD} && (!--$customcount{$FTPCMD})) {
! 3244: # used enough times so blank the custom command reply
! 3245: $commandreply{$FTPCMD}="";
! 3246: }
! 3247:
! 3248: sendcontrol $text;
! 3249: $check = 0;
! 3250: }
! 3251: else {
! 3252: # See if there is any display text for the command
! 3253: $text = $displaytext{$FTPCMD};
! 3254: if($text && ($text ne "")) {
! 3255: if($proto eq 'imap') {
! 3256: sendcontrol "$cmdid $text\r\n";
! 3257: }
! 3258: else {
! 3259: sendcontrol "$text\r\n";
! 3260: }
! 3261:
! 3262: $check = 0;
! 3263: }
! 3264:
! 3265: # only perform this if we're not faking a reply
! 3266: my $func = $commandfunc{uc($FTPCMD)};
! 3267: if($func) {
! 3268: &$func($FTPARG, $FTPCMD);
! 3269: $check = 0;
! 3270: }
! 3271: }
! 3272: }
! 3273:
! 3274: if($check) {
! 3275: logmsg "$FTPCMD wasn't handled!\n";
! 3276: if($proto eq 'pop3') {
! 3277: sendcontrol "-ERR $FTPCMD is not dealt with!\r\n";
! 3278: }
! 3279: elsif($proto eq 'imap') {
! 3280: sendcontrol "$cmdid BAD $FTPCMD is not dealt with!\r\n";
! 3281: }
! 3282: else {
! 3283: sendcontrol "500 $FTPCMD is not dealt with!\r\n";
! 3284: }
! 3285: }
! 3286:
! 3287: } # while(1)
! 3288: logmsg "====> Client disconnected\n";
! 3289:
! 3290: if($serverlogslocked) {
! 3291: $serverlogslocked = 0;
! 3292: clear_advisor_read_lock($SERVERLOGS_LOCK);
! 3293: }
! 3294: }
! 3295:
! 3296: killsockfilters($proto, $ipvnum, $idnum, $verbose);
! 3297: unlink($pidfile);
! 3298: if($serverlogslocked) {
! 3299: $serverlogslocked = 0;
! 3300: clear_advisor_read_lock($SERVERLOGS_LOCK);
! 3301: }
! 3302:
! 3303: exit;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to ftpserver.pl CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [ELWIX - Embedded LightWeight unIX -] / embedaddon / curl / tests