ftpserver.pl 89 KB

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