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