ftpserver.pl 24 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909
  1. #!/usr/bin/env perl
  2. #***************************************************************************
  3. # _ _ ____ _
  4. # Project ___| | | | _ \| |
  5. # / __| | | | |_) | |
  6. # | (__| |_| | _ <| |___
  7. # \___|\___/|_| \_\_____|
  8. #
  9. # Copyright (C) 1998 - 2008, Daniel Stenberg, <[email protected]>, et al.
  10. #
  11. # This software is licensed as described in the file COPYING, which
  12. # you should have received as part of this distribution. The terms
  13. # are also available at http://curl.haxx.se/docs/copyright.html.
  14. #
  15. # You may opt to use, copy, modify, merge, publish, distribute and/or sell
  16. # copies of the Software, and permit persons to whom the Software is
  17. # furnished to do so, under the terms of the COPYING file.
  18. #
  19. # This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY
  20. # KIND, either express or implied.
  21. #
  22. # $Id$
  23. ###########################################################################
  24. # This is the FTP server designed for the curl test suite.
  25. #
  26. # It is meant to exercise curl, it is not meant to be a fully working
  27. # or even very standard compliant server.
  28. #
  29. # You may optionally specify port on the command line, otherwise it'll
  30. # default to port 8921.
  31. #
  32. # All socket/network/TCP related stuff is done by the 'sockfilt' program.
  33. #
  34. use strict;
  35. use IPC::Open2;
  36. #use Time::HiRes qw( gettimeofday ); # not available in perl 5.6
  37. require "getpart.pm";
  38. require "ftp.pm";
  39. my $ftpdnum="";
  40. # open and close each time to allow removal at any time
  41. sub logmsg {
  42. # if later than perl 5.6 is used
  43. # my ($seconds, $microseconds) = gettimeofday;
  44. my $seconds = time();
  45. my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
  46. localtime($seconds);
  47. open(FTPLOG, ">>log/ftpd$ftpdnum.log");
  48. printf FTPLOG ("%02d:%02d:%02d ", $hour, $min, $sec);
  49. print FTPLOG @_;
  50. close(FTPLOG);
  51. }
  52. sub ftpmsg {
  53. # append to the server.input file
  54. open(INPUT, ">>log/server$ftpdnum.input") ||
  55. logmsg "failed to open log/server$ftpdnum.input\n";
  56. print INPUT @_;
  57. close(INPUT);
  58. # use this, open->print->close system only to make the file
  59. # open as little as possible, to make the test suite run
  60. # better on windows/cygwin
  61. }
  62. my $verbose=0; # set to 1 for debugging
  63. my $pasvbadip=0;
  64. my $retrweirdo=0;
  65. my $retrnosize=0;
  66. my $srcdir=".";
  67. my $nosave=0;
  68. my $controldelay=0; # set to 1 to delay the control connect data sending to
  69. # test that curl deals with that nicely
  70. my $slavepid; # for the DATA connection sockfilt slave process
  71. my $ipv6;
  72. my $ext; # append to log/pid file names
  73. my $grok_eprt;
  74. my $port = 8921; # just a default
  75. my $listenaddr = "127.0.0.1"; # just a default
  76. my $pidfile = ".ftpd.pid"; # a default, use --pidfile
  77. my $SERVERLOGS_LOCK="log/serverlogs.lock"; # server logs advisor read lock
  78. do {
  79. if($ARGV[0] eq "-v") {
  80. $verbose=1;
  81. }
  82. elsif($ARGV[0] eq "-s") {
  83. $srcdir=$ARGV[1];
  84. shift @ARGV;
  85. }
  86. elsif($ARGV[0] eq "--id") {
  87. $ftpdnum=$ARGV[1];
  88. shift @ARGV;
  89. }
  90. elsif($ARGV[0] eq "--pidfile") {
  91. $pidfile=$ARGV[1];
  92. shift @ARGV;
  93. }
  94. elsif($ARGV[0] eq "--ipv6") {
  95. $ipv6="--ipv6";
  96. $ext="ipv6";
  97. $grok_eprt = 1;
  98. }
  99. elsif($ARGV[0] eq "--port") {
  100. $port = $ARGV[1];
  101. shift @ARGV;
  102. }
  103. elsif($ARGV[0] eq "--addr") {
  104. $listenaddr = $ARGV[1];
  105. $listenaddr =~ s/^\[(.*)\]$/\1/;
  106. shift @ARGV;
  107. }
  108. } while(shift @ARGV);
  109. sub catch_zap {
  110. my $signame = shift;
  111. print STDERR "ftpserver.pl received SIG$signame, exiting\n";
  112. ftpkillslaves(1);
  113. clear_advisor_read_lock($SERVERLOGS_LOCK);
  114. die "Somebody sent me a SIG$signame";
  115. }
  116. $SIG{INT} = \&catch_zap;
  117. $SIG{KILL} = \&catch_zap;
  118. my $sfpid;
  119. local(*SFREAD, *SFWRITE);
  120. sub sysread_or_die {
  121. my $FH = shift;
  122. my $scalar = shift;
  123. my $length = shift;
  124. my $fcaller;
  125. my $lcaller;
  126. my $result;
  127. $result = sysread($$FH, $$scalar, $length);
  128. if(not defined $result) {
  129. ($fcaller, $lcaller) = (caller)[1,2];
  130. logmsg "Failed to read input\n";
  131. logmsg "Error: ftp$ftpdnum$ext sysread error: $!\n";
  132. kill(9, $sfpid);
  133. waitpid($sfpid, 0);
  134. clear_advisor_read_lock($SERVERLOGS_LOCK);
  135. die "Died in sysread_or_die() at $fcaller " .
  136. "line $lcaller. ftp$ftpdnum$ext sysread error: $!\n";
  137. }
  138. elsif($result == 0) {
  139. ($fcaller, $lcaller) = (caller)[1,2];
  140. logmsg "Failed to read input\n";
  141. logmsg "Error: ftp$ftpdnum$ext read zero\n";
  142. kill(9, $sfpid);
  143. waitpid($sfpid, 0);
  144. clear_advisor_read_lock($SERVERLOGS_LOCK);
  145. die "Died in sysread_or_die() at $fcaller " .
  146. "line $lcaller. ftp$ftpdnum$ext read zero\n";
  147. }
  148. return $result;
  149. }
  150. sub startsf {
  151. my $cmd="./server/sockfilt --port $port --logfile log/sockctrl$ftpdnum$ext.log --pidfile .sockfilt$ftpdnum$ext.pid $ipv6";
  152. $sfpid = open2(*SFREAD, *SFWRITE, $cmd);
  153. print STDERR "$cmd\n" if($verbose);
  154. print SFWRITE "PING\n";
  155. my $pong;
  156. sysread SFREAD, $pong, 5;
  157. if($pong !~ /^PONG/) {
  158. logmsg "Failed sockfilt command: $cmd\n";
  159. kill(9, $sfpid);
  160. waitpid($sfpid, 0);
  161. clear_advisor_read_lock($SERVERLOGS_LOCK);
  162. die "Failed to start sockfilt!";
  163. }
  164. }
  165. # remove the file here so that if startsf() fails, it is very noticeable
  166. unlink($pidfile);
  167. startsf();
  168. logmsg sprintf("FTP server listens on port IPv%d/$port\n", $ipv6?6:4);
  169. open(PID, ">$pidfile");
  170. print PID $$."\n";
  171. close(PID);
  172. logmsg("logged pid $$ in $pidfile\n");
  173. sub sockfilt {
  174. my $l;
  175. foreach $l (@_) {
  176. printf SFWRITE "DATA\n%04x\n", length($l);
  177. print SFWRITE $l;
  178. }
  179. }
  180. # Send data to the client on the control stream, which happens to be plain
  181. # stdout.
  182. sub sendcontrol {
  183. if(!$controldelay) {
  184. # spit it all out at once
  185. sockfilt @_;
  186. }
  187. else {
  188. my $a = join("", @_);
  189. my @a = split("", $a);
  190. for(@a) {
  191. sockfilt $_;
  192. select(undef, undef, undef, 0.01);
  193. }
  194. }
  195. my $log;
  196. foreach $log (@_) {
  197. my $l = $log;
  198. $l =~ s/[\r\n]//g;
  199. logmsg "> \"$l\"\n";
  200. }
  201. }
  202. # Send data to the client on the data stream
  203. sub senddata {
  204. my $l;
  205. foreach $l (@_) {
  206. printf DWRITE "DATA\n%04x\n", length($l);
  207. print DWRITE $l;
  208. }
  209. }
  210. # this text is shown before the function specified below is run
  211. my %displaytext = ('USER' => '331 We are happy you popped in!',
  212. 'PASS' => '230 Welcome you silly person',
  213. 'PORT' => '200 You said PORT - I say FINE',
  214. 'TYPE' => '200 I modify TYPE as you wanted',
  215. 'LIST' => '150 here comes a directory',
  216. 'NLST' => '150 here comes a directory',
  217. 'CWD' => '250 CWD command successful.',
  218. 'SYST' => '215 UNIX Type: L8', # just fake something
  219. 'QUIT' => '221 bye bye baby', # just reply something
  220. 'PWD' => '257 "/nowhere/anywhere" is current directory',
  221. 'MKD' => '257 Created your requested directory',
  222. 'REST' => '350 Yeah yeah we set it there for you',
  223. 'DELE' => '200 OK OK OK whatever you say',
  224. 'RNFR' => '350 Received your order. Please provide more',
  225. 'RNTO' => '250 Ok, thanks. File renaming completed.',
  226. 'NOOP' => '200 Yes, I\'m very good at doing nothing.',
  227. 'PBSZ' => '500 PBSZ not implemented',
  228. 'PROT' => '500 PROT not implemented',
  229. );
  230. # callback functions for certain commands
  231. my %commandfunc = ( 'PORT' => \&PORT_command,
  232. 'EPRT' => \&PORT_command,
  233. 'LIST' => \&LIST_command,
  234. 'NLST' => \&NLST_command,
  235. 'PASV' => \&PASV_command,
  236. 'EPSV' => \&PASV_command,
  237. 'RETR' => \&RETR_command,
  238. 'SIZE' => \&SIZE_command,
  239. 'REST' => \&REST_command,
  240. 'STOR' => \&STOR_command,
  241. 'APPE' => \&STOR_command, # append looks like upload
  242. 'MDTM' => \&MDTM_command,
  243. );
  244. sub close_dataconn {
  245. my ($closed)=@_; # non-zero if already disconnected
  246. if(!$closed) {
  247. logmsg "* disconnect data connection\n";
  248. print DWRITE "DISC\n";
  249. my $i;
  250. sysread DREAD, $i, 5;
  251. }
  252. else {
  253. logmsg "data connection already disconnected\n";
  254. }
  255. logmsg "=====> Closed data connection\n";
  256. logmsg "* quit sockfilt for data (pid $slavepid)\n";
  257. print DWRITE "QUIT\n";
  258. waitpid $slavepid, 0;
  259. $slavepid=0;
  260. }
  261. my $rest=0;
  262. sub REST_command {
  263. $rest = $_[0];
  264. logmsg "Set REST position to $rest\n"
  265. }
  266. sub LIST_command {
  267. # print "150 ASCII data connection for /bin/ls (193.15.23.1,59196) (0 bytes)\r\n";
  268. # this is a built-in fake-dir ;-)
  269. my @ftpdir=("total 20\r\n",
  270. "drwxr-xr-x 8 98 98 512 Oct 22 13:06 .\r\n",
  271. "drwxr-xr-x 8 98 98 512 Oct 22 13:06 ..\r\n",
  272. "drwxr-xr-x 2 98 98 512 May 2 1996 .NeXT\r\n",
  273. "-r--r--r-- 1 0 1 35 Jul 16 1996 README\r\n",
  274. "lrwxrwxrwx 1 0 1 7 Dec 9 1999 bin -> usr/bin\r\n",
  275. "dr-xr-xr-x 2 0 1 512 Oct 1 1997 dev\r\n",
  276. "drwxrwxrwx 2 98 98 512 May 29 16:04 download.html\r\n",
  277. "dr-xr-xr-x 2 0 1 512 Nov 30 1995 etc\r\n",
  278. "drwxrwxrwx 2 98 1 512 Oct 30 14:33 pub\r\n",
  279. "dr-xr-xr-x 5 0 1 512 Oct 1 1997 usr\r\n");
  280. logmsg "pass LIST data on data connection\n";
  281. for(@ftpdir) {
  282. senddata $_;
  283. }
  284. close_dataconn(0);
  285. sendcontrol "226 ASCII transfer complete\r\n";
  286. return 0;
  287. }
  288. sub NLST_command {
  289. my @ftpdir=("file", "with space", "fake", "..", " ..", "funny", "README");
  290. logmsg "pass NLST data on data connection\n";
  291. for(@ftpdir) {
  292. senddata "$_\r\n";
  293. }
  294. close_dataconn(0);
  295. sendcontrol "226 ASCII transfer complete\r\n";
  296. return 0;
  297. }
  298. sub MDTM_command {
  299. my $testno = $_[0];
  300. my $testpart = "";
  301. if ($testno > 10000) {
  302. $testpart = $testno % 10000;
  303. $testno = int($testno / 10000);
  304. }
  305. loadtest("$srcdir/data/test$testno");
  306. my @data = getpart("reply", "mdtm");
  307. my $reply = $data[0];
  308. chomp $reply;
  309. if($reply <0) {
  310. sendcontrol "550 $testno: no such file.\r\n";
  311. }
  312. elsif($reply) {
  313. sendcontrol "$reply\r\n";
  314. }
  315. else {
  316. sendcontrol "500 MDTM: no such command.\r\n";
  317. }
  318. return 0;
  319. }
  320. sub SIZE_command {
  321. my $testno = $_[0];
  322. my $testpart = "";
  323. if ($testno > 10000) {
  324. $testpart = $testno % 10000;
  325. $testno = int($testno / 10000);
  326. }
  327. loadtest("$srcdir/data/test$testno");
  328. if($testno eq "verifiedserver") {
  329. my $response = "WE ROOLZ: $$\r\n";
  330. my $size = length($response);
  331. sendcontrol "213 $size\r\n";
  332. return 0;
  333. }
  334. my @data = getpart("reply", "size");
  335. my $size = $data[0];
  336. if($size) {
  337. if($size > -1) {
  338. sendcontrol "213 $size\r\n";
  339. }
  340. else {
  341. sendcontrol "550 $testno: No such file or directory.\r\n";
  342. }
  343. }
  344. else {
  345. $size=0;
  346. @data = getpart("reply", "data$testpart");
  347. for(@data) {
  348. $size += length($_);
  349. }
  350. if($size) {
  351. sendcontrol "213 $size\r\n";
  352. }
  353. else {
  354. sendcontrol "550 $testno: No such file or directory.\r\n";
  355. }
  356. }
  357. return 0;
  358. }
  359. sub RETR_command {
  360. my ($testno) = @_;
  361. if($testno =~ /^verifiedserver$/) {
  362. # this is the secret command that verifies that this actually is
  363. # the curl test server
  364. my $response = "WE ROOLZ: $$\r\n";
  365. my $len = length($response);
  366. sendcontrol "150 Binary junk ($len bytes).\r\n";
  367. senddata "WE ROOLZ: $$\r\n";
  368. close_dataconn(0);
  369. sendcontrol "226 File transfer complete\r\n";
  370. if($verbose) {
  371. print STDERR "FTPD: We returned proof we are the test server\n";
  372. }
  373. return 0;
  374. }
  375. $testno =~ s/^([^0-9]*)//;
  376. my $testpart = "";
  377. if ($testno > 10000) {
  378. $testpart = $testno % 10000;
  379. $testno = int($testno / 10000);
  380. }
  381. loadtest("$srcdir/data/test$testno");
  382. my @data = getpart("reply", "data$testpart");
  383. my $size=0;
  384. for(@data) {
  385. $size += length($_);
  386. }
  387. my %hash = getpartattr("reply", "data$testpart");
  388. if($size || $hash{'sendzero'}) {
  389. if($rest) {
  390. # move read pointer forward
  391. $size -= $rest;
  392. logmsg "REST $rest was removed from size, makes $size left\n";
  393. $rest = 0; # reset REST offset again
  394. }
  395. if($retrweirdo) {
  396. sendcontrol "150 Binary data connection for $testno () ($size bytes).\r\n",
  397. "226 File transfer complete\r\n";
  398. for(@data) {
  399. my $send = $_;
  400. senddata $send;
  401. }
  402. close_dataconn(0);
  403. $retrweirdo=0; # switch off the weirdo again!
  404. }
  405. else {
  406. my $sz = "($size bytes)";
  407. if($retrnosize) {
  408. $sz = "size?";
  409. }
  410. sendcontrol "150 Binary data connection for $testno () $sz.\r\n";
  411. for(@data) {
  412. my $send = $_;
  413. senddata $send;
  414. }
  415. close_dataconn(0);
  416. sendcontrol "226 File transfer complete\r\n";
  417. }
  418. }
  419. else {
  420. sendcontrol "550 $testno: No such file or directory.\r\n";
  421. }
  422. return 0;
  423. }
  424. sub STOR_command {
  425. my $testno=$_[0];
  426. my $filename = "log/upload.$testno";
  427. logmsg "STOR test number $testno in $filename\n";
  428. sendcontrol "125 Gimme gimme gimme!\r\n";
  429. open(FILE, ">$filename") ||
  430. return 0; # failed to open output
  431. my $line;
  432. my $ulsize=0;
  433. my $disc=0;
  434. while (5 == (sysread DREAD, $line, 5)) {
  435. if($line eq "DATA\n") {
  436. my $i;
  437. sysread DREAD, $i, 5;
  438. #print STDERR " GOT: $i";
  439. my $size = hex($i);
  440. sysread DREAD, $line, $size;
  441. #print STDERR " GOT: $size bytes\n";
  442. $ulsize += $size;
  443. print FILE $line if(!$nosave);
  444. logmsg "> Appending $size bytes to file\n";
  445. }
  446. elsif($line eq "DISC\n") {
  447. # disconnect!
  448. $disc=1;
  449. last;
  450. }
  451. else {
  452. logmsg "No support for: $line";
  453. last;
  454. }
  455. }
  456. if($nosave) {
  457. print FILE "$ulsize bytes would've been stored here\n";
  458. }
  459. close(FILE);
  460. close_dataconn($disc);
  461. logmsg "received $ulsize bytes upload\n";
  462. sendcontrol "226 File transfer complete\r\n";
  463. return 0;
  464. }
  465. sub PASV_command {
  466. my ($arg, $cmd)=@_;
  467. my $pasvport;
  468. my $pidf=".sockdata$ftpdnum$ext.pid";
  469. my $prev = checkserver($pidf);
  470. if($prev > 0) {
  471. print "kill existing server: $prev\n" if($verbose);
  472. kill(9, $prev);
  473. waitpid($prev, 0);
  474. }
  475. # We fire up a new sockfilt to do the data transfer for us.
  476. $slavepid = open2(\*DREAD, \*DWRITE,
  477. "./server/sockfilt --port 0 --logfile log/sockdata$ftpdnum$ext.log --pidfile $pidf $ipv6");
  478. print DWRITE "PING\n";
  479. my $pong;
  480. sysread_or_die(\*DREAD, \$pong, 5);
  481. if($pong !~ /^PONG/) {
  482. kill(9, $slavepid);
  483. waitpid($slavepid, 0);
  484. sendcontrol "500 no free ports!\r\n";
  485. logmsg "failed to run sockfilt for data connection\n";
  486. return 0;
  487. }
  488. logmsg "Run sockfilt for data on pid $slavepid\n";
  489. # Find out what port we listen on
  490. my $i;
  491. print DWRITE "PORT\n";
  492. # READ the response code
  493. sysread_or_die(\*DREAD, \$i, 5);
  494. # READ the response size
  495. sysread_or_die(\*DREAD, \$i, 5);
  496. my $size = hex($i);
  497. # READ the response data
  498. sysread_or_die(\*DREAD, \$i, $size);
  499. # The data is in the format
  500. # IPvX/NNN
  501. if($i =~ /IPv(\d)\/(\d+)/) {
  502. # FIX: deal with IP protocol version
  503. $pasvport = $2;
  504. }
  505. if($cmd ne "EPSV") {
  506. # PASV reply
  507. my $p=$listenaddr;
  508. $p =~ s/\./,/g;
  509. if($pasvbadip) {
  510. $p="1,2,3,4";
  511. }
  512. sendcontrol sprintf("227 Entering Passive Mode ($p,%d,%d)\n",
  513. ($pasvport/256), ($pasvport%256));
  514. }
  515. else {
  516. # EPSV reply
  517. sendcontrol sprintf("229 Entering Passive Mode (|||%d|)\n", $pasvport);
  518. }
  519. eval {
  520. local $SIG{ALRM} = sub { die "alarm\n" };
  521. # assume swift operations unless explicitly slow
  522. alarm ($controldelay?20:10);
  523. # Wait for 'CNCT'
  524. my $input;
  525. while(sysread(DREAD, $input, 5)) {
  526. if($input !~ /^CNCT/) {
  527. # we wait for a connected client
  528. logmsg "Odd, we got $input from client\n";
  529. next;
  530. }
  531. logmsg "====> Client DATA connect\n";
  532. last;
  533. }
  534. alarm 0;
  535. };
  536. if ($@) {
  537. # timed out
  538. print DWRITE "QUIT\n";
  539. waitpid $slavepid, 0;
  540. logmsg "accept failed\n";
  541. $slavepid=0;
  542. return;
  543. }
  544. else {
  545. logmsg "data connection setup on port $pasvport\n";
  546. }
  547. return;
  548. }
  549. # Support both PORT and EPRT here. Consider LPRT too.
  550. sub PORT_command {
  551. my ($arg, $cmd) = @_;
  552. my $port;
  553. my $addr;
  554. # We always ignore the given IP and use localhost.
  555. if($cmd eq "PORT") {
  556. if($arg !~ /(\d+),(\d+),(\d+),(\d+),(\d+),(\d+)/) {
  557. logmsg "bad PORT-line: $arg\n";
  558. sendcontrol "500 silly you, go away\r\n";
  559. return 0;
  560. }
  561. $port = ($5<<8)+$6;
  562. $addr = "$1.$2.$3.$4";
  563. }
  564. # EPRT |2|::1|49706|
  565. elsif(($cmd eq "EPRT") && ($grok_eprt)) {
  566. if($arg !~ /(\d+)\|([^\|]+)\|(\d+)/) {
  567. sendcontrol "500 silly you, go away\r\n";
  568. return 0;
  569. }
  570. sendcontrol "200 Thanks for dropping by. We contact you later\r\n";
  571. $port = $3;
  572. $addr = $2;
  573. }
  574. else {
  575. sendcontrol "500 we don't like $cmd now\r\n";
  576. return 0;
  577. }
  578. if(!$port || $port > 65535) {
  579. print STDERR "very illegal PORT number: $port\n";
  580. return 1;
  581. }
  582. # We fire up a new sockfilt to do the data transfer for us.
  583. # FIX: make it use IPv6 if need be
  584. my $filtcmd="./server/sockfilt --connect $port --addr $addr --logfile log/sockdata$ftpdnum$ext.log --pidfile .sockdata$ftpdnum$ext.pid $ipv6";
  585. $slavepid = open2(\*DREAD, \*DWRITE, $filtcmd);
  586. print STDERR "$filtcmd\n" if($verbose);
  587. print DWRITE "PING\n";
  588. my $pong;
  589. sysread DREAD, $pong, 5;
  590. if($pong !~ /^PONG/) {
  591. logmsg "Failed sockfilt for data connection\n";
  592. kill(9, $slavepid);
  593. waitpid($slavepid, 0);
  594. }
  595. logmsg "====> Client DATA connect to port $port\n";
  596. return;
  597. }
  598. my %customreply;
  599. my %customcount;
  600. my %delayreply;
  601. sub customize {
  602. $nosave = 0; # default is to save as normal
  603. $controldelay = 0; # default is no delaying the responses
  604. $retrweirdo = 0;
  605. $retrnosize = 0;
  606. $pasvbadip = 0;
  607. $nosave = 0;
  608. %customreply = ();
  609. %customcount = ();
  610. %delayreply = ();
  611. open(CUSTOM, "<log/ftpserver.cmd") ||
  612. return 1;
  613. logmsg "FTPD: Getting commands from log/ftpserver.cmd\n";
  614. while(<CUSTOM>) {
  615. if($_ =~ /REPLY ([A-Z]+) (.*)/) {
  616. $customreply{$1}=eval "qq{$2}";
  617. logmsg "FTPD: set custom reply for $1\n";
  618. }
  619. if($_ =~ /COUNT ([A-Z]+) (.*)/) {
  620. # we blank the customreply for this command when having
  621. # been used this number of times
  622. $customcount{$1}=$2;
  623. logmsg "FTPD: blank custom reply for $1 after $2 uses\n";
  624. }
  625. elsif($_ =~ /DELAY ([A-Z]+) (\d*)/) {
  626. $delayreply{$1}=$2;
  627. logmsg "FTPD: delay reply for $1 with $2 seconds\n";
  628. }
  629. elsif($_ =~ /SLOWDOWN/) {
  630. $controldelay=1;
  631. logmsg "FTPD: send response with 0.1 sec delay between each byte\n";
  632. }
  633. elsif($_ =~ /RETRWEIRDO/) {
  634. logmsg "FTPD: instructed to use RETRWEIRDO\n";
  635. $retrweirdo=1;
  636. }
  637. elsif($_ =~ /RETRNOSIZE/) {
  638. logmsg "FTPD: instructed to use RETRNOSIZE\n";
  639. $retrnosize=1;
  640. }
  641. elsif($_ =~ /PASVBADIP/) {
  642. logmsg "FTPD: instructed to use PASVBADIP\n";
  643. $pasvbadip=1;
  644. }
  645. elsif($_ =~ /NOSAVE/) {
  646. # don't actually store the file we upload - to be used when
  647. # uploading insanely huge amounts
  648. $nosave = 1;
  649. logmsg "FTPD: NOSAVE prevents saving of uploaded data\n";
  650. }
  651. }
  652. close(CUSTOM);
  653. }
  654. my @welcome=(
  655. '220- _ _ ____ _ '."\r\n",
  656. '220- ___| | | | _ \| | '."\r\n",
  657. '220- / __| | | | |_) | | '."\r\n",
  658. '220- | (__| |_| | _ <| |___ '."\r\n",
  659. '220 \___|\___/|_| \_\_____|'."\r\n");
  660. while(1) {
  661. #
  662. # We read 'sockfilt' commands.
  663. #
  664. my $input;
  665. logmsg "Awaiting input\n";
  666. sysread_or_die(\*SFREAD, \$input, 5);
  667. if($input !~ /^CNCT/) {
  668. # we wait for a connected client
  669. logmsg "sockfilt said: $input";
  670. next;
  671. }
  672. logmsg "====> Client connect\n";
  673. set_advisor_read_lock($SERVERLOGS_LOCK);
  674. # flush data:
  675. $| = 1;
  676. kill(9, $slavepid) if($slavepid);
  677. waitpid($slavepid, 0) if($slavepid);
  678. $slavepid=0;
  679. &customize(); # read test control instructions
  680. sendcontrol @welcome;
  681. if($verbose) {
  682. for(@welcome) {
  683. print STDERR "OUT: $_";
  684. }
  685. }
  686. while(1) {
  687. my $i;
  688. # Now we expect to read DATA\n[hex size]\n[prot], where the [prot]
  689. # part only is FTP lingo.
  690. # COMMAND
  691. sysread_or_die(\*SFREAD, \$i, 5);
  692. if($i !~ /^DATA/) {
  693. logmsg "sockfilt said $i";
  694. if($i =~ /^DISC/) {
  695. # disconnect
  696. last;
  697. }
  698. next;
  699. }
  700. # SIZE of data
  701. sysread_or_die(\*SFREAD, \$i, 5);
  702. my $size = hex($i);
  703. # data
  704. sysread SFREAD, $_, $size;
  705. ftpmsg $_;
  706. # Remove trailing CRLF.
  707. s/[\n\r]+$//;
  708. unless (m/^([A-Z]{3,4})\s?(.*)/i) {
  709. sendcontrol "500 '$_': command not understood.\r\n";
  710. last;
  711. }
  712. my $FTPCMD=$1;
  713. my $FTPARG=$2;
  714. my $full=$_;
  715. logmsg "< \"$full\"\n";
  716. if($verbose) {
  717. print STDERR "IN: $full\n";
  718. }
  719. my $delay = $delayreply{$FTPCMD};
  720. if($delay) {
  721. # just go sleep this many seconds!
  722. logmsg("Sleep for $delay seconds\n");
  723. sleep($delay);
  724. }
  725. my $text;
  726. $text = $customreply{$FTPCMD};
  727. my $fake = $text;
  728. if($text eq "") {
  729. $text = $displaytext{$FTPCMD};
  730. }
  731. else {
  732. if($customcount{$FTPCMD} && (!--$customcount{$FTPCMD})) {
  733. # used enough number of times, now blank the customreply
  734. $customreply{$FTPCMD}="";
  735. }
  736. }
  737. my $check;
  738. if($text) {
  739. sendcontrol "$text\r\n";
  740. }
  741. else {
  742. $check=1; # no response yet
  743. }
  744. if($fake eq "") {
  745. # only perform this if we're not faking a reply
  746. my $func = $commandfunc{$FTPCMD};
  747. if($func) {
  748. &$func($FTPARG, $FTPCMD);
  749. $check=0; # taken care of
  750. }
  751. }
  752. if($check) {
  753. logmsg "$FTPCMD wasn't handled!\n";
  754. sendcontrol "500 $FTPCMD is not dealt with!\r\n";
  755. }
  756. } # while(1)
  757. logmsg "====> Client disconnected\n";
  758. clear_advisor_read_lock($SERVERLOGS_LOCK);
  759. }
  760. print SFWRITE "QUIT\n";
  761. waitpid $sfpid, 0;
  762. clear_advisor_read_lock($SERVERLOGS_LOCK);
  763. exit;