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