tests/ftpserver.pl

   1 #!/usr/bin/env perl
   2 #***************************************************************************
   3 #                                  _   _ ____  _
   4 #  Project                     ___| | | |  _ \| |
   5 #                             / __| | | | |_) | |
   6 #                            | (__| |_| |  _ <| |___
   7 #                             \___|\___/|_| \_\_____|
   8 #
   9 # Copyright (C) 1998 - 2010, 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 http://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     @INC=(@INC, $ENV{'srcdir'}, '.');
  43     # sub second timestamping needs Time::HiRes
  44     eval {
  45         no warnings "all";
  46         require Time::HiRes;
  47         import  Time::HiRes qw( gettimeofday );
  48     }
  49 }
  50
  51 use strict;
  52 use warnings;
  53 use IPC::Open2;
  54
  55 require "getpart.pm";
  56 require "ftp.pm";
  57 require "directories.pm";
  58
  59 use serverhelp qw(
  60     servername_str
  61     server_pidfilename
  62     server_logfilename
  63     mainsockf_pidfilename
  64     mainsockf_logfilename
  65     datasockf_pidfilename
  66     datasockf_logfilename
  67     );
  68
  69 #**********************************************************************
  70 # global vars...
  71 #
  72 my $verbose = 0;    # set to 1 for debugging
  73 my $idstr = "";     # server instance string
  74 my $idnum = 1;      # server instance number
  75 my $ipvnum = 4;     # server IPv number (4 or 6)
  76 my $proto = 'ftp';  # default server protocol
  77 my $srcdir;         # directory where ftpserver.pl is located
  78 my $srvrname;       # server name for presentation purposes
  79 my $grok_eprt;
  80
  81 my $path   = '.';
  82 my $logdir = $path .'/log';
  83
  84 #**********************************************************************
  85 # global vars used for server address and primary listener port
  86 #
  87 my $port = 8921;               # default primary listener port
  88 my $listenaddr = '127.0.0.1';  # default address for listener port
  89
  90 #**********************************************************************
  91 # global vars used for file names
  92 #
  93 my $pidfile;            # server pid file name
  94 my $logfile;            # server log file name
  95 my $mainsockf_pidfile;  # pid file for primary connection sockfilt process
  96 my $mainsockf_logfile;  # log file for primary connection sockfilt process
  97 my $datasockf_pidfile;  # pid file for secondary connection sockfilt process
  98 my $datasockf_logfile;  # log file for secondary connection sockfilt process
  99
 100 #**********************************************************************
 101 # global vars used for server logs advisor read lock handling
 102 #
 103 my $SERVERLOGS_LOCK = 'log/serverlogs.lock';
 104 my $serverlogslocked = 0;
 105
 106 #**********************************************************************
 107 # global vars used for child processes PID tracking
 108 #
 109 my $sfpid;        # PID for primary connection sockfilt process
 110 my $slavepid;     # PID for secondary connection sockfilt process
 111
 112 #**********************************************************************
 113 # global typeglob filehandle vars to read/write from/to sockfilters
 114 #
 115 local *SFREAD;    # used to read from primary connection
 116 local *SFWRITE;   # used to write to primary connection
 117 local *DREAD;     # used to read from secondary connection
 118 local *DWRITE;    # used to write to secondary connection
 119
 120 #**********************************************************************
 121 # global vars which depend on server protocol selection
 122 #
 123 my %commandfunc;  # protocol command specific function callbacks
 124 my %displaytext;  # text returned to client before callback runs
 125 my @welcome;      # text returned to client upon connection
 126
 127 #**********************************************************************
 128 # global vars customized for each test from the server commands file
 129 #
 130 my $ctrldelay;    # set if server should throttle ctrl stream
 131 my $datadelay;    # set if server should throttle data stream
 132 my $retrweirdo;   # set if ftp server should use RETRWEIRDO
 133 my $retrnosize;   # set if ftp server should use RETRNOSIZE
 134 my $pasvbadip;    # set if ftp server should use PASVBADIP
 135 my $nosave;       # set if ftp server should not save uploaded data
 136 my %customreply;  #
 137 my %customcount;  #
 138 my %delayreply;   #
 139
 140 #**********************************************************************
 141 # global variables for to test ftp wildcardmatching or other test that
 142 # need flexible LIST responses.. and corresponding files.
 143 # $ftptargetdir is keeping the fake "name" of LIST directory.
 144 my $ftplistparserstate;
 145 my $ftptargetdir;
 146
 147 #**********************************************************************
 148 # global vars used for signal handling
 149 #
 150 my $got_exit_signal = 0; # set if program should finish execution ASAP
 151 my $exit_signal;         # first signal handled in exit_signal_handler
 152
 153 #**********************************************************************
 154 # exit_signal_handler will be triggered to indicate that the program
 155 # should finish its execution in a controlled way as soon as possible.
 156 # For now, program will also terminate from within this handler.
 157 #
 158 sub exit_signal_handler {
 159     my $signame = shift;
 160     # For now, simply mimic old behavior.
 161     killsockfilters($proto, $ipvnum, $idnum, $verbose);
 162     unlink($pidfile);
 163     if($serverlogslocked) {
 164         $serverlogslocked = 0;
 165         clear_advisor_read_lock($SERVERLOGS_LOCK);
 166     }
 167     exit;
 168 }
 169
 170 #**********************************************************************
 171 # logmsg is general message logging subroutine for our test servers.
 172 #
 173 sub logmsg {
 174     my $now;
 175     # sub second timestamping needs Time::HiRes
 176     if($Time::HiRes::VERSION) {
 177         my ($seconds, $usec) = gettimeofday();
 178         my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
 179             localtime($seconds);
 180         $now = sprintf("%02d:%02d:%02d.%06d ", $hour, $min, $sec, $usec);
 181     }
 182     else {
 183         my $seconds = time();
 184         my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
 185             localtime($seconds);
 186         $now = sprintf("%02d:%02d:%02d ", $hour, $min, $sec);
 187     }
 188     if(open(LOGFILEFH, ">>$logfile")) {
 189         print LOGFILEFH $now;
 190         print LOGFILEFH @_;
 191         close(LOGFILEFH);
 192     }
 193 }
 194
 195 sub ftpmsg {
 196   # append to the server.input file
 197   open(INPUT, ">>log/server$idstr.input") ||
 198     logmsg "failed to open log/server$idstr.input\n";
 199
 200   print INPUT @_;
 201   close(INPUT);
 202
 203   # use this, open->print->close system only to make the file
 204   # open as little as possible, to make the test suite run
 205   # better on windows/cygwin
 206 }
 207
 208
 209 sub sysread_or_die {
 210     my $FH     = shift;
 211     my $scalar = shift;
 212     my $length = shift;
 213     my $fcaller;
 214     my $lcaller;
 215     my $result;
 216
 217     $result = sysread($$FH, $$scalar, $length);
 218
 219     if(not defined $result) {
 220         ($fcaller, $lcaller) = (caller)[1,2];
 221         logmsg "Failed to read input\n";
 222         logmsg "Error: $srvrname server, sysread error: $!\n";
 223         logmsg "Exited from sysread_or_die() at $fcaller " .
 224                "line $lcaller. $srvrname server, sysread error: $!\n";
 225         killsockfilters($proto, $ipvnum, $idnum, $verbose);
 226         unlink($pidfile);
 227         if($serverlogslocked) {
 228             $serverlogslocked = 0;
 229             clear_advisor_read_lock($SERVERLOGS_LOCK);
 230         }
 231         exit;
 232     }
 233     elsif($result == 0) {
 234         ($fcaller, $lcaller) = (caller)[1,2];
 235         logmsg "Failed to read input\n";
 236         logmsg "Error: $srvrname server, read zero\n";
 237         logmsg "Exited from sysread_or_die() at $fcaller " .
 238                "line $lcaller. $srvrname server, read zero\n";
 239         killsockfilters($proto, $ipvnum, $idnum, $verbose);
 240         unlink($pidfile);
 241         if($serverlogslocked) {
 242             $serverlogslocked = 0;
 243             clear_advisor_read_lock($SERVERLOGS_LOCK);
 244         }
 245         exit;
 246     }
 247
 248     return $result;
 249 }
 250
 251 sub startsf {
 252     my $mainsockfcmd = "./server/sockfilt " .
 253         "--ipv$ipvnum --port $port " .
 254         "--pidfile \"$mainsockf_pidfile\" " .
 255         "--logfile \"$mainsockf_logfile\"";
 256     $sfpid = open2(*SFREAD, *SFWRITE, $mainsockfcmd);
 257
 258     print STDERR "$mainsockfcmd\n" if($verbose);
 259
 260     print SFWRITE "PING\n";
 261     my $pong;
 262     sysread_or_die(\*SFREAD, \$pong, 5);
 263
 264     if($pong !~ /^PONG/) {
 265         logmsg "Failed sockfilt command: $mainsockfcmd\n";
 266         killsockfilters($proto, $ipvnum, $idnum, $verbose);
 267         unlink($pidfile);
 268         if($serverlogslocked) {
 269             $serverlogslocked = 0;
 270             clear_advisor_read_lock($SERVERLOGS_LOCK);
 271         }
 272         die "Failed to start sockfilt!";
 273     }
 274 }
 275
 276
 277 sub sockfilt {
 278     my $l;
 279     foreach $l (@_) {
 280         printf SFWRITE "DATA\n%04x\n", length($l);
 281         print SFWRITE $l;
 282     }
 283 }
 284
 285
 286 sub sockfiltsecondary {
 287     my $l;
 288     foreach $l (@_) {
 289         printf DWRITE "DATA\n%04x\n", length($l);
 290         print DWRITE $l;
 291     }
 292 }
 293
 294
 295 # Send data to the client on the control stream, which happens to be plain
 296 # stdout.
 297
 298 sub sendcontrol {
 299     if(!$ctrldelay) {
 300         # spit it all out at once
 301         sockfilt @_;
 302     }
 303     else {
 304         my $a = join("", @_);
 305         my @a = split("", $a);
 306
 307         for(@a) {
 308             sockfilt $_;
 309             select(undef, undef, undef, 0.01);
 310         }
 311     }
 312     my $log;
 313     foreach $log (@_) {
 314         my $l = $log;
 315         $l =~ s/[\r\n]//g;
 316         logmsg "> \"$l\"\n";
 317     }
 318 }
 319
 320 # Send data to the client on the data stream
 321
 322 sub senddata {
 323     my $l;
 324     foreach $l (@_) {
 325       if(!$datadelay) {
 326         # spit it all out at once
 327         sockfiltsecondary $l;
 328       }
 329       else {
 330           # pause between each byte
 331           for (split(//,$l)) {
 332               sockfiltsecondary $_;
 333               select(undef, undef, undef, 0.01);
 334           }
 335       }
 336     }
 337 }
 338
 339 #**********************************************************************
 340 # protocolsetup initializes the 'displaytext' and 'commandfunc' hashes
 341 # for the given protocol. References to protocol command callbacks are
 342 # stored in 'commandfunc' hash, and text which will be returned to the
 343 # client before the command callback runs is stored in 'displaytext'.
 344 #
 345 sub protocolsetup {
 346     my $proto = $_[0];
 347
 348     if($proto eq 'ftp') {
 349         %commandfunc = (
 350             'PORT' => \&PORT_ftp,
 351             'EPRT' => \&PORT_ftp,
 352             'LIST' => \&LIST_ftp,
 353             'NLST' => \&NLST_ftp,
 354             'PASV' => \&PASV_ftp,
 355             'CWD'  => \&CWD_ftp,
 356             'PWD'  => \&PWD_ftp,
 357             'EPSV' => \&PASV_ftp,
 358             'RETR' => \&RETR_ftp,
 359             'SIZE' => \&SIZE_ftp,
 360             'REST' => \&REST_ftp,
 361             'STOR' => \&STOR_ftp,
 362             'APPE' => \&STOR_ftp, # append looks like upload
 363             'MDTM' => \&MDTM_ftp,
 364         );
 365         %displaytext = (
 366             'USER' => '331 We are happy you popped in!',
 367             'PASS' => '230 Welcome you silly person',
 368             'PORT' => '200 You said PORT - I say FINE',
 369             'TYPE' => '200 I modify TYPE as you wanted',
 370             'LIST' => '150 here comes a directory',
 371             'NLST' => '150 here comes a directory',
 372             'CWD'  => '250 CWD command successful.',
 373             'SYST' => '215 UNIX Type: L8', # just fake something
 374             'QUIT' => '221 bye bye baby', # just reply something
 375             'MKD'  => '257 Created your requested directory',
 376             'REST' => '350 Yeah yeah we set it there for you',
 377             'DELE' => '200 OK OK OK whatever you say',
 378             'RNFR' => '350 Received your order. Please provide more',
 379             'RNTO' => '250 Ok, thanks. File renaming completed.',
 380             'NOOP' => '200 Yes, I\'m very good at doing nothing.',
 381             'PBSZ' => '500 PBSZ not implemented',
 382             'PROT' => '500 PROT not implemented',
 383         );
 384         @welcome = (
 385             '220-        _   _ ____  _     '."\r\n",
 386             '220-    ___| | | |  _ \| |    '."\r\n",
 387             '220-   / __| | | | |_) | |    '."\r\n",
 388             '220-  | (__| |_| |  _ <| |___ '."\r\n",
 389             '220    \___|\___/|_| \_\_____|'."\r\n"
 390         );
 391     }
 392     elsif($proto eq 'pop3') {
 393         %commandfunc = (
 394             'RETR' => \&RETR_pop3,
 395         );
 396         %displaytext = (
 397             'USER' => '+OK We are happy you popped in!',
 398             'PASS' => '+OK Access granted',
 399             'QUIT' => '+OK byebye',
 400         );
 401         @welcome = (
 402             '        _   _ ____  _     '."\r\n",
 403             '    ___| | | |  _ \| |    '."\r\n",
 404             '   / __| | | | |_) | |    '."\r\n",
 405             '  | (__| |_| |  _ <| |___ '."\r\n",
 406             '   \___|\___/|_| \_\_____|'."\r\n",
 407             '+OK cURL POP3 server ready to serve'."\r\n"
 408         );
 409     }
 410     elsif($proto eq 'imap') {
 411         %commandfunc = (
 412             'FETCH'  => \&FETCH_imap,
 413             'SELECT' => \&SELECT_imap,
 414         );
 415         %displaytext = (
 416             'LOGIN'  => ' OK We are happy you popped in!',
 417             'SELECT' => ' OK selection done',
 418             'LOGOUT' => ' OK thanks for the fish',
 419         );
 420         @welcome = (
 421             '        _   _ ____  _     '."\r\n",
 422             '    ___| | | |  _ \| |    '."\r\n",
 423             '   / __| | | | |_) | |    '."\r\n",
 424             '  | (__| |_| |  _ <| |___ '."\r\n",
 425             '   \___|\___/|_| \_\_____|'."\r\n",
 426             '* OK cURL IMAP server ready to serve'."\r\n"
 427         );
 428     }
 429     elsif($proto eq 'smtp') {
 430         %commandfunc = (
 431             'DATA' => \&DATA_smtp,
 432             'RCPT' => \&RCPT_smtp,
 433         );
 434         %displaytext = (
 435             'EHLO' => '230 We are happy you popped in!',
 436             'MAIL' => '200 Note taken',
 437             'RCPT' => '200 Receivers accepted',
 438             'QUIT' => '200 byebye',
 439         );
 440         @welcome = (
 441             '220-        _   _ ____  _     '."\r\n",
 442             '220-    ___| | | |  _ \| |    '."\r\n",
 443             '220-   / __| | | | |_) | |    '."\r\n",
 444             '220-  | (__| |_| |  _ <| |___ '."\r\n",
 445             '220    \___|\___/|_| \_\_____|'."\r\n"
 446         );
 447     }
 448 }
 449
 450 sub close_dataconn {
 451     my ($closed)=@_; # non-zero if already disconnected
 452
 453     my $datapid = processexists($datasockf_pidfile);
 454
 455     if(!$closed) {
 456         logmsg "* disconnect data connection\n";
 457         if($datapid > 0) {
 458             print DWRITE "DISC\n";
 459             my $i;
 460             sysread DREAD, $i, 5;
 461         }
 462     }
 463     else {
 464         logmsg "data connection already disconnected\n";
 465     }
 466     logmsg "=====> Closed data connection\n";
 467
 468     logmsg "* quit sockfilt for data (pid $datapid)\n";
 469     if($datapid > 0) {
 470         print DWRITE "QUIT\n";
 471         waitpid($datapid, 0);
 472         unlink($datasockf_pidfile) if(-f $datasockf_pidfile);
 473     }
 474 }
 475
 476 ################
 477 ################ SMTP commands
 478 ################
 479
 480 # what set by "RCPT"
 481 my $smtp_rcpt;
 482
 483 sub DATA_smtp {
 484     my $testno;
 485
 486     if($smtp_rcpt =~ /^TO:(.*)/) {
 487         $testno = $1;
 488     }
 489     else {
 490         return; # failure
 491     }
 492
 493     if($testno eq "<verifiedserver>") {
 494         sendcontrol "554 WE ROOLZ: $$\r\n";
 495         return 0; # don't wait for data now
 496     }
 497     else {
 498         $testno =~ s/^([^0-9]*)([0-9]+).*/$2/;
 499         sendcontrol "354 Show me the mail\r\n";
 500     }
 501
 502     logmsg "===> rcpt $testno was $smtp_rcpt\n";
 503
 504     my $filename = "log/upload.$testno";
 505
 506     logmsg "Store test number $testno in $filename\n";
 507
 508     open(FILE, ">$filename") ||
 509         return 0; # failed to open output
 510
 511     my $line;
 512     my $ulsize=0;
 513     my $disc=0;
 514     my $raw;
 515     while (5 == (sysread \*SFREAD, $line, 5)) {
 516         if($line eq "DATA\n") {
 517             my $i;
 518             my $eob;
 519             sysread \*SFREAD, $i, 5;
 520
 521             my $size = 0;
 522             if($i =~ /^([0-9a-fA-F]{4})\n/) {
 523                 $size = hex($1);
 524             }
 525
 526             sysread \*SFREAD, $line, $size;
 527
 528             $ulsize += $size;
 529             print FILE $line if(!$nosave);
 530
 531             $raw .= $line;
 532             if($raw =~ /\x0d\x0a\x2e\x0d\x0a/) {
 533                 # end of data marker!
 534                 $eob = 1;
 535             }
 536             logmsg "> Appending $size bytes to file\n";
 537             if($eob) {
 538                 logmsg "Found SMTP EOB marker\n";
 539                 last;
 540             }
 541         }
 542         elsif($line eq "DISC\n") {
 543             # disconnect!
 544             $disc=1;
 545             last;
 546         }
 547         else {
 548             logmsg "No support for: $line";
 549             last;
 550         }
 551     }
 552     if($nosave) {
 553         print FILE "$ulsize bytes would've been stored here\n";
 554     }
 555     close(FILE);
 556     sendcontrol "250 OK, data received!\r\n";
 557     logmsg "received $ulsize bytes upload\n";
 558
 559 }
 560
 561 sub RCPT_smtp {
 562     my ($args) = @_;
 563
 564     $smtp_rcpt = $args;
 565 }
 566
 567 ################
 568 ################ IMAP commands
 569 ################
 570
 571 # global to allow the command functions to read it
 572 my $cmdid;
 573
 574 # what was picked by SELECT
 575 my $selected;
 576
 577 sub SELECT_imap {
 578     my ($testno) = @_;
 579     my @data;
 580     my $size;
 581
 582     logmsg "SELECT_imap got test $testno\n";
 583
 584     $selected = $testno;
 585
 586     return 0;
 587 }
 588
 589
 590 sub FETCH_imap {
 591      my ($testno) = @_;
 592      my @data;
 593      my $size;
 594
 595      logmsg "FETCH_imap got test $testno\n";
 596
 597      $testno = $selected;
 598
 599      if($testno =~ /^verifiedserver$/) {
 600          # this is the secret command that verifies that this actually is
 601          # the curl test server
 602          my $response = "WE ROOLZ: $$\r\n";
 603          if($verbose) {
 604              print STDERR "FTPD: We returned proof we are the test server\n";
 605          }
 606          $data[0] = $response;
 607          logmsg "return proof we are we\n";
 608      }
 609      else {
 610          logmsg "retrieve a mail\n";
 611
 612          $testno =~ s/^([^0-9]*)//;
 613          my $testpart = "";
 614          if ($testno > 10000) {
 615              $testpart = $testno % 10000;
 616              $testno = int($testno / 10000);
 617          }
 618
 619          # send mail content
 620          loadtest("$srcdir/data/test$testno");
 621
 622          @data = getpart("reply", "data$testpart");
 623      }
 624
 625      for (@data) {
 626          $size += length($_);
 627      }
 628
 629      sendcontrol "* FETCH starts {$size}\r\n";
 630
 631      for my $d (@data) {
 632          sendcontrol $d;
 633      }
 634
 635      sendcontrol "$cmdid OK FETCH completed\r\n";
 636
 637      return 0;
 638 }
 639
 640 ################
 641 ################ POP3 commands
 642 ################
 643
 644 sub RETR_pop3 {
 645      my ($testno) = @_;
 646      my @data;
 647
 648      if($testno =~ /^verifiedserver$/) {
 649          # this is the secret command that verifies that this actually is
 650          # the curl test server
 651          my $response = "WE ROOLZ: $$\r\n";
 652          if($verbose) {
 653              print STDERR "FTPD: We returned proof we are the test server\n";
 654          }
 655          $data[0] = $response;
 656          logmsg "return proof we are we\n";
 657      }
 658      else {
 659          logmsg "retrieve a mail\n";
 660
 661          $testno =~ s/^([^0-9]*)//;
 662          my $testpart = "";
 663          if ($testno > 10000) {
 664              $testpart = $testno % 10000;
 665              $testno = int($testno / 10000);
 666          }
 667
 668          # send mail content
 669          loadtest("$srcdir/data/test$testno");
 670
 671          @data = getpart("reply", "data$testpart");
 672      }
 673
 674      sendcontrol "+OK Mail transfer starts\r\n";
 675
 676      for my $d (@data) {
 677          sendcontrol $d;
 678      }
 679
 680      # end with the magic 5-byte end of mail marker
 681      sendcontrol "\r\n.\r\n";
 682
 683      return 0;
 684 }
 685
 686 ################
 687 ################ FTP commands
 688 ################
 689 my $rest=0;
 690 sub REST_ftp {
 691     $rest = $_[0];
 692     logmsg "Set REST position to $rest\n"
 693 }
 694
 695 sub switch_directory_goto {
 696   my $target_dir = $_;
 697
 698   if(!$ftptargetdir) {
 699     $ftptargetdir = "/";
 700   }
 701
 702   if($target_dir eq "") {
 703     $ftptargetdir = "/";
 704   }
 705   elsif($target_dir eq "..") {
 706     if($ftptargetdir eq "/") {
 707       $ftptargetdir = "/";
 708     }
 709     else {
 710       $ftptargetdir =~ s/[[:alnum:]]+\/$//;
 711     }
 712   }
 713   else {
 714     $ftptargetdir .= $target_dir . "/";
 715   }
 716 }
 717
 718 sub switch_directory {
 719     my $target_dir = $_[0];
 720
 721     if($target_dir eq "/") {
 722         $ftptargetdir = "/";
 723     }
 724     else {
 725         my @dirs = split("/", $target_dir);
 726         for(@dirs) {
 727           switch_directory_goto($_);
 728         }
 729     }
 730 }
 731
 732 sub CWD_ftp {
 733   my ($folder, $fullcommand) = $_[0];
 734   switch_directory($folder);
 735   if($ftptargetdir =~ /^\/fully_simulated/) {
 736     $ftplistparserstate = "enabled";
 737   }
 738   else {
 739     undef $ftplistparserstate;
 740   }
 741 }
 742
 743 sub PWD_ftp {
 744     my $mydir;
 745     $mydir = $ftptargetdir ? $ftptargetdir : "/";
 746
 747     if($mydir ne "/") {
 748         $mydir =~ s/\/$//;
 749     }
 750     sendcontrol "257 \"$mydir\" is current directory\r\n";
 751 }
 752
 753 sub LIST_ftp {
 754   #  print "150 ASCII data connection for /bin/ls (193.15.23.1,59196) (0 bytes)\r\n";
 755
 756 # this is a built-in fake-dir ;-)
 757 my @ftpdir=("total 20\r\n",
 758 "drwxr-xr-x   8 98       98           512 Oct 22 13:06 .\r\n",
 759 "drwxr-xr-x   8 98       98           512 Oct 22 13:06 ..\r\n",
 760 "drwxr-xr-x   2 98       98           512 May  2  1996 .NeXT\r\n",
 761 "-r--r--r--   1 0        1             35 Jul 16  1996 README\r\n",
 762 "lrwxrwxrwx   1 0        1              7 Dec  9  1999 bin -> usr/bin\r\n",
 763 "dr-xr-xr-x   2 0        1            512 Oct  1  1997 dev\r\n",
 764 "drwxrwxrwx   2 98       98           512 May 29 16:04 download.html\r\n",
 765 "dr-xr-xr-x   2 0        1            512 Nov 30  1995 etc\r\n",
 766 "drwxrwxrwx   2 98       1            512 Oct 30 14:33 pub\r\n",
 767 "dr-xr-xr-x   5 0        1            512 Oct  1  1997 usr\r\n");
 768
 769     if($ftplistparserstate) {
 770       @ftpdir = ftp_contentlist($ftptargetdir);
 771     }
 772
 773     logmsg "pass LIST data on data connection\n";
 774     for(@ftpdir) {
 775         senddata $_;
 776     }
 777     close_dataconn(0);
 778     sendcontrol "226 ASCII transfer complete\r\n";
 779     return 0;
 780 }
 781
 782 sub NLST_ftp {
 783     my @ftpdir=("file", "with space", "fake", "..", " ..", "funny", "README");
 784     logmsg "pass NLST data on data connection\n";
 785     for(@ftpdir) {
 786         senddata "$_\r\n";
 787     }
 788     close_dataconn(0);
 789     sendcontrol "226 ASCII transfer complete\r\n";
 790     return 0;
 791 }
 792
 793 sub MDTM_ftp {
 794     my $testno = $_[0];
 795     my $testpart = "";
 796     if ($testno > 10000) {
 797         $testpart = $testno % 10000;
 798         $testno = int($testno / 10000);
 799     }
 800
 801     loadtest("$srcdir/data/test$testno");
 802
 803     my @data = getpart("reply", "mdtm");
 804
 805     my $reply = $data[0];
 806     chomp $reply if($reply);
 807
 808     if($reply && ($reply =~ /^[+-]?\d+$/) && ($reply < 0)) {
 809         sendcontrol "550 $testno: no such file.\r\n";
 810     }
 811     elsif($reply) {
 812         sendcontrol "$reply\r\n";
 813     }
 814     else {
 815         sendcontrol "500 MDTM: no such command.\r\n";
 816     }
 817     return 0;
 818 }
 819
 820 sub SIZE_ftp {
 821     my $testno = $_[0];
 822     if($ftplistparserstate) {
 823         my $size = wildcard_filesize($ftptargetdir, $testno);
 824         if($size == -1) {
 825             sendcontrol "550 $testno: No such file or directory.\r\n";
 826         }
 827         else {
 828             sendcontrol "213 $size\r\n";
 829         }
 830         return 0;
 831     }
 832
 833     if($testno =~ /^verifiedserver$/) {
 834         my $response = "WE ROOLZ: $$\r\n";
 835         my $size = length($response);
 836         sendcontrol "213 $size\r\n";
 837         return 0;
 838     }
 839
 840     if($testno =~ /(\d+)\/?$/) {
 841         $testno = $1;
 842     }
 843     else {
 844         print STDERR "SIZE_ftp: invalid test number: $testno\n";
 845         return 1;
 846     }
 847
 848     my $testpart = "";
 849     if($testno > 10000) {
 850         $testpart = $testno % 10000;
 851         $testno = int($testno / 10000);
 852     }
 853
 854     loadtest("$srcdir/data/test$testno");
 855
 856     my @data = getpart("reply", "size");
 857
 858     my $size = $data[0];
 859
 860     if($size) {
 861         if($size > -1) {
 862             sendcontrol "213 $size\r\n";
 863         }
 864         else {
 865             sendcontrol "550 $testno: No such file or directory.\r\n";
 866         }
 867     }
 868     else {
 869         $size=0;
 870         @data = getpart("reply", "data$testpart");
 871         for(@data) {
 872             $size += length($_);
 873         }
 874         if($size) {
 875             sendcontrol "213 $size\r\n";
 876         }
 877         else {
 878             sendcontrol "550 $testno: No such file or directory.\r\n";
 879         }
 880     }
 881     return 0;
 882 }
 883
 884 sub RETR_ftp {
 885     my ($testno) = @_;
 886
 887     if($ftplistparserstate) {
 888         my @content = wildcard_getfile($ftptargetdir, $testno);
 889         if($content[0] == -1) {
 890             #file not found
 891         }
 892         else {
 893             my $size = length $content[1];
 894             sendcontrol "150 Binary data connection for $testno ($size bytes).\r\n",
 895             senddata $content[1];
 896             close_dataconn(0);
 897             sendcontrol "226 File transfer complete\r\n";
 898         }
 899         return 0;
 900     }
 901
 902     if($testno =~ /^verifiedserver$/) {
 903         # this is the secret command that verifies that this actually is
 904         # the curl test server
 905         my $response = "WE ROOLZ: $$\r\n";
 906         my $len = length($response);
 907         sendcontrol "150 Binary junk ($len bytes).\r\n";
 908         senddata "WE ROOLZ: $$\r\n";
 909         close_dataconn(0);
 910         sendcontrol "226 File transfer complete\r\n";
 911         if($verbose) {
 912             print STDERR "FTPD: We returned proof we are the test server\n";
 913         }
 914         return 0;
 915     }
 916
 917     $testno =~ s/^([^0-9]*)//;
 918     my $testpart = "";
 919     if ($testno > 10000) {
 920         $testpart = $testno % 10000;
 921         $testno = int($testno / 10000);
 922     }
 923
 924     loadtest("$srcdir/data/test$testno");
 925
 926     my @data = getpart("reply", "data$testpart");
 927
 928     my $size=0;
 929     for(@data) {
 930         $size += length($_);
 931     }
 932
 933     my %hash = getpartattr("reply", "data$testpart");
 934
 935     if($size || $hash{'sendzero'}) {
 936
 937         if($rest) {
 938             # move read pointer forward
 939             $size -= $rest;
 940             logmsg "REST $rest was removed from size, makes $size left\n";
 941             $rest = 0; # reset REST offset again
 942         }
 943         if($retrweirdo) {
 944             sendcontrol "150 Binary data connection for $testno () ($size bytes).\r\n",
 945             "226 File transfer complete\r\n";
 946
 947             for(@data) {
 948                 my $send = $_;
 949                 senddata $send;
 950             }
 951             close_dataconn(0);
 952             $retrweirdo=0; # switch off the weirdo again!
 953         }
 954         else {
 955             my $sz = "($size bytes)";
 956             if($retrnosize) {
 957                 $sz = "size?";
 958             }
 959
 960             sendcontrol "150 Binary data connection for $testno () $sz.\r\n";
 961
 962             for(@data) {
 963                 my $send = $_;
 964                 senddata $send;
 965             }
 966             close_dataconn(0);
 967             sendcontrol "226 File transfer complete\r\n";
 968         }
 969     }
 970     else {
 971         sendcontrol "550 $testno: No such file or directory.\r\n";
 972     }
 973     return 0;
 974 }
 975
 976 sub STOR_ftp {
 977     my $testno=$_[0];
 978
 979     my $filename = "log/upload.$testno";
 980
 981     logmsg "STOR test number $testno in $filename\n";
 982
 983     sendcontrol "125 Gimme gimme gimme!\r\n";
 984
 985     open(FILE, ">$filename") ||
 986         return 0; # failed to open output
 987
 988     my $line;
 989     my $ulsize=0;
 990     my $disc=0;
 991     while (5 == (sysread DREAD, $line, 5)) {
 992         if($line eq "DATA\n") {
 993             my $i;
 994             sysread DREAD, $i, 5;
 995
 996             my $size = 0;
 997             if($i =~ /^([0-9a-fA-F]{4})\n/) {
 998                 $size = hex($1);
 999             }
1000
1001             sysread DREAD, $line, $size;
1002
1003             #print STDERR "  GOT: $size bytes\n";
1004
1005             $ulsize += $size;
1006             print FILE $line if(!$nosave);
1007             logmsg "> Appending $size bytes to file\n";
1008         }
1009         elsif($line eq "DISC\n") {
1010             # disconnect!
1011             $disc=1;
1012             last;
1013         }
1014         else {
1015             logmsg "No support for: $line";
1016             last;
1017         }
1018     }
1019     if($nosave) {
1020         print FILE "$ulsize bytes would've been stored here\n";
1021     }
1022     close(FILE);
1023     close_dataconn($disc);
1024     logmsg "received $ulsize bytes upload\n";
1025     sendcontrol "226 File transfer complete\r\n";
1026     return 0;
1027 }
1028
1029 sub PASV_ftp {
1030     my ($arg, $cmd)=@_;
1031     my $pasvport;
1032
1033     # kill previous data connection sockfilt when alive
1034     killsockfilters($proto, $ipvnum, $idnum, $verbose, 'data');
1035
1036     # We fire up a new sockfilt to do the data transfer for us.
1037     my $datasockfcmd = "./server/sockfilt " .
1038         "--ipv$ipvnum --port 0 " .
1039         "--pidfile \"$datasockf_pidfile\" " .
1040         "--logfile \"$datasockf_logfile\"";
1041     $slavepid = open2(\*DREAD, \*DWRITE, $datasockfcmd);
1042
1043     print DWRITE "PING\n";
1044     my $pong;
1045     sysread_or_die(\*DREAD, \$pong, 5);
1046
1047     if($pong !~ /^PONG/) {
1048         logmsg "failed to run sockfilt for data connection\n";
1049         killsockfilters($proto, $ipvnum, $idnum, $verbose, 'data');
1050         sendcontrol "500 no free ports!\r\n";
1051         return 0;
1052     }
1053
1054     logmsg "Run sockfilt for data on pid $slavepid\n";
1055
1056     # Find out what port we listen on
1057     my $i;
1058     print DWRITE "PORT\n";
1059
1060     # READ the response code
1061     sysread_or_die(\*DREAD, \$i, 5);
1062
1063     # READ the response size
1064     sysread_or_die(\*DREAD, \$i, 5);
1065
1066     my $size = 0;
1067     if($i =~ /^([0-9a-fA-F]{4})\n/) {
1068         $size = hex($1);
1069     }
1070
1071     # READ the response data
1072     sysread_or_die(\*DREAD, \$i, $size);
1073
1074     # The data is in the format
1075     # IPvX/NNN
1076
1077     if($i =~ /IPv(\d)\/(\d+)/) {
1078         # FIX: deal with IP protocol version
1079         $pasvport = $2;
1080     }
1081
1082     if($cmd ne "EPSV") {
1083         # PASV reply
1084         my $p=$listenaddr;
1085         $p =~ s/\./,/g;
1086         if($pasvbadip) {
1087             $p="1,2,3,4";
1088         }
1089         sendcontrol sprintf("227 Entering Passive Mode ($p,%d,%d)\n",
1090                             ($pasvport/256), ($pasvport%256));
1091     }
1092     else {
1093         # EPSV reply
1094         sendcontrol sprintf("229 Entering Passive Mode (|||%d|)\n", $pasvport);
1095     }
1096
1097     eval {
1098         local $SIG{ALRM} = sub { die "alarm\n" };
1099
1100         # assume swift operations unless explicitly slow
1101         alarm ($datadelay?20:10);
1102
1103         # Wait for 'CNCT'
1104         my $input;
1105
1106         while(sysread(DREAD, $input, 5)) {
1107
1108             if($input !~ /^CNCT/) {
1109                 # we wait for a connected client
1110                 logmsg "Odd, we got $input from client\n";
1111                 next;
1112             }
1113             logmsg "====> Client DATA connect\n";
1114             last;
1115         }
1116         alarm 0;
1117     };
1118     if ($@) {
1119         # timed out
1120         logmsg "$srvrname server timed out awaiting data connection ".
1121             "on port $pasvport\n";
1122         logmsg "accept failed or connection not even attempted\n";
1123         killsockfilters($proto, $ipvnum, $idnum, $verbose, 'data');
1124         return;
1125     }
1126     else {
1127         logmsg "data connection setup on port $pasvport\n";
1128     }
1129
1130     return;
1131 }
1132
1133 # Support both PORT and EPRT here. Consider LPRT too.
1134
1135 sub PORT_ftp {
1136     my ($arg, $cmd) = @_;
1137     my $port;
1138     my $addr;
1139
1140     # We always ignore the given IP and use localhost.
1141
1142     if($cmd eq "PORT") {
1143         if($arg !~ /(\d+),(\d+),(\d+),(\d+),(\d+),(\d+)/) {
1144             logmsg "bad PORT-line: $arg\n";
1145             sendcontrol "500 silly you, go away\r\n";
1146             return 0;
1147         }
1148         $port = ($5<<8)+$6;
1149         $addr = "$1.$2.$3.$4";
1150     }
1151     # EPRT |2|::1|49706|
1152     elsif(($cmd eq "EPRT") && ($grok_eprt)) {
1153         if($arg !~ /(\d+)\|([^\|]+)\|(\d+)/) {
1154             sendcontrol "500 silly you, go away\r\n";
1155             return 0;
1156         }
1157         sendcontrol "200 Thanks for dropping by. We contact you later\r\n";
1158         $port = $3;
1159         $addr = $2;
1160     }
1161     else {
1162         sendcontrol "500 we don't like $cmd now\r\n";
1163         return 0;
1164     }
1165
1166     if(!$port || $port > 65535) {
1167         print STDERR "very illegal PORT number: $port\n";
1168         return 1;
1169     }
1170
1171     # We fire up a new sockfilt to do the data transfer for us.
1172     my $datasockfcmd = "./server/sockfilt " .
1173         "--ipv$ipvnum --connect $port --addr \"$addr\" " .
1174         "--pidfile \"$datasockf_pidfile\" " .
1175         "--logfile \"$datasockf_logfile\"";
1176     $slavepid = open2(\*DREAD, \*DWRITE, $datasockfcmd);
1177
1178     print STDERR "$datasockfcmd\n" if($verbose);
1179
1180     print DWRITE "PING\n";
1181     my $pong;
1182     sysread_or_die(\*DREAD, \$pong, 5);
1183
1184     if($pong !~ /^PONG/) {
1185         logmsg "Failed sockfilt for data connection\n";
1186         killsockfilters($proto, $ipvnum, $idnum, $verbose, 'data');
1187     }
1188
1189     logmsg "====> Client DATA connect to port $port\n";
1190
1191     return;
1192 }
1193
1194 #**********************************************************************
1195 # customize configures test server operation for each curl test, reading
1196 # configuration commands/parameters from server commands file each time
1197 # a new client control connection is established with the test server.
1198 # On success returns 1, otherwise zero.
1199 #
1200 sub customize {
1201     $ctrldelay = 0;    # default is no throttling of the ctrl stream
1202     $datadelay = 0;    # default is no throttling of the data stream
1203     $retrweirdo = 0;   # default is no use of RETRWEIRDO
1204     $retrnosize = 0;   # default is no use of RETRNOSIZE
1205     $pasvbadip = 0;    # default is no use of PASVBADIP
1206     $nosave = 0;       # default is to actually save uploaded data to file
1207     %customreply = (); #
1208     %customcount = (); #
1209     %delayreply = ();  #
1210
1211     open(CUSTOM, "<log/ftpserver.cmd") ||
1212         return 1;
1213
1214     logmsg "FTPD: Getting commands from log/ftpserver.cmd\n";
1215
1216     while(<CUSTOM>) {
1217         if($_ =~ /REPLY ([A-Za-z0-9+\/=]+) (.*)/) {
1218             $customreply{$1}=eval "qq{$2}";
1219             logmsg "FTPD: set custom reply for $1\n";
1220         }
1221         if($_ =~ /COUNT ([A-Z]+) (.*)/) {
1222             # we blank the customreply for this command when having
1223             # been used this number of times
1224             $customcount{$1}=$2;
1225             logmsg "FTPD: blank custom reply for $1 after $2 uses\n";
1226         }
1227         elsif($_ =~ /DELAY ([A-Z]+) (\d*)/) {
1228             $delayreply{$1}=$2;
1229             logmsg "FTPD: delay reply for $1 with $2 seconds\n";
1230         }
1231         elsif($_ =~ /SLOWDOWN/) {
1232             $ctrldelay=1;
1233             $datadelay=1;
1234             logmsg "FTPD: send response with 0.01 sec delay between each byte\n";
1235         }
1236         elsif($_ =~ /RETRWEIRDO/) {
1237             logmsg "FTPD: instructed to use RETRWEIRDO\n";
1238             $retrweirdo=1;
1239         }
1240         elsif($_ =~ /RETRNOSIZE/) {
1241             logmsg "FTPD: instructed to use RETRNOSIZE\n";
1242             $retrnosize=1;
1243         }
1244         elsif($_ =~ /PASVBADIP/) {
1245             logmsg "FTPD: instructed to use PASVBADIP\n";
1246             $pasvbadip=1;
1247         }
1248         elsif($_ =~ /NOSAVE/) {
1249             # don't actually store the file we upload - to be used when
1250             # uploading insanely huge amounts
1251             $nosave = 1;
1252             logmsg "FTPD: NOSAVE prevents saving of uploaded data\n";
1253         }
1254     }
1255     close(CUSTOM);
1256 }
1257
1258 #----------------------------------------------------------------------
1259 #----------------------------------------------------------------------
1260 #---------------------------  END OF SUBS  ----------------------------
1261 #----------------------------------------------------------------------
1262 #----------------------------------------------------------------------
1263
1264 #**********************************************************************
1265 # Parse command line options
1266 #
1267 # Options:
1268 #
1269 # --verbose   # verbose
1270 # --srcdir    # source directory
1271 # --id        # server instance number
1272 # --proto     # server protocol
1273 # --pidfile   # server pid file
1274 # --logfile   # server log file
1275 # --ipv4      # server IP version 4
1276 # --ipv6      # server IP version 6
1277 # --port      # server listener port
1278 # --addr      # server address for listener port binding
1279 #
1280 while(@ARGV) {
1281     if($ARGV[0] eq '--verbose') {
1282         $verbose = 1;
1283     }
1284     elsif($ARGV[0] eq '--srcdir') {
1285         if($ARGV[1]) {
1286             $srcdir = $ARGV[1];
1287             shift @ARGV;
1288         }
1289     }
1290     elsif($ARGV[0] eq '--id') {
1291         if($ARGV[1] && ($ARGV[1] =~ /^(\d+)$/)) {
1292             $idnum = $1 if($1 > 0);
1293             shift @ARGV;
1294         }
1295     }
1296     elsif($ARGV[0] eq '--proto') {
1297         if($ARGV[1] && ($ARGV[1] =~ /^(ftp|imap|pop3|smtp)$/)) {
1298             $proto = $1;
1299             shift @ARGV;
1300         }
1301         else {
1302             die "unsupported protocol $ARGV[1]";
1303         }
1304     }
1305     elsif($ARGV[0] eq '--pidfile') {
1306         if($ARGV[1]) {
1307             $pidfile = $ARGV[1];
1308             shift @ARGV;
1309         }
1310     }
1311     elsif($ARGV[0] eq '--logfile') {
1312         if($ARGV[1]) {
1313             $logfile = $ARGV[1];
1314             shift @ARGV;
1315         }
1316     }
1317     elsif($ARGV[0] eq '--ipv4') {
1318         $ipvnum = 4;
1319         $listenaddr = '127.0.0.1' if($listenaddr eq '::1');
1320         $grok_eprt = 0;
1321     }
1322     elsif($ARGV[0] eq '--ipv6') {
1323         $ipvnum = 6;
1324         $listenaddr = '::1' if($listenaddr eq '127.0.0.1');
1325         $grok_eprt = 1;
1326     }
1327     elsif($ARGV[0] eq '--port') {
1328         if($ARGV[1] && ($ARGV[1] =~ /^(\d+)$/)) {
1329             $port = $1 if($1 > 1024);
1330             shift @ARGV;
1331         }
1332     }
1333     elsif($ARGV[0] eq '--addr') {
1334         if($ARGV[1]) {
1335             my $tmpstr = $ARGV[1];
1336             if($tmpstr =~ /^(\d\d?\d?)\.(\d\d?\d?)\.(\d\d?\d?)\.(\d\d?\d?)$/) {
1337                 $listenaddr = "$1.$2.$3.$4" if($ipvnum == 4);
1338             }
1339             elsif($ipvnum == 6) {
1340                 $listenaddr = $tmpstr;
1341                 $listenaddr =~ s/^\[(.*)\]$/$1/;
1342             }
1343             shift @ARGV;
1344         }
1345     }
1346     else {
1347         print STDERR "\nWarning: ftpserver.pl unknown parameter: $ARGV[0]\n";
1348     }
1349     shift @ARGV;
1350 }
1351
1352 #***************************************************************************
1353 # Initialize command line option dependant variables
1354 #
1355
1356 if(!$srcdir) {
1357     $srcdir = $ENV{'srcdir'} || '.';
1358 }
1359 if(!$pidfile) {
1360     $pidfile = "$path/". server_pidfilename($proto, $ipvnum, $idnum);
1361 }
1362 if(!$logfile) {
1363     $logfile = server_logfilename($logdir, $proto, $ipvnum, $idnum);
1364 }
1365
1366 $mainsockf_pidfile = "$path/".
1367     mainsockf_pidfilename($proto, $ipvnum, $idnum);
1368 $mainsockf_logfile =
1369     mainsockf_logfilename($logdir, $proto, $ipvnum, $idnum);
1370
1371 if($proto eq 'ftp') {
1372     $datasockf_pidfile = "$path/".
1373         datasockf_pidfilename($proto, $ipvnum, $idnum);
1374     $datasockf_logfile =
1375         datasockf_logfilename($logdir, $proto, $ipvnum, $idnum);
1376 }
1377
1378 $srvrname = servername_str($proto, $ipvnum, $idnum);
1379
1380 $idstr = "$idnum" if($idnum > 1);
1381
1382 protocolsetup($proto);
1383
1384 $SIG{INT} = \&exit_signal_handler;
1385 $SIG{TERM} = \&exit_signal_handler;
1386
1387 startsf();
1388
1389 logmsg sprintf("%s server listens on port IPv${ipvnum}/${port}\n", uc($proto));
1390
1391 open(PID, ">$pidfile");
1392 print PID $$."\n";
1393 close(PID);
1394
1395 logmsg("logged pid $$ in $pidfile\n");
1396
1397
1398 while(1) {
1399     #
1400     # We read 'sockfilt' commands.
1401     #
1402     my $input;
1403
1404     logmsg "Awaiting input\n";
1405     sysread_or_die(\*SFREAD, \$input, 5);
1406
1407     if($input !~ /^CNCT/) {
1408         # we wait for a connected client
1409         logmsg "sockfilt said: $input";
1410         next;
1411     }
1412     logmsg "====> Client connect\n";
1413
1414     set_advisor_read_lock($SERVERLOGS_LOCK);
1415     $serverlogslocked = 1;
1416
1417     # flush data:
1418     $| = 1;
1419
1420     killsockfilters($proto, $ipvnum, $idnum, $verbose, 'data');
1421
1422     &customize(); # read test control instructions
1423
1424     sendcontrol @welcome;
1425
1426     #remove global variables from last connection
1427     if($ftplistparserstate) {
1428       undef $ftplistparserstate;
1429     }
1430     if($ftptargetdir) {
1431       undef $ftptargetdir;
1432     }
1433
1434     if($verbose) {
1435         for(@welcome) {
1436             print STDERR "OUT: $_";
1437         }
1438     }
1439
1440     while(1) {
1441         my $i;
1442
1443         # Now we expect to read DATA\n[hex size]\n[prot], where the [prot]
1444         # part only is FTP lingo.
1445
1446         # COMMAND
1447         sysread_or_die(\*SFREAD, \$i, 5);
1448
1449         if($i !~ /^DATA/) {
1450             logmsg "sockfilt said $i";
1451             if($i =~ /^DISC/) {
1452                 # disconnect
1453                 last;
1454             }
1455             next;
1456         }
1457
1458         # SIZE of data
1459         sysread_or_die(\*SFREAD, \$i, 5);
1460
1461         my $size = 0;
1462         if($i =~ /^([0-9a-fA-F]{4})\n/) {
1463             $size = hex($1);
1464         }
1465
1466         # data
1467         sysread SFREAD, $_, $size;
1468
1469         ftpmsg $_;
1470
1471         # Remove trailing CRLF.
1472         s/[\n\r]+$//;
1473
1474         my $FTPCMD;
1475         my $FTPARG;
1476         my $full=$_;
1477         if($proto eq "imap") {
1478             # IMAP is different with its identifier first on the command line
1479             unless (m/^([^ ]+) ([^ ]+) (.*)/ ||
1480                     m/^([^ ]+) ([^ ]+)/) {
1481                 sendcontrol "$1 '$_': command not understood.\r\n";
1482                 last;
1483             }
1484             $cmdid=$1; # set the global variable
1485             $FTPCMD=$2;
1486             $FTPARG=$3;
1487         }
1488         elsif (m/^([A-Z]{3,4})(\s(.*))?$/i) {
1489             $FTPCMD=$1;
1490             $FTPARG=$3;
1491         }
1492         elsif($proto eq "smtp" && m/^[A-Z0-9+\/]{0,512}={0,2}$/i) {
1493             # SMTP long "commands" are base64 authentication data.
1494             $FTPCMD=$_;
1495             $FTPARG="";
1496         }
1497         else {
1498             sendcontrol "500 '$_': command not understood.\r\n";
1499             last;
1500         }
1501
1502         logmsg "< \"$full\"\n";
1503
1504         if($verbose) {
1505             print STDERR "IN: $full\n";
1506         }
1507
1508         my $delay = $delayreply{$FTPCMD};
1509         if($delay) {
1510             # just go sleep this many seconds!
1511             logmsg("Sleep for $delay seconds\n");
1512             my $twentieths = $delay * 20;
1513             while($twentieths--) {
1514                 select(undef, undef, undef, 0.05) unless($got_exit_signal);
1515             }
1516         }
1517
1518         my $text;
1519         $text = $customreply{$FTPCMD};
1520         my $fake = $text;
1521
1522         if($text && ($text ne "")) {
1523             if($customcount{$FTPCMD} && (!--$customcount{$FTPCMD})) {
1524                 # used enough number of times, now blank the customreply
1525                 $customreply{$FTPCMD}="";
1526             }
1527         }
1528         else {
1529             $text = $displaytext{$FTPCMD};
1530         }
1531         my $check;
1532         if($text && ($text ne "")) {
1533             if($cmdid && ($cmdid ne "")) {
1534                 sendcontrol "$cmdid$text\r\n";
1535             }
1536             else {
1537                 sendcontrol "$text\r\n";
1538             }
1539         }
1540         else {
1541             $check=1; # no response yet
1542         }
1543
1544         unless($fake && ($fake ne "")) {
1545             # only perform this if we're not faking a reply
1546             my $func = $commandfunc{$FTPCMD};
1547             if($func) {
1548                 &$func($FTPARG, $FTPCMD);
1549                 $check=0; # taken care of
1550             }
1551         }
1552
1553         if($check) {
1554             logmsg "$FTPCMD wasn't handled!\n";
1555             sendcontrol "500 $FTPCMD is not dealt with!\r\n";
1556         }
1557
1558     } # while(1)
1559     logmsg "====> Client disconnected\n";
1560
1561     if($serverlogslocked) {
1562         $serverlogslocked = 0;
1563         clear_advisor_read_lock($SERVERLOGS_LOCK);
1564     }
1565 }
1566
1567 killsockfilters($proto, $ipvnum, $idnum, $verbose);
1568 unlink($pidfile);
1569 if($serverlogslocked) {
1570     $serverlogslocked = 0;
1571     clear_advisor_read_lock($SERVERLOGS_LOCK);
1572 }
1573
1574 exit;