neo/curl/tests/ftpserver.pl

   1 #!/usr/bin/perl
   2 #***************************************************************************
   3 #                                  _   _ ____  _
   4 #  Project                     ___| | | |  _ \| |
   5 #                             / __| | | | |_) | |
   6 #                            | (__| |_| |  _ <| |___
   7 #                             \___|\___/|_| \_\_____|
   8 #
   9 # Copyright (C) 1998 - 2004, 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 # $Id: ftpserver.pl,v 1.40 2004/03/01 07:16:45 bagder Exp $
  23 ###########################################################################
  24
  25 # This is the FTP server designed for the curl test suite.
  26 #
  27 # It is meant to exercise curl, it is not meant to be a fully working
  28 # or even very standard compliant server.
  29 #
  30 # You may optionally specify port on the command line, otherwise it'll
  31 # default to port 8921.
  32 #
  33
  34 use Socket;
  35 use FileHandle;
  36
  37 use strict;
  38
  39 require "getpart.pm";
  40
  41 open(FTPLOG, ">log/ftpd.log") ||
  42     print STDERR "failed to open log file, runs without logging\n";
  43
  44 sub logmsg { print FTPLOG "$$: "; print FTPLOG @_; }
  45
  46 sub ftpmsg {
  47   # append to the server.input file
  48   open(INPUT, ">>log/server.input") ||
  49     logmsg "failed to open log/server.input\n";
  50
  51   INPUT->autoflush(1);
  52   print INPUT @_;
  53   close(INPUT);
  54
  55   # use this, open->print->close system only to make the file
  56   # open as little as possible, to make the test suite run
  57   # better on windows/cygwin
  58 }
  59
  60 my $verbose=0; # set to 1 for debugging
  61 my $retrweirdo=0;
  62 my $retrnosize=0;
  63 my $srcdir=".";
  64
  65 my $port = 8921; # just a default
  66 do {
  67     if($ARGV[0] eq "-v") {
  68         $verbose=1;
  69     }
  70     elsif($ARGV[0] eq "-s") {
  71         $srcdir=$ARGV[1];
  72         shift @ARGV;
  73     }
  74     elsif($ARGV[0] =~ /^(\d+)$/) {
  75         $port = $1;
  76     }
  77 } while(shift @ARGV);
  78
  79 my $proto = getprotobyname('tcp') || 6;
  80
  81 socket(Server, PF_INET, SOCK_STREAM, $proto)|| die "socket: $!";
  82 setsockopt(Server, SOL_SOCKET, SO_REUSEADDR,
  83            pack("l", 1)) || die "setsockopt: $!";
  84 bind(Server, sockaddr_in($port, INADDR_ANY))|| die "bind: $!";
  85 listen(Server,SOMAXCONN) || die "listen: $!";
  86
  87 #print "FTP server started on port $port\n";
  88
  89 open(PID, ">.ftp.pid");
  90 print PID $$;
  91 close(PID);
  92
  93 my $waitedpid = 0;
  94 my $paddr;
  95
  96 sub REAPER {
  97     $waitedpid = wait;
  98     $SIG{CHLD} = \&REAPER;  # loathe sysV
  99     logmsg "reaped $waitedpid" . ($? ? " with exit $?\n" : "\n");
 100 }
 101
 102 # USER is ok in fresh state
 103 my %commandok = (
 104                  'USER' => 'fresh',
 105                  'PASS' => 'passwd',
 106                  'PASV' => 'loggedin|twosock',
 107                  'EPSV' => 'loggedin|twosock',
 108                  'PORT' => 'loggedin|twosock',
 109                  'TYPE' => 'loggedin|twosock',
 110                  'LIST' => 'twosock',
 111                  'NLST' => 'twosock',
 112                  'RETR' => 'twosock',
 113                  'STOR' => 'twosock',
 114                  'APPE' => 'twosock',
 115                  'REST' => 'twosock',
 116                  'CWD'  => 'loggedin|twosock',
 117                  'SYST' => 'loggedin',
 118                  'SIZE' => 'loggedin|twosock',
 119                  'PWD'  => 'loggedin|twosock',
 120                  'MKD'  => 'loggedin|twosock',
 121                  'QUIT'  => 'loggedin|twosock',
 122                  'RNFR'  => 'loggedin|twosock',
 123                  'RNTO'  => 'loggedin|twosock',
 124                  'DELE' => 'loggedin|twosock',
 125                  'MDTM' => 'loggedin|twosock',
 126                  );
 127
 128 # initially, we're in 'fresh' state
 129 my %statechange = ( 'USER' => 'passwd',    # USER goes to passwd state
 130                     'PASS' => 'loggedin',  # PASS goes to loggedin state
 131                     'PORT' => 'twosock',   # PORT goes to twosock
 132                     'PASV' => 'twosock',   # PASV goes to twosock
 133                     'EPSV' => 'twosock',   # EPSV goes to twosock
 134                     );
 135
 136 # this text is shown before the function specified below is run
 137 my %displaytext = ('USER' => '331 We are happy you popped in!',
 138                    'PASS' => '230 Welcome you silly person',
 139                    'PORT' => '200 You said PORT - I say FINE',
 140                    'TYPE' => '200 I modify TYPE as you wanted',
 141                    'LIST' => '150 here comes a directory',
 142                    'NLST' => '150 here comes a directory',
 143                    'CWD'  => '250 CWD command successful.',
 144                    'SYST' => '215 UNIX Type: L8', # just fake something
 145                    'QUIT' => '221 bye bye baby', # just reply something
 146                    'PWD'  => '257 "/nowhere/anywhere" is current directory',
 147                    'MKD'  => '257 Created your requested directory',
 148                    'REST' => '350 Yeah yeah we set it there for you',
 149                    'DELE' => '200 OK OK OK whatever you say',
 150                    'RNFR' => '350 Received your order. Please provide more',
 151                    'RNTO' => '250 Ok, thanks. File renaming completed.',
 152                    );
 153
 154 # callback functions for certain commands
 155 my %commandfunc = ( 'PORT' => \&PORT_command,
 156                     'LIST' => \&LIST_command,
 157                     'NLST' => \&NLST_command,
 158                     'PASV' => \&PASV_command,
 159                     'EPSV' => \&PASV_command,
 160                     'RETR' => \&RETR_command,
 161                     'SIZE' => \&SIZE_command,
 162                     'REST' => \&REST_command,
 163                     'STOR' => \&STOR_command,
 164                     'APPE' => \&STOR_command, # append looks like upload
 165                     'MDTM' => \&MDTM_command,
 166                     );
 167
 168 my $rest=0;
 169 sub REST_command {
 170     $rest = $_[0];
 171     logmsg "Set REST position to $rest\n"
 172 }
 173
 174 sub LIST_command {
 175   #  print "150 ASCII data connection for /bin/ls (193.15.23.1,59196) (0 bytes)\r\n";
 176
 177 # this is a built-in fake-dir ;-)
 178 my @ftpdir=("total 20\r\n",
 179 "drwxr-xr-x   8 98       98           512 Oct 22 13:06 .\r\n",
 180 "drwxr-xr-x   8 98       98           512 Oct 22 13:06 ..\r\n",
 181 "drwxr-xr-x   2 98       98           512 May  2  1996 .NeXT\r\n",
 182 "-r--r--r--   1 0        1             35 Jul 16  1996 README\r\n",
 183 "lrwxrwxrwx   1 0        1              7 Dec  9  1999 bin -> usr/bin\r\n",
 184 "dr-xr-xr-x   2 0        1            512 Oct  1  1997 dev\r\n",
 185 "drwxrwxrwx   2 98       98           512 May 29 16:04 download.html\r\n",
 186 "dr-xr-xr-x   2 0        1            512 Nov 30  1995 etc\r\n",
 187 "drwxrwxrwx   2 98       1            512 Oct 30 14:33 pub\r\n",
 188 "dr-xr-xr-x   5 0        1            512 Oct  1  1997 usr\r\n");
 189
 190     logmsg "$$: pass data to child pid\n";
 191     for(@ftpdir) {
 192         print SOCK $_;
 193     }
 194     close(SOCK);
 195     logmsg "$$: done passing data to child pid\n";
 196
 197     print "226 ASCII transfer complete\r\n";
 198     return 0;
 199 }
 200
 201 sub NLST_command {
 202     my @ftpdir=("file", "with space", "fake", "..", " ..", "funny", "README");
 203     for(@ftpdir) {
 204         print SOCK "$_\r\n";
 205     }
 206     close(SOCK);
 207     print "226 ASCII transfer complete\r\n";
 208     return 0;
 209 }
 210
 211 sub MDTM_command {
 212     my $testno = $_[0];
 213
 214     loadtest("$srcdir/data/test$testno");
 215
 216     logmsg "MDTM $testno\n";
 217
 218     my @data = getpart("reply", "mdtm");
 219
 220     my $reply = $data[0];
 221     chomp $reply;
 222
 223     if($reply <0) {
 224         print "550 $testno: no such file.\r\n";
 225         logmsg "MDTM $testno: no such file\n";
 226     }
 227     elsif($reply) {
 228         print "$reply\r\n";
 229         logmsg "MDTM $testno returned $reply\n";
 230     }
 231     else {
 232         print "500 MDTM: no such command.\r\n";
 233         logmsg "MDTM: no such command\n";
 234     }
 235     return 0;
 236 }
 237
 238 sub SIZE_command {
 239     my $testno = $_[0];
 240
 241     loadtest("$srcdir/data/test$testno");
 242
 243     logmsg "SIZE number $testno\n";
 244
 245     my @data = getpart("reply", "size");
 246
 247     my $size = $data[0];
 248
 249     if($size) {
 250         if($size > -1) {
 251             print "213 $size\r\n";
 252             logmsg "SIZE $testno returned $size\n";
 253         }
 254         else {
 255             print "550 $testno: No such file or directory.\r\n";
 256             logmsg "SIZE $testno: no such file\n";
 257         }
 258     }
 259     else {
 260         $size=0;
 261         @data = getpart("reply", "data");
 262         for(@data) {
 263             $size += length($_);
 264         }
 265         if($size) {
 266             print "213 $size\r\n";
 267             logmsg "SIZE $testno returned $size\n";
 268         }
 269         else {
 270             print "550 $testno: No such file or directory.\r\n";
 271             logmsg "SIZE $testno: no such file\n";
 272         }
 273     }
 274     return 0;
 275 }
 276
 277 sub RETR_command {
 278     my $testno = $_[0];
 279
 280     logmsg "RETR test number $testno\n";
 281
 282     if($testno =~ /^verifiedserver$/) {
 283         # this is the secret command that verifies that this actually is
 284         # the curl test server
 285         my $response = "WE ROOLZ: $$\r\n";
 286         my $len = length($response);
 287         print "150 Binary junk ($len bytes).\r\n";
 288         print SOCK "WE ROOLZ: $$\r\n";
 289         close(SOCK);
 290         print "226 File transfer complete\r\n";
 291         if($verbose) {
 292             print STDERR "FTPD: We returned proof we are the test server\n";
 293         }
 294         logmsg "we returned proof that we are the test server\n";
 295         return 0;
 296     }
 297
 298     loadtest("$srcdir/data/test$testno");
 299
 300     my @data = getpart("reply", "data");
 301
 302     my $size=0;
 303     for(@data) {
 304         $size += length($_);
 305     }
 306
 307     if($size) {
 308
 309         if($rest) {
 310             # move read pointer forward
 311             $size -= $rest;
 312             logmsg "REST $rest was removed from size, makes $size left\n";
 313             $rest = 0; # reset REST offset again
 314         }
 315         if($retrweirdo) {
 316             print "150 Binary data connection for $testno () ($size bytes).\r\n",
 317             "226 File transfer complete\r\n";
 318             logmsg "150+226 in one shot!\n";
 319
 320             for(@data) {
 321                 my $send = $_;
 322                 print SOCK $send;
 323             }
 324             close(SOCK);
 325             $retrweirdo=0; # switch off the weirdo again!
 326         }
 327         else {
 328             my $sz = "($size bytes)";
 329             if($retrnosize) {
 330                 $sz = "size?";
 331             }
 332
 333             print "150 Binary data connection for $testno () $sz.\r\n";
 334             logmsg "150 Binary data connection for $testno () $sz.\n";
 335
 336             for(@data) {
 337                 my $send = $_;
 338                 print SOCK $send;
 339             }
 340             close(SOCK);
 341
 342             print "226 File transfer complete\r\n";
 343         }
 344     }
 345     else {
 346         print "550 $testno: No such file or directory.\r\n";
 347         logmsg "550 $testno: no such file\n";
 348     }
 349     return 0;
 350 }
 351
 352 sub STOR_command {
 353     my $testno=$_[0];
 354
 355     my $filename = "log/upload.$testno";
 356
 357     logmsg "STOR test number $testno in $filename\n";
 358
 359     print "125 Gimme gimme gimme!\r\n";
 360
 361     open(FILE, ">$filename") ||
 362         return 0; # failed to open output
 363
 364     my $line;
 365     my $ulsize=0;
 366     while (defined($line = <SOCK>)) {
 367         $ulsize += length($line);
 368         print FILE $line;
 369     }
 370     close(FILE);
 371     close(SOCK);
 372
 373     logmsg "received $ulsize bytes upload\n";
 374
 375     print "226 File transfer complete\r\n";
 376     return 0;
 377 }
 378
 379 my $pasvport=9000;
 380 sub PASV_command {
 381     my ($arg, $cmd)=@_;
 382
 383     socket(Server2, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
 384     setsockopt(Server2, SOL_SOCKET, SO_REUSEADDR,
 385                pack("l", 1)) || die "setsockopt: $!";
 386
 387     my $ok=0;
 388
 389     $pasvport++; # don't reuse the previous
 390     for(1 .. 10) {
 391         if($pasvport > 65535) {
 392             $pasvport = 1025;
 393         }
 394         if(bind(Server2, sockaddr_in($pasvport, INADDR_ANY))) {
 395             $ok=1;
 396             last;
 397         }
 398         $pasvport+= 3; # try another port please
 399     }
 400     if(!$ok) {
 401         print "500 no free ports!\r\n";
 402         logmsg "couldn't find free port\n";
 403         return 0;
 404     }
 405     listen(Server2,SOMAXCONN) || die "listen: $!";
 406
 407     if($cmd ne "EPSV") {
 408         # PASV reply
 409         logmsg "replying to a $cmd command\n";
 410         printf("227 Entering Passive Mode (127,0,0,1,%d,%d)\n",
 411                ($pasvport/256), ($pasvport%256));
 412     }
 413     else {
 414         # EPSV reply
 415         logmsg "replying to a $cmd command\n";
 416         printf("229 Entering Passive Mode (|||%d|)\n", $pasvport);
 417     }
 418
 419     my $paddr = accept(SOCK, Server2);
 420     my($iport,$iaddr) = sockaddr_in($paddr);
 421     my $name = gethostbyaddr($iaddr,AF_INET);
 422
 423     close(Server2); # close the listener when its served its purpose!
 424
 425     logmsg "$$: data connection from $name [", inet_ntoa($iaddr), "] at port $iport\n";
 426
 427     return;
 428 }
 429
 430
 431 sub PORT_command {
 432     my $arg = $_[0];
 433
 434     if($arg !~ /(\d+),(\d+),(\d+),(\d+),(\d+),(\d+)/) {
 435         logmsg "bad PORT-line: $arg\n";
 436         print "500 silly you, go away\r\n";
 437         return 0;
 438     }
 439     my $iaddr = inet_aton("$1.$2.$3.$4");
 440
 441     my $port = ($5<<8)+$6;
 442
 443     if(!$port || $port > 65535) {
 444         print STDERR "very illegal PORT number: $port\n";
 445         return 1;
 446     }
 447
 448     my $paddr = sockaddr_in($port, $iaddr);
 449     my $proto   = getprotobyname('tcp') || 6;
 450
 451     socket(SOCK, PF_INET, SOCK_STREAM, $proto) || die "major failure";
 452     connect(SOCK, $paddr)    || return 1;
 453
 454     return \&SOCK;
 455 }
 456
 457 $SIG{CHLD} = \&REAPER;
 458
 459 my %customreply;
 460 my %customcount;
 461 my %delayreply;
 462 sub customize {
 463     undef %customreply;
 464     open(CUSTOM, "<log/ftpserver.cmd") ||
 465         return 1;
 466
 467     logmsg "FTPD: Getting commands from log/ftpserver.cmd\n";
 468
 469     while(<CUSTOM>) {
 470         if($_ =~ /REPLY ([A-Z]+) (.*)/) {
 471             $customreply{$1}=$2;
 472         }
 473         if($_ =~ /COUNT ([A-Z]+) (.*)/) {
 474             # we blank the customreply for this command when having
 475             # been used this number of times
 476             $customcount{$1}=$2;
 477         }
 478         elsif($_ =~ /DELAY ([A-Z]+) (\d*)/) {
 479             $delayreply{$1}=$2;
 480         }
 481         elsif($_ =~ /RETRWEIRDO/) {
 482             print "instructed to use RETRWEIRDO\n";
 483             $retrweirdo=1;
 484         }
 485         elsif($_ =~ /RETRNOSIZE/) {
 486             print "instructed to use RETRNOSIZE\n";
 487             $retrnosize=1;
 488         }
 489     }
 490     close(CUSTOM);
 491 }
 492
 493 my @welcome=(
 494             '220-        _   _ ____  _     '."\r\n",
 495             '220-    ___| | | |  _ \| |    '."\r\n",
 496             '220-   / __| | | | |_) | |    '."\r\n",
 497             '220-  | (__| |_| |  _ <| |___ '."\r\n",
 498             '220    \___|\___/|_| \_\_____|'."\r\n");
 499
 500 for ( $waitedpid = 0;
 501       ($paddr = accept(Client,Server)) || $waitedpid;
 502         $waitedpid = 0, close Client)
 503 {
 504     next if $waitedpid and not $paddr;
 505     my($port,$iaddr) = sockaddr_in($paddr);
 506     my $name = gethostbyaddr($iaddr,AF_INET);
 507
 508     # flush data:
 509     $| = 1;
 510
 511     logmsg "connection from $name [", inet_ntoa($iaddr), "] at port $port\n";
 512
 513     open(STDIN,  "<&Client")   || die "can't dup client to stdin";
 514     open(STDOUT, ">&Client")   || die "can't dup client to stdout";
 515
 516     FTPLOG->autoflush(1);
 517     &customize(); # read test control instructions
 518
 519     print @welcome;
 520     if($verbose) {
 521         for(@welcome) {
 522             print STDERR "OUT: $_";
 523         }
 524     }
 525     my $state="fresh";
 526
 527     while(1) {
 528
 529         last unless defined ($_ = <STDIN>);
 530
 531         ftpmsg $_;
 532
 533         # Remove trailing CRLF.
 534         s/[\n\r]+$//;
 535
 536         unless (m/^([A-Z]{3,4})\s?(.*)/i) {
 537             print "500 '$_': command not understood.\r\n";
 538             logmsg "unknown crap received, bailing out hard\n";
 539             last;
 540         }
 541         my $FTPCMD=$1;
 542         my $FTPARG=$2;
 543         my $full=$_;
 544
 545         logmsg "GOT: ($1) $_\n";
 546
 547         if($verbose) {
 548             print STDERR "IN: $full\n";
 549         }
 550
 551         my $ok = $commandok{$FTPCMD};
 552         if($ok !~ /$state/) {
 553             print "500 $FTPCMD not OK in state: $state!\r\n";
 554             next;
 555         }
 556
 557         my $newstate=$statechange{$FTPCMD};
 558         if($newstate eq "") {
 559             # remain in the same state
 560         }
 561         else {
 562             $state = $newstate;
 563         }
 564
 565         my $delay = $delayreply{$FTPCMD};
 566         if($delay) {
 567             # just go sleep this many seconds!
 568             sleep($delay);
 569         }
 570
 571         my $text;
 572         $text = $customreply{$FTPCMD};
 573         my $fake = $text;
 574         if($text eq "") {
 575             $text = $displaytext{$FTPCMD};
 576         }
 577         else {
 578             if($customcount{$FTPCMD} && (!--$customcount{$FTPCMD})) {
 579                 # used enough number of times, now blank the customreply
 580                 $customreply{$FTPCMD}="";
 581             }
 582             logmsg "$FTPCMD made to send '$text'\n";
 583         }
 584         if($text) {
 585             print "$text\r\n";
 586         }
 587
 588         if($fake eq "") {
 589             # only perform this if we're not faking a reply
 590             # see if the new state is a function caller.
 591             my $func = $commandfunc{$FTPCMD};
 592             if($func) {
 593                 # it is!
 594                 \&$func($FTPARG, $FTPCMD);
 595             }
 596         }
 597
 598         logmsg "set to state $state\n";
 599
 600     } # while(1)
 601     close(Client);
 602 }