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