runtests.pl 201 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065306630673068306930703071307230733074307530763077307830793080308130823083308430853086308730883089309030913092309330943095309630973098309931003101310231033104310531063107310831093110311131123113311431153116311731183119312031213122312331243125312631273128312931303131313231333134313531363137313831393140314131423143314431453146314731483149315031513152315331543155315631573158315931603161316231633164316531663167316831693170317131723173317431753176317731783179318031813182318331843185318631873188318931903191319231933194319531963197319831993200320132023203320432053206320732083209321032113212321332143215321632173218321932203221322232233224322532263227322832293230323132323233323432353236323732383239324032413242324332443245324632473248324932503251325232533254325532563257325832593260326132623263326432653266326732683269327032713272327332743275327632773278327932803281328232833284328532863287328832893290329132923293329432953296329732983299330033013302330333043305330633073308330933103311331233133314331533163317331833193320332133223323332433253326332733283329333033313332333333343335333633373338333933403341334233433344334533463347334833493350335133523353335433553356335733583359336033613362336333643365336633673368336933703371337233733374337533763377337833793380338133823383338433853386338733883389339033913392339333943395339633973398339934003401340234033404340534063407340834093410341134123413341434153416341734183419342034213422342334243425342634273428342934303431343234333434343534363437343834393440344134423443344434453446344734483449345034513452345334543455345634573458345934603461346234633464346534663467346834693470347134723473347434753476347734783479348034813482348334843485348634873488348934903491349234933494349534963497349834993500350135023503350435053506350735083509351035113512351335143515351635173518351935203521352235233524352535263527352835293530353135323533353435353536353735383539354035413542354335443545354635473548354935503551355235533554355535563557355835593560356135623563356435653566356735683569357035713572357335743575357635773578357935803581358235833584358535863587358835893590359135923593359435953596359735983599360036013602360336043605360636073608360936103611361236133614361536163617361836193620362136223623362436253626362736283629363036313632363336343635363636373638363936403641364236433644364536463647364836493650365136523653365436553656365736583659366036613662366336643665366636673668366936703671367236733674367536763677367836793680368136823683368436853686368736883689369036913692369336943695369636973698369937003701370237033704370537063707370837093710371137123713371437153716371737183719372037213722372337243725372637273728372937303731373237333734373537363737373837393740374137423743374437453746374737483749375037513752375337543755375637573758375937603761376237633764376537663767376837693770377137723773377437753776377737783779378037813782378337843785378637873788378937903791379237933794379537963797379837993800380138023803380438053806380738083809381038113812381338143815381638173818381938203821382238233824382538263827382838293830383138323833383438353836383738383839384038413842384338443845384638473848384938503851385238533854385538563857385838593860386138623863386438653866386738683869387038713872387338743875387638773878387938803881388238833884388538863887388838893890389138923893389438953896389738983899390039013902390339043905390639073908390939103911391239133914391539163917391839193920392139223923392439253926392739283929393039313932393339343935393639373938393939403941394239433944394539463947394839493950395139523953395439553956395739583959396039613962396339643965396639673968396939703971397239733974397539763977397839793980398139823983398439853986398739883989399039913992399339943995399639973998399940004001400240034004400540064007400840094010401140124013401440154016401740184019402040214022402340244025402640274028402940304031403240334034403540364037403840394040404140424043404440454046404740484049405040514052405340544055405640574058405940604061406240634064406540664067406840694070407140724073407440754076407740784079408040814082408340844085408640874088408940904091409240934094409540964097409840994100410141024103410441054106410741084109411041114112411341144115411641174118411941204121412241234124412541264127412841294130413141324133413441354136413741384139414041414142414341444145414641474148414941504151415241534154415541564157415841594160416141624163416441654166416741684169417041714172417341744175417641774178417941804181418241834184418541864187418841894190419141924193419441954196419741984199420042014202420342044205420642074208420942104211421242134214421542164217421842194220422142224223422442254226422742284229423042314232423342344235423642374238423942404241424242434244424542464247424842494250425142524253425442554256425742584259426042614262426342644265426642674268426942704271427242734274427542764277427842794280428142824283428442854286428742884289429042914292429342944295429642974298429943004301430243034304430543064307430843094310431143124313431443154316431743184319432043214322432343244325432643274328432943304331433243334334433543364337433843394340434143424343434443454346434743484349435043514352435343544355435643574358435943604361436243634364436543664367436843694370437143724373437443754376437743784379438043814382438343844385438643874388438943904391439243934394439543964397439843994400440144024403440444054406440744084409441044114412441344144415441644174418441944204421442244234424442544264427442844294430443144324433443444354436443744384439444044414442444344444445444644474448444944504451445244534454445544564457445844594460446144624463446444654466446744684469447044714472447344744475447644774478447944804481448244834484448544864487448844894490449144924493449444954496449744984499450045014502450345044505450645074508450945104511451245134514451545164517451845194520452145224523452445254526452745284529453045314532453345344535453645374538453945404541454245434544454545464547454845494550455145524553455445554556455745584559456045614562456345644565456645674568456945704571457245734574457545764577457845794580458145824583458445854586458745884589459045914592459345944595459645974598459946004601460246034604460546064607460846094610461146124613461446154616461746184619462046214622462346244625462646274628462946304631463246334634463546364637463846394640464146424643464446454646464746484649465046514652465346544655465646574658465946604661466246634664466546664667466846694670467146724673467446754676467746784679468046814682468346844685468646874688468946904691469246934694469546964697469846994700470147024703470447054706470747084709471047114712471347144715471647174718471947204721472247234724472547264727472847294730473147324733473447354736473747384739474047414742474347444745474647474748474947504751475247534754475547564757475847594760476147624763476447654766476747684769477047714772477347744775477647774778477947804781478247834784478547864787478847894790479147924793479447954796479747984799480048014802480348044805480648074808480948104811481248134814481548164817481848194820482148224823482448254826482748284829483048314832483348344835483648374838483948404841484248434844484548464847484848494850485148524853485448554856485748584859486048614862486348644865486648674868486948704871487248734874487548764877487848794880488148824883488448854886488748884889489048914892489348944895489648974898489949004901490249034904490549064907490849094910491149124913491449154916491749184919492049214922492349244925492649274928492949304931493249334934493549364937493849394940494149424943494449454946494749484949495049514952495349544955495649574958495949604961496249634964496549664967496849694970497149724973497449754976497749784979498049814982498349844985498649874988498949904991499249934994499549964997499849995000500150025003500450055006500750085009501050115012501350145015501650175018501950205021502250235024502550265027502850295030503150325033503450355036503750385039504050415042504350445045504650475048504950505051505250535054505550565057505850595060506150625063506450655066506750685069507050715072507350745075507650775078507950805081508250835084508550865087508850895090509150925093509450955096509750985099510051015102510351045105510651075108510951105111511251135114511551165117511851195120512151225123512451255126512751285129513051315132513351345135513651375138513951405141514251435144514551465147514851495150515151525153515451555156515751585159516051615162516351645165516651675168516951705171517251735174517551765177517851795180518151825183518451855186518751885189519051915192519351945195519651975198519952005201520252035204520552065207520852095210521152125213521452155216521752185219522052215222522352245225522652275228522952305231523252335234523552365237523852395240524152425243524452455246524752485249525052515252525352545255525652575258525952605261526252635264526552665267526852695270527152725273527452755276527752785279528052815282528352845285528652875288528952905291529252935294529552965297529852995300530153025303530453055306530753085309531053115312531353145315531653175318531953205321532253235324532553265327532853295330533153325333533453355336533753385339534053415342534353445345534653475348534953505351535253535354535553565357535853595360536153625363536453655366536753685369537053715372537353745375537653775378537953805381538253835384538553865387538853895390539153925393539453955396539753985399540054015402540354045405540654075408540954105411541254135414541554165417541854195420542154225423542454255426542754285429543054315432543354345435543654375438543954405441544254435444544554465447544854495450545154525453545454555456545754585459546054615462546354645465546654675468546954705471547254735474547554765477547854795480548154825483548454855486548754885489549054915492549354945495549654975498549955005501550255035504550555065507550855095510551155125513551455155516551755185519552055215522552355245525552655275528552955305531553255335534553555365537553855395540554155425543554455455546554755485549555055515552555355545555555655575558555955605561556255635564556555665567556855695570557155725573557455755576557755785579558055815582558355845585558655875588558955905591559255935594559555965597559855995600560156025603560456055606560756085609561056115612561356145615561656175618561956205621562256235624562556265627562856295630563156325633563456355636563756385639564056415642564356445645564656475648564956505651565256535654565556565657565856595660566156625663566456655666566756685669567056715672567356745675567656775678567956805681568256835684568556865687568856895690569156925693569456955696569756985699570057015702570357045705570657075708570957105711571257135714571557165717571857195720572157225723572457255726572757285729573057315732573357345735573657375738573957405741574257435744574557465747574857495750575157525753575457555756575757585759576057615762576357645765576657675768576957705771577257735774577557765777577857795780578157825783578457855786578757885789579057915792579357945795579657975798579958005801580258035804580558065807580858095810581158125813581458155816581758185819582058215822582358245825582658275828582958305831583258335834583558365837583858395840584158425843584458455846584758485849585058515852585358545855585658575858585958605861586258635864586558665867586858695870587158725873587458755876587758785879588058815882588358845885588658875888588958905891589258935894589558965897589858995900590159025903590459055906590759085909591059115912591359145915591659175918591959205921592259235924592559265927592859295930593159325933593459355936593759385939594059415942594359445945594659475948594959505951595259535954595559565957595859595960596159625963596459655966596759685969597059715972597359745975597659775978597959805981598259835984598559865987598859895990599159925993599459955996599759985999600060016002600360046005600660076008600960106011601260136014601560166017601860196020602160226023602460256026602760286029603060316032603360346035603660376038603960406041604260436044604560466047604860496050605160526053605460556056605760586059606060616062606360646065606660676068606960706071607260736074607560766077607860796080608160826083608460856086608760886089609060916092609360946095609660976098609961006101610261036104610561066107610861096110611161126113611461156116611761186119612061216122612361246125612661276128612961306131613261336134613561366137613861396140614161426143614461456146614761486149615061516152615361546155615661576158615961606161616261636164616561666167616861696170617161726173617461756176617761786179618061816182618361846185618661876188618961906191619261936194619561966197619861996200620162026203620462056206620762086209621062116212621362146215621662176218621962206221622262236224622562266227622862296230623162326233623462356236623762386239624062416242624362446245624662476248624962506251625262536254625562566257625862596260626162626263626462656266626762686269627062716272627362746275627662776278627962806281628262836284628562866287628862896290629162926293629462956296629762986299630063016302630363046305630663076308630963106311631263136314631563166317631863196320632163226323632463256326632763286329633063316332633363346335633663376338633963406341634263436344634563466347634863496350635163526353635463556356635763586359636063616362636363646365636663676368636963706371637263736374637563766377637863796380638163826383638463856386638763886389639063916392639363946395639663976398639964006401640264036404640564066407640864096410641164126413641464156416641764186419642064216422642364246425642664276428642964306431
  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. # Experimental hooks are available to run tests remotely on machines that
  26. # are able to run curl but are unable to run the test harness.
  27. # The following sections need to be modified:
  28. #
  29. # $HOSTIP, $HOST6IP - Set to the address of the host running the test suite
  30. # $CLIENTIP, $CLIENT6IP - Set to the address of the host running curl
  31. # runclient, runclientoutput - Modify to copy all the files in the log/
  32. # directory to the system running curl, run the given command remotely
  33. # and save the return code or returned stdout (respectively), then
  34. # copy all the files from the remote system's log/ directory back to
  35. # the host running the test suite. This can be done a few ways, such
  36. # as using scp & ssh, rsync & telnet, or using a NFS shared directory
  37. # and ssh.
  38. #
  39. # 'make && make test' needs to be done on both machines before making the
  40. # above changes and running runtests.pl manually. In the shared NFS case,
  41. # the contents of the tests/server/ directory must be from the host
  42. # running the test suite, while the rest must be from the host running curl.
  43. #
  44. # Note that even with these changes a number of tests will still fail (mainly
  45. # to do with cookies, those that set environment variables, or those that
  46. # do more than touch the file system in a <precheck> or <postcheck>
  47. # section). These can be added to the $TESTCASES line below,
  48. # e.g. $TESTCASES="!8 !31 !63 !cookies..."
  49. #
  50. # Finally, to properly support -g and -n, checktestcmd needs to change
  51. # to check the remote system's PATH, and the places in the code where
  52. # the curl binary is read directly to determine its type also need to be
  53. # fixed. As long as the -g option is never given, and the -n is always
  54. # given, this won't be a problem.
  55. # These should be the only variables that might be needed to get edited:
  56. BEGIN {
  57. # Define srcdir to the location of the tests source directory. This is
  58. # usually set by the Makefile, but for out-of-tree builds with direct
  59. # invocation of runtests.pl, it may not be set.
  60. if(!defined $ENV{'srcdir'}) {
  61. use File::Basename;
  62. $ENV{'srcdir'} = dirname(__FILE__);
  63. }
  64. push(@INC, $ENV{'srcdir'});
  65. # run time statistics needs Time::HiRes
  66. eval {
  67. no warnings "all";
  68. require Time::HiRes;
  69. import Time::HiRes qw( time );
  70. }
  71. }
  72. use strict;
  73. # Promote all warnings to fatal
  74. use warnings FATAL => 'all';
  75. use Cwd;
  76. use Digest::MD5 qw(md5);
  77. use MIME::Base64;
  78. # Subs imported from serverhelp module
  79. use serverhelp qw(
  80. serverfactors
  81. servername_id
  82. servername_str
  83. servername_canon
  84. server_pidfilename
  85. server_portfilename
  86. server_logfilename
  87. );
  88. # Variables and subs imported from sshhelp module
  89. use sshhelp qw(
  90. $sshdexe
  91. $sshexe
  92. $sftpexe
  93. $sshconfig
  94. $sftpconfig
  95. $sshdlog
  96. $sshlog
  97. $sftplog
  98. $sftpcmds
  99. display_sshdconfig
  100. display_sshconfig
  101. display_sftpconfig
  102. display_sshdlog
  103. display_sshlog
  104. display_sftplog
  105. exe_ext
  106. find_sshd
  107. find_ssh
  108. find_sftp
  109. find_httptlssrv
  110. sshversioninfo
  111. );
  112. use pathhelp;
  113. require "getpart.pm"; # array functions
  114. require "valgrind.pm"; # valgrind report parser
  115. require "ftp.pm";
  116. require "azure.pm";
  117. require "appveyor.pm";
  118. my $HOSTIP="127.0.0.1"; # address on which the test server listens
  119. my $HOST6IP="[::1]"; # address on which the test server listens
  120. my $CLIENTIP="127.0.0.1"; # address which curl uses for incoming connections
  121. my $CLIENT6IP="[::1]"; # address which curl uses for incoming connections
  122. my %PORT = (nolisten => 47); # port we use for a local non-listening service
  123. my $HTTPUNIXPATH; # HTTP server Unix domain socket path
  124. my $SOCKSUNIXPATH; # socks server Unix domain socket path
  125. my $use_external_proxy = 0;
  126. my $proxy_address;
  127. my %custom_skip_reasons;
  128. my $SSHSRVMD5 = "[uninitialized]"; # MD5 of ssh server public key
  129. my $SSHSRVSHA256 = "[uninitialized]"; # SHA256 of ssh server public key
  130. my $VERSION=""; # curl's reported version number
  131. my $srcdir = $ENV{'srcdir'} || '.';
  132. my $CURL="../src/curl".exe_ext('TOOL'); # what curl binary to run on the tests
  133. my $VCURL=$CURL; # what curl binary to use to verify the servers with
  134. # VCURL is handy to set to the system one when the one you
  135. # just built hangs or crashes and thus prevent verification
  136. my $ACURL=$VCURL; # what curl binary to use to talk to APIs (relevant for CI)
  137. # ACURL is handy to set to the system one for reliability
  138. my $DBGCURL=$CURL; #"../src/.libs/curl"; # alternative for debugging
  139. my $LOGDIR="log";
  140. my $TESTDIR="$srcdir/data";
  141. my $LIBDIR="./libtest";
  142. my $UNITDIR="./unit";
  143. # TODO: change this to use server_inputfilename()
  144. my $SERVERIN="$LOGDIR/server.input"; # what curl sent the server
  145. my $SERVER2IN="$LOGDIR/server2.input"; # what curl sent the second server
  146. my $PROXYIN="$LOGDIR/proxy.input"; # what curl sent the proxy
  147. my $SOCKSIN="$LOGDIR/socksd-request.log"; # what curl sent to the SOCKS proxy
  148. my $CURLLOG="commands.log"; # all command lines run
  149. my $FTPDCMD="$LOGDIR/ftpserver.cmd"; # copy server instructions here
  150. my $SERVERLOGS_LOCK="$LOGDIR/serverlogs.lock"; # server logs advisor read lock
  151. my $CURLCONFIG="../curl-config"; # curl-config from current build
  152. # Normally, all test cases should be run, but at times it is handy to
  153. # simply run a particular one:
  154. my $TESTCASES="all";
  155. # To run specific test cases, set them like:
  156. # $TESTCASES="1 2 3 7 8";
  157. #######################################################################
  158. # No variables below this point should need to be modified
  159. #
  160. # invoke perl like this:
  161. my $perl="perl -I$srcdir";
  162. my $server_response_maxtime=13;
  163. my $debug_build=0; # built debug enabled (--enable-debug)
  164. my $has_memory_tracking=0; # built with memory tracking (--enable-curldebug)
  165. my $libtool;
  166. my $repeat = 0;
  167. # name of the file that the memory debugging creates:
  168. my $memdump="$LOGDIR/memdump";
  169. # the path to the script that analyzes the memory debug output file:
  170. my $memanalyze="$perl $srcdir/memanalyze.pl";
  171. my $pwd = getcwd(); # current working directory
  172. my $posix_pwd = $pwd;
  173. my $start;
  174. my $ftpchecktime=1; # time it took to verify our test FTP server
  175. my $scrambleorder;
  176. my $stunnel = checkcmd("stunnel4") || checkcmd("tstunnel") || checkcmd("stunnel");
  177. my $valgrind = checktestcmd("valgrind");
  178. my $valgrind_logfile="--logfile";
  179. my $valgrind_tool;
  180. my $gdb = checktestcmd("gdb");
  181. my $httptlssrv = find_httptlssrv();
  182. my $uname_release = `uname -r`;
  183. my $is_wsl = $uname_release =~ /Microsoft$/;
  184. my $has_ssl; # set if libcurl is built with SSL support
  185. my $has_largefile; # set if libcurl is built with large file support
  186. my $has_idn; # set if libcurl is built with IDN support
  187. my $http_ipv6; # set if HTTP server has IPv6 support
  188. my $http_unix; # set if HTTP server has Unix sockets support
  189. my $ftp_ipv6; # set if FTP server has IPv6 support
  190. my $tftp_ipv6; # set if TFTP server has IPv6 support
  191. my $gopher_ipv6; # set if Gopher server has IPv6 support
  192. my $has_ipv6; # set if libcurl is built with IPv6 support
  193. my $has_unix; # set if libcurl is built with Unix sockets support
  194. my $has_libz; # set if libcurl is built with libz support
  195. my $has_brotli; # set if libcurl is built with brotli support
  196. my $has_zstd; # set if libcurl is built with zstd support
  197. my $has_getrlimit; # set if system has getrlimit()
  198. my $has_ntlm; # set if libcurl is built with NTLM support
  199. my $has_ntlm_wb; # set if libcurl is built with NTLM delegation to winbind
  200. my $has_sspi; # set if libcurl is built with Windows SSPI
  201. my $has_gssapi; # set if libcurl is built with a GSS-API library
  202. my $has_kerberos; # set if libcurl is built with Kerberos support
  203. my $has_spnego; # set if libcurl is built with SPNEGO support
  204. my $has_charconv; # set if libcurl is built with CharConv support
  205. my $has_tls_srp; # set if libcurl is built with TLS-SRP support
  206. my $has_http2; # set if libcurl is built with HTTP2 support
  207. my $has_h2c; # set if libcurl is built with h2c support
  208. my $has_http3; # set if libcurl is built with HTTP3 support
  209. my $has_httpsproxy; # set if libcurl is built with HTTPS-proxy support
  210. my $has_crypto; # set if libcurl is built with cryptographic support
  211. my $has_cares; # set if built with c-ares
  212. my $has_threadedres;# set if built with threaded resolver
  213. my $has_psl; # set if libcurl is built with PSL support
  214. my $has_altsvc; # set if libcurl is built with alt-svc support
  215. my $has_hsts; # set if libcurl is built with HSTS support
  216. my $has_ldpreload; # set if built for systems supporting LD_PRELOAD
  217. my $has_multissl; # set if build with MultiSSL support
  218. my $has_manual; # set if built with built-in manual
  219. my $has_win32; # set if built for Windows
  220. my $has_mingw; # set if built with MinGW (as opposed to MinGW-w64)
  221. my $has_hyper = 0; # set if built with Hyper
  222. my $has_libssh2; # set if built with libssh2
  223. my $has_libssh; # set if built with libssh
  224. my $has_oldlibssh; # set if built with libssh < 0.9.4
  225. my $has_wolfssh; # set if built with wolfssh
  226. my $has_unicode; # set if libcurl is built with Unicode support
  227. my $has_threadsafe; # set if libcurl is built with thread-safety support
  228. # this version is decided by the particular nghttp2 library that is being used
  229. my $h2cver = "h2c";
  230. my $has_rustls; # built with rustls
  231. my $has_openssl; # built with a lib using an OpenSSL-like API
  232. my $has_gnutls; # built with GnuTLS
  233. my $has_nss; # built with NSS
  234. my $has_wolfssl; # built with wolfSSL
  235. my $has_bearssl; # built with BearSSL
  236. my $has_schannel; # built with Schannel
  237. my $has_sectransp; # built with Secure Transport
  238. my $has_boringssl; # built with BoringSSL
  239. my $has_libressl; # built with libressl
  240. my $has_mbedtls; # built with mbedTLS
  241. my $has_sslpinning; # built with a TLS backend that supports pinning
  242. my $has_shared = "unknown"; # built shared
  243. my $resolver; # name of the resolver backend (for human presentation)
  244. my $has_textaware; # set if running on a system that has a text mode concept
  245. # on files. Windows for example
  246. my @protocols; # array of lowercase supported protocol servers
  247. my $skipped=0; # number of tests skipped; reported in main loop
  248. my %skipped; # skipped{reason}=counter, reasons for skip
  249. my @teststat; # teststat[testnum]=reason, reasons for skip
  250. my %disabled_keywords; # key words of tests to skip
  251. my %ignored_keywords; # key words of tests to ignore results
  252. my %enabled_keywords; # key words of tests to run
  253. my %disabled; # disabled test cases
  254. my %ignored; # ignored results of test cases
  255. my $sshdid; # for socks server, ssh daemon version id
  256. my $sshdvernum; # for socks server, ssh daemon version number
  257. my $sshdverstr; # for socks server, ssh daemon version string
  258. my $sshderror; # for socks server, ssh daemon version error
  259. my $defserverlogslocktimeout = 2; # timeout to await server logs lock removal
  260. my $defpostcommanddelay = 0; # delay between command and postcheck sections
  261. my $timestats; # time stamping and stats generation
  262. my $fullstats; # show time stats for every single test
  263. my %timeprepini; # timestamp for each test preparation start
  264. my %timesrvrini; # timestamp for each test required servers verification start
  265. my %timesrvrend; # timestamp for each test required servers verification end
  266. my %timetoolini; # timestamp for each test command run starting
  267. my %timetoolend; # timestamp for each test command run stopping
  268. my %timesrvrlog; # timestamp for each test server logs lock removal
  269. my %timevrfyend; # timestamp for each test result verification end
  270. my $testnumcheck; # test number, set in singletest sub.
  271. my %oldenv;
  272. my %feature; # array of enabled features
  273. my %keywords; # array of keywords from the test spec
  274. #######################################################################
  275. # variables that command line options may set
  276. #
  277. my $short;
  278. my $automakestyle;
  279. my $verbose;
  280. my $debugprotocol;
  281. my $no_debuginfod;
  282. my $anyway;
  283. my $gdbthis; # run test case with gdb debugger
  284. my $gdbxwin; # use windowed gdb when using gdb
  285. my $keepoutfiles; # keep stdout and stderr files after tests
  286. my $clearlocks; # force removal of files by killing locking processes
  287. my $listonly; # only list the tests
  288. my $postmortem; # display detailed info about failed tests
  289. my $err_unexpected; # error instead of warning on server unexpectedly alive
  290. my $run_event_based; # run curl with --test-event to test the event API
  291. my $run_disabeled; # run the specific tests even if listed in DISABLED
  292. my %run; # running server
  293. my %doesntrun; # servers that don't work, identified by pidfile
  294. my %serverpidfile;# all server pid file names, identified by server id
  295. my %serverportfile;# all server port file names, identified by server id
  296. my %runcert; # cert file currently in use by an ssl running server
  297. # torture test variables
  298. my $torture;
  299. my $tortnum;
  300. my $tortalloc;
  301. my $shallow;
  302. my $randseed = 0;
  303. # Azure Pipelines specific variables
  304. my $AZURE_RUN_ID = 0;
  305. my $AZURE_RESULT_ID = 0;
  306. #######################################################################
  307. # logmsg is our general message logging subroutine.
  308. #
  309. sub logmsg {
  310. for(@_) {
  311. my $line = $_;
  312. if ($is_wsl) {
  313. # use \r\n for WSL shell
  314. $line =~ s/\r?\n$/\r\n/g;
  315. }
  316. print "$line";
  317. }
  318. }
  319. # get the name of the current user
  320. my $USER = $ENV{USER}; # Linux
  321. if (!$USER) {
  322. $USER = $ENV{USERNAME}; # Windows
  323. if (!$USER) {
  324. $USER = $ENV{LOGNAME}; # Some Unix (I think)
  325. }
  326. }
  327. # enable memory debugging if curl is compiled with it
  328. $ENV{'CURL_MEMDEBUG'} = $memdump;
  329. $ENV{'CURL_ENTROPY'}="12345678";
  330. $ENV{'CURL_FORCETIME'}=1; # for debug NTLM magic
  331. $ENV{'CURL_GLOBAL_INIT'}=1; # debug curl_global_init/cleanup use
  332. $ENV{'HOME'}=$pwd;
  333. $ENV{'CURL_HOME'}=$ENV{'HOME'};
  334. $ENV{'XDG_CONFIG_HOME'}=$ENV{'HOME'};
  335. $ENV{'COLUMNS'}=79; # screen width!
  336. sub catch_zap {
  337. my $signame = shift;
  338. logmsg "runtests.pl received SIG$signame, exiting\n";
  339. stopservers($verbose);
  340. die "Somebody sent me a SIG$signame";
  341. }
  342. $SIG{INT} = \&catch_zap;
  343. $SIG{TERM} = \&catch_zap;
  344. ##########################################################################
  345. # Clear all possible '*_proxy' environment variables for various protocols
  346. # to prevent them to interfere with our testing!
  347. my $protocol;
  348. foreach $protocol (('ftp', 'http', 'ftps', 'https', 'no', 'all')) {
  349. my $proxy = "${protocol}_proxy";
  350. # clear lowercase version
  351. delete $ENV{$proxy} if($ENV{$proxy});
  352. # clear uppercase version
  353. delete $ENV{uc($proxy)} if($ENV{uc($proxy)});
  354. }
  355. # make sure we don't get affected by other variables that control our
  356. # behavior
  357. delete $ENV{'SSL_CERT_DIR'} if($ENV{'SSL_CERT_DIR'});
  358. delete $ENV{'SSL_CERT_PATH'} if($ENV{'SSL_CERT_PATH'});
  359. delete $ENV{'CURL_CA_BUNDLE'} if($ENV{'CURL_CA_BUNDLE'});
  360. # provide defaults from our config file for ENV vars not explicitly
  361. # set by the caller
  362. if (open(my $fd, "< config")) {
  363. while(my $line = <$fd>) {
  364. next if ($line =~ /^#/);
  365. chomp $line;
  366. my ($name, $val) = split(/\s*:\s*/, $line, 2);
  367. $ENV{$name} = $val if(!$ENV{$name});
  368. }
  369. close($fd);
  370. }
  371. # Check if we have nghttpx available and if it talks http/3
  372. my $nghttpx_h3 = 0;
  373. if (!$ENV{"NGHTTPX"}) {
  374. $ENV{"NGHTTPX"} = checktestcmd("nghttpx");
  375. }
  376. if ($ENV{"NGHTTPX"}) {
  377. my $nghttpx_version=join(' ', runclientoutput("$ENV{'NGHTTPX'} -v"));
  378. $nghttpx_h3 = $nghttpx_version =~ /nghttp3\//;
  379. chomp $nghttpx_h3;
  380. }
  381. #######################################################################
  382. # Load serverpidfile and serverportfile hashes with file names for all
  383. # possible servers.
  384. #
  385. sub init_serverpidfile_hash {
  386. for my $proto (('ftp', 'gopher', 'http', 'imap', 'pop3', 'smtp', 'http/2', 'http/3')) {
  387. for my $ssl (('', 's')) {
  388. for my $ipvnum ((4, 6)) {
  389. for my $idnum ((1, 2, 3)) {
  390. my $serv = servername_id("$proto$ssl", $ipvnum, $idnum);
  391. my $pidf = server_pidfilename("$proto$ssl", $ipvnum, $idnum);
  392. $serverpidfile{$serv} = $pidf;
  393. my $portf = server_portfilename("$proto$ssl", $ipvnum, $idnum);
  394. $serverportfile{$serv} = $portf;
  395. }
  396. }
  397. }
  398. }
  399. for my $proto (('tftp', 'sftp', 'socks', 'ssh', 'rtsp', 'httptls',
  400. 'dict', 'smb', 'smbs', 'telnet', 'mqtt')) {
  401. for my $ipvnum ((4, 6)) {
  402. for my $idnum ((1, 2)) {
  403. my $serv = servername_id($proto, $ipvnum, $idnum);
  404. my $pidf = server_pidfilename($proto, $ipvnum, $idnum);
  405. $serverpidfile{$serv} = $pidf;
  406. my $portf = server_portfilename($proto, $ipvnum, $idnum);
  407. $serverportfile{$serv} = $portf;
  408. }
  409. }
  410. }
  411. for my $proto (('http', 'imap', 'pop3', 'smtp', 'http/2', 'http/3')) {
  412. for my $ssl (('', 's')) {
  413. my $serv = servername_id("$proto$ssl", "unix", 1);
  414. my $pidf = server_pidfilename("$proto$ssl", "unix", 1);
  415. $serverpidfile{$serv} = $pidf;
  416. my $portf = server_portfilename("$proto$ssl", "unix", 1);
  417. $serverportfile{$serv} = $portf;
  418. }
  419. }
  420. }
  421. #######################################################################
  422. # Check if a given child process has just died. Reaps it if so.
  423. #
  424. sub checkdied {
  425. use POSIX ":sys_wait_h";
  426. my $pid = $_[0];
  427. if((not defined $pid) || $pid <= 0) {
  428. return 0;
  429. }
  430. my $rc = pidwait($pid, &WNOHANG);
  431. return ($rc == $pid)?1:0;
  432. }
  433. #######################################################################
  434. # Start a new thread/process and run the given command line in there.
  435. # Return the pids (yes plural) of the new child process to the parent.
  436. #
  437. sub startnew {
  438. my ($cmd, $pidfile, $timeout, $fake)=@_;
  439. logmsg "startnew: $cmd\n" if ($verbose);
  440. my $child = fork();
  441. my $pid2 = 0;
  442. if(not defined $child) {
  443. logmsg "startnew: fork() failure detected\n";
  444. return (-1,-1);
  445. }
  446. if(0 == $child) {
  447. # Here we are the child. Run the given command.
  448. # Flush output.
  449. $| = 1;
  450. # Put an "exec" in front of the command so that the child process
  451. # keeps this child's process ID.
  452. exec("exec $cmd") || die "Can't exec() $cmd: $!";
  453. # exec() should never return back here to this process. We protect
  454. # ourselves by calling die() just in case something goes really bad.
  455. die "error: exec() has returned";
  456. }
  457. # Ugly hack but ssh client and gnutls-serv don't support pid files
  458. if ($fake) {
  459. if(open(OUT, ">$pidfile")) {
  460. print OUT $child . "\n";
  461. close(OUT);
  462. logmsg "startnew: $pidfile faked with pid=$child\n" if($verbose);
  463. }
  464. else {
  465. logmsg "startnew: failed to write fake $pidfile with pid=$child\n";
  466. }
  467. # could/should do a while connect fails sleep a bit and loop
  468. portable_sleep($timeout);
  469. if (checkdied($child)) {
  470. logmsg "startnew: child process has failed to start\n" if($verbose);
  471. return (-1,-1);
  472. }
  473. }
  474. my $count = $timeout;
  475. while($count--) {
  476. if(-f $pidfile && -s $pidfile && open(PID, "<$pidfile")) {
  477. $pid2 = 0 + <PID>;
  478. close(PID);
  479. if(($pid2 > 0) && pidexists($pid2)) {
  480. # if $pid2 is valid, then make sure this pid is alive, as
  481. # otherwise it is just likely to be the _previous_ pidfile or
  482. # similar!
  483. last;
  484. }
  485. # invalidate $pid2 if not actually alive
  486. $pid2 = 0;
  487. }
  488. if (checkdied($child)) {
  489. logmsg "startnew: child process has died, server might start up\n"
  490. if($verbose);
  491. # We can't just abort waiting for the server with a
  492. # return (-1,-1);
  493. # because the server might have forked and could still start
  494. # up normally. Instead, just reduce the amount of time we remain
  495. # waiting.
  496. $count >>= 2;
  497. }
  498. sleep(1);
  499. }
  500. # Return two PIDs, the one for the child process we spawned and the one
  501. # reported by the server itself (in case it forked again on its own).
  502. # Both (potentially) need to be killed at the end of the test.
  503. return ($child, $pid2);
  504. }
  505. #######################################################################
  506. # Check for a command in the PATH of the test server.
  507. #
  508. sub checkcmd {
  509. my ($cmd)=@_;
  510. my @paths=(split(":", $ENV{'PATH'}), "/usr/sbin", "/usr/local/sbin",
  511. "/sbin", "/usr/bin", "/usr/local/bin",
  512. "$LIBDIR/.libs", "$LIBDIR");
  513. for(@paths) {
  514. if( -x "$_/$cmd" && ! -d "$_/$cmd") {
  515. # executable bit but not a directory!
  516. return "$_/$cmd";
  517. }
  518. }
  519. }
  520. #######################################################################
  521. # Get the list of tests that the tests/data/Makefile.am knows about!
  522. #
  523. my $disttests = "";
  524. sub get_disttests {
  525. # If a non-default $TESTDIR is being used there may not be any
  526. # Makefile.inc in which case there's nothing to do.
  527. open(D, "<$TESTDIR/Makefile.inc") or return;
  528. while(<D>) {
  529. chomp $_;
  530. if(($_ =~ /^#/) ||($_ !~ /test/)) {
  531. next;
  532. }
  533. $disttests .= $_;
  534. }
  535. close(D);
  536. }
  537. #######################################################################
  538. # Check for a command in the PATH of the machine running curl.
  539. #
  540. sub checktestcmd {
  541. my ($cmd)=@_;
  542. return checkcmd($cmd);
  543. }
  544. #######################################################################
  545. # Run the application under test and return its return code
  546. #
  547. sub runclient {
  548. my ($cmd)=@_;
  549. my $ret = system($cmd);
  550. print "CMD ($ret): $cmd\n" if($verbose && !$torture);
  551. return $ret;
  552. # This is one way to test curl on a remote machine
  553. # my $out = system("ssh $CLIENTIP cd \'$pwd\' \\; \'$cmd\'");
  554. # sleep 2; # time to allow the NFS server to be updated
  555. # return $out;
  556. }
  557. #######################################################################
  558. # Run the application under test and return its stdout
  559. #
  560. sub runclientoutput {
  561. my ($cmd)=@_;
  562. return `$cmd 2>/dev/null`;
  563. # This is one way to test curl on a remote machine
  564. # my @out = `ssh $CLIENTIP cd \'$pwd\' \\; \'$cmd\'`;
  565. # sleep 2; # time to allow the NFS server to be updated
  566. # return @out;
  567. }
  568. #######################################################################
  569. # Memory allocation test and failure torture testing.
  570. #
  571. sub torture {
  572. my ($testcmd, $testnum, $gdbline) = @_;
  573. # remove memdump first to be sure we get a new nice and clean one
  574. unlink($memdump);
  575. # First get URL from test server, ignore the output/result
  576. runclient($testcmd);
  577. logmsg " CMD: $testcmd\n" if($verbose);
  578. # memanalyze -v is our friend, get the number of allocations made
  579. my $count=0;
  580. my @out = `$memanalyze -v $memdump`;
  581. for(@out) {
  582. if(/^Operations: (\d+)/) {
  583. $count = $1;
  584. last;
  585. }
  586. }
  587. if(!$count) {
  588. logmsg " found no functions to make fail\n";
  589. return 0;
  590. }
  591. my @ttests = (1 .. $count);
  592. if($shallow && ($shallow < $count)) {
  593. my $discard = scalar(@ttests) - $shallow;
  594. my $percent = sprintf("%.2f%%", $shallow * 100 / scalar(@ttests));
  595. logmsg " $count functions found, but only fail $shallow ($percent)\n";
  596. while($discard) {
  597. my $rm;
  598. do {
  599. # find a test to discard
  600. $rm = rand(scalar(@ttests));
  601. } while(!$ttests[$rm]);
  602. $ttests[$rm] = undef;
  603. $discard--;
  604. }
  605. }
  606. else {
  607. logmsg " $count functions to make fail\n";
  608. }
  609. for (@ttests) {
  610. my $limit = $_;
  611. my $fail;
  612. my $dumped_core;
  613. if(!defined($limit)) {
  614. # --shallow can undefine them
  615. next;
  616. }
  617. if($tortalloc && ($tortalloc != $limit)) {
  618. next;
  619. }
  620. if($verbose) {
  621. my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
  622. localtime(time());
  623. my $now = sprintf("%02d:%02d:%02d ", $hour, $min, $sec);
  624. logmsg "Fail function no: $limit at $now\r";
  625. }
  626. # make the memory allocation function number $limit return failure
  627. $ENV{'CURL_MEMLIMIT'} = $limit;
  628. # remove memdump first to be sure we get a new nice and clean one
  629. unlink($memdump);
  630. my $cmd = $testcmd;
  631. if($valgrind && !$gdbthis) {
  632. my @valgrindoption = getpart("verify", "valgrind");
  633. if((!@valgrindoption) || ($valgrindoption[0] !~ /disable/)) {
  634. my $valgrindcmd = "$valgrind ";
  635. $valgrindcmd .= "$valgrind_tool " if($valgrind_tool);
  636. $valgrindcmd .= "--quiet --leak-check=yes ";
  637. $valgrindcmd .= "--suppressions=$srcdir/valgrind.supp ";
  638. # $valgrindcmd .= "--gen-suppressions=all ";
  639. $valgrindcmd .= "--num-callers=16 ";
  640. $valgrindcmd .= "${valgrind_logfile}=$LOGDIR/valgrind$testnum";
  641. $cmd = "$valgrindcmd $testcmd";
  642. }
  643. }
  644. logmsg "*** Function number $limit is now set to fail ***\n" if($gdbthis);
  645. my $ret = 0;
  646. if($gdbthis) {
  647. runclient($gdbline);
  648. }
  649. else {
  650. $ret = runclient($cmd);
  651. }
  652. #logmsg "$_ Returned " . ($ret >> 8) . "\n";
  653. # Now clear the variable again
  654. delete $ENV{'CURL_MEMLIMIT'} if($ENV{'CURL_MEMLIMIT'});
  655. if(-r "core") {
  656. # there's core file present now!
  657. logmsg " core dumped\n";
  658. $dumped_core = 1;
  659. $fail = 2;
  660. }
  661. if($valgrind) {
  662. my @e = valgrindparse("$LOGDIR/valgrind$testnum");
  663. if(@e && $e[0]) {
  664. if($automakestyle) {
  665. logmsg "FAIL: torture $testnum - valgrind\n";
  666. }
  667. else {
  668. logmsg " valgrind ERROR ";
  669. logmsg @e;
  670. }
  671. $fail = 1;
  672. }
  673. }
  674. # verify that it returns a proper error code, doesn't leak memory
  675. # and doesn't core dump
  676. if(($ret & 255) || ($ret >> 8) >= 128) {
  677. logmsg " system() returned $ret\n";
  678. $fail=1;
  679. }
  680. else {
  681. my @memdata=`$memanalyze $memdump`;
  682. my $leak=0;
  683. for(@memdata) {
  684. if($_ ne "") {
  685. # well it could be other memory problems as well, but
  686. # we call it leak for short here
  687. $leak=1;
  688. }
  689. }
  690. if($leak) {
  691. logmsg "** MEMORY FAILURE\n";
  692. logmsg @memdata;
  693. logmsg `$memanalyze -l $memdump`;
  694. $fail = 1;
  695. }
  696. }
  697. if($fail) {
  698. logmsg " Failed on function number $limit in test.\n",
  699. " invoke with \"-t$limit\" to repeat this single case.\n";
  700. stopservers($verbose);
  701. return 1;
  702. }
  703. }
  704. logmsg "torture OK\n";
  705. return 0;
  706. }
  707. #######################################################################
  708. # Return the port to use for the given protocol.
  709. #
  710. sub protoport {
  711. my ($proto) = @_;
  712. return $PORT{$proto} || "[not running]";
  713. }
  714. #######################################################################
  715. # Stop a test server along with pids which aren't in the %run hash yet.
  716. # This also stops all servers which are relative to the given one.
  717. #
  718. sub stopserver {
  719. my ($server, $pidlist) = @_;
  720. #
  721. # kill sockfilter processes for pingpong relative server
  722. #
  723. if($server =~ /^(ftp|imap|pop3|smtp)s?(\d*)(-ipv6|)$/) {
  724. my $proto = $1;
  725. my $idnum = ($2 && ($2 > 1)) ? $2 : 1;
  726. my $ipvnum = ($3 && ($3 =~ /6$/)) ? 6 : 4;
  727. killsockfilters($proto, $ipvnum, $idnum, $verbose);
  728. }
  729. #
  730. # All servers relative to the given one must be stopped also
  731. #
  732. my @killservers;
  733. if($server =~ /^(ftp|http|imap|pop3|smtp)s((\d*)(-ipv6|-unix|))$/) {
  734. # given a stunnel based ssl server, also kill non-ssl underlying one
  735. push @killservers, "${1}${2}";
  736. }
  737. elsif($server =~ /^(ftp|http|imap|pop3|smtp)((\d*)(-ipv6|-unix|))$/) {
  738. # given a non-ssl server, also kill stunnel based ssl piggybacking one
  739. push @killservers, "${1}s${2}";
  740. }
  741. elsif($server =~ /^(socks)((\d*)(-ipv6|))$/) {
  742. # given a socks server, also kill ssh underlying one
  743. push @killservers, "ssh${2}";
  744. }
  745. elsif($server =~ /^(ssh)((\d*)(-ipv6|))$/) {
  746. # given a ssh server, also kill socks piggybacking one
  747. push @killservers, "socks${2}";
  748. }
  749. if($server eq "http" or $server eq "https") {
  750. # since the http2+3 server is a proxy that needs to know about the
  751. # dynamic http port it too needs to get restarted when the http server
  752. # is killed
  753. push @killservers, "http/2";
  754. push @killservers, "http/3";
  755. }
  756. push @killservers, $server;
  757. #
  758. # kill given pids and server relative ones clearing them in %run hash
  759. #
  760. foreach my $server (@killservers) {
  761. if($run{$server}) {
  762. # we must prepend a space since $pidlist may already contain a pid
  763. $pidlist .= " $run{$server}";
  764. $run{$server} = 0;
  765. }
  766. $runcert{$server} = 0 if($runcert{$server});
  767. }
  768. killpid($verbose, $pidlist);
  769. #
  770. # cleanup server pid files
  771. #
  772. my $result = 0;
  773. foreach my $server (@killservers) {
  774. my $pidfile = $serverpidfile{$server};
  775. my $pid = processexists($pidfile);
  776. if($pid > 0) {
  777. if($err_unexpected) {
  778. logmsg "ERROR: ";
  779. $result = -1;
  780. }
  781. else {
  782. logmsg "Warning: ";
  783. }
  784. logmsg "$server server unexpectedly alive\n";
  785. killpid($verbose, $pid);
  786. }
  787. unlink($pidfile) if(-f $pidfile);
  788. }
  789. return $result;
  790. }
  791. #######################################################################
  792. # Return flags to let curl use an external HTTP proxy
  793. #
  794. sub getexternalproxyflags {
  795. return " --proxy $proxy_address ";
  796. }
  797. #######################################################################
  798. # Verify that the server that runs on $ip, $port is our server. This also
  799. # implies that we can speak with it, as there might be occasions when the
  800. # server runs fine but we cannot talk to it ("Failed to connect to ::1: Can't
  801. # assign requested address")
  802. #
  803. sub verifyhttp {
  804. my ($proto, $ipvnum, $idnum, $ip, $port_or_path) = @_;
  805. my $server = servername_id($proto, $ipvnum, $idnum);
  806. my $pid = 0;
  807. my $bonus="";
  808. # $port_or_path contains a path for Unix sockets, sws ignores the port
  809. my $port = ($ipvnum eq "unix") ? 80 : $port_or_path;
  810. my $verifyout = "$LOGDIR/".
  811. servername_canon($proto, $ipvnum, $idnum) .'_verify.out';
  812. unlink($verifyout) if(-f $verifyout);
  813. my $verifylog = "$LOGDIR/".
  814. servername_canon($proto, $ipvnum, $idnum) .'_verify.log';
  815. unlink($verifylog) if(-f $verifylog);
  816. if($proto eq "gopher") {
  817. # gopher is funny
  818. $bonus="1/";
  819. }
  820. my $flags = "--max-time $server_response_maxtime ";
  821. $flags .= "--output $verifyout ";
  822. $flags .= "--silent ";
  823. $flags .= "--verbose ";
  824. $flags .= "--globoff ";
  825. $flags .= "--unix-socket '$port_or_path' " if $ipvnum eq "unix";
  826. $flags .= "--insecure " if($proto eq 'https');
  827. if($use_external_proxy) {
  828. $flags .= getexternalproxyflags();
  829. }
  830. $flags .= "\"$proto://$ip:$port/${bonus}verifiedserver\"";
  831. my $cmd = "$VCURL $flags 2>$verifylog";
  832. # verify if our/any server is running on this port
  833. logmsg "RUN: $cmd\n" if($verbose);
  834. my $res = runclient($cmd);
  835. $res >>= 8; # rotate the result
  836. if($res & 128) {
  837. logmsg "RUN: curl command died with a coredump\n";
  838. return -1;
  839. }
  840. if($res && $verbose) {
  841. logmsg "RUN: curl command returned $res\n";
  842. if(open(FILE, "<$verifylog")) {
  843. while(my $string = <FILE>) {
  844. logmsg "RUN: $string" if($string !~ /^([ \t]*)$/);
  845. }
  846. close(FILE);
  847. }
  848. }
  849. my $data;
  850. if(open(FILE, "<$verifyout")) {
  851. while(my $string = <FILE>) {
  852. $data = $string;
  853. last; # only want first line
  854. }
  855. close(FILE);
  856. }
  857. if($data && ($data =~ /WE ROOLZ: (\d+)/)) {
  858. $pid = 0+$1;
  859. }
  860. elsif($res == 6) {
  861. # curl: (6) Couldn't resolve host '::1'
  862. logmsg "RUN: failed to resolve host ($proto://$ip:$port/verifiedserver)\n";
  863. return -1;
  864. }
  865. elsif($data || ($res && ($res != 7))) {
  866. logmsg "RUN: Unknown server on our $server port: $port ($res)\n";
  867. return -1;
  868. }
  869. return $pid;
  870. }
  871. #######################################################################
  872. # Verify that the server that runs on $ip, $port is our server. This also
  873. # implies that we can speak with it, as there might be occasions when the
  874. # server runs fine but we cannot talk to it ("Failed to connect to ::1: Can't
  875. # assign requested address")
  876. #
  877. sub verifyftp {
  878. my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
  879. my $server = servername_id($proto, $ipvnum, $idnum);
  880. my $pid = 0;
  881. my $time=time();
  882. my $extra="";
  883. my $verifylog = "$LOGDIR/".
  884. servername_canon($proto, $ipvnum, $idnum) .'_verify.log';
  885. unlink($verifylog) if(-f $verifylog);
  886. if($proto eq "ftps") {
  887. $extra .= "--insecure --ftp-ssl-control ";
  888. }
  889. my $flags = "--max-time $server_response_maxtime ";
  890. $flags .= "--silent ";
  891. $flags .= "--verbose ";
  892. $flags .= "--globoff ";
  893. $flags .= $extra;
  894. if($use_external_proxy) {
  895. $flags .= getexternalproxyflags();
  896. }
  897. $flags .= "\"$proto://$ip:$port/verifiedserver\"";
  898. my $cmd = "$VCURL $flags 2>$verifylog";
  899. # check if this is our server running on this port:
  900. logmsg "RUN: $cmd\n" if($verbose);
  901. my @data = runclientoutput($cmd);
  902. my $res = $? >> 8; # rotate the result
  903. if($res & 128) {
  904. logmsg "RUN: curl command died with a coredump\n";
  905. return -1;
  906. }
  907. foreach my $line (@data) {
  908. if($line =~ /WE ROOLZ: (\d+)/) {
  909. # this is our test server with a known pid!
  910. $pid = 0+$1;
  911. last;
  912. }
  913. }
  914. if($pid <= 0 && @data && $data[0]) {
  915. # this is not a known server
  916. logmsg "RUN: Unknown server on our $server port: $port\n";
  917. return 0;
  918. }
  919. # we can/should use the time it took to verify the FTP server as a measure
  920. # on how fast/slow this host/FTP is.
  921. my $took = int(0.5+time()-$time);
  922. if($verbose) {
  923. logmsg "RUN: Verifying our test $server server took $took seconds\n";
  924. }
  925. $ftpchecktime = $took>=1?$took:1; # make sure it never is below 1
  926. return $pid;
  927. }
  928. #######################################################################
  929. # Verify that the server that runs on $ip, $port is our server. This also
  930. # implies that we can speak with it, as there might be occasions when the
  931. # server runs fine but we cannot talk to it ("Failed to connect to ::1: Can't
  932. # assign requested address")
  933. #
  934. sub verifyrtsp {
  935. my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
  936. my $server = servername_id($proto, $ipvnum, $idnum);
  937. my $pid = 0;
  938. my $verifyout = "$LOGDIR/".
  939. servername_canon($proto, $ipvnum, $idnum) .'_verify.out';
  940. unlink($verifyout) if(-f $verifyout);
  941. my $verifylog = "$LOGDIR/".
  942. servername_canon($proto, $ipvnum, $idnum) .'_verify.log';
  943. unlink($verifylog) if(-f $verifylog);
  944. my $flags = "--max-time $server_response_maxtime ";
  945. $flags .= "--output $verifyout ";
  946. $flags .= "--silent ";
  947. $flags .= "--verbose ";
  948. $flags .= "--globoff ";
  949. if($use_external_proxy) {
  950. $flags .= getexternalproxyflags();
  951. }
  952. # currently verification is done using http
  953. $flags .= "\"http://$ip:$port/verifiedserver\"";
  954. my $cmd = "$VCURL $flags 2>$verifylog";
  955. # verify if our/any server is running on this port
  956. logmsg "RUN: $cmd\n" if($verbose);
  957. my $res = runclient($cmd);
  958. $res >>= 8; # rotate the result
  959. if($res & 128) {
  960. logmsg "RUN: curl command died with a coredump\n";
  961. return -1;
  962. }
  963. if($res && $verbose) {
  964. logmsg "RUN: curl command returned $res\n";
  965. if(open(FILE, "<$verifylog")) {
  966. while(my $string = <FILE>) {
  967. logmsg "RUN: $string" if($string !~ /^([ \t]*)$/);
  968. }
  969. close(FILE);
  970. }
  971. }
  972. my $data;
  973. if(open(FILE, "<$verifyout")) {
  974. while(my $string = <FILE>) {
  975. $data = $string;
  976. last; # only want first line
  977. }
  978. close(FILE);
  979. }
  980. if($data && ($data =~ /RTSP_SERVER WE ROOLZ: (\d+)/)) {
  981. $pid = 0+$1;
  982. }
  983. elsif($res == 6) {
  984. # curl: (6) Couldn't resolve host '::1'
  985. logmsg "RUN: failed to resolve host ($proto://$ip:$port/verifiedserver)\n";
  986. return -1;
  987. }
  988. elsif($data || ($res != 7)) {
  989. logmsg "RUN: Unknown server on our $server port: $port\n";
  990. return -1;
  991. }
  992. return $pid;
  993. }
  994. #######################################################################
  995. # Verify that the ssh server has written out its pidfile, recovering
  996. # the pid from the file and returning it if a process with that pid is
  997. # actually alive.
  998. #
  999. sub verifyssh {
  1000. my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
  1001. my $server = servername_id($proto, $ipvnum, $idnum);
  1002. my $pidfile = server_pidfilename($proto, $ipvnum, $idnum);
  1003. my $pid = 0;
  1004. if(open(FILE, "<$pidfile")) {
  1005. $pid=0+<FILE>;
  1006. close(FILE);
  1007. }
  1008. if($pid > 0) {
  1009. # if we have a pid it is actually our ssh server,
  1010. # since runsshserver() unlinks previous pidfile
  1011. if(!pidexists($pid)) {
  1012. logmsg "RUN: SSH server has died after starting up\n";
  1013. checkdied($pid);
  1014. unlink($pidfile);
  1015. $pid = -1;
  1016. }
  1017. }
  1018. return $pid;
  1019. }
  1020. #######################################################################
  1021. # Verify that we can connect to the sftp server, properly authenticate
  1022. # with generated config and key files and run a simple remote pwd.
  1023. #
  1024. sub verifysftp {
  1025. my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
  1026. my $server = servername_id($proto, $ipvnum, $idnum);
  1027. my $verified = 0;
  1028. # Find out sftp client canonical file name
  1029. my $sftp = find_sftp();
  1030. if(!$sftp) {
  1031. logmsg "RUN: SFTP server cannot find $sftpexe\n";
  1032. return -1;
  1033. }
  1034. # Find out ssh client canonical file name
  1035. my $ssh = find_ssh();
  1036. if(!$ssh) {
  1037. logmsg "RUN: SFTP server cannot find $sshexe\n";
  1038. return -1;
  1039. }
  1040. # Connect to sftp server, authenticate and run a remote pwd
  1041. # command using our generated configuration and key files
  1042. my $cmd = "\"$sftp\" -b $sftpcmds -F $sftpconfig -S \"$ssh\" $ip > $sftplog 2>&1";
  1043. my $res = runclient($cmd);
  1044. # Search for pwd command response in log file
  1045. if(open(SFTPLOGFILE, "<$sftplog")) {
  1046. while(<SFTPLOGFILE>) {
  1047. if(/^Remote working directory: /) {
  1048. $verified = 1;
  1049. last;
  1050. }
  1051. }
  1052. close(SFTPLOGFILE);
  1053. }
  1054. return $verified;
  1055. }
  1056. #######################################################################
  1057. # Verify that the non-stunnel HTTP TLS extensions capable server that runs
  1058. # on $ip, $port is our server. This also implies that we can speak with it,
  1059. # as there might be occasions when the server runs fine but we cannot talk
  1060. # to it ("Failed to connect to ::1: Can't assign requested address")
  1061. #
  1062. sub verifyhttptls {
  1063. my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
  1064. my $server = servername_id($proto, $ipvnum, $idnum);
  1065. my $pidfile = server_pidfilename($proto, $ipvnum, $idnum);
  1066. my $pid = 0;
  1067. my $verifyout = "$LOGDIR/".
  1068. servername_canon($proto, $ipvnum, $idnum) .'_verify.out';
  1069. unlink($verifyout) if(-f $verifyout);
  1070. my $verifylog = "$LOGDIR/".
  1071. servername_canon($proto, $ipvnum, $idnum) .'_verify.log';
  1072. unlink($verifylog) if(-f $verifylog);
  1073. my $flags = "--max-time $server_response_maxtime ";
  1074. $flags .= "--output $verifyout ";
  1075. $flags .= "--verbose ";
  1076. $flags .= "--globoff ";
  1077. $flags .= "--insecure ";
  1078. $flags .= "--tlsauthtype SRP ";
  1079. $flags .= "--tlsuser jsmith ";
  1080. $flags .= "--tlspassword abc ";
  1081. if($use_external_proxy) {
  1082. $flags .= getexternalproxyflags();
  1083. }
  1084. $flags .= "\"https://$ip:$port/verifiedserver\"";
  1085. my $cmd = "$VCURL $flags 2>$verifylog";
  1086. # verify if our/any server is running on this port
  1087. logmsg "RUN: $cmd\n" if($verbose);
  1088. my $res = runclient($cmd);
  1089. $res >>= 8; # rotate the result
  1090. if($res & 128) {
  1091. logmsg "RUN: curl command died with a coredump\n";
  1092. return -1;
  1093. }
  1094. if($res && $verbose) {
  1095. logmsg "RUN: curl command returned $res\n";
  1096. if(open(FILE, "<$verifylog")) {
  1097. while(my $string = <FILE>) {
  1098. logmsg "RUN: $string" if($string !~ /^([ \t]*)$/);
  1099. }
  1100. close(FILE);
  1101. }
  1102. }
  1103. my $data;
  1104. if(open(FILE, "<$verifyout")) {
  1105. while(my $string = <FILE>) {
  1106. $data .= $string;
  1107. }
  1108. close(FILE);
  1109. }
  1110. if($data && ($data =~ /(GNUTLS|GnuTLS)/) && open(FILE, "<$pidfile")) {
  1111. $pid=0+<FILE>;
  1112. close(FILE);
  1113. if($pid > 0) {
  1114. # if we have a pid it is actually our httptls server,
  1115. # since runhttptlsserver() unlinks previous pidfile
  1116. if(!pidexists($pid)) {
  1117. logmsg "RUN: $server server has died after starting up\n";
  1118. checkdied($pid);
  1119. unlink($pidfile);
  1120. $pid = -1;
  1121. }
  1122. }
  1123. return $pid;
  1124. }
  1125. elsif($res == 6) {
  1126. # curl: (6) Couldn't resolve host '::1'
  1127. logmsg "RUN: failed to resolve host (https://$ip:$port/verifiedserver)\n";
  1128. return -1;
  1129. }
  1130. elsif($data || ($res && ($res != 7))) {
  1131. logmsg "RUN: Unknown server on our $server port: $port ($res)\n";
  1132. return -1;
  1133. }
  1134. return $pid;
  1135. }
  1136. #######################################################################
  1137. # STUB for verifying socks
  1138. #
  1139. sub verifysocks {
  1140. my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
  1141. my $server = servername_id($proto, $ipvnum, $idnum);
  1142. my $pidfile = server_pidfilename($proto, $ipvnum, $idnum);
  1143. my $pid = 0;
  1144. if(open(FILE, "<$pidfile")) {
  1145. $pid=0+<FILE>;
  1146. close(FILE);
  1147. }
  1148. if($pid > 0) {
  1149. # if we have a pid it is actually our socks server,
  1150. # since runsocksserver() unlinks previous pidfile
  1151. if(!pidexists($pid)) {
  1152. logmsg "RUN: SOCKS server has died after starting up\n";
  1153. checkdied($pid);
  1154. unlink($pidfile);
  1155. $pid = -1;
  1156. }
  1157. }
  1158. return $pid;
  1159. }
  1160. #######################################################################
  1161. # Verify that the server that runs on $ip, $port is our server. This also
  1162. # implies that we can speak with it, as there might be occasions when the
  1163. # server runs fine but we cannot talk to it ("Failed to connect to ::1: Can't
  1164. # assign requested address")
  1165. #
  1166. sub verifysmb {
  1167. my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
  1168. my $server = servername_id($proto, $ipvnum, $idnum);
  1169. my $pid = 0;
  1170. my $time=time();
  1171. my $extra="";
  1172. my $verifylog = "$LOGDIR/".
  1173. servername_canon($proto, $ipvnum, $idnum) .'_verify.log';
  1174. unlink($verifylog) if(-f $verifylog);
  1175. my $flags = "--max-time $server_response_maxtime ";
  1176. $flags .= "--silent ";
  1177. $flags .= "--verbose ";
  1178. $flags .= "--globoff ";
  1179. $flags .= "-u 'curltest:curltest' ";
  1180. $flags .= $extra;
  1181. $flags .= "\"$proto://$ip:$port/SERVER/verifiedserver\"";
  1182. my $cmd = "$VCURL $flags 2>$verifylog";
  1183. # check if this is our server running on this port:
  1184. logmsg "RUN: $cmd\n" if($verbose);
  1185. my @data = runclientoutput($cmd);
  1186. my $res = $? >> 8; # rotate the result
  1187. if($res & 128) {
  1188. logmsg "RUN: curl command died with a coredump\n";
  1189. return -1;
  1190. }
  1191. foreach my $line (@data) {
  1192. if($line =~ /WE ROOLZ: (\d+)/) {
  1193. # this is our test server with a known pid!
  1194. $pid = 0+$1;
  1195. last;
  1196. }
  1197. }
  1198. if($pid <= 0 && @data && $data[0]) {
  1199. # this is not a known server
  1200. logmsg "RUN: Unknown server on our $server port: $port\n";
  1201. return 0;
  1202. }
  1203. # we can/should use the time it took to verify the server as a measure
  1204. # on how fast/slow this host is.
  1205. my $took = int(0.5+time()-$time);
  1206. if($verbose) {
  1207. logmsg "RUN: Verifying our test $server server took $took seconds\n";
  1208. }
  1209. $ftpchecktime = $took>=1?$took:1; # make sure it never is below 1
  1210. return $pid;
  1211. }
  1212. #######################################################################
  1213. # Verify that the server that runs on $ip, $port is our server. This also
  1214. # implies that we can speak with it, as there might be occasions when the
  1215. # server runs fine but we cannot talk to it ("Failed to connect to ::1: Can't
  1216. # assign requested address")
  1217. #
  1218. sub verifytelnet {
  1219. my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
  1220. my $server = servername_id($proto, $ipvnum, $idnum);
  1221. my $pid = 0;
  1222. my $time=time();
  1223. my $extra="";
  1224. my $verifylog = "$LOGDIR/".
  1225. servername_canon($proto, $ipvnum, $idnum) .'_verify.log';
  1226. unlink($verifylog) if(-f $verifylog);
  1227. my $flags = "--max-time $server_response_maxtime ";
  1228. $flags .= "--silent ";
  1229. $flags .= "--verbose ";
  1230. $flags .= "--globoff ";
  1231. $flags .= "--upload-file - ";
  1232. $flags .= $extra;
  1233. $flags .= "\"$proto://$ip:$port\"";
  1234. my $cmd = "echo 'verifiedserver' | $VCURL $flags 2>$verifylog";
  1235. # check if this is our server running on this port:
  1236. logmsg "RUN: $cmd\n" if($verbose);
  1237. my @data = runclientoutput($cmd);
  1238. my $res = $? >> 8; # rotate the result
  1239. if($res & 128) {
  1240. logmsg "RUN: curl command died with a coredump\n";
  1241. return -1;
  1242. }
  1243. foreach my $line (@data) {
  1244. if($line =~ /WE ROOLZ: (\d+)/) {
  1245. # this is our test server with a known pid!
  1246. $pid = 0+$1;
  1247. last;
  1248. }
  1249. }
  1250. if($pid <= 0 && @data && $data[0]) {
  1251. # this is not a known server
  1252. logmsg "RUN: Unknown server on our $server port: $port\n";
  1253. return 0;
  1254. }
  1255. # we can/should use the time it took to verify the server as a measure
  1256. # on how fast/slow this host is.
  1257. my $took = int(0.5+time()-$time);
  1258. if($verbose) {
  1259. logmsg "RUN: Verifying our test $server server took $took seconds\n";
  1260. }
  1261. return $pid;
  1262. }
  1263. #######################################################################
  1264. # Verify that the server that runs on $ip, $port is our server.
  1265. # Retry over several seconds before giving up. The ssh server in
  1266. # particular can take a long time to start if it needs to generate
  1267. # keys on a slow or loaded host.
  1268. #
  1269. # Just for convenience, test harness uses 'https' and 'httptls' literals
  1270. # as values for 'proto' variable in order to differentiate different
  1271. # servers. 'https' literal is used for stunnel based https test servers,
  1272. # and 'httptls' is used for non-stunnel https test servers.
  1273. #
  1274. my %protofunc = ('http' => \&verifyhttp,
  1275. 'https' => \&verifyhttp,
  1276. 'rtsp' => \&verifyrtsp,
  1277. 'ftp' => \&verifyftp,
  1278. 'pop3' => \&verifyftp,
  1279. 'imap' => \&verifyftp,
  1280. 'smtp' => \&verifyftp,
  1281. 'ftps' => \&verifyftp,
  1282. 'pop3s' => \&verifyftp,
  1283. 'imaps' => \&verifyftp,
  1284. 'smtps' => \&verifyftp,
  1285. 'tftp' => \&verifyftp,
  1286. 'ssh' => \&verifyssh,
  1287. 'socks' => \&verifysocks,
  1288. 'socks5unix' => \&verifysocks,
  1289. 'gopher' => \&verifyhttp,
  1290. 'httptls' => \&verifyhttptls,
  1291. 'dict' => \&verifyftp,
  1292. 'smb' => \&verifysmb,
  1293. 'telnet' => \&verifytelnet);
  1294. sub verifyserver {
  1295. my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
  1296. my $count = 30; # try for this many seconds
  1297. my $pid;
  1298. while($count--) {
  1299. my $fun = $protofunc{$proto};
  1300. $pid = &$fun($proto, $ipvnum, $idnum, $ip, $port);
  1301. if($pid > 0) {
  1302. last;
  1303. }
  1304. elsif($pid < 0) {
  1305. # a real failure, stop trying and bail out
  1306. return 0;
  1307. }
  1308. sleep(1);
  1309. }
  1310. return $pid;
  1311. }
  1312. #######################################################################
  1313. # Single shot server responsiveness test. This should only be used
  1314. # to verify that a server present in %run hash is still functional
  1315. #
  1316. sub responsiveserver {
  1317. my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
  1318. my $prev_verbose = $verbose;
  1319. $verbose = 0;
  1320. my $fun = $protofunc{$proto};
  1321. my $pid = &$fun($proto, $ipvnum, $idnum, $ip, $port);
  1322. $verbose = $prev_verbose;
  1323. if($pid > 0) {
  1324. return 1; # responsive
  1325. }
  1326. my $srvrname = servername_str($proto, $ipvnum, $idnum);
  1327. logmsg " server precheck FAILED (unresponsive $srvrname server)\n";
  1328. return 0;
  1329. }
  1330. #######################################################################
  1331. # start the http2 server
  1332. #
  1333. sub runhttp2server {
  1334. my ($verbose) = @_;
  1335. my $server;
  1336. my $srvrname;
  1337. my $pidfile;
  1338. my $logfile;
  1339. my $flags = "";
  1340. my $proto="http/2";
  1341. my $ipvnum = 4;
  1342. my $idnum = 0;
  1343. my $exe = "$perl $srcdir/http2-server.pl";
  1344. my $verbose_flag = "--verbose ";
  1345. $server = servername_id($proto, $ipvnum, $idnum);
  1346. $pidfile = $serverpidfile{$server};
  1347. # don't retry if the server doesn't work
  1348. if ($doesntrun{$pidfile}) {
  1349. return (0, 0, 0, 0);
  1350. }
  1351. my $pid = processexists($pidfile);
  1352. if($pid > 0) {
  1353. stopserver($server, "$pid");
  1354. }
  1355. unlink($pidfile) if(-f $pidfile);
  1356. $srvrname = servername_str($proto, $ipvnum, $idnum);
  1357. $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
  1358. $flags .= "--nghttpx \"$ENV{'NGHTTPX'}\" ";
  1359. $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
  1360. $flags .= "--connect $HOSTIP:" . protoport("http") . " ";
  1361. $flags .= $verbose_flag if($debugprotocol);
  1362. my ($http2pid, $pid2);
  1363. my $port = 23113;
  1364. my $port2 = 23114;
  1365. for(1 .. 10) {
  1366. $port += int(rand(900));
  1367. $port2 += int(rand(900));
  1368. my $aflags = "--port $port --port2 $port2 $flags";
  1369. my $cmd = "$exe $aflags";
  1370. ($http2pid, $pid2) = startnew($cmd, $pidfile, 15, 0);
  1371. if($http2pid <= 0 || !pidexists($http2pid)) {
  1372. # it is NOT alive
  1373. stopserver($server, "$pid2");
  1374. $doesntrun{$pidfile} = 1;
  1375. $http2pid = $pid2 = 0;
  1376. next;
  1377. }
  1378. $doesntrun{$pidfile} = 0;
  1379. if($verbose) {
  1380. logmsg "RUN: $srvrname server PID $http2pid ".
  1381. "http-port $port https-port $port2 ".
  1382. "backend $HOSTIP:" . protoport("http") . "\n";
  1383. }
  1384. last;
  1385. }
  1386. logmsg "RUN: failed to start the $srvrname server\n" if(!$http2pid);
  1387. return ($http2pid, $pid2, $port, $port2);
  1388. }
  1389. #######################################################################
  1390. # start the http3 server
  1391. #
  1392. sub runhttp3server {
  1393. my ($verbose, $cert) = @_;
  1394. my $server;
  1395. my $srvrname;
  1396. my $pidfile;
  1397. my $logfile;
  1398. my $flags = "";
  1399. my $proto="http/3";
  1400. my $ipvnum = 4;
  1401. my $idnum = 0;
  1402. my $exe = "$perl $srcdir/http3-server.pl";
  1403. my $verbose_flag = "--verbose ";
  1404. $server = servername_id($proto, $ipvnum, $idnum);
  1405. $pidfile = $serverpidfile{$server};
  1406. # don't retry if the server doesn't work
  1407. if ($doesntrun{$pidfile}) {
  1408. return (0, 0, 0);
  1409. }
  1410. my $pid = processexists($pidfile);
  1411. if($pid > 0) {
  1412. stopserver($server, "$pid");
  1413. }
  1414. unlink($pidfile) if(-f $pidfile);
  1415. $srvrname = servername_str($proto, $ipvnum, $idnum);
  1416. $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
  1417. $flags .= "--nghttpx \"$ENV{'NGHTTPX'}\" ";
  1418. $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
  1419. $flags .= "--connect $HOSTIP:" . protoport("http") . " ";
  1420. $flags .= "--cert \"$cert\" " if($cert);
  1421. $flags .= $verbose_flag if($debugprotocol);
  1422. my ($http3pid, $pid3);
  1423. my $port = 24113;
  1424. for(1 .. 10) {
  1425. $port += int(rand(900));
  1426. my $aflags = "--port $port $flags";
  1427. my $cmd = "$exe $aflags";
  1428. ($http3pid, $pid3) = startnew($cmd, $pidfile, 15, 0);
  1429. if($http3pid <= 0 || !pidexists($http3pid)) {
  1430. # it is NOT alive
  1431. stopserver($server, "$pid3");
  1432. $doesntrun{$pidfile} = 1;
  1433. $http3pid = $pid3 = 0;
  1434. next;
  1435. }
  1436. $doesntrun{$pidfile} = 0;
  1437. if($verbose) {
  1438. logmsg "RUN: $srvrname server PID $http3pid port $port\n";
  1439. }
  1440. last;
  1441. }
  1442. logmsg "RUN: failed to start the $srvrname server\n" if(!$http3pid);
  1443. return ($http3pid, $pid3, $port);
  1444. }
  1445. #######################################################################
  1446. # start the http server
  1447. #
  1448. sub runhttpserver {
  1449. my ($proto, $verbose, $alt, $port_or_path) = @_;
  1450. my $ip = $HOSTIP;
  1451. my $ipvnum = 4;
  1452. my $idnum = 1;
  1453. my $server;
  1454. my $srvrname;
  1455. my $pidfile;
  1456. my $logfile;
  1457. my $flags = "";
  1458. my $exe = "$perl $srcdir/http-server.pl";
  1459. my $verbose_flag = "--verbose ";
  1460. if($alt eq "ipv6") {
  1461. # if IPv6, use a different setup
  1462. $ipvnum = 6;
  1463. $ip = $HOST6IP;
  1464. }
  1465. elsif($alt eq "proxy") {
  1466. # basically the same, but another ID
  1467. $idnum = 2;
  1468. }
  1469. elsif($alt eq "unix") {
  1470. # IP (protocol) is mutually exclusive with Unix sockets
  1471. $ipvnum = "unix";
  1472. }
  1473. $server = servername_id($proto, $ipvnum, $idnum);
  1474. $pidfile = $serverpidfile{$server};
  1475. my $portfile = $serverportfile{$server};
  1476. # don't retry if the server doesn't work
  1477. if ($doesntrun{$pidfile}) {
  1478. return (0, 0, 0);
  1479. }
  1480. my $pid = processexists($pidfile);
  1481. if($pid > 0) {
  1482. stopserver($server, "$pid");
  1483. }
  1484. unlink($pidfile) if(-f $pidfile);
  1485. $srvrname = servername_str($proto, $ipvnum, $idnum);
  1486. $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
  1487. $flags .= "--gopher " if($proto eq "gopher");
  1488. $flags .= "--connect $HOSTIP " if($alt eq "proxy");
  1489. $flags .= $verbose_flag if($debugprotocol);
  1490. $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
  1491. $flags .= "--portfile $portfile ";
  1492. $flags .= "--id $idnum " if($idnum > 1);
  1493. if($ipvnum eq "unix") {
  1494. $flags .= "--unix-socket '$port_or_path' ";
  1495. } else {
  1496. $flags .= "--ipv$ipvnum --port 0 ";
  1497. }
  1498. $flags .= "--srcdir \"$TESTDIR/..\"";
  1499. my $cmd = "$exe $flags";
  1500. my ($httppid, $pid2) = startnew($cmd, $pidfile, 15, 0);
  1501. if($httppid <= 0 || !pidexists($httppid)) {
  1502. # it is NOT alive
  1503. logmsg "RUN: failed to start the $srvrname server\n";
  1504. stopserver($server, "$pid2");
  1505. displaylogs($testnumcheck);
  1506. $doesntrun{$pidfile} = 1;
  1507. return (0, 0, 0);
  1508. }
  1509. # where is it?
  1510. my $port = 0;
  1511. if(!$port_or_path) {
  1512. $port = $port_or_path = pidfromfile($portfile);
  1513. }
  1514. # Server is up. Verify that we can speak to it.
  1515. my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port_or_path);
  1516. if(!$pid3) {
  1517. logmsg "RUN: $srvrname server failed verification\n";
  1518. # failed to talk to it properly. Kill the server and return failure
  1519. stopserver($server, "$httppid $pid2");
  1520. displaylogs($testnumcheck);
  1521. $doesntrun{$pidfile} = 1;
  1522. return (0, 0, 0);
  1523. }
  1524. $pid2 = $pid3;
  1525. if($verbose) {
  1526. logmsg "RUN: $srvrname server is on PID $httppid port $port_or_path\n";
  1527. }
  1528. return ($httppid, $pid2, $port);
  1529. }
  1530. #######################################################################
  1531. # start the https stunnel based server
  1532. #
  1533. sub runhttpsserver {
  1534. my ($verbose, $proto, $proxy, $certfile) = @_;
  1535. my $ip = $HOSTIP;
  1536. my $ipvnum = 4;
  1537. my $idnum = 1;
  1538. my $server;
  1539. my $srvrname;
  1540. my $pidfile;
  1541. my $logfile;
  1542. my $flags = "";
  1543. if($proxy eq "proxy") {
  1544. # the https-proxy runs as https2
  1545. $idnum = 2;
  1546. }
  1547. if(!$stunnel) {
  1548. return (0, 0, 0);
  1549. }
  1550. $server = servername_id($proto, $ipvnum, $idnum);
  1551. $pidfile = $serverpidfile{$server};
  1552. # don't retry if the server doesn't work
  1553. if ($doesntrun{$pidfile}) {
  1554. return (0, 0, 0);
  1555. }
  1556. my $pid = processexists($pidfile);
  1557. if($pid > 0) {
  1558. stopserver($server, "$pid");
  1559. }
  1560. unlink($pidfile) if(-f $pidfile);
  1561. $srvrname = servername_str($proto, $ipvnum, $idnum);
  1562. $certfile = 'stunnel.pem' unless($certfile);
  1563. $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
  1564. $flags .= "--verbose " if($debugprotocol);
  1565. $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
  1566. $flags .= "--id $idnum " if($idnum > 1);
  1567. $flags .= "--ipv$ipvnum --proto $proto ";
  1568. $flags .= "--certfile \"$certfile\" " if($certfile ne 'stunnel.pem');
  1569. $flags .= "--stunnel \"$stunnel\" --srcdir \"$srcdir\" ";
  1570. if($proto eq "gophers") {
  1571. $flags .= "--connect " . protoport("gopher");
  1572. }
  1573. elsif(!$proxy) {
  1574. $flags .= "--connect " . protoport("http");
  1575. }
  1576. else {
  1577. # for HTTPS-proxy we connect to the HTTP proxy
  1578. $flags .= "--connect " . protoport("httpproxy");
  1579. }
  1580. my $pid2;
  1581. my $httpspid;
  1582. my $port = 24512; # start attempt
  1583. for (1 .. 10) {
  1584. $port += int(rand(600));
  1585. my $options = "$flags --accept $port";
  1586. my $cmd = "$perl $srcdir/secureserver.pl $options";
  1587. ($httpspid, $pid2) = startnew($cmd, $pidfile, 15, 0);
  1588. if($httpspid <= 0 || !pidexists($httpspid)) {
  1589. # it is NOT alive
  1590. stopserver($server, "$pid2");
  1591. displaylogs($testnumcheck);
  1592. $doesntrun{$pidfile} = 1;
  1593. $httpspid = $pid2 = 0;
  1594. next;
  1595. }
  1596. # we have a server!
  1597. if($verbose) {
  1598. logmsg "RUN: $srvrname server is PID $httpspid port $port\n";
  1599. }
  1600. last;
  1601. }
  1602. $runcert{$server} = $certfile;
  1603. logmsg "RUN: failed to start the $srvrname server\n" if(!$httpspid);
  1604. return ($httpspid, $pid2, $port);
  1605. }
  1606. #######################################################################
  1607. # start the non-stunnel HTTP TLS extensions capable server
  1608. #
  1609. sub runhttptlsserver {
  1610. my ($verbose, $ipv6) = @_;
  1611. my $proto = "httptls";
  1612. my $ip = ($ipv6 && ($ipv6 =~ /6$/)) ? "$HOST6IP" : "$HOSTIP";
  1613. my $ipvnum = ($ipv6 && ($ipv6 =~ /6$/)) ? 6 : 4;
  1614. my $idnum = 1;
  1615. my $server;
  1616. my $srvrname;
  1617. my $pidfile;
  1618. my $logfile;
  1619. my $flags = "";
  1620. if(!$httptlssrv) {
  1621. return (0,0);
  1622. }
  1623. $server = servername_id($proto, $ipvnum, $idnum);
  1624. $pidfile = $serverpidfile{$server};
  1625. # don't retry if the server doesn't work
  1626. if ($doesntrun{$pidfile}) {
  1627. return (0, 0, 0);
  1628. }
  1629. my $pid = processexists($pidfile);
  1630. if($pid > 0) {
  1631. stopserver($server, "$pid");
  1632. }
  1633. unlink($pidfile) if(-f $pidfile);
  1634. $srvrname = servername_str($proto, $ipvnum, $idnum);
  1635. $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
  1636. $flags .= "--http ";
  1637. $flags .= "--debug 1 " if($debugprotocol);
  1638. $flags .= "--priority NORMAL:+SRP ";
  1639. $flags .= "--srppasswd $srcdir/certs/srp-verifier-db ";
  1640. $flags .= "--srppasswdconf $srcdir/certs/srp-verifier-conf";
  1641. my $port = 24367;
  1642. my ($httptlspid, $pid2);
  1643. for (1 .. 10) {
  1644. $port += int(rand(800));
  1645. my $allflags = "--port $port $flags";
  1646. my $cmd = "$httptlssrv $allflags > $logfile 2>&1";
  1647. ($httptlspid, $pid2) = startnew($cmd, $pidfile, 10, 1);
  1648. if($httptlspid <= 0 || !pidexists($httptlspid)) {
  1649. # it is NOT alive
  1650. stopserver($server, "$pid2");
  1651. displaylogs($testnumcheck);
  1652. $doesntrun{$pidfile} = 1;
  1653. $httptlspid = $pid2 = 0;
  1654. next;
  1655. }
  1656. $doesntrun{$pidfile} = 0;
  1657. if($verbose) {
  1658. logmsg "RUN: $srvrname server PID $httptlspid port $port\n";
  1659. }
  1660. last;
  1661. }
  1662. logmsg "RUN: failed to start the $srvrname server\n" if(!$httptlspid);
  1663. return ($httptlspid, $pid2, $port);
  1664. }
  1665. #######################################################################
  1666. # start the pingpong server (FTP, POP3, IMAP, SMTP)
  1667. #
  1668. sub runpingpongserver {
  1669. my ($proto, $id, $verbose, $ipv6) = @_;
  1670. my $port;
  1671. my $ip = ($ipv6 && ($ipv6 =~ /6$/)) ? "$HOST6IP" : "$HOSTIP";
  1672. my $ipvnum = ($ipv6 && ($ipv6 =~ /6$/)) ? 6 : 4;
  1673. my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1;
  1674. my $server;
  1675. my $srvrname;
  1676. my $pidfile;
  1677. my $logfile;
  1678. my $flags = "";
  1679. $server = servername_id($proto, $ipvnum, $idnum);
  1680. $pidfile = $serverpidfile{$server};
  1681. my $portfile = $serverportfile{$server};
  1682. # don't retry if the server doesn't work
  1683. if ($doesntrun{$pidfile}) {
  1684. return (0,0);
  1685. }
  1686. my $pid = processexists($pidfile);
  1687. if($pid > 0) {
  1688. stopserver($server, "$pid");
  1689. }
  1690. unlink($pidfile) if(-f $pidfile);
  1691. $srvrname = servername_str($proto, $ipvnum, $idnum);
  1692. $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
  1693. $flags .= "--verbose " if($debugprotocol);
  1694. $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
  1695. $flags .= "--portfile \"$portfile\" ";
  1696. $flags .= "--srcdir \"$srcdir\" --proto $proto ";
  1697. $flags .= "--id $idnum " if($idnum > 1);
  1698. $flags .= "--ipv$ipvnum --port 0 --addr \"$ip\"";
  1699. my $cmd = "$perl $srcdir/ftpserver.pl $flags";
  1700. my ($ftppid, $pid2) = startnew($cmd, $pidfile, 15, 0);
  1701. if($ftppid <= 0 || !pidexists($ftppid)) {
  1702. # it is NOT alive
  1703. logmsg "RUN: failed to start the $srvrname server\n";
  1704. stopserver($server, "$pid2");
  1705. displaylogs($testnumcheck);
  1706. $doesntrun{$pidfile} = 1;
  1707. return (0,0);
  1708. }
  1709. # where is it?
  1710. $port = pidfromfile($portfile);
  1711. logmsg "PINGPONG runs on port $port ($portfile)\n" if($verbose);
  1712. # Server is up. Verify that we can speak to it.
  1713. my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port);
  1714. if(!$pid3) {
  1715. logmsg "RUN: $srvrname server failed verification\n";
  1716. # failed to talk to it properly. Kill the server and return failure
  1717. stopserver($server, "$ftppid $pid2");
  1718. displaylogs($testnumcheck);
  1719. $doesntrun{$pidfile} = 1;
  1720. return (0,0);
  1721. }
  1722. $pid2 = $pid3;
  1723. logmsg "RUN: $srvrname server is PID $ftppid port $port\n" if($verbose);
  1724. # Assign the correct port variable!
  1725. if($proto =~ /^(?:ftp|imap|pop3|smtp)$/) {
  1726. $PORT{$proto . ($ipvnum == 6? '6': '')} = $port;
  1727. }
  1728. else {
  1729. print STDERR "Unsupported protocol $proto!!\n";
  1730. return (0,0);
  1731. }
  1732. return ($pid2, $ftppid);
  1733. }
  1734. #######################################################################
  1735. # start the ftps/imaps/pop3s/smtps server (or rather, tunnel)
  1736. #
  1737. sub runsecureserver {
  1738. my ($verbose, $ipv6, $certfile, $proto, $clearport) = @_;
  1739. my $ip = ($ipv6 && ($ipv6 =~ /6$/)) ? "$HOST6IP" : "$HOSTIP";
  1740. my $ipvnum = ($ipv6 && ($ipv6 =~ /6$/)) ? 6 : 4;
  1741. my $idnum = 1;
  1742. my $server;
  1743. my $srvrname;
  1744. my $pidfile;
  1745. my $logfile;
  1746. my $flags = "";
  1747. if(!$stunnel) {
  1748. return (0,0);
  1749. }
  1750. $server = servername_id($proto, $ipvnum, $idnum);
  1751. $pidfile = $serverpidfile{$server};
  1752. # don't retry if the server doesn't work
  1753. if ($doesntrun{$pidfile}) {
  1754. return (0, 0, 0);
  1755. }
  1756. my $pid = processexists($pidfile);
  1757. if($pid > 0) {
  1758. stopserver($server, "$pid");
  1759. }
  1760. unlink($pidfile) if(-f $pidfile);
  1761. $srvrname = servername_str($proto, $ipvnum, $idnum);
  1762. $certfile = 'stunnel.pem' unless($certfile);
  1763. $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
  1764. $flags .= "--verbose " if($debugprotocol);
  1765. $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
  1766. $flags .= "--id $idnum " if($idnum > 1);
  1767. $flags .= "--ipv$ipvnum --proto $proto ";
  1768. $flags .= "--certfile \"$certfile\" " if($certfile ne 'stunnel.pem');
  1769. $flags .= "--stunnel \"$stunnel\" --srcdir \"$srcdir\" ";
  1770. $flags .= "--connect $clearport";
  1771. my $protospid;
  1772. my $pid2;
  1773. my $port = 26713 + ord $proto;
  1774. my %usedports = reverse %PORT;
  1775. for (1 .. 10) {
  1776. $port += int(rand(700));
  1777. next if exists $usedports{$port};
  1778. my $options = "$flags --accept $port";
  1779. my $cmd = "$perl $srcdir/secureserver.pl $options";
  1780. ($protospid, $pid2) = startnew($cmd, $pidfile, 15, 0);
  1781. if($protospid <= 0 || !pidexists($protospid)) {
  1782. # it is NOT alive
  1783. stopserver($server, "$pid2");
  1784. displaylogs($testnumcheck);
  1785. $doesntrun{$pidfile} = 1;
  1786. $protospid = $pid2 = 0;
  1787. next;
  1788. }
  1789. $doesntrun{$pidfile} = 0;
  1790. $runcert{$server} = $certfile;
  1791. if($verbose) {
  1792. logmsg "RUN: $srvrname server is PID $protospid port $port\n";
  1793. }
  1794. last;
  1795. }
  1796. logmsg "RUN: failed to start the $srvrname server\n" if(!$protospid);
  1797. return ($protospid, $pid2, $port);
  1798. }
  1799. #######################################################################
  1800. # start the tftp server
  1801. #
  1802. sub runtftpserver {
  1803. my ($id, $verbose, $ipv6) = @_;
  1804. my $ip = $HOSTIP;
  1805. my $proto = 'tftp';
  1806. my $ipvnum = 4;
  1807. my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1;
  1808. my $server;
  1809. my $srvrname;
  1810. my $pidfile;
  1811. my $logfile;
  1812. my $flags = "";
  1813. if($ipv6) {
  1814. # if IPv6, use a different setup
  1815. $ipvnum = 6;
  1816. $ip = $HOST6IP;
  1817. }
  1818. $server = servername_id($proto, $ipvnum, $idnum);
  1819. $pidfile = $serverpidfile{$server};
  1820. my $portfile = $serverportfile{$server};
  1821. # don't retry if the server doesn't work
  1822. if ($doesntrun{$pidfile}) {
  1823. return (0, 0, 0);
  1824. }
  1825. my $pid = processexists($pidfile);
  1826. if($pid > 0) {
  1827. stopserver($server, "$pid");
  1828. }
  1829. unlink($pidfile) if(-f $pidfile);
  1830. $srvrname = servername_str($proto, $ipvnum, $idnum);
  1831. $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
  1832. $flags .= "--verbose " if($debugprotocol);
  1833. $flags .= "--pidfile \"$pidfile\" ".
  1834. "--portfile \"$portfile\" ".
  1835. "--logfile \"$logfile\" ";
  1836. $flags .= "--id $idnum " if($idnum > 1);
  1837. $flags .= "--ipv$ipvnum --port 0 --srcdir \"$srcdir\"";
  1838. my $cmd = "$perl $srcdir/tftpserver.pl $flags";
  1839. my ($tftppid, $pid2) = startnew($cmd, $pidfile, 15, 0);
  1840. if($tftppid <= 0 || !pidexists($tftppid)) {
  1841. # it is NOT alive
  1842. logmsg "RUN: failed to start the $srvrname server\n";
  1843. stopserver($server, "$pid2");
  1844. displaylogs($testnumcheck);
  1845. $doesntrun{$pidfile} = 1;
  1846. return (0, 0, 0);
  1847. }
  1848. my $port = pidfromfile($portfile);
  1849. # Server is up. Verify that we can speak to it.
  1850. my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port);
  1851. if(!$pid3) {
  1852. logmsg "RUN: $srvrname server failed verification\n";
  1853. # failed to talk to it properly. Kill the server and return failure
  1854. stopserver($server, "$tftppid $pid2");
  1855. displaylogs($testnumcheck);
  1856. $doesntrun{$pidfile} = 1;
  1857. return (0, 0, 0);
  1858. }
  1859. $pid2 = $pid3;
  1860. if($verbose) {
  1861. logmsg "RUN: $srvrname server on PID $tftppid port $port\n";
  1862. }
  1863. return ($pid2, $tftppid, $port);
  1864. }
  1865. #######################################################################
  1866. # start the rtsp server
  1867. #
  1868. sub runrtspserver {
  1869. my ($verbose, $ipv6) = @_;
  1870. my $ip = $HOSTIP;
  1871. my $proto = 'rtsp';
  1872. my $ipvnum = 4;
  1873. my $idnum = 1;
  1874. my $server;
  1875. my $srvrname;
  1876. my $pidfile;
  1877. my $logfile;
  1878. my $flags = "";
  1879. if($ipv6) {
  1880. # if IPv6, use a different setup
  1881. $ipvnum = 6;
  1882. $ip = $HOST6IP;
  1883. }
  1884. $server = servername_id($proto, $ipvnum, $idnum);
  1885. $pidfile = $serverpidfile{$server};
  1886. my $portfile = $serverportfile{$server};
  1887. # don't retry if the server doesn't work
  1888. if ($doesntrun{$pidfile}) {
  1889. return (0, 0, 0);
  1890. }
  1891. my $pid = processexists($pidfile);
  1892. if($pid > 0) {
  1893. stopserver($server, "$pid");
  1894. }
  1895. unlink($pidfile) if(-f $pidfile);
  1896. $srvrname = servername_str($proto, $ipvnum, $idnum);
  1897. $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
  1898. $flags .= "--verbose " if($debugprotocol);
  1899. $flags .= "--pidfile \"$pidfile\" ".
  1900. "--portfile \"$portfile\" ".
  1901. "--logfile \"$logfile\" ";
  1902. $flags .= "--id $idnum " if($idnum > 1);
  1903. $flags .= "--ipv$ipvnum --port 0 --srcdir \"$srcdir\"";
  1904. my $cmd = "$perl $srcdir/rtspserver.pl $flags";
  1905. my ($rtsppid, $pid2) = startnew($cmd, $pidfile, 15, 0);
  1906. if($rtsppid <= 0 || !pidexists($rtsppid)) {
  1907. # it is NOT alive
  1908. logmsg "RUN: failed to start the $srvrname server\n";
  1909. stopserver($server, "$pid2");
  1910. displaylogs($testnumcheck);
  1911. $doesntrun{$pidfile} = 1;
  1912. return (0, 0, 0);
  1913. }
  1914. my $port = pidfromfile($portfile);
  1915. # Server is up. Verify that we can speak to it.
  1916. my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port);
  1917. if(!$pid3) {
  1918. logmsg "RUN: $srvrname server failed verification\n";
  1919. # failed to talk to it properly. Kill the server and return failure
  1920. stopserver($server, "$rtsppid $pid2");
  1921. displaylogs($testnumcheck);
  1922. $doesntrun{$pidfile} = 1;
  1923. return (0, 0, 0);
  1924. }
  1925. $pid2 = $pid3;
  1926. if($verbose) {
  1927. logmsg "RUN: $srvrname server PID $rtsppid port $port\n";
  1928. }
  1929. return ($rtsppid, $pid2, $port);
  1930. }
  1931. #######################################################################
  1932. # Start the ssh (scp/sftp) server
  1933. #
  1934. sub runsshserver {
  1935. my ($id, $verbose, $ipv6) = @_;
  1936. my $ip=$HOSTIP;
  1937. my $proto = 'ssh';
  1938. my $ipvnum = 4;
  1939. my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1;
  1940. my $server;
  1941. my $srvrname;
  1942. my $pidfile;
  1943. my $logfile;
  1944. my $port = 20000; # no lower port
  1945. if(!$USER) {
  1946. logmsg "Can't start ssh server due to lack of USER name";
  1947. return (0,0,0);
  1948. }
  1949. $server = servername_id($proto, $ipvnum, $idnum);
  1950. $pidfile = $serverpidfile{$server};
  1951. # don't retry if the server doesn't work
  1952. if ($doesntrun{$pidfile}) {
  1953. return (0, 0, 0);
  1954. }
  1955. my $sshd = find_sshd();
  1956. if($sshd) {
  1957. ($sshdid,$sshdvernum,$sshdverstr,$sshderror) = sshversioninfo($sshd);
  1958. }
  1959. my $pid = processexists($pidfile);
  1960. if($pid > 0) {
  1961. stopserver($server, "$pid");
  1962. }
  1963. unlink($pidfile) if(-f $pidfile);
  1964. $srvrname = servername_str($proto, $ipvnum, $idnum);
  1965. $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
  1966. my $flags = "";
  1967. $flags .= "--verbose " if($verbose);
  1968. $flags .= "--debugprotocol " if($debugprotocol);
  1969. $flags .= "--pidfile \"$pidfile\" ";
  1970. $flags .= "--id $idnum " if($idnum > 1);
  1971. $flags .= "--ipv$ipvnum --addr \"$ip\" ";
  1972. $flags .= "--user \"$USER\"";
  1973. my $sshpid;
  1974. my $pid2;
  1975. my $wport = 0,
  1976. my @tports;
  1977. for(1 .. 10) {
  1978. # sshd doesn't have a way to pick an unused random port number, so
  1979. # instead we iterate over possible port numbers to use until we find
  1980. # one that works
  1981. $port += int(rand(500));
  1982. push @tports, $port;
  1983. my $options = "$flags --sshport $port";
  1984. my $cmd = "$perl $srcdir/sshserver.pl $options";
  1985. ($sshpid, $pid2) = startnew($cmd, $pidfile, 60, 0);
  1986. # on loaded systems sshserver start up can take longer than the
  1987. # timeout passed to startnew, when this happens startnew completes
  1988. # without being able to read the pidfile and consequently returns a
  1989. # zero pid2 above.
  1990. if($sshpid <= 0 || !pidexists($sshpid)) {
  1991. # it is NOT alive
  1992. stopserver($server, "$pid2");
  1993. $doesntrun{$pidfile} = 1;
  1994. $sshpid = $pid2 = 0;
  1995. next;
  1996. }
  1997. # once it is known that the ssh server is alive, sftp server
  1998. # verification is performed actually connecting to it, authenticating
  1999. # and performing a very simple remote command. This verification is
  2000. # tried only one time.
  2001. $sshdlog = server_logfilename($LOGDIR, 'ssh', $ipvnum, $idnum);
  2002. $sftplog = server_logfilename($LOGDIR, 'sftp', $ipvnum, $idnum);
  2003. if(verifysftp('sftp', $ipvnum, $idnum, $ip, $port) < 1) {
  2004. logmsg "RUN: SFTP server failed verification\n";
  2005. # failed to talk to it properly. Kill the server and return failure
  2006. display_sftplog();
  2007. display_sftpconfig();
  2008. display_sshdlog();
  2009. display_sshdconfig();
  2010. stopserver($server, "$sshpid $pid2");
  2011. $doesntrun{$pidfile} = 1;
  2012. $sshpid = $pid2 = 0;
  2013. next;
  2014. }
  2015. # we're happy, no need to loop anymore!
  2016. $doesntrun{$pidfile} = 0;
  2017. $wport = $port;
  2018. last;
  2019. }
  2020. logmsg "RUN: failed to start the $srvrname server on $port\n" if(!$sshpid);
  2021. if(!$wport) {
  2022. logmsg "RUN: couldn't start $srvrname. Tried these ports:";
  2023. logmsg "RUN: ".join(", ", @tports);
  2024. return (0,0,0);
  2025. }
  2026. my $hstpubmd5f = "curl_host_rsa_key.pub_md5";
  2027. if(!open(PUBMD5FILE, "<", $hstpubmd5f) ||
  2028. (read(PUBMD5FILE, $SSHSRVMD5, 32) != 32) ||
  2029. !close(PUBMD5FILE) ||
  2030. ($SSHSRVMD5 !~ /^[a-f0-9]{32}$/i))
  2031. {
  2032. my $msg = "Fatal: $srvrname pubkey md5 missing : \"$hstpubmd5f\" : $!";
  2033. logmsg "$msg\n";
  2034. stopservers($verbose);
  2035. die $msg;
  2036. }
  2037. my $hstpubsha256f = "curl_host_rsa_key.pub_sha256";
  2038. if(!open(PUBSHA256FILE, "<", $hstpubsha256f) ||
  2039. (read(PUBSHA256FILE, $SSHSRVSHA256, 48) == 0) ||
  2040. !close(PUBSHA256FILE))
  2041. {
  2042. my $msg = "Fatal: $srvrname pubkey sha256 missing : \"$hstpubsha256f\" : $!";
  2043. logmsg "$msg\n";
  2044. stopservers($verbose);
  2045. die $msg;
  2046. }
  2047. logmsg "RUN: $srvrname on PID $pid2 port $wport\n" if($verbose);
  2048. return ($pid2, $sshpid, $wport);
  2049. }
  2050. #######################################################################
  2051. # Start the MQTT server
  2052. #
  2053. sub runmqttserver {
  2054. my ($id, $verbose, $ipv6) = @_;
  2055. my $ip=$HOSTIP;
  2056. my $proto = 'mqtt';
  2057. my $port = protoport($proto);
  2058. my $ipvnum = 4;
  2059. my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1;
  2060. my $server;
  2061. my $srvrname;
  2062. my $pidfile;
  2063. my $portfile;
  2064. my $logfile;
  2065. my $flags = "";
  2066. $server = servername_id($proto, $ipvnum, $idnum);
  2067. $pidfile = $serverpidfile{$server};
  2068. $portfile = $serverportfile{$server};
  2069. # don't retry if the server doesn't work
  2070. if ($doesntrun{$pidfile}) {
  2071. return (0,0);
  2072. }
  2073. my $pid = processexists($pidfile);
  2074. if($pid > 0) {
  2075. stopserver($server, "$pid");
  2076. }
  2077. unlink($pidfile) if(-f $pidfile);
  2078. $srvrname = servername_str($proto, $ipvnum, $idnum);
  2079. $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
  2080. # start our MQTT server - on a random port!
  2081. my $cmd="server/mqttd".exe_ext('SRV').
  2082. " --port 0 ".
  2083. " --pidfile $pidfile".
  2084. " --portfile $portfile".
  2085. " --config $FTPDCMD";
  2086. my ($sockspid, $pid2) = startnew($cmd, $pidfile, 30, 0);
  2087. if($sockspid <= 0 || !pidexists($sockspid)) {
  2088. # it is NOT alive
  2089. logmsg "RUN: failed to start the $srvrname server\n";
  2090. stopserver($server, "$pid2");
  2091. $doesntrun{$pidfile} = 1;
  2092. return (0,0);
  2093. }
  2094. my $mqttport = pidfromfile($portfile);
  2095. $PORT{"mqtt"} = $mqttport;
  2096. if($verbose) {
  2097. logmsg "RUN: $srvrname server is now running PID $pid2 on PORT $mqttport\n";
  2098. }
  2099. return ($pid2, $sockspid);
  2100. }
  2101. #######################################################################
  2102. # Start the socks server
  2103. #
  2104. sub runsocksserver {
  2105. my ($id, $verbose, $ipv6, $is_unix) = @_;
  2106. my $ip=$HOSTIP;
  2107. my $proto = 'socks';
  2108. my $ipvnum = 4;
  2109. my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1;
  2110. my $server;
  2111. my $srvrname;
  2112. my $pidfile;
  2113. my $logfile;
  2114. my $flags = "";
  2115. $server = servername_id($proto, $ipvnum, $idnum);
  2116. $pidfile = $serverpidfile{$server};
  2117. my $portfile = $serverportfile{$server};
  2118. # don't retry if the server doesn't work
  2119. if ($doesntrun{$pidfile}) {
  2120. return (0, 0, 0);
  2121. }
  2122. my $pid = processexists($pidfile);
  2123. if($pid > 0) {
  2124. stopserver($server, "$pid");
  2125. }
  2126. unlink($pidfile) if(-f $pidfile);
  2127. $srvrname = servername_str($proto, $ipvnum, $idnum);
  2128. $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
  2129. # start our socks server, get commands from the FTP cmd file
  2130. my $cmd="";
  2131. if($is_unix) {
  2132. $cmd="server/socksd".exe_ext('SRV').
  2133. " --pidfile $pidfile".
  2134. " --unix-socket $SOCKSUNIXPATH".
  2135. " --backend $HOSTIP".
  2136. " --config $FTPDCMD";
  2137. } else {
  2138. $cmd="server/socksd".exe_ext('SRV').
  2139. " --port 0 ".
  2140. " --pidfile $pidfile".
  2141. " --portfile $portfile".
  2142. " --backend $HOSTIP".
  2143. " --config $FTPDCMD";
  2144. }
  2145. my ($sockspid, $pid2) = startnew($cmd, $pidfile, 30, 0);
  2146. if($sockspid <= 0 || !pidexists($sockspid)) {
  2147. # it is NOT alive
  2148. logmsg "RUN: failed to start the $srvrname server\n";
  2149. stopserver($server, "$pid2");
  2150. $doesntrun{$pidfile} = 1;
  2151. return (0, 0, 0);
  2152. }
  2153. my $port = pidfromfile($portfile);
  2154. if($verbose) {
  2155. logmsg "RUN: $srvrname server is now running PID $pid2\n";
  2156. }
  2157. return ($pid2, $sockspid, $port);
  2158. }
  2159. #######################################################################
  2160. # start the dict server
  2161. #
  2162. sub rundictserver {
  2163. my ($verbose, $alt) = @_;
  2164. my $proto = "dict";
  2165. my $ip = $HOSTIP;
  2166. my $ipvnum = 4;
  2167. my $idnum = 1;
  2168. my $server;
  2169. my $srvrname;
  2170. my $pidfile;
  2171. my $logfile;
  2172. my $flags = "";
  2173. if($alt eq "ipv6") {
  2174. # No IPv6
  2175. }
  2176. $server = servername_id($proto, $ipvnum, $idnum);
  2177. $pidfile = $serverpidfile{$server};
  2178. # don't retry if the server doesn't work
  2179. if ($doesntrun{$pidfile}) {
  2180. return (0, 0, 0);
  2181. }
  2182. my $pid = processexists($pidfile);
  2183. if($pid > 0) {
  2184. stopserver($server, "$pid");
  2185. }
  2186. unlink($pidfile) if(-f $pidfile);
  2187. $srvrname = servername_str($proto, $ipvnum, $idnum);
  2188. $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
  2189. $flags .= "--verbose 1 " if($debugprotocol);
  2190. $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
  2191. $flags .= "--id $idnum " if($idnum > 1);
  2192. $flags .= "--srcdir \"$srcdir\" ";
  2193. $flags .= "--host $HOSTIP";
  2194. my $port = 29000;
  2195. my ($dictpid, $pid2);
  2196. for(1 .. 10) {
  2197. $port += int(rand(900));
  2198. my $aflags = "--port $port $flags";
  2199. my $cmd = "$srcdir/dictserver.py $aflags";
  2200. ($dictpid, $pid2) = startnew($cmd, $pidfile, 15, 0);
  2201. if($dictpid <= 0 || !pidexists($dictpid)) {
  2202. # it is NOT alive
  2203. stopserver($server, "$pid2");
  2204. displaylogs($testnumcheck);
  2205. $doesntrun{$pidfile} = 1;
  2206. $dictpid = $pid2 = 0;
  2207. next;
  2208. }
  2209. $doesntrun{$pidfile} = 0;
  2210. if($verbose) {
  2211. logmsg "RUN: $srvrname server PID $dictpid port $port\n";
  2212. }
  2213. last;
  2214. }
  2215. logmsg "RUN: failed to start the $srvrname server\n" if(!$dictpid);
  2216. return ($dictpid, $pid2, $port);
  2217. }
  2218. #######################################################################
  2219. # start the SMB server
  2220. #
  2221. sub runsmbserver {
  2222. my ($verbose, $alt) = @_;
  2223. my $proto = "smb";
  2224. my $ip = $HOSTIP;
  2225. my $ipvnum = 4;
  2226. my $idnum = 1;
  2227. my $server;
  2228. my $srvrname;
  2229. my $pidfile;
  2230. my $logfile;
  2231. my $flags = "";
  2232. if($alt eq "ipv6") {
  2233. # No IPv6
  2234. }
  2235. $server = servername_id($proto, $ipvnum, $idnum);
  2236. $pidfile = $serverpidfile{$server};
  2237. # don't retry if the server doesn't work
  2238. if ($doesntrun{$pidfile}) {
  2239. return (0, 0, 0);
  2240. }
  2241. my $pid = processexists($pidfile);
  2242. if($pid > 0) {
  2243. stopserver($server, "$pid");
  2244. }
  2245. unlink($pidfile) if(-f $pidfile);
  2246. $srvrname = servername_str($proto, $ipvnum, $idnum);
  2247. $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
  2248. $flags .= "--verbose 1 " if($debugprotocol);
  2249. $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
  2250. $flags .= "--id $idnum " if($idnum > 1);
  2251. $flags .= "--srcdir \"$srcdir\" ";
  2252. $flags .= "--host $HOSTIP";
  2253. my ($smbpid, $pid2);
  2254. my $port = 31923;
  2255. for(1 .. 10) {
  2256. $port += int(rand(760));
  2257. my $aflags = "--port $port $flags";
  2258. my $cmd = "$srcdir/smbserver.py $aflags";
  2259. ($smbpid, $pid2) = startnew($cmd, $pidfile, 15, 0);
  2260. if($smbpid <= 0 || !pidexists($smbpid)) {
  2261. # it is NOT alive
  2262. stopserver($server, "$pid2");
  2263. displaylogs($testnumcheck);
  2264. $doesntrun{$pidfile} = 1;
  2265. $smbpid = $pid2 = 0;
  2266. next;
  2267. }
  2268. $doesntrun{$pidfile} = 0;
  2269. if($verbose) {
  2270. logmsg "RUN: $srvrname server PID $smbpid port $port\n";
  2271. }
  2272. last;
  2273. }
  2274. logmsg "RUN: failed to start the $srvrname server\n" if(!$smbpid);
  2275. return ($smbpid, $pid2, $port);
  2276. }
  2277. #######################################################################
  2278. # start the telnet server
  2279. #
  2280. sub runnegtelnetserver {
  2281. my ($verbose, $alt) = @_;
  2282. my $proto = "telnet";
  2283. my $ip = $HOSTIP;
  2284. my $ipvnum = 4;
  2285. my $idnum = 1;
  2286. my $server;
  2287. my $srvrname;
  2288. my $pidfile;
  2289. my $logfile;
  2290. my $flags = "";
  2291. if($alt eq "ipv6") {
  2292. # No IPv6
  2293. }
  2294. $server = servername_id($proto, $ipvnum, $idnum);
  2295. $pidfile = $serverpidfile{$server};
  2296. # don't retry if the server doesn't work
  2297. if ($doesntrun{$pidfile}) {
  2298. return (0, 0, 0);
  2299. }
  2300. my $pid = processexists($pidfile);
  2301. if($pid > 0) {
  2302. stopserver($server, "$pid");
  2303. }
  2304. unlink($pidfile) if(-f $pidfile);
  2305. $srvrname = servername_str($proto, $ipvnum, $idnum);
  2306. $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
  2307. $flags .= "--verbose 1 " if($debugprotocol);
  2308. $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
  2309. $flags .= "--id $idnum " if($idnum > 1);
  2310. $flags .= "--srcdir \"$srcdir\"";
  2311. my ($ntelpid, $pid2);
  2312. my $port = 32000;
  2313. for(1 .. 10) {
  2314. $port += int(rand(800));
  2315. my $aflags = "--port $port $flags";
  2316. my $cmd = "$srcdir/negtelnetserver.py $aflags";
  2317. ($ntelpid, $pid2) = startnew($cmd, $pidfile, 15, 0);
  2318. if($ntelpid <= 0 || !pidexists($ntelpid)) {
  2319. # it is NOT alive
  2320. stopserver($server, "$pid2");
  2321. displaylogs($testnumcheck);
  2322. $doesntrun{$pidfile} = 1;
  2323. $ntelpid = $pid2 = 0;
  2324. next;
  2325. }
  2326. $doesntrun{$pidfile} = 0;
  2327. if($verbose) {
  2328. logmsg "RUN: $srvrname server PID $ntelpid port $port\n";
  2329. }
  2330. last;
  2331. }
  2332. logmsg "RUN: failed to start the $srvrname server\n" if(!$ntelpid);
  2333. return ($ntelpid, $pid2, $port);
  2334. }
  2335. #######################################################################
  2336. # Single shot http and gopher server responsiveness test. This should only
  2337. # be used to verify that a server present in %run hash is still functional
  2338. #
  2339. sub responsive_http_server {
  2340. my ($proto, $verbose, $alt, $port_or_path) = @_;
  2341. my $ip = $HOSTIP;
  2342. my $ipvnum = 4;
  2343. my $idnum = 1;
  2344. if($alt eq "ipv6") {
  2345. # if IPv6, use a different setup
  2346. $ipvnum = 6;
  2347. $ip = $HOST6IP;
  2348. }
  2349. elsif($alt eq "proxy") {
  2350. $idnum = 2;
  2351. }
  2352. elsif($alt eq "unix") {
  2353. # IP (protocol) is mutually exclusive with Unix sockets
  2354. $ipvnum = "unix";
  2355. }
  2356. return &responsiveserver($proto, $ipvnum, $idnum, $ip, $port_or_path);
  2357. }
  2358. #######################################################################
  2359. # Single shot pingpong server responsiveness test. This should only be
  2360. # used to verify that a server present in %run hash is still functional
  2361. #
  2362. sub responsive_pingpong_server {
  2363. my ($proto, $id, $verbose, $ipv6) = @_;
  2364. my $port;
  2365. my $ip = ($ipv6 && ($ipv6 =~ /6$/)) ? "$HOST6IP" : "$HOSTIP";
  2366. my $ipvnum = ($ipv6 && ($ipv6 =~ /6$/)) ? 6 : 4;
  2367. my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1;
  2368. my $protoip = $proto . ($ipvnum == 6? '6': '');
  2369. if($proto =~ /^(?:ftp|imap|pop3|smtp)$/) {
  2370. $port = protoport($protoip);
  2371. }
  2372. else {
  2373. print STDERR "Unsupported protocol $proto!!\n";
  2374. return 0;
  2375. }
  2376. return &responsiveserver($proto, $ipvnum, $idnum, $ip, $port);
  2377. }
  2378. #######################################################################
  2379. # Single shot rtsp server responsiveness test. This should only be
  2380. # used to verify that a server present in %run hash is still functional
  2381. #
  2382. sub responsive_rtsp_server {
  2383. my ($verbose, $ipv6) = @_;
  2384. my $proto = 'rtsp';
  2385. my $port = protoport($proto);
  2386. my $ip = $HOSTIP;
  2387. my $ipvnum = 4;
  2388. my $idnum = 1;
  2389. if($ipv6) {
  2390. # if IPv6, use a different setup
  2391. $ipvnum = 6;
  2392. $port = protoport('rtsp6');
  2393. $ip = $HOST6IP;
  2394. }
  2395. return &responsiveserver($proto, $ipvnum, $idnum, $ip, $port);
  2396. }
  2397. #######################################################################
  2398. # Single shot tftp server responsiveness test. This should only be
  2399. # used to verify that a server present in %run hash is still functional
  2400. #
  2401. sub responsive_tftp_server {
  2402. my ($id, $verbose, $ipv6) = @_;
  2403. my $proto = 'tftp';
  2404. my $port = protoport($proto);
  2405. my $ip = $HOSTIP;
  2406. my $ipvnum = 4;
  2407. my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1;
  2408. if($ipv6) {
  2409. # if IPv6, use a different setup
  2410. $ipvnum = 6;
  2411. $port = protoport('tftp6');
  2412. $ip = $HOST6IP;
  2413. }
  2414. return &responsiveserver($proto, $ipvnum, $idnum, $ip, $port);
  2415. }
  2416. #######################################################################
  2417. # Single shot non-stunnel HTTP TLS extensions capable server
  2418. # responsiveness test. This should only be used to verify that a
  2419. # server present in %run hash is still functional
  2420. #
  2421. sub responsive_httptls_server {
  2422. my ($verbose, $ipv6) = @_;
  2423. my $ipvnum = ($ipv6 && ($ipv6 =~ /6$/)) ? 6 : 4;
  2424. my $proto = "httptls";
  2425. my $port = protoport($proto);
  2426. my $ip = "$HOSTIP";
  2427. my $idnum = 1;
  2428. if ($ipvnum == 6) {
  2429. $port = protoport("httptls6");
  2430. $ip = "$HOST6IP";
  2431. }
  2432. return &responsiveserver($proto, $ipvnum, $idnum, $ip, $port);
  2433. }
  2434. #######################################################################
  2435. # Kill the processes that still lock files in a directory
  2436. #
  2437. sub clearlocks {
  2438. my $dir = $_[0];
  2439. my $done = 0;
  2440. if(pathhelp::os_is_win()) {
  2441. $dir = pathhelp::sys_native_abs_path($dir);
  2442. $dir =~ s/\//\\\\/g;
  2443. my $handle = "handle.exe";
  2444. if($ENV{"PROCESSOR_ARCHITECTURE"} =~ /64$/) {
  2445. $handle = "handle64.exe";
  2446. }
  2447. my @handles = `$handle $dir -accepteula -nobanner`;
  2448. for $handle (@handles) {
  2449. if($handle =~ /^(\S+)\s+pid:\s+(\d+)\s+type:\s+(\w+)\s+([0-9A-F]+):\s+(.+)\r\r/) {
  2450. logmsg "Found $3 lock of '$5' ($4) by $1 ($2)\n";
  2451. # Ignore stunnel since we cannot do anything about its locks
  2452. if("$3" eq "File" && "$1" ne "tstunnel.exe") {
  2453. logmsg "Killing IMAGENAME eq $1 and PID eq $2\n";
  2454. system("taskkill.exe -f -fi \"IMAGENAME eq $1\" -fi \"PID eq $2\" >nul 2>&1");
  2455. $done = 1;
  2456. }
  2457. }
  2458. }
  2459. }
  2460. return $done;
  2461. }
  2462. #######################################################################
  2463. # Remove all files in the specified directory
  2464. #
  2465. sub cleardir {
  2466. my $dir = $_[0];
  2467. my $done = 1;
  2468. my $file;
  2469. # Get all files
  2470. opendir(my $dh, $dir) ||
  2471. return 0; # can't open dir
  2472. while($file = readdir($dh)) {
  2473. if(($file !~ /^(\.|\.\.)\z/)) {
  2474. if(-d "$dir/$file") {
  2475. if(!cleardir("$dir/$file")) {
  2476. $done = 0;
  2477. }
  2478. if(!rmdir("$dir/$file")) {
  2479. $done = 0;
  2480. }
  2481. }
  2482. else {
  2483. # Ignore stunnel since we cannot do anything about its locks
  2484. if(!unlink("$dir/$file") && "$file" !~ /_stunnel\.log$/) {
  2485. $done = 0;
  2486. }
  2487. }
  2488. }
  2489. }
  2490. closedir $dh;
  2491. return $done;
  2492. }
  2493. #######################################################################
  2494. # compare test results with the expected output, we might filter off
  2495. # some pattern that is allowed to differ, output test results
  2496. #
  2497. sub compare {
  2498. my ($testnum, $testname, $subject, $firstref, $secondref)=@_;
  2499. my $result = compareparts($firstref, $secondref);
  2500. if($result) {
  2501. # timestamp test result verification end
  2502. $timevrfyend{$testnum} = Time::HiRes::time();
  2503. if(!$short) {
  2504. logmsg "\n $testnum: $subject FAILED:\n";
  2505. logmsg showdiff($LOGDIR, $firstref, $secondref);
  2506. }
  2507. elsif(!$automakestyle) {
  2508. logmsg "FAILED\n";
  2509. }
  2510. else {
  2511. # automakestyle
  2512. logmsg "FAIL: $testnum - $testname - $subject\n";
  2513. }
  2514. }
  2515. return $result;
  2516. }
  2517. sub setupfeatures {
  2518. $feature{"alt-svc"} = $has_altsvc;
  2519. $feature{"bearssl"} = $has_bearssl;
  2520. $feature{"brotli"} = $has_brotli;
  2521. $feature{"c-ares"} = $has_cares;
  2522. $feature{"crypto"} = $has_crypto;
  2523. $feature{"debug"} = $debug_build;
  2524. $feature{"getrlimit"} = $has_getrlimit;
  2525. $feature{"GnuTLS"} = $has_gnutls;
  2526. $feature{"GSS-API"} = $has_gssapi;
  2527. $feature{"h2c"} = $has_h2c;
  2528. $feature{"HSTS"} = $has_hsts;
  2529. $feature{"http/2"} = $has_http2;
  2530. $feature{"http/3"} = $has_http3;
  2531. $feature{"https-proxy"} = $has_httpsproxy;
  2532. $feature{"hyper"} = $has_hyper;
  2533. $feature{"idn"} = $has_idn;
  2534. $feature{"ipv6"} = $has_ipv6;
  2535. $feature{"Kerberos"} = $has_kerberos;
  2536. $feature{"large_file"} = $has_largefile;
  2537. $feature{"ld_preload"} = ($has_ldpreload && !$debug_build);
  2538. $feature{"libssh"} = $has_libssh;
  2539. $feature{"libssh2"} = $has_libssh2;
  2540. $feature{"libz"} = $has_libz;
  2541. $feature{"manual"} = $has_manual;
  2542. $feature{"MinGW"} = $has_mingw;
  2543. $feature{"MultiSSL"} = $has_multissl;
  2544. $feature{"mbedtls"} = $has_mbedtls;
  2545. $feature{"NSS"} = $has_nss;
  2546. $feature{"NTLM"} = $has_ntlm;
  2547. $feature{"NTLM_WB"} = $has_ntlm_wb;
  2548. $feature{"oldlibssh"} = $has_oldlibssh;
  2549. $feature{"OpenSSL"} = $has_openssl || $has_libressl || $has_boringssl;
  2550. $feature{"PSL"} = $has_psl;
  2551. $feature{"rustls"} = $has_rustls;
  2552. $feature{"Schannel"} = $has_schannel;
  2553. $feature{"sectransp"} = $has_sectransp;
  2554. $feature{"SPNEGO"} = $has_spnego;
  2555. $feature{"SSL"} = $has_ssl;
  2556. $feature{"SSLpinning"} = $has_sslpinning;
  2557. $feature{"SSPI"} = $has_sspi;
  2558. $feature{"threaded-resolver"} = $has_threadedres;
  2559. $feature{"threadsafe"} = $has_threadsafe;
  2560. $feature{"TLS-SRP"} = $has_tls_srp;
  2561. $feature{"TrackMemory"} = $has_memory_tracking;
  2562. $feature{"Unicode"} = $has_unicode;
  2563. $feature{"unittest"} = $debug_build;
  2564. $feature{"unix-sockets"} = $has_unix;
  2565. $feature{"win32"} = $has_win32;
  2566. $feature{"wolfssh"} = $has_wolfssh;
  2567. $feature{"wolfssl"} = $has_wolfssl;
  2568. $feature{"zstd"} = $has_zstd;
  2569. # make each protocol an enabled "feature"
  2570. for my $p (@protocols) {
  2571. $feature{$p} = 1;
  2572. }
  2573. # 'socks' was once here but is now removed
  2574. #
  2575. # strings that must match the names used in server/disabled.c
  2576. #
  2577. $feature{"cookies"} = 1;
  2578. $feature{"DoH"} = 1;
  2579. $feature{"HTTP-auth"} = 1;
  2580. $feature{"Mime"} = 1;
  2581. $feature{"netrc"} = 1;
  2582. $feature{"parsedate"} = 1;
  2583. $feature{"proxy"} = 1;
  2584. $feature{"shuffle-dns"} = 1;
  2585. $feature{"typecheck"} = 1;
  2586. $feature{"verbose-strings"} = 1;
  2587. $feature{"wakeup"} = 1;
  2588. $feature{"headers-api"} = 1;
  2589. $feature{"xattr"} = 1;
  2590. $feature{"nghttpx"} = !!$ENV{'NGHTTPX'};
  2591. $feature{"nghttpx-h3"} = !!$nghttpx_h3;
  2592. }
  2593. #######################################################################
  2594. # display information about curl and the host the test suite runs on
  2595. #
  2596. sub checksystem {
  2597. unlink($memdump); # remove this if there was one left
  2598. my $feat;
  2599. my $curl;
  2600. my $libcurl;
  2601. my $versretval;
  2602. my $versnoexec;
  2603. my @version=();
  2604. my @disabled;
  2605. my $dis = "";
  2606. my $curlverout="$LOGDIR/curlverout.log";
  2607. my $curlvererr="$LOGDIR/curlvererr.log";
  2608. my $versioncmd="$CURL --version 1>$curlverout 2>$curlvererr";
  2609. unlink($curlverout);
  2610. unlink($curlvererr);
  2611. $versretval = runclient($versioncmd);
  2612. $versnoexec = $!;
  2613. open(VERSOUT, "<$curlverout");
  2614. @version = <VERSOUT>;
  2615. close(VERSOUT);
  2616. open(DISABLED, "server/disabled".exe_ext('TOOL')."|");
  2617. @disabled = <DISABLED>;
  2618. close(DISABLED);
  2619. if($disabled[0]) {
  2620. map s/[\r\n]//g, @disabled;
  2621. $dis = join(", ", @disabled);
  2622. }
  2623. $resolver="stock";
  2624. for(@version) {
  2625. chomp;
  2626. if($_ =~ /^curl ([^ ]*)/) {
  2627. $curl = $_;
  2628. $VERSION = $1;
  2629. $curl =~ s/^(.*)(libcurl.*)/$1/g;
  2630. $libcurl = $2;
  2631. if($curl =~ /linux|bsd|solaris/) {
  2632. $has_ldpreload = 1;
  2633. }
  2634. if($curl =~ /win32|Windows|mingw(32|64)/) {
  2635. # This is a Windows MinGW build or native build, we need to use
  2636. # Win32-style path.
  2637. $pwd = pathhelp::sys_native_current_path();
  2638. $has_textaware = 1;
  2639. $has_win32 = 1;
  2640. $has_mingw = 1 if ($curl =~ /-pc-mingw32/);
  2641. }
  2642. if ($libcurl =~ /\s(winssl|schannel)\b/i) {
  2643. $has_schannel=1;
  2644. $has_sslpinning=1;
  2645. }
  2646. elsif ($libcurl =~ /\sopenssl\b/i) {
  2647. $has_openssl=1;
  2648. $has_sslpinning=1;
  2649. }
  2650. elsif ($libcurl =~ /\sgnutls\b/i) {
  2651. $has_gnutls=1;
  2652. $has_sslpinning=1;
  2653. }
  2654. elsif ($libcurl =~ /\srustls-ffi\b/i) {
  2655. $has_rustls=1;
  2656. }
  2657. elsif ($libcurl =~ /\snss\b/i) {
  2658. $has_nss=1;
  2659. $has_sslpinning=1;
  2660. }
  2661. elsif ($libcurl =~ /\swolfssl\b/i) {
  2662. $has_wolfssl=1;
  2663. $has_sslpinning=1;
  2664. }
  2665. elsif ($libcurl =~ /\sbearssl\b/i) {
  2666. $has_bearssl=1;
  2667. }
  2668. elsif ($libcurl =~ /\ssecuretransport\b/i) {
  2669. $has_sectransp=1;
  2670. $has_sslpinning=1;
  2671. }
  2672. elsif ($libcurl =~ /\sBoringSSL\b/i) {
  2673. $has_boringssl=1;
  2674. $has_sslpinning=1;
  2675. }
  2676. elsif ($libcurl =~ /\slibressl\b/i) {
  2677. $has_libressl=1;
  2678. $has_sslpinning=1;
  2679. }
  2680. elsif ($libcurl =~ /\smbedTLS\b/i) {
  2681. $has_mbedtls=1;
  2682. $has_sslpinning=1;
  2683. }
  2684. if ($libcurl =~ /ares/i) {
  2685. $has_cares=1;
  2686. $resolver="c-ares";
  2687. }
  2688. if ($libcurl =~ /Hyper/i) {
  2689. $has_hyper=1;
  2690. }
  2691. if ($libcurl =~ /nghttp2/i) {
  2692. # nghttp2 supports h2c, hyper does not
  2693. $has_h2c=1;
  2694. }
  2695. if ($libcurl =~ /libssh2/i) {
  2696. $has_libssh2=1;
  2697. }
  2698. if ($libcurl =~ /libssh\/([0-9.]*)\//i) {
  2699. $has_libssh=1;
  2700. if($1 =~ /(\d+)\.(\d+).(\d+)/) {
  2701. my $v = $1 * 100 + $2 * 10 + $3;
  2702. if($v < 94) {
  2703. # before 0.9.4
  2704. $has_oldlibssh = 1;
  2705. }
  2706. }
  2707. }
  2708. if ($libcurl =~ /wolfssh/i) {
  2709. $has_wolfssh=1;
  2710. }
  2711. }
  2712. elsif($_ =~ /^Protocols: (.*)/i) {
  2713. # these are the protocols compiled in to this libcurl
  2714. @protocols = split(' ', lc($1));
  2715. # Generate a "proto-ipv6" version of each protocol to match the
  2716. # IPv6 <server> name and a "proto-unix" to match the variant which
  2717. # uses Unix domain sockets. This works even if support isn't
  2718. # compiled in because the <features> test will fail.
  2719. push @protocols, map(("$_-ipv6", "$_-unix"), @protocols);
  2720. # 'http-proxy' is used in test cases to do CONNECT through
  2721. push @protocols, 'http-proxy';
  2722. # 'none' is used in test cases to mean no server
  2723. push @protocols, 'none';
  2724. }
  2725. elsif($_ =~ /^Features: (.*)/i) {
  2726. $feat = $1;
  2727. if($feat =~ /TrackMemory/i) {
  2728. # built with memory tracking support (--enable-curldebug)
  2729. $has_memory_tracking = 1;
  2730. }
  2731. if($feat =~ /debug/i) {
  2732. # curl was built with --enable-debug
  2733. $debug_build = 1;
  2734. }
  2735. if($feat =~ /SSL/i) {
  2736. # ssl enabled
  2737. $has_ssl=1;
  2738. }
  2739. if($feat =~ /MultiSSL/i) {
  2740. # multiple ssl backends available.
  2741. $has_multissl=1;
  2742. }
  2743. if($feat =~ /Largefile/i) {
  2744. # large file support
  2745. $has_largefile=1;
  2746. }
  2747. if($feat =~ /IDN/i) {
  2748. # IDN support
  2749. $has_idn=1;
  2750. }
  2751. if($feat =~ /IPv6/i) {
  2752. $has_ipv6 = 1;
  2753. }
  2754. if($feat =~ /UnixSockets/i) {
  2755. $has_unix = 1;
  2756. }
  2757. if($feat =~ /libz/i) {
  2758. $has_libz = 1;
  2759. }
  2760. if($feat =~ /brotli/i) {
  2761. $has_brotli = 1;
  2762. }
  2763. if($feat =~ /zstd/i) {
  2764. $has_zstd = 1;
  2765. }
  2766. if($feat =~ /NTLM/i) {
  2767. # NTLM enabled
  2768. $has_ntlm=1;
  2769. # Use this as a proxy for any cryptographic authentication
  2770. $has_crypto=1;
  2771. }
  2772. if($feat =~ /NTLM_WB/i) {
  2773. # NTLM delegation to winbind daemon ntlm_auth helper enabled
  2774. $has_ntlm_wb=1;
  2775. }
  2776. if($feat =~ /SSPI/i) {
  2777. # SSPI enabled
  2778. $has_sspi=1;
  2779. }
  2780. if($feat =~ /GSS-API/i) {
  2781. # GSS-API enabled
  2782. $has_gssapi=1;
  2783. }
  2784. if($feat =~ /Kerberos/i) {
  2785. # Kerberos enabled
  2786. $has_kerberos=1;
  2787. # Use this as a proxy for any cryptographic authentication
  2788. $has_crypto=1;
  2789. }
  2790. if($feat =~ /SPNEGO/i) {
  2791. # SPNEGO enabled
  2792. $has_spnego=1;
  2793. # Use this as a proxy for any cryptographic authentication
  2794. $has_crypto=1;
  2795. }
  2796. if($feat =~ /CharConv/i) {
  2797. # CharConv enabled
  2798. $has_charconv=1;
  2799. }
  2800. if($feat =~ /TLS-SRP/i) {
  2801. # TLS-SRP enabled
  2802. $has_tls_srp=1;
  2803. }
  2804. if($feat =~ /PSL/i) {
  2805. # PSL enabled
  2806. $has_psl=1;
  2807. }
  2808. if($feat =~ /alt-svc/i) {
  2809. # alt-svc enabled
  2810. $has_altsvc=1;
  2811. }
  2812. if($feat =~ /HSTS/i) {
  2813. $has_hsts=1;
  2814. }
  2815. if($feat =~ /AsynchDNS/i) {
  2816. if(!$has_cares) {
  2817. # this means threaded resolver
  2818. $has_threadedres=1;
  2819. $resolver="threaded";
  2820. }
  2821. }
  2822. if($feat =~ /HTTP2/) {
  2823. # http2 enabled
  2824. $has_http2=1;
  2825. push @protocols, 'http/2';
  2826. }
  2827. if($feat =~ /HTTP3/) {
  2828. # http3 enabled
  2829. $has_http3=1;
  2830. push @protocols, 'http/3';
  2831. }
  2832. if($feat =~ /HTTPS-proxy/) {
  2833. $has_httpsproxy=1;
  2834. # 'https-proxy' is used as "server" so consider it a protocol
  2835. push @protocols, 'https-proxy';
  2836. }
  2837. if($feat =~ /Unicode/i) {
  2838. $has_unicode = 1;
  2839. }
  2840. if($feat =~ /threadsafe/i) {
  2841. $has_threadsafe = 1;
  2842. }
  2843. }
  2844. #
  2845. # Test harness currently uses a non-stunnel server in order to
  2846. # run HTTP TLS-SRP tests required when curl is built with https
  2847. # protocol support and TLS-SRP feature enabled. For convenience
  2848. # 'httptls' may be included in the test harness protocols array
  2849. # to differentiate this from classic stunnel based 'https' test
  2850. # harness server.
  2851. #
  2852. if($has_tls_srp) {
  2853. my $add_httptls;
  2854. for(@protocols) {
  2855. if($_ =~ /^https(-ipv6|)$/) {
  2856. $add_httptls=1;
  2857. last;
  2858. }
  2859. }
  2860. if($add_httptls && (! grep /^httptls$/, @protocols)) {
  2861. push @protocols, 'httptls';
  2862. push @protocols, 'httptls-ipv6';
  2863. }
  2864. }
  2865. }
  2866. if(!$curl) {
  2867. logmsg "unable to get curl's version, further details are:\n";
  2868. logmsg "issued command: \n";
  2869. logmsg "$versioncmd \n";
  2870. if ($versretval == -1) {
  2871. logmsg "command failed with: \n";
  2872. logmsg "$versnoexec \n";
  2873. }
  2874. elsif ($versretval & 127) {
  2875. logmsg sprintf("command died with signal %d, and %s coredump.\n",
  2876. ($versretval & 127), ($versretval & 128)?"a":"no");
  2877. }
  2878. else {
  2879. logmsg sprintf("command exited with value %d \n", $versretval >> 8);
  2880. }
  2881. logmsg "contents of $curlverout: \n";
  2882. displaylogcontent("$curlverout");
  2883. logmsg "contents of $curlvererr: \n";
  2884. displaylogcontent("$curlvererr");
  2885. die "couldn't get curl's version";
  2886. }
  2887. if(-r "../lib/curl_config.h") {
  2888. open(CONF, "<../lib/curl_config.h");
  2889. while(<CONF>) {
  2890. if($_ =~ /^\#define HAVE_GETRLIMIT/) {
  2891. $has_getrlimit = 1;
  2892. }
  2893. }
  2894. close(CONF);
  2895. }
  2896. if($has_ipv6) {
  2897. # client has IPv6 support
  2898. # check if the HTTP server has it!
  2899. my $cmd = "server/sws".exe_ext('SRV')." --version";
  2900. my @sws = `$cmd`;
  2901. if($sws[0] =~ /IPv6/) {
  2902. # HTTP server has IPv6 support!
  2903. $http_ipv6 = 1;
  2904. $gopher_ipv6 = 1;
  2905. }
  2906. # check if the FTP server has it!
  2907. $cmd = "server/sockfilt".exe_ext('SRV')." --version";
  2908. @sws = `$cmd`;
  2909. if($sws[0] =~ /IPv6/) {
  2910. # FTP server has IPv6 support!
  2911. $ftp_ipv6 = 1;
  2912. }
  2913. }
  2914. if($has_unix) {
  2915. # client has Unix sockets support, check whether the HTTP server has it
  2916. my $cmd = "server/sws".exe_ext('SRV')." --version";
  2917. my @sws = `$cmd`;
  2918. $http_unix = 1 if($sws[0] =~ /unix/);
  2919. }
  2920. if(!$has_memory_tracking && $torture) {
  2921. die "can't run torture tests since curl was built without ".
  2922. "TrackMemory feature (--enable-curldebug)";
  2923. }
  2924. open(M, "$CURL -M 2>&1|");
  2925. while(my $s = <M>) {
  2926. if($s =~ /built-in manual was disabled at build-time/) {
  2927. $has_manual = 0;
  2928. last;
  2929. }
  2930. $has_manual = 1;
  2931. last;
  2932. }
  2933. close(M);
  2934. $has_shared = `sh $CURLCONFIG --built-shared`;
  2935. chomp $has_shared;
  2936. my $hostname=join(' ', runclientoutput("hostname"));
  2937. my $hosttype=join(' ', runclientoutput("uname -a"));
  2938. my $hostos=$^O;
  2939. logmsg ("********* System characteristics ******** \n",
  2940. "* $curl\n",
  2941. "* $libcurl\n",
  2942. "* Features: $feat\n",
  2943. "* Disabled: $dis\n",
  2944. "* Host: $hostname",
  2945. "* System: $hosttype",
  2946. "* OS: $hostos\n");
  2947. if($has_memory_tracking && $has_threadedres) {
  2948. $has_memory_tracking = 0;
  2949. logmsg("*\n",
  2950. "*** DISABLES memory tracking when using threaded resolver\n",
  2951. "*\n");
  2952. }
  2953. logmsg sprintf("* Servers: %s", $stunnel?"SSL ":"");
  2954. logmsg sprintf("%s", $http_ipv6?"HTTP-IPv6 ":"");
  2955. logmsg sprintf("%s", $http_unix?"HTTP-unix ":"");
  2956. logmsg sprintf("%s\n", $ftp_ipv6?"FTP-IPv6 ":"");
  2957. logmsg sprintf("* Env: %s%s%s", $valgrind?"Valgrind ":"",
  2958. $run_event_based?"event-based ":"",
  2959. $nghttpx_h3);
  2960. logmsg sprintf("%s\n", $libtool?"Libtool ":"");
  2961. logmsg ("* Seed: $randseed\n");
  2962. if($verbose) {
  2963. if($has_unix) {
  2964. logmsg "* Unix socket paths:\n";
  2965. if($http_unix) {
  2966. logmsg sprintf("* HTTP-Unix:%s\n", $HTTPUNIXPATH);
  2967. logmsg sprintf("* Socks-Unix:%s\n", $SOCKSUNIXPATH);
  2968. }
  2969. }
  2970. }
  2971. logmsg "***************************************** \n";
  2972. setupfeatures();
  2973. # toggle off the features that were disabled in the build
  2974. for my $d(@disabled) {
  2975. $feature{$d} = 0;
  2976. }
  2977. }
  2978. #######################################################################
  2979. # substitute the variable stuff into either a joined up file or
  2980. # a command, in either case passed by reference
  2981. #
  2982. sub subVariables {
  2983. my ($thing, $testnum, $prefix) = @_;
  2984. my $port;
  2985. if(!$prefix) {
  2986. $prefix = "%";
  2987. }
  2988. # test server ports
  2989. foreach my $proto ('DICT',
  2990. 'FTP', 'FTP6', 'FTPS',
  2991. 'GOPHER', 'GOPHER6', 'GOPHERS',
  2992. 'HTTP', 'HTTP6', 'HTTPS',
  2993. 'HTTPSPROXY', 'HTTPTLS', 'HTTPTLS6',
  2994. 'HTTP2', 'HTTP2TLS',
  2995. 'HTTP3',
  2996. 'IMAP', 'IMAP6', 'IMAPS',
  2997. 'MQTT',
  2998. 'NOLISTEN',
  2999. 'POP3', 'POP36', 'POP3S',
  3000. 'RTSP', 'RTSP6',
  3001. 'SMB', 'SMBS',
  3002. 'SMTP', 'SMTP6', 'SMTPS',
  3003. 'SOCKS',
  3004. 'SSH',
  3005. 'TELNET',
  3006. 'TFTP', 'TFTP6') {
  3007. $port = protoport(lc $proto);
  3008. $$thing =~ s/${prefix}(?:$proto)PORT/$port/g;
  3009. }
  3010. # Special case: for PROXYPORT substitution, use httpproxy.
  3011. $port = protoport('httpproxy');
  3012. $$thing =~ s/${prefix}PROXYPORT/$port/g;
  3013. # server Unix domain socket paths
  3014. $$thing =~ s/${prefix}HTTPUNIXPATH/$HTTPUNIXPATH/g;
  3015. $$thing =~ s/${prefix}SOCKSUNIXPATH/$SOCKSUNIXPATH/g;
  3016. # client IP addresses
  3017. $$thing =~ s/${prefix}CLIENT6IP/$CLIENT6IP/g;
  3018. $$thing =~ s/${prefix}CLIENTIP/$CLIENTIP/g;
  3019. # server IP addresses
  3020. $$thing =~ s/${prefix}HOST6IP/$HOST6IP/g;
  3021. $$thing =~ s/${prefix}HOSTIP/$HOSTIP/g;
  3022. # misc
  3023. $$thing =~ s/${prefix}CURL/$CURL/g;
  3024. $$thing =~ s/${prefix}PWD/$pwd/g;
  3025. $$thing =~ s/${prefix}POSIX_PWD/$posix_pwd/g;
  3026. $$thing =~ s/${prefix}VERSION/$VERSION/g;
  3027. $$thing =~ s/${prefix}TESTNUMBER/$testnum/g;
  3028. my $file_pwd = $pwd;
  3029. if($file_pwd !~ /^\//) {
  3030. $file_pwd = "/$file_pwd";
  3031. }
  3032. my $ssh_pwd = $posix_pwd;
  3033. if ($sshdid && $sshdid =~ /OpenSSH-Windows/) {
  3034. $ssh_pwd = $file_pwd;
  3035. }
  3036. $$thing =~ s/${prefix}FILE_PWD/$file_pwd/g;
  3037. $$thing =~ s/${prefix}SSH_PWD/$ssh_pwd/g;
  3038. $$thing =~ s/${prefix}SRCDIR/$srcdir/g;
  3039. $$thing =~ s/${prefix}USER/$USER/g;
  3040. $$thing =~ s/${prefix}SSHSRVMD5/$SSHSRVMD5/g;
  3041. $$thing =~ s/${prefix}SSHSRVSHA256/$SSHSRVSHA256/g;
  3042. # The purpose of FTPTIME2 and FTPTIME3 is to provide times that can be
  3043. # used for time-out tests and that would work on most hosts as these
  3044. # adjust for the startup/check time for this particular host. We needed to
  3045. # do this to make the test suite run better on very slow hosts.
  3046. my $ftp2 = $ftpchecktime * 2;
  3047. my $ftp3 = $ftpchecktime * 3;
  3048. $$thing =~ s/${prefix}FTPTIME2/$ftp2/g;
  3049. $$thing =~ s/${prefix}FTPTIME3/$ftp3/g;
  3050. # HTTP2
  3051. $$thing =~ s/${prefix}H2CVER/$h2cver/g;
  3052. }
  3053. sub subBase64 {
  3054. my ($thing) = @_;
  3055. # cut out the base64 piece
  3056. if($$thing =~ s/%b64\[(.*)\]b64%/%%B64%%/i) {
  3057. my $d = $1;
  3058. # encode %NN characters
  3059. $d =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
  3060. my $enc = encode_base64($d, "");
  3061. # put the result into there
  3062. $$thing =~ s/%%B64%%/$enc/;
  3063. }
  3064. # hex decode
  3065. if($$thing =~ s/%hex\[(.*)\]hex%/%%HEX%%/i) {
  3066. # decode %NN characters
  3067. my $d = $1;
  3068. $d =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
  3069. $$thing =~ s/%%HEX%%/$d/;
  3070. }
  3071. if($$thing =~ s/%repeat\[(\d+) x (.*)\]%/%%REPEAT%%/i) {
  3072. # decode %NN characters
  3073. my ($d, $n) = ($2, $1);
  3074. $d =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
  3075. my $all = $d x $n;
  3076. $$thing =~ s/%%REPEAT%%/$all/;
  3077. }
  3078. }
  3079. my $prevupdate;
  3080. sub subNewlines {
  3081. my ($force, $thing) = @_;
  3082. if($force) {
  3083. # enforce CRLF newline
  3084. $$thing =~ s/\x0d*\x0a/\x0d\x0a/;
  3085. return;
  3086. }
  3087. # When curl is built with Hyper, it gets all response headers delivered as
  3088. # name/value pairs and curl "invents" the newlines when it saves the
  3089. # headers. Therefore, curl will always save headers with CRLF newlines
  3090. # when built to use Hyper. By making sure we deliver all tests using CRLF
  3091. # as well, all test comparisons will survive without knowing about this
  3092. # little quirk.
  3093. if(($$thing =~ /^HTTP\/(1.1|1.0|2|3) [1-5][^\x0d]*\z/) ||
  3094. ($$thing =~ /^(GET|POST|PUT|DELETE) \S+ HTTP\/\d+(\.\d+)?/) ||
  3095. (($$thing =~ /^[a-z0-9_-]+: [^\x0d]*\z/i) &&
  3096. # skip curl error messages
  3097. ($$thing !~ /^curl: \(\d+\) /))) {
  3098. # enforce CRLF newline
  3099. $$thing =~ s/\x0d*\x0a/\x0d\x0a/;
  3100. $prevupdate = 1;
  3101. }
  3102. else {
  3103. if(($$thing =~ /^\n\z/) && $prevupdate) {
  3104. # if there's a blank link after a line we update, we hope it is
  3105. # the empty line following headers
  3106. $$thing =~ s/\x0a/\x0d\x0a/;
  3107. }
  3108. $prevupdate = 0;
  3109. }
  3110. }
  3111. #######################################################################
  3112. # Provide time stamps for single test skipped events
  3113. #
  3114. sub timestampskippedevents {
  3115. my $testnum = $_[0];
  3116. return if((not defined($testnum)) || ($testnum < 1));
  3117. if($timestats) {
  3118. if($timevrfyend{$testnum}) {
  3119. return;
  3120. }
  3121. elsif($timesrvrlog{$testnum}) {
  3122. $timevrfyend{$testnum} = $timesrvrlog{$testnum};
  3123. return;
  3124. }
  3125. elsif($timetoolend{$testnum}) {
  3126. $timevrfyend{$testnum} = $timetoolend{$testnum};
  3127. $timesrvrlog{$testnum} = $timetoolend{$testnum};
  3128. }
  3129. elsif($timetoolini{$testnum}) {
  3130. $timevrfyend{$testnum} = $timetoolini{$testnum};
  3131. $timesrvrlog{$testnum} = $timetoolini{$testnum};
  3132. $timetoolend{$testnum} = $timetoolini{$testnum};
  3133. }
  3134. elsif($timesrvrend{$testnum}) {
  3135. $timevrfyend{$testnum} = $timesrvrend{$testnum};
  3136. $timesrvrlog{$testnum} = $timesrvrend{$testnum};
  3137. $timetoolend{$testnum} = $timesrvrend{$testnum};
  3138. $timetoolini{$testnum} = $timesrvrend{$testnum};
  3139. }
  3140. elsif($timesrvrini{$testnum}) {
  3141. $timevrfyend{$testnum} = $timesrvrini{$testnum};
  3142. $timesrvrlog{$testnum} = $timesrvrini{$testnum};
  3143. $timetoolend{$testnum} = $timesrvrini{$testnum};
  3144. $timetoolini{$testnum} = $timesrvrini{$testnum};
  3145. $timesrvrend{$testnum} = $timesrvrini{$testnum};
  3146. }
  3147. elsif($timeprepini{$testnum}) {
  3148. $timevrfyend{$testnum} = $timeprepini{$testnum};
  3149. $timesrvrlog{$testnum} = $timeprepini{$testnum};
  3150. $timetoolend{$testnum} = $timeprepini{$testnum};
  3151. $timetoolini{$testnum} = $timeprepini{$testnum};
  3152. $timesrvrend{$testnum} = $timeprepini{$testnum};
  3153. $timesrvrini{$testnum} = $timeprepini{$testnum};
  3154. }
  3155. }
  3156. }
  3157. #
  3158. # 'prepro' processes the input array and replaces %-variables in the array
  3159. # etc. Returns the processed version of the array
  3160. sub prepro {
  3161. my $testnum = shift;
  3162. my (@entiretest) = @_;
  3163. my $show = 1;
  3164. my @out;
  3165. my $data_crlf;
  3166. for my $s (@entiretest) {
  3167. my $f = $s;
  3168. if($s =~ /^ *%if (.*)/) {
  3169. my $cond = $1;
  3170. my $rev = 0;
  3171. if($cond =~ /^!(.*)/) {
  3172. $cond = $1;
  3173. $rev = 1;
  3174. }
  3175. $rev ^= $feature{$cond} ? 1 : 0;
  3176. $show = $rev;
  3177. next;
  3178. }
  3179. elsif($s =~ /^ *%else/) {
  3180. $show ^= 1;
  3181. next;
  3182. }
  3183. elsif($s =~ /^ *%endif/) {
  3184. $show = 1;
  3185. next;
  3186. }
  3187. if($show) {
  3188. # The processor does CRLF replacements in the <data*> sections if
  3189. # necessary since those parts might be read by separate servers.
  3190. if($s =~ /^ *<data(.*)\>/) {
  3191. if($1 =~ /crlf="yes"/ ||
  3192. ($has_hyper && ($keywords{"HTTP"} || $keywords{"HTTPS"}))) {
  3193. $data_crlf = 1;
  3194. }
  3195. }
  3196. elsif(($s =~ /^ *<\/data/) && $data_crlf) {
  3197. $data_crlf = 0;
  3198. }
  3199. subVariables(\$s, $testnum, "%");
  3200. subBase64(\$s);
  3201. subNewlines(0, \$s) if($data_crlf);
  3202. push @out, $s;
  3203. }
  3204. }
  3205. return @out;
  3206. }
  3207. #######################################################################
  3208. # Run a single specified test case
  3209. #
  3210. sub singletest {
  3211. my ($evbased, # 1 means switch on if possible (and "curl" is tested)
  3212. # returns "not a test" if it can't be used for this test
  3213. $testnum,
  3214. $count,
  3215. $total)=@_;
  3216. my @what;
  3217. my $why;
  3218. my $cmd;
  3219. my $disablevalgrind;
  3220. my $errorreturncode = 1; # 1 means normal error, 2 means ignored error
  3221. # fist, remove all lingering log files
  3222. if(!cleardir($LOGDIR) && $clearlocks) {
  3223. clearlocks($LOGDIR);
  3224. cleardir($LOGDIR);
  3225. }
  3226. # copy test number to a global scope var, this allows
  3227. # testnum checking when starting test harness servers.
  3228. $testnumcheck = $testnum;
  3229. # timestamp test preparation start
  3230. $timeprepini{$testnum} = Time::HiRes::time();
  3231. if($disttests !~ /test$testnum(\W|\z)/ ) {
  3232. logmsg "Warning: test$testnum not present in tests/data/Makefile.inc\n";
  3233. }
  3234. if($disabled{$testnum}) {
  3235. if(!$run_disabeled) {
  3236. $why = "listed in DISABLED";
  3237. }
  3238. else {
  3239. logmsg "Warning: test$testnum is explicitly disabled\n";
  3240. }
  3241. }
  3242. if($ignored{$testnum}) {
  3243. logmsg "Warning: test$testnum result is ignored\n";
  3244. $errorreturncode = 2;
  3245. }
  3246. # load the test case file definition
  3247. if(loadtest("${TESTDIR}/test${testnum}")) {
  3248. if($verbose) {
  3249. # this is not a test
  3250. logmsg "RUN: $testnum doesn't look like a test case\n";
  3251. }
  3252. $why = "no test";
  3253. }
  3254. else {
  3255. @what = getpart("client", "features");
  3256. }
  3257. # We require a feature to be present
  3258. for(@what) {
  3259. my $f = $_;
  3260. $f =~ s/\s//g;
  3261. if($f =~ /^([^!].*)$/) {
  3262. if($feature{$1}) {
  3263. next;
  3264. }
  3265. $why = "curl lacks $1 support";
  3266. last;
  3267. }
  3268. }
  3269. # We require a feature to not be present
  3270. if(!$why) {
  3271. for(@what) {
  3272. my $f = $_;
  3273. $f =~ s/\s//g;
  3274. if($f =~ /^!(.*)$/) {
  3275. if(!$feature{$1}) {
  3276. next;
  3277. }
  3278. }
  3279. else {
  3280. next;
  3281. }
  3282. $why = "curl has $1 support";
  3283. last;
  3284. }
  3285. }
  3286. if(!$why) {
  3287. my @info_keywords = getpart("info", "keywords");
  3288. my $match;
  3289. my $k;
  3290. # Clear the list of keywords from the last test
  3291. %keywords = ();
  3292. if(!$info_keywords[0]) {
  3293. $why = "missing the <keywords> section!";
  3294. }
  3295. for $k (@info_keywords) {
  3296. chomp $k;
  3297. if ($disabled_keywords{lc($k)}) {
  3298. $why = "disabled by keyword";
  3299. } elsif ($enabled_keywords{lc($k)}) {
  3300. $match = 1;
  3301. }
  3302. if ($ignored_keywords{lc($k)}) {
  3303. logmsg "Warning: test$testnum result is ignored due to $k\n";
  3304. $errorreturncode = 2;
  3305. }
  3306. $keywords{$k} = 1;
  3307. }
  3308. if(!$why && !$match && %enabled_keywords) {
  3309. $why = "disabled by missing keyword";
  3310. }
  3311. }
  3312. if (!$why && defined $custom_skip_reasons{test}{$testnum}) {
  3313. $why = $custom_skip_reasons{test}{$testnum};
  3314. }
  3315. if (!$why && defined $custom_skip_reasons{tool}) {
  3316. foreach my $tool (getpart("client", "tool")) {
  3317. foreach my $tool_skip_pattern (keys %{$custom_skip_reasons{tool}}) {
  3318. if ($tool =~ /$tool_skip_pattern/i) {
  3319. $why = $custom_skip_reasons{tool}{$tool_skip_pattern};
  3320. }
  3321. }
  3322. }
  3323. }
  3324. if (!$why && defined $custom_skip_reasons{keyword}) {
  3325. foreach my $keyword (getpart("info", "keywords")) {
  3326. foreach my $keyword_skip_pattern (keys %{$custom_skip_reasons{keyword}}) {
  3327. if ($keyword =~ /$keyword_skip_pattern/i) {
  3328. $why = $custom_skip_reasons{keyword}{$keyword_skip_pattern};
  3329. }
  3330. }
  3331. }
  3332. }
  3333. # test definition may instruct to (un)set environment vars
  3334. # this is done this early, so that the precheck can use environment
  3335. # variables and still bail out fine on errors
  3336. # restore environment variables that were modified in a previous run
  3337. foreach my $var (keys %oldenv) {
  3338. if($oldenv{$var} eq 'notset') {
  3339. delete $ENV{$var} if($ENV{$var});
  3340. }
  3341. else {
  3342. $ENV{$var} = $oldenv{$var};
  3343. }
  3344. delete $oldenv{$var};
  3345. }
  3346. # get the name of the test early
  3347. my @testname= getpart("client", "name");
  3348. my $testname = $testname[0];
  3349. $testname =~ s/\n//g;
  3350. # create test result in CI services
  3351. if(azure_check_environment() && $AZURE_RUN_ID) {
  3352. $AZURE_RESULT_ID = azure_create_test_result($ACURL, $AZURE_RUN_ID, $testnum, $testname);
  3353. }
  3354. elsif(appveyor_check_environment()) {
  3355. appveyor_create_test_result($ACURL, $testnum, $testname);
  3356. }
  3357. # remove test server commands file before servers are started/verified
  3358. unlink($FTPDCMD) if(-f $FTPDCMD);
  3359. # timestamp required servers verification start
  3360. $timesrvrini{$testnum} = Time::HiRes::time();
  3361. if(!$why) {
  3362. $why = serverfortest($testnum);
  3363. }
  3364. # Save a preprocessed version of the entire test file. This allows more
  3365. # "basic" test case readers to enjoy variable replacements.
  3366. my @entiretest = fulltest();
  3367. my $otest = "log/test$testnum";
  3368. @entiretest = prepro($testnum, @entiretest);
  3369. # save the new version
  3370. open(D, ">$otest");
  3371. foreach my $bytes (@entiretest) {
  3372. print D pack('a*', $bytes) or die "Failed to print '$bytes': $!";
  3373. }
  3374. close(D);
  3375. # in case the process changed the file, reload it
  3376. loadtest("log/test${testnum}");
  3377. # timestamp required servers verification end
  3378. $timesrvrend{$testnum} = Time::HiRes::time();
  3379. my @setenv = getpart("client", "setenv");
  3380. if(@setenv) {
  3381. foreach my $s (@setenv) {
  3382. chomp $s;
  3383. if($s =~ /([^=]*)=(.*)/) {
  3384. my ($var, $content) = ($1, $2);
  3385. # remember current setting, to restore it once test runs
  3386. $oldenv{$var} = ($ENV{$var})?"$ENV{$var}":'notset';
  3387. # set new value
  3388. if(!$content) {
  3389. delete $ENV{$var} if($ENV{$var});
  3390. }
  3391. else {
  3392. if($var =~ /^LD_PRELOAD/) {
  3393. if(exe_ext('TOOL') && (exe_ext('TOOL') eq '.exe')) {
  3394. # print "Skipping LD_PRELOAD due to lack of OS support\n";
  3395. next;
  3396. }
  3397. if($debug_build || ($has_shared ne "yes")) {
  3398. # print "Skipping LD_PRELOAD due to no release shared build\n";
  3399. next;
  3400. }
  3401. }
  3402. $ENV{$var} = "$content";
  3403. print "setenv $var = $content\n" if($verbose);
  3404. }
  3405. }
  3406. }
  3407. }
  3408. if($use_external_proxy) {
  3409. $ENV{http_proxy} = $proxy_address;
  3410. $ENV{HTTPS_PROXY} = $proxy_address;
  3411. }
  3412. if(!$why) {
  3413. my @precheck = getpart("client", "precheck");
  3414. if(@precheck) {
  3415. $cmd = $precheck[0];
  3416. chomp $cmd;
  3417. if($cmd) {
  3418. my @p = split(/ /, $cmd);
  3419. if($p[0] !~ /\//) {
  3420. # the first word, the command, does not contain a slash so
  3421. # we will scan the "improved" PATH to find the command to
  3422. # be able to run it
  3423. my $fullp = checktestcmd($p[0]);
  3424. if($fullp) {
  3425. $p[0] = $fullp;
  3426. }
  3427. $cmd = join(" ", @p);
  3428. }
  3429. my @o = `$cmd 2>log/precheck-$testnum`;
  3430. if($o[0]) {
  3431. $why = $o[0];
  3432. chomp $why;
  3433. } elsif($?) {
  3434. $why = "precheck command error";
  3435. }
  3436. logmsg "prechecked $cmd\n" if($verbose);
  3437. }
  3438. }
  3439. }
  3440. if($why && !$listonly) {
  3441. # there's a problem, count it as "skipped"
  3442. $skipped++;
  3443. $skipped{$why}++;
  3444. $teststat[$testnum]=$why; # store reason for this test case
  3445. if(!$short) {
  3446. if($skipped{$why} <= 3) {
  3447. # show only the first three skips for each reason
  3448. logmsg sprintf("test %04d SKIPPED: $why\n", $testnum);
  3449. }
  3450. }
  3451. timestampskippedevents($testnum);
  3452. return -1;
  3453. }
  3454. logmsg sprintf("test %04d...", $testnum) if(!$automakestyle);
  3455. my %replyattr = getpartattr("reply", "data");
  3456. my @reply;
  3457. if (partexists("reply", "datacheck")) {
  3458. for my $partsuffix (('', '1', '2', '3', '4')) {
  3459. my @replycheckpart = getpart("reply", "datacheck".$partsuffix);
  3460. if(@replycheckpart) {
  3461. my %replycheckpartattr = getpartattr("reply", "datacheck".$partsuffix);
  3462. # get the mode attribute
  3463. my $filemode=$replycheckpartattr{'mode'};
  3464. if($filemode && ($filemode eq "text") && $has_textaware) {
  3465. # text mode when running on windows: fix line endings
  3466. map s/\r\n/\n/g, @replycheckpart;
  3467. map s/\n/\r\n/g, @replycheckpart;
  3468. }
  3469. if($replycheckpartattr{'nonewline'}) {
  3470. # Yes, we must cut off the final newline from the final line
  3471. # of the datacheck
  3472. chomp($replycheckpart[$#replycheckpart]);
  3473. }
  3474. if($replycheckpartattr{'crlf'} ||
  3475. ($has_hyper && ($keywords{"HTTP"}
  3476. || $keywords{"HTTPS"}))) {
  3477. map subNewlines(0, \$_), @replycheckpart;
  3478. }
  3479. push(@reply, @replycheckpart);
  3480. }
  3481. }
  3482. }
  3483. else {
  3484. # check against the data section
  3485. @reply = getpart("reply", "data");
  3486. if(@reply) {
  3487. my %hash = getpartattr("reply", "data");
  3488. if($hash{'nonewline'}) {
  3489. # cut off the final newline from the final line of the data
  3490. chomp($reply[$#reply]);
  3491. }
  3492. }
  3493. # get the mode attribute
  3494. my $filemode=$replyattr{'mode'};
  3495. if($filemode && ($filemode eq "text") && $has_textaware) {
  3496. # text mode when running on windows: fix line endings
  3497. map s/\r\n/\n/g, @reply;
  3498. map s/\n/\r\n/g, @reply;
  3499. }
  3500. if($replyattr{'crlf'} ||
  3501. ($has_hyper && ($keywords{"HTTP"}
  3502. || $keywords{"HTTPS"}))) {
  3503. map subNewlines(0, \$_), @reply;
  3504. }
  3505. }
  3506. # this is the valid protocol blurb curl should generate
  3507. my @protocol= getpart("verify", "protocol");
  3508. # this is the valid protocol blurb curl should generate to a proxy
  3509. my @proxyprot = getpart("verify", "proxy");
  3510. # redirected stdout/stderr to these files
  3511. $STDOUT="$LOGDIR/stdout$testnum";
  3512. $STDERR="$LOGDIR/stderr$testnum";
  3513. # if this section exists, we verify that the stdout contained this:
  3514. my @validstdout = getpart("verify", "stdout");
  3515. my @validstderr = getpart("verify", "stderr");
  3516. # if this section exists, we verify upload
  3517. my @upload = getpart("verify", "upload");
  3518. if(@upload) {
  3519. my %hash = getpartattr("verify", "upload");
  3520. if($hash{'nonewline'}) {
  3521. # cut off the final newline from the final line of the upload data
  3522. chomp($upload[$#upload]);
  3523. }
  3524. }
  3525. # if this section exists, it might be FTP server instructions:
  3526. my @ftpservercmd = getpart("reply", "servercmd");
  3527. my $CURLOUT="$LOGDIR/curl$testnum.out"; # curl output if not stdout
  3528. # name of the test
  3529. logmsg "[$testname]\n" if(!$short);
  3530. if($listonly) {
  3531. timestampskippedevents($testnum);
  3532. return 0; # look successful
  3533. }
  3534. my @codepieces = getpart("client", "tool");
  3535. my $tool="";
  3536. if(@codepieces) {
  3537. $tool = $codepieces[0];
  3538. chomp $tool;
  3539. $tool .= exe_ext('TOOL');
  3540. }
  3541. # remove server output logfile
  3542. unlink($SERVERIN);
  3543. unlink($SERVER2IN);
  3544. unlink($PROXYIN);
  3545. push @ftpservercmd, "Testnum $testnum\n";
  3546. # write the instructions to file
  3547. writearray($FTPDCMD, \@ftpservercmd);
  3548. # get the command line options to use
  3549. my @blaha;
  3550. ($cmd, @blaha)= getpart("client", "command");
  3551. if($cmd) {
  3552. # make some nice replace operations
  3553. $cmd =~ s/\n//g; # no newlines please
  3554. # substitute variables in the command line
  3555. }
  3556. else {
  3557. # there was no command given, use something silly
  3558. $cmd="-";
  3559. }
  3560. if($has_memory_tracking) {
  3561. unlink($memdump);
  3562. }
  3563. # create (possibly-empty) files before starting the test
  3564. for my $partsuffix (('', '1', '2', '3', '4')) {
  3565. my @inputfile=getpart("client", "file".$partsuffix);
  3566. my %fileattr = getpartattr("client", "file".$partsuffix);
  3567. my $filename=$fileattr{'name'};
  3568. if(@inputfile || $filename) {
  3569. if(!$filename) {
  3570. logmsg "ERROR: section client=>file has no name attribute\n";
  3571. timestampskippedevents($testnum);
  3572. return -1;
  3573. }
  3574. my $fileContent = join('', @inputfile);
  3575. # make directories if needed
  3576. my $path = $filename;
  3577. # cut off the file name part
  3578. $path =~ s/^(.*)\/[^\/]*/$1/;
  3579. my @parts = split(/\//, $path);
  3580. if($parts[0] eq "log") {
  3581. # the file is in log/
  3582. my $d = shift @parts;
  3583. for(@parts) {
  3584. $d .= "/$_";
  3585. mkdir $d; # 0777
  3586. }
  3587. }
  3588. open(OUTFILE, ">$filename");
  3589. binmode OUTFILE; # for crapage systems, use binary
  3590. if($fileattr{'nonewline'}) {
  3591. # cut off the final newline
  3592. chomp($fileContent);
  3593. }
  3594. print OUTFILE $fileContent;
  3595. close(OUTFILE);
  3596. }
  3597. }
  3598. my %cmdhash = getpartattr("client", "command");
  3599. my $out="";
  3600. if((!$cmdhash{'option'}) || ($cmdhash{'option'} !~ /no-output/)) {
  3601. #We may slap on --output!
  3602. if (!@validstdout ||
  3603. ($cmdhash{'option'} && $cmdhash{'option'} =~ /force-output/)) {
  3604. $out=" --output $CURLOUT ";
  3605. }
  3606. }
  3607. my $serverlogslocktimeout = $defserverlogslocktimeout;
  3608. if($cmdhash{'timeout'}) {
  3609. # test is allowed to override default server logs lock timeout
  3610. if($cmdhash{'timeout'} =~ /(\d+)/) {
  3611. $serverlogslocktimeout = $1 if($1 >= 0);
  3612. }
  3613. }
  3614. my $postcommanddelay = $defpostcommanddelay;
  3615. if($cmdhash{'delay'}) {
  3616. # test is allowed to specify a delay after command is executed
  3617. if($cmdhash{'delay'} =~ /(\d+)/) {
  3618. $postcommanddelay = $1 if($1 > 0);
  3619. }
  3620. }
  3621. my $CMDLINE;
  3622. my $cmdargs;
  3623. my $cmdtype = $cmdhash{'type'} || "default";
  3624. my $fail_due_event_based = $evbased;
  3625. if($cmdtype eq "perl") {
  3626. # run the command line prepended with "perl"
  3627. $cmdargs ="$cmd";
  3628. $CMDLINE = "$perl ";
  3629. $tool=$CMDLINE;
  3630. $disablevalgrind=1;
  3631. }
  3632. elsif($cmdtype eq "shell") {
  3633. # run the command line prepended with "/bin/sh"
  3634. $cmdargs ="$cmd";
  3635. $CMDLINE = "/bin/sh ";
  3636. $tool=$CMDLINE;
  3637. $disablevalgrind=1;
  3638. }
  3639. elsif(!$tool && !$keywords{"unittest"}) {
  3640. # run curl, add suitable command line options
  3641. my $inc="";
  3642. if((!$cmdhash{'option'}) || ($cmdhash{'option'} !~ /no-include/)) {
  3643. $inc = " --include";
  3644. }
  3645. $cmdargs = "$out$inc ";
  3646. if($cmdhash{'option'} && ($cmdhash{'option'} =~ /binary-trace/)) {
  3647. $cmdargs .= "--trace log/trace$testnum ";
  3648. }
  3649. else {
  3650. $cmdargs .= "--trace-ascii log/trace$testnum ";
  3651. }
  3652. $cmdargs .= "--trace-time ";
  3653. if($evbased) {
  3654. $cmdargs .= "--test-event ";
  3655. $fail_due_event_based--;
  3656. }
  3657. $cmdargs .= $cmd;
  3658. if ($use_external_proxy) {
  3659. $cmdargs .= " --proxy $proxy_address ";
  3660. }
  3661. }
  3662. else {
  3663. $cmdargs = " $cmd"; # $cmd is the command line for the test file
  3664. $CURLOUT = $STDOUT; # sends received data to stdout
  3665. # Default the tool to a unit test with the same name as the test spec
  3666. if($keywords{"unittest"} && !$tool) {
  3667. $tool="unit$testnum";
  3668. }
  3669. if($tool =~ /^lib/) {
  3670. $CMDLINE="$LIBDIR/$tool";
  3671. }
  3672. elsif($tool =~ /^unit/) {
  3673. $CMDLINE="$UNITDIR/$tool";
  3674. }
  3675. if(! -f $CMDLINE) {
  3676. logmsg "The tool set in the test case for this: '$tool' does not exist\n";
  3677. timestampskippedevents($testnum);
  3678. return -1;
  3679. }
  3680. $DBGCURL=$CMDLINE;
  3681. }
  3682. if($fail_due_event_based) {
  3683. logmsg "This test cannot run event based\n";
  3684. timestampskippedevents($testnum);
  3685. return -1;
  3686. }
  3687. if($gdbthis) {
  3688. # gdb is incompatible with valgrind, so disable it when debugging
  3689. # Perhaps a better approach would be to run it under valgrind anyway
  3690. # with --db-attach=yes or --vgdb=yes.
  3691. $disablevalgrind=1;
  3692. }
  3693. my @stdintest = getpart("client", "stdin");
  3694. if(@stdintest) {
  3695. my $stdinfile="$LOGDIR/stdin-for-$testnum";
  3696. my %hash = getpartattr("client", "stdin");
  3697. if($hash{'nonewline'}) {
  3698. # cut off the final newline from the final line of the stdin data
  3699. chomp($stdintest[$#stdintest]);
  3700. }
  3701. writearray($stdinfile, \@stdintest);
  3702. $cmdargs .= " <$stdinfile";
  3703. }
  3704. if(!$tool) {
  3705. $CMDLINE="$CURL";
  3706. }
  3707. my $usevalgrind;
  3708. if($valgrind && !$disablevalgrind) {
  3709. my @valgrindoption = getpart("verify", "valgrind");
  3710. if((!@valgrindoption) || ($valgrindoption[0] !~ /disable/)) {
  3711. $usevalgrind = 1;
  3712. my $valgrindcmd = "$valgrind ";
  3713. $valgrindcmd .= "$valgrind_tool " if($valgrind_tool);
  3714. $valgrindcmd .= "--quiet --leak-check=yes ";
  3715. $valgrindcmd .= "--suppressions=$srcdir/valgrind.supp ";
  3716. # $valgrindcmd .= "--gen-suppressions=all ";
  3717. $valgrindcmd .= "--num-callers=16 ";
  3718. $valgrindcmd .= "${valgrind_logfile}=$LOGDIR/valgrind$testnum";
  3719. $CMDLINE = "$valgrindcmd $CMDLINE";
  3720. }
  3721. }
  3722. $CMDLINE .= "$cmdargs >$STDOUT 2>$STDERR";
  3723. if($verbose) {
  3724. logmsg "$CMDLINE\n";
  3725. }
  3726. open(CMDLOG, ">", "$LOGDIR/$CURLLOG");
  3727. print CMDLOG "$CMDLINE\n";
  3728. close(CMDLOG);
  3729. unlink("core");
  3730. my $dumped_core;
  3731. my $cmdres;
  3732. if($gdbthis) {
  3733. my $gdbinit = "$TESTDIR/gdbinit$testnum";
  3734. open(GDBCMD, ">$LOGDIR/gdbcmd");
  3735. print GDBCMD "set args $cmdargs\n";
  3736. print GDBCMD "show args\n";
  3737. print GDBCMD "source $gdbinit\n" if -e $gdbinit;
  3738. close(GDBCMD);
  3739. }
  3740. # Flush output.
  3741. $| = 1;
  3742. # timestamp starting of test command
  3743. $timetoolini{$testnum} = Time::HiRes::time();
  3744. # run the command line we built
  3745. if ($torture) {
  3746. $cmdres = torture($CMDLINE,
  3747. $testnum,
  3748. "$gdb --directory $LIBDIR $DBGCURL -x $LOGDIR/gdbcmd");
  3749. }
  3750. elsif($gdbthis) {
  3751. my $GDBW = ($gdbxwin) ? "-w" : "";
  3752. runclient("$gdb --directory $LIBDIR $DBGCURL $GDBW -x $LOGDIR/gdbcmd");
  3753. $cmdres=0; # makes it always continue after a debugged run
  3754. }
  3755. else {
  3756. $cmdres = runclient("$CMDLINE");
  3757. my $signal_num = $cmdres & 127;
  3758. $dumped_core = $cmdres & 128;
  3759. if(!$anyway && ($signal_num || $dumped_core)) {
  3760. $cmdres = 1000;
  3761. }
  3762. else {
  3763. $cmdres >>= 8;
  3764. $cmdres = (2000 + $signal_num) if($signal_num && !$cmdres);
  3765. }
  3766. }
  3767. # timestamp finishing of test command
  3768. $timetoolend{$testnum} = Time::HiRes::time();
  3769. if(!$dumped_core) {
  3770. if(-r "core") {
  3771. # there's core file present now!
  3772. $dumped_core = 1;
  3773. }
  3774. }
  3775. if($dumped_core) {
  3776. logmsg "core dumped\n";
  3777. if(0 && $gdb) {
  3778. logmsg "running gdb for post-mortem analysis:\n";
  3779. open(GDBCMD, ">$LOGDIR/gdbcmd2");
  3780. print GDBCMD "bt\n";
  3781. close(GDBCMD);
  3782. runclient("$gdb --directory libtest -x $LOGDIR/gdbcmd2 -batch $DBGCURL core ");
  3783. # unlink("$LOGDIR/gdbcmd2");
  3784. }
  3785. }
  3786. # If a server logs advisor read lock file exists, it is an indication
  3787. # that the server has not yet finished writing out all its log files,
  3788. # including server request log files used for protocol verification.
  3789. # So, if the lock file exists the script waits here a certain amount
  3790. # of time until the server removes it, or the given time expires.
  3791. if($serverlogslocktimeout) {
  3792. my $lockretry = $serverlogslocktimeout * 20;
  3793. while((-f $SERVERLOGS_LOCK) && $lockretry--) {
  3794. portable_sleep(0.05);
  3795. }
  3796. if(($lockretry < 0) &&
  3797. ($serverlogslocktimeout >= $defserverlogslocktimeout)) {
  3798. logmsg "Warning: server logs lock timeout ",
  3799. "($serverlogslocktimeout seconds) expired\n";
  3800. }
  3801. }
  3802. # Test harness ssh server does not have this synchronization mechanism,
  3803. # this implies that some ssh server based tests might need a small delay
  3804. # once that the client command has run to avoid false test failures.
  3805. #
  3806. # gnutls-serv also lacks this synchronization mechanism, so gnutls-serv
  3807. # based tests might need a small delay once that the client command has
  3808. # run to avoid false test failures.
  3809. portable_sleep($postcommanddelay) if($postcommanddelay);
  3810. # timestamp removal of server logs advisor read lock
  3811. $timesrvrlog{$testnum} = Time::HiRes::time();
  3812. # test definition might instruct to stop some servers
  3813. # stop also all servers relative to the given one
  3814. my @killtestservers = getpart("client", "killserver");
  3815. if(@killtestservers) {
  3816. foreach my $server (@killtestservers) {
  3817. chomp $server;
  3818. if(stopserver($server)) {
  3819. return 1; # normal error if asked to fail on unexpected alive
  3820. }
  3821. }
  3822. }
  3823. # run the postcheck command
  3824. my @postcheck= getpart("client", "postcheck");
  3825. if(@postcheck) {
  3826. $cmd = join("", @postcheck);
  3827. chomp $cmd;
  3828. if($cmd) {
  3829. logmsg "postcheck $cmd\n" if($verbose);
  3830. my $rc = runclient("$cmd");
  3831. # Must run the postcheck command in torture mode in order
  3832. # to clean up, but the result can't be relied upon.
  3833. if($rc != 0 && !$torture) {
  3834. logmsg " postcheck FAILED\n";
  3835. # timestamp test result verification end
  3836. $timevrfyend{$testnum} = Time::HiRes::time();
  3837. return $errorreturncode;
  3838. }
  3839. }
  3840. }
  3841. # restore environment variables that were modified
  3842. if(%oldenv) {
  3843. foreach my $var (keys %oldenv) {
  3844. if($oldenv{$var} eq 'notset') {
  3845. delete $ENV{$var} if($ENV{$var});
  3846. }
  3847. else {
  3848. $ENV{$var} = "$oldenv{$var}";
  3849. }
  3850. }
  3851. }
  3852. # Skip all the verification on torture tests
  3853. if ($torture) {
  3854. # timestamp test result verification end
  3855. $timevrfyend{$testnum} = Time::HiRes::time();
  3856. return $cmdres;
  3857. }
  3858. my @err = getpart("verify", "errorcode");
  3859. my $errorcode = $err[0] || "0";
  3860. my $ok="";
  3861. my $res;
  3862. chomp $errorcode;
  3863. if (@validstdout) {
  3864. # verify redirected stdout
  3865. my @actual = loadarray($STDOUT);
  3866. # what parts to cut off from stdout
  3867. my @stripfile = getpart("verify", "stripfile");
  3868. foreach my $strip (@stripfile) {
  3869. chomp $strip;
  3870. my @newgen;
  3871. for(@actual) {
  3872. eval $strip;
  3873. if($_) {
  3874. push @newgen, $_;
  3875. }
  3876. }
  3877. # this is to get rid of array entries that vanished (zero
  3878. # length) because of replacements
  3879. @actual = @newgen;
  3880. }
  3881. # get all attributes
  3882. my %hash = getpartattr("verify", "stdout");
  3883. # get the mode attribute
  3884. my $filemode=$hash{'mode'};
  3885. if($filemode && ($filemode eq "text") && $has_textaware) {
  3886. # text mode when running on windows: fix line endings
  3887. map s/\r\n/\n/g, @validstdout;
  3888. map s/\n/\r\n/g, @validstdout;
  3889. }
  3890. if($hash{'nonewline'}) {
  3891. # Yes, we must cut off the final newline from the final line
  3892. # of the protocol data
  3893. chomp($validstdout[$#validstdout]);
  3894. }
  3895. if($hash{'crlf'} ||
  3896. ($has_hyper && ($keywords{"HTTP"}
  3897. || $keywords{"HTTPS"}))) {
  3898. map subNewlines(0, \$_), @validstdout;
  3899. }
  3900. $res = compare($testnum, $testname, "stdout", \@actual, \@validstdout);
  3901. if($res) {
  3902. return $errorreturncode;
  3903. }
  3904. $ok .= "s";
  3905. }
  3906. else {
  3907. $ok .= "-"; # stdout not checked
  3908. }
  3909. if (@validstderr) {
  3910. # verify redirected stderr
  3911. my @actual = loadarray($STDERR);
  3912. # what parts to cut off from stderr
  3913. my @stripfile = getpart("verify", "stripfile");
  3914. foreach my $strip (@stripfile) {
  3915. chomp $strip;
  3916. my @newgen;
  3917. for(@actual) {
  3918. eval $strip;
  3919. if($_) {
  3920. push @newgen, $_;
  3921. }
  3922. }
  3923. # this is to get rid of array entries that vanished (zero
  3924. # length) because of replacements
  3925. @actual = @newgen;
  3926. }
  3927. # get all attributes
  3928. my %hash = getpartattr("verify", "stderr");
  3929. # get the mode attribute
  3930. my $filemode=$hash{'mode'};
  3931. if($filemode && ($filemode eq "text") && $has_hyper) {
  3932. # text mode check in hyper-mode. Sometimes necessary if the stderr
  3933. # data *looks* like HTTP and thus has gotten CRLF newlines
  3934. # mistakenly
  3935. map s/\r\n/\n/g, @validstderr;
  3936. }
  3937. if($filemode && ($filemode eq "text") && $has_textaware) {
  3938. # text mode when running on windows: fix line endings
  3939. map s/\r\n/\n/g, @validstderr;
  3940. map s/\n/\r\n/g, @validstderr;
  3941. }
  3942. if($hash{'nonewline'}) {
  3943. # Yes, we must cut off the final newline from the final line
  3944. # of the protocol data
  3945. chomp($validstderr[$#validstderr]);
  3946. }
  3947. $res = compare($testnum, $testname, "stderr", \@actual, \@validstderr);
  3948. if($res) {
  3949. return $errorreturncode;
  3950. }
  3951. $ok .= "r";
  3952. }
  3953. else {
  3954. $ok .= "-"; # stderr not checked
  3955. }
  3956. if(@protocol) {
  3957. # Verify the sent request
  3958. my @out = loadarray($SERVERIN);
  3959. # what to cut off from the live protocol sent by curl
  3960. my @strip = getpart("verify", "strip");
  3961. my @protstrip=@protocol;
  3962. # check if there's any attributes on the verify/protocol section
  3963. my %hash = getpartattr("verify", "protocol");
  3964. if($hash{'nonewline'}) {
  3965. # Yes, we must cut off the final newline from the final line
  3966. # of the protocol data
  3967. chomp($protstrip[$#protstrip]);
  3968. }
  3969. for(@strip) {
  3970. # strip off all lines that match the patterns from both arrays
  3971. chomp $_;
  3972. @out = striparray( $_, \@out);
  3973. @protstrip= striparray( $_, \@protstrip);
  3974. }
  3975. # what parts to cut off from the protocol
  3976. my @strippart = getpart("verify", "strippart");
  3977. my $strip;
  3978. for $strip (@strippart) {
  3979. chomp $strip;
  3980. for(@out) {
  3981. eval $strip;
  3982. }
  3983. }
  3984. if($hash{'crlf'}) {
  3985. map subNewlines(1, \$_), @protstrip;
  3986. }
  3987. if((!$out[0] || ($out[0] eq "")) && $protstrip[0]) {
  3988. logmsg "\n $testnum: protocol FAILED!\n".
  3989. " There was no content at all in the file $SERVERIN.\n".
  3990. " Server glitch? Total curl failure? Returned: $cmdres\n";
  3991. return $errorreturncode;
  3992. }
  3993. $res = compare($testnum, $testname, "protocol", \@out, \@protstrip);
  3994. if($res) {
  3995. return $errorreturncode;
  3996. }
  3997. $ok .= "p";
  3998. }
  3999. else {
  4000. $ok .= "-"; # protocol not checked
  4001. }
  4002. if(!$replyattr{'nocheck'} && (@reply || $replyattr{'sendzero'})) {
  4003. # verify the received data
  4004. my @out = loadarray($CURLOUT);
  4005. $res = compare($testnum, $testname, "data", \@out, \@reply);
  4006. if ($res) {
  4007. return $errorreturncode;
  4008. }
  4009. $ok .= "d";
  4010. }
  4011. else {
  4012. $ok .= "-"; # data not checked
  4013. }
  4014. if(@upload) {
  4015. # verify uploaded data
  4016. my @out = loadarray("$LOGDIR/upload.$testnum");
  4017. # what parts to cut off from the upload
  4018. my @strippart = getpart("verify", "strippart");
  4019. my $strip;
  4020. for $strip (@strippart) {
  4021. chomp $strip;
  4022. for(@out) {
  4023. eval $strip;
  4024. }
  4025. }
  4026. $res = compare($testnum, $testname, "upload", \@out, \@upload);
  4027. if ($res) {
  4028. return $errorreturncode;
  4029. }
  4030. $ok .= "u";
  4031. }
  4032. else {
  4033. $ok .= "-"; # upload not checked
  4034. }
  4035. if(@proxyprot) {
  4036. # Verify the sent proxy request
  4037. my @out = loadarray($PROXYIN);
  4038. # what to cut off from the live protocol sent by curl, we use the
  4039. # same rules as for <protocol>
  4040. my @strip = getpart("verify", "strip");
  4041. my @protstrip=@proxyprot;
  4042. # check if there's any attributes on the verify/protocol section
  4043. my %hash = getpartattr("verify", "proxy");
  4044. if($hash{'nonewline'}) {
  4045. # Yes, we must cut off the final newline from the final line
  4046. # of the protocol data
  4047. chomp($protstrip[$#protstrip]);
  4048. }
  4049. for(@strip) {
  4050. # strip off all lines that match the patterns from both arrays
  4051. chomp $_;
  4052. @out = striparray( $_, \@out);
  4053. @protstrip= striparray( $_, \@protstrip);
  4054. }
  4055. # what parts to cut off from the protocol
  4056. my @strippart = getpart("verify", "strippart");
  4057. my $strip;
  4058. for $strip (@strippart) {
  4059. chomp $strip;
  4060. for(@out) {
  4061. eval $strip;
  4062. }
  4063. }
  4064. if($hash{'crlf'} ||
  4065. ($has_hyper && ($keywords{"HTTP"} || $keywords{"HTTPS"}))) {
  4066. map subNewlines(0, \$_), @protstrip;
  4067. }
  4068. $res = compare($testnum, $testname, "proxy", \@out, \@protstrip);
  4069. if($res) {
  4070. return $errorreturncode;
  4071. }
  4072. $ok .= "P";
  4073. }
  4074. else {
  4075. $ok .= "-"; # protocol not checked
  4076. }
  4077. my $outputok;
  4078. for my $partsuffix (('', '1', '2', '3', '4')) {
  4079. my @outfile=getpart("verify", "file".$partsuffix);
  4080. if(@outfile || partexists("verify", "file".$partsuffix) ) {
  4081. # we're supposed to verify a dynamically generated file!
  4082. my %hash = getpartattr("verify", "file".$partsuffix);
  4083. my $filename=$hash{'name'};
  4084. if(!$filename) {
  4085. logmsg "ERROR: section verify=>file$partsuffix ".
  4086. "has no name attribute\n";
  4087. stopservers($verbose);
  4088. # timestamp test result verification end
  4089. $timevrfyend{$testnum} = Time::HiRes::time();
  4090. return -1;
  4091. }
  4092. my @generated=loadarray($filename);
  4093. # what parts to cut off from the file
  4094. my @stripfile = getpart("verify", "stripfile".$partsuffix);
  4095. my $filemode=$hash{'mode'};
  4096. if($filemode && ($filemode eq "text") && $has_textaware) {
  4097. # text mode when running on windows: fix line endings
  4098. map s/\r\n/\n/g, @outfile;
  4099. map s/\n/\r\n/g, @outfile;
  4100. }
  4101. if($hash{'crlf'} ||
  4102. ($has_hyper && ($keywords{"HTTP"}
  4103. || $keywords{"HTTPS"}))) {
  4104. map subNewlines(0, \$_), @outfile;
  4105. }
  4106. my $strip;
  4107. for $strip (@stripfile) {
  4108. chomp $strip;
  4109. my @newgen;
  4110. for(@generated) {
  4111. eval $strip;
  4112. if($_) {
  4113. push @newgen, $_;
  4114. }
  4115. }
  4116. # this is to get rid of array entries that vanished (zero
  4117. # length) because of replacements
  4118. @generated = @newgen;
  4119. }
  4120. $res = compare($testnum, $testname, "output ($filename)",
  4121. \@generated, \@outfile);
  4122. if($res) {
  4123. return $errorreturncode;
  4124. }
  4125. $outputok = 1; # output checked
  4126. }
  4127. }
  4128. $ok .= ($outputok) ? "o" : "-"; # output checked or not
  4129. # verify SOCKS proxy details
  4130. my @socksprot = getpart("verify", "socks");
  4131. if(@socksprot) {
  4132. # Verify the sent SOCKS proxy details
  4133. my @out = loadarray($SOCKSIN);
  4134. $res = compare($testnum, $testname, "socks", \@out, \@socksprot);
  4135. if($res) {
  4136. return $errorreturncode;
  4137. }
  4138. }
  4139. # accept multiple comma-separated error codes
  4140. my @splerr = split(/ *, */, $errorcode);
  4141. my $errok;
  4142. foreach my $e (@splerr) {
  4143. if($e == $cmdres) {
  4144. # a fine error code
  4145. $errok = 1;
  4146. last;
  4147. }
  4148. }
  4149. if($errok) {
  4150. $ok .= "e";
  4151. }
  4152. else {
  4153. if(!$short) {
  4154. logmsg sprintf("\n%s returned $cmdres, when expecting %s\n",
  4155. (!$tool)?"curl":$tool, $errorcode);
  4156. }
  4157. logmsg " exit FAILED\n";
  4158. # timestamp test result verification end
  4159. $timevrfyend{$testnum} = Time::HiRes::time();
  4160. return $errorreturncode;
  4161. }
  4162. if($has_memory_tracking) {
  4163. if(! -f $memdump) {
  4164. logmsg "\n** ALERT! memory tracking with no output file?\n"
  4165. if(!$cmdtype eq "perl");
  4166. }
  4167. else {
  4168. my @memdata=`$memanalyze $memdump`;
  4169. my $leak=0;
  4170. for(@memdata) {
  4171. if($_ ne "") {
  4172. # well it could be other memory problems as well, but
  4173. # we call it leak for short here
  4174. $leak=1;
  4175. }
  4176. }
  4177. if($leak) {
  4178. logmsg "\n** MEMORY FAILURE\n";
  4179. logmsg @memdata;
  4180. # timestamp test result verification end
  4181. $timevrfyend{$testnum} = Time::HiRes::time();
  4182. return $errorreturncode;
  4183. }
  4184. else {
  4185. $ok .= "m";
  4186. }
  4187. }
  4188. }
  4189. else {
  4190. $ok .= "-"; # memory not checked
  4191. }
  4192. if($valgrind) {
  4193. if($usevalgrind) {
  4194. unless(opendir(DIR, "$LOGDIR")) {
  4195. logmsg "ERROR: unable to read $LOGDIR\n";
  4196. # timestamp test result verification end
  4197. $timevrfyend{$testnum} = Time::HiRes::time();
  4198. return $errorreturncode;
  4199. }
  4200. my @files = readdir(DIR);
  4201. closedir(DIR);
  4202. my $vgfile;
  4203. foreach my $file (@files) {
  4204. if($file =~ /^valgrind$testnum(\..*|)$/) {
  4205. $vgfile = $file;
  4206. last;
  4207. }
  4208. }
  4209. if(!$vgfile) {
  4210. logmsg "ERROR: valgrind log file missing for test $testnum\n";
  4211. # timestamp test result verification end
  4212. $timevrfyend{$testnum} = Time::HiRes::time();
  4213. return $errorreturncode;
  4214. }
  4215. my @e = valgrindparse("$LOGDIR/$vgfile");
  4216. if(@e && $e[0]) {
  4217. if($automakestyle) {
  4218. logmsg "FAIL: $testnum - $testname - valgrind\n";
  4219. }
  4220. else {
  4221. logmsg " valgrind ERROR ";
  4222. logmsg @e;
  4223. }
  4224. # timestamp test result verification end
  4225. $timevrfyend{$testnum} = Time::HiRes::time();
  4226. return $errorreturncode;
  4227. }
  4228. $ok .= "v";
  4229. }
  4230. else {
  4231. if($verbose && !$disablevalgrind) {
  4232. logmsg " valgrind SKIPPED\n";
  4233. }
  4234. $ok .= "-"; # skipped
  4235. }
  4236. }
  4237. else {
  4238. $ok .= "-"; # valgrind not checked
  4239. }
  4240. # add 'E' for event-based
  4241. $ok .= $evbased ? "E" : "-";
  4242. logmsg "$ok " if(!$short);
  4243. # timestamp test result verification end
  4244. $timevrfyend{$testnum} = Time::HiRes::time();
  4245. my $sofar= time()-$start;
  4246. my $esttotal = $sofar/$count * $total;
  4247. my $estleft = $esttotal - $sofar;
  4248. my $left=sprintf("remaining: %02d:%02d",
  4249. $estleft/60,
  4250. $estleft%60);
  4251. my $took = $timevrfyend{$testnum} - $timeprepini{$testnum};
  4252. my $duration = sprintf("duration: %02d:%02d",
  4253. $sofar/60, $sofar%60);
  4254. if(!$automakestyle) {
  4255. logmsg sprintf("OK (%-3d out of %-3d, %s, took %.3fs, %s)\n",
  4256. $count, $total, $left, $took, $duration);
  4257. }
  4258. else {
  4259. logmsg "PASS: $testnum - $testname\n";
  4260. }
  4261. if($errorreturncode==2) {
  4262. logmsg "Warning: test$testnum result is ignored, but passed!\n";
  4263. }
  4264. return 0;
  4265. }
  4266. #######################################################################
  4267. # Stop all running test servers
  4268. #
  4269. sub stopservers {
  4270. my $verbose = $_[0];
  4271. #
  4272. # kill sockfilter processes for all pingpong servers
  4273. #
  4274. killallsockfilters($verbose);
  4275. #
  4276. # kill all server pids from %run hash clearing them
  4277. #
  4278. my $pidlist;
  4279. foreach my $server (keys %run) {
  4280. if($run{$server}) {
  4281. if($verbose) {
  4282. my $prev = 0;
  4283. my $pids = $run{$server};
  4284. foreach my $pid (split(' ', $pids)) {
  4285. if($pid != $prev) {
  4286. logmsg sprintf("* kill pid for %s => %d\n",
  4287. $server, $pid);
  4288. $prev = $pid;
  4289. }
  4290. }
  4291. }
  4292. $pidlist .= "$run{$server} ";
  4293. $run{$server} = 0;
  4294. }
  4295. $runcert{$server} = 0 if($runcert{$server});
  4296. }
  4297. killpid($verbose, $pidlist);
  4298. #
  4299. # cleanup all server pid files
  4300. #
  4301. my $result = 0;
  4302. foreach my $server (keys %serverpidfile) {
  4303. my $pidfile = $serverpidfile{$server};
  4304. my $pid = processexists($pidfile);
  4305. if($pid > 0) {
  4306. if($err_unexpected) {
  4307. logmsg "ERROR: ";
  4308. $result = -1;
  4309. }
  4310. else {
  4311. logmsg "Warning: ";
  4312. }
  4313. logmsg "$server server unexpectedly alive\n";
  4314. killpid($verbose, $pid);
  4315. }
  4316. unlink($pidfile) if(-f $pidfile);
  4317. }
  4318. return $result;
  4319. }
  4320. #######################################################################
  4321. # startservers() starts all the named servers
  4322. #
  4323. # Returns: string with error reason or blank for success
  4324. #
  4325. sub startservers {
  4326. my @what = @_;
  4327. my ($pid, $pid2);
  4328. for(@what) {
  4329. my (@whatlist) = split(/\s+/,$_);
  4330. my $what = lc($whatlist[0]);
  4331. $what =~ s/[^a-z0-9\/-]//g;
  4332. my $certfile;
  4333. if($what =~ /^(ftp|gopher|http|imap|pop3|smtp)s((\d*)(-ipv6|-unix|))$/) {
  4334. $certfile = ($whatlist[1]) ? $whatlist[1] : 'stunnel.pem';
  4335. }
  4336. if(($what eq "pop3") ||
  4337. ($what eq "ftp") ||
  4338. ($what eq "imap") ||
  4339. ($what eq "smtp")) {
  4340. if($torture && $run{$what} &&
  4341. !responsive_pingpong_server($what, "", $verbose)) {
  4342. if(stopserver($what)) {
  4343. return "failed stopping unresponsive ".uc($what)." server";
  4344. }
  4345. }
  4346. if(!$run{$what}) {
  4347. ($pid, $pid2) = runpingpongserver($what, "", $verbose);
  4348. if($pid <= 0) {
  4349. return "failed starting ". uc($what) ." server";
  4350. }
  4351. printf ("* pid $what => %d %d\n", $pid, $pid2) if($verbose);
  4352. $run{$what}="$pid $pid2";
  4353. }
  4354. }
  4355. elsif($what eq "ftp-ipv6") {
  4356. if($torture && $run{'ftp-ipv6'} &&
  4357. !responsive_pingpong_server("ftp", "", $verbose, "ipv6")) {
  4358. if(stopserver('ftp-ipv6')) {
  4359. return "failed stopping unresponsive FTP-IPv6 server";
  4360. }
  4361. }
  4362. if(!$run{'ftp-ipv6'}) {
  4363. ($pid, $pid2) = runpingpongserver("ftp", "", $verbose, "ipv6");
  4364. if($pid <= 0) {
  4365. return "failed starting FTP-IPv6 server";
  4366. }
  4367. logmsg sprintf("* pid ftp-ipv6 => %d %d\n", $pid,
  4368. $pid2) if($verbose);
  4369. $run{'ftp-ipv6'}="$pid $pid2";
  4370. }
  4371. }
  4372. elsif($what eq "gopher") {
  4373. if($torture && $run{'gopher'} &&
  4374. !responsive_http_server("gopher", $verbose, 0,
  4375. protoport("gopher"))) {
  4376. if(stopserver('gopher')) {
  4377. return "failed stopping unresponsive GOPHER server";
  4378. }
  4379. }
  4380. if(!$run{'gopher'}) {
  4381. ($pid, $pid2, $PORT{'gopher'}) =
  4382. runhttpserver("gopher", $verbose, 0);
  4383. if($pid <= 0) {
  4384. return "failed starting GOPHER server";
  4385. }
  4386. logmsg sprintf ("* pid gopher => %d %d\n", $pid, $pid2)
  4387. if($verbose);
  4388. $run{'gopher'}="$pid $pid2";
  4389. }
  4390. }
  4391. elsif($what eq "gopher-ipv6") {
  4392. if($torture && $run{'gopher-ipv6'} &&
  4393. !responsive_http_server("gopher", $verbose, "ipv6",
  4394. protoport("gopher"))) {
  4395. if(stopserver('gopher-ipv6')) {
  4396. return "failed stopping unresponsive GOPHER-IPv6 server";
  4397. }
  4398. }
  4399. if(!$run{'gopher-ipv6'}) {
  4400. ($pid, $pid2, $PORT{"gopher6"}) =
  4401. runhttpserver("gopher", $verbose, "ipv6");
  4402. if($pid <= 0) {
  4403. return "failed starting GOPHER-IPv6 server";
  4404. }
  4405. logmsg sprintf("* pid gopher-ipv6 => %d %d\n", $pid,
  4406. $pid2) if($verbose);
  4407. $run{'gopher-ipv6'}="$pid $pid2";
  4408. }
  4409. }
  4410. elsif($what eq "http/3") {
  4411. if(!$run{'http/3'}) {
  4412. ($pid, $pid2, $PORT{"http3"}) = runhttp3server($verbose);
  4413. if($pid <= 0) {
  4414. return "failed starting HTTP/3 server";
  4415. }
  4416. logmsg sprintf ("* pid http/3 => %d %d\n", $pid, $pid2)
  4417. if($verbose);
  4418. $run{'http/3'}="$pid $pid2";
  4419. }
  4420. }
  4421. elsif($what eq "http/2") {
  4422. if(!$run{'http/2'}) {
  4423. ($pid, $pid2, $PORT{"http2"}, $PORT{"http2tls"}) =
  4424. runhttp2server($verbose);
  4425. if($pid <= 0) {
  4426. return "failed starting HTTP/2 server";
  4427. }
  4428. logmsg sprintf ("* pid http/2 => %d %d\n", $pid, $pid2)
  4429. if($verbose);
  4430. $run{'http/2'}="$pid $pid2";
  4431. }
  4432. }
  4433. elsif($what eq "http") {
  4434. if($torture && $run{'http'} &&
  4435. !responsive_http_server("http", $verbose, 0, protoport('http'))) {
  4436. if(stopserver('http')) {
  4437. return "failed stopping unresponsive HTTP server";
  4438. }
  4439. }
  4440. if(!$run{'http'}) {
  4441. ($pid, $pid2, $PORT{'http'}) =
  4442. runhttpserver("http", $verbose, 0);
  4443. if($pid <= 0) {
  4444. return "failed starting HTTP server";
  4445. }
  4446. logmsg sprintf ("* pid http => %d %d\n", $pid, $pid2)
  4447. if($verbose);
  4448. $run{'http'}="$pid $pid2";
  4449. }
  4450. }
  4451. elsif($what eq "http-proxy") {
  4452. if($torture && $run{'http-proxy'} &&
  4453. !responsive_http_server("http", $verbose, "proxy",
  4454. protoport("httpproxy"))) {
  4455. if(stopserver('http-proxy')) {
  4456. return "failed stopping unresponsive HTTP-proxy server";
  4457. }
  4458. }
  4459. if(!$run{'http-proxy'}) {
  4460. ($pid, $pid2, $PORT{"httpproxy"}) =
  4461. runhttpserver("http", $verbose, "proxy");
  4462. if($pid <= 0) {
  4463. return "failed starting HTTP-proxy server";
  4464. }
  4465. logmsg sprintf ("* pid http-proxy => %d %d\n", $pid, $pid2)
  4466. if($verbose);
  4467. $run{'http-proxy'}="$pid $pid2";
  4468. }
  4469. }
  4470. elsif($what eq "http-ipv6") {
  4471. if($torture && $run{'http-ipv6'} &&
  4472. !responsive_http_server("http", $verbose, "ipv6",
  4473. protoport("http6"))) {
  4474. if(stopserver('http-ipv6')) {
  4475. return "failed stopping unresponsive HTTP-IPv6 server";
  4476. }
  4477. }
  4478. if(!$run{'http-ipv6'}) {
  4479. ($pid, $pid2, $PORT{"http6"}) =
  4480. runhttpserver("http", $verbose, "ipv6");
  4481. if($pid <= 0) {
  4482. return "failed starting HTTP-IPv6 server";
  4483. }
  4484. logmsg sprintf("* pid http-ipv6 => %d %d\n", $pid, $pid2)
  4485. if($verbose);
  4486. $run{'http-ipv6'}="$pid $pid2";
  4487. }
  4488. }
  4489. elsif($what eq "rtsp") {
  4490. if($torture && $run{'rtsp'} &&
  4491. !responsive_rtsp_server($verbose)) {
  4492. if(stopserver('rtsp')) {
  4493. return "failed stopping unresponsive RTSP server";
  4494. }
  4495. }
  4496. if(!$run{'rtsp'}) {
  4497. ($pid, $pid2, $PORT{'rtsp'}) = runrtspserver($verbose);
  4498. if($pid <= 0) {
  4499. return "failed starting RTSP server";
  4500. }
  4501. printf ("* pid rtsp => %d %d\n", $pid, $pid2) if($verbose);
  4502. $run{'rtsp'}="$pid $pid2";
  4503. }
  4504. }
  4505. elsif($what eq "rtsp-ipv6") {
  4506. if($torture && $run{'rtsp-ipv6'} &&
  4507. !responsive_rtsp_server($verbose, "ipv6")) {
  4508. if(stopserver('rtsp-ipv6')) {
  4509. return "failed stopping unresponsive RTSP-IPv6 server";
  4510. }
  4511. }
  4512. if(!$run{'rtsp-ipv6'}) {
  4513. ($pid, $pid2, $PORT{'rtsp6'}) = runrtspserver($verbose, "ipv6");
  4514. if($pid <= 0) {
  4515. return "failed starting RTSP-IPv6 server";
  4516. }
  4517. logmsg sprintf("* pid rtsp-ipv6 => %d %d\n", $pid, $pid2)
  4518. if($verbose);
  4519. $run{'rtsp-ipv6'}="$pid $pid2";
  4520. }
  4521. }
  4522. elsif($what =~ /^(ftp|imap|pop3|smtp)s$/) {
  4523. my $cproto = $1;
  4524. if(!$stunnel) {
  4525. # we can't run ftps tests without stunnel
  4526. return "no stunnel";
  4527. }
  4528. if($runcert{$what} && ($runcert{$what} ne $certfile)) {
  4529. # stop server when running and using a different cert
  4530. if(stopserver($what)) {
  4531. return "failed stopping $what server with different cert";
  4532. }
  4533. }
  4534. if($torture && $run{$cproto} &&
  4535. !responsive_pingpong_server($cproto, "", $verbose)) {
  4536. if(stopserver($cproto)) {
  4537. return "failed stopping unresponsive $cproto server";
  4538. }
  4539. }
  4540. if(!$run{$cproto}) {
  4541. ($pid, $pid2) = runpingpongserver($cproto, "", $verbose);
  4542. if($pid <= 0) {
  4543. return "failed starting $cproto server";
  4544. }
  4545. printf ("* pid $cproto => %d %d\n", $pid, $pid2) if($verbose);
  4546. $run{$cproto}="$pid $pid2";
  4547. }
  4548. if(!$run{$what}) {
  4549. ($pid, $pid2, $PORT{$what}) =
  4550. runsecureserver($verbose, "", $certfile, $what,
  4551. protoport($cproto));
  4552. if($pid <= 0) {
  4553. return "failed starting $what server (stunnel)";
  4554. }
  4555. logmsg sprintf("* pid $what => %d %d\n", $pid, $pid2)
  4556. if($verbose);
  4557. $run{$what}="$pid $pid2";
  4558. }
  4559. }
  4560. elsif($what eq "file") {
  4561. # we support it but have no server!
  4562. }
  4563. elsif($what eq "https") {
  4564. if(!$stunnel) {
  4565. # we can't run https tests without stunnel
  4566. return "no stunnel";
  4567. }
  4568. if($runcert{'https'} && ($runcert{'https'} ne $certfile)) {
  4569. # stop server when running and using a different cert
  4570. if(stopserver('https')) {
  4571. return "failed stopping HTTPS server with different cert";
  4572. }
  4573. }
  4574. if($torture && $run{'http'} &&
  4575. !responsive_http_server("http", $verbose, 0,
  4576. protoport('http'))) {
  4577. if(stopserver('http')) {
  4578. return "failed stopping unresponsive HTTP server";
  4579. }
  4580. }
  4581. if(!$run{'http'}) {
  4582. ($pid, $pid2, $PORT{'http'}) =
  4583. runhttpserver("http", $verbose, 0);
  4584. if($pid <= 0) {
  4585. return "failed starting HTTP server";
  4586. }
  4587. printf ("* pid http => %d %d\n", $pid, $pid2) if($verbose);
  4588. $run{'http'}="$pid $pid2";
  4589. }
  4590. if(!$run{'https'}) {
  4591. ($pid, $pid2, $PORT{'https'}) =
  4592. runhttpsserver($verbose, "https", "", $certfile);
  4593. if($pid <= 0) {
  4594. return "failed starting HTTPS server (stunnel)";
  4595. }
  4596. logmsg sprintf("* pid https => %d %d\n", $pid, $pid2)
  4597. if($verbose);
  4598. $run{'https'}="$pid $pid2";
  4599. }
  4600. }
  4601. elsif($what eq "gophers") {
  4602. if(!$stunnel) {
  4603. # we can't run TLS tests without stunnel
  4604. return "no stunnel";
  4605. }
  4606. if($runcert{'gophers'} && ($runcert{'gophers'} ne $certfile)) {
  4607. # stop server when running and using a different cert
  4608. if(stopserver('gophers')) {
  4609. return "failed stopping GOPHERS server with different crt";
  4610. }
  4611. }
  4612. if($torture && $run{'gopher'} &&
  4613. !responsive_http_server("gopher", $verbose, 0,
  4614. protoport('gopher'))) {
  4615. if(stopserver('gopher')) {
  4616. return "failed stopping unresponsive GOPHER server";
  4617. }
  4618. }
  4619. if(!$run{'gopher'}) {
  4620. my $port;
  4621. ($pid, $pid2, $port) =
  4622. runhttpserver("gopher", $verbose, 0);
  4623. $PORT{'gopher'} = $port;
  4624. if($pid <= 0) {
  4625. return "failed starting GOPHER server";
  4626. }
  4627. printf ("* pid gopher => %d %d\n", $pid, $pid2) if($verbose);
  4628. print "GOPHERPORT => $port\n" if($verbose);
  4629. $run{'gopher'}="$pid $pid2";
  4630. }
  4631. if(!$run{'gophers'}) {
  4632. my $port;
  4633. ($pid, $pid2, $port) =
  4634. runhttpsserver($verbose, "gophers", "", $certfile);
  4635. $PORT{'gophers'} = $port;
  4636. if($pid <= 0) {
  4637. return "failed starting GOPHERS server (stunnel)";
  4638. }
  4639. logmsg sprintf("* pid gophers => %d %d\n", $pid, $pid2)
  4640. if($verbose);
  4641. print "GOPHERSPORT => $port\n" if($verbose);
  4642. $run{'gophers'}="$pid $pid2";
  4643. }
  4644. }
  4645. elsif($what eq "https-proxy") {
  4646. if(!$stunnel) {
  4647. # we can't run https-proxy tests without stunnel
  4648. return "no stunnel";
  4649. }
  4650. if($runcert{'https-proxy'} &&
  4651. ($runcert{'https-proxy'} ne $certfile)) {
  4652. # stop server when running and using a different cert
  4653. if(stopserver('https-proxy')) {
  4654. return "failed stopping HTTPS-proxy with different cert";
  4655. }
  4656. }
  4657. # we front the http-proxy with stunnel so we need to make sure the
  4658. # proxy runs as well
  4659. my $f = startservers("http-proxy");
  4660. if($f) {
  4661. return $f;1
  4662. }
  4663. if(!$run{'https-proxy'}) {
  4664. ($pid, $pid2, $PORT{"httpsproxy"}) =
  4665. runhttpsserver($verbose, "https", "proxy", $certfile);
  4666. if($pid <= 0) {
  4667. return "failed starting HTTPS-proxy (stunnel)";
  4668. }
  4669. logmsg sprintf("* pid https-proxy => %d %d\n", $pid, $pid2)
  4670. if($verbose);
  4671. $run{'https-proxy'}="$pid $pid2";
  4672. }
  4673. }
  4674. elsif($what eq "httptls") {
  4675. if(!$httptlssrv) {
  4676. # for now, we can't run http TLS-EXT tests without gnutls-serv
  4677. return "no gnutls-serv (with SRP support)";
  4678. }
  4679. if($torture && $run{'httptls'} &&
  4680. !responsive_httptls_server($verbose, "IPv4")) {
  4681. if(stopserver('httptls')) {
  4682. return "failed stopping unresponsive HTTPTLS server";
  4683. }
  4684. }
  4685. if(!$run{'httptls'}) {
  4686. ($pid, $pid2, $PORT{'httptls'}) =
  4687. runhttptlsserver($verbose, "IPv4");
  4688. if($pid <= 0) {
  4689. return "failed starting HTTPTLS server (gnutls-serv)";
  4690. }
  4691. logmsg sprintf("* pid httptls => %d %d\n", $pid, $pid2)
  4692. if($verbose);
  4693. $run{'httptls'}="$pid $pid2";
  4694. }
  4695. }
  4696. elsif($what eq "httptls-ipv6") {
  4697. if(!$httptlssrv) {
  4698. # for now, we can't run http TLS-EXT tests without gnutls-serv
  4699. return "no gnutls-serv";
  4700. }
  4701. if($torture && $run{'httptls-ipv6'} &&
  4702. !responsive_httptls_server($verbose, "ipv6")) {
  4703. if(stopserver('httptls-ipv6')) {
  4704. return "failed stopping unresponsive HTTPTLS-IPv6 server";
  4705. }
  4706. }
  4707. if(!$run{'httptls-ipv6'}) {
  4708. ($pid, $pid2, $PORT{"httptls6"}) =
  4709. runhttptlsserver($verbose, "ipv6");
  4710. if($pid <= 0) {
  4711. return "failed starting HTTPTLS-IPv6 server (gnutls-serv)";
  4712. }
  4713. logmsg sprintf("* pid httptls-ipv6 => %d %d\n", $pid, $pid2)
  4714. if($verbose);
  4715. $run{'httptls-ipv6'}="$pid $pid2";
  4716. }
  4717. }
  4718. elsif($what eq "tftp") {
  4719. if($torture && $run{'tftp'} &&
  4720. !responsive_tftp_server("", $verbose)) {
  4721. if(stopserver('tftp')) {
  4722. return "failed stopping unresponsive TFTP server";
  4723. }
  4724. }
  4725. if(!$run{'tftp'}) {
  4726. ($pid, $pid2, $PORT{'tftp'}) =
  4727. runtftpserver("", $verbose);
  4728. if($pid <= 0) {
  4729. return "failed starting TFTP server";
  4730. }
  4731. printf ("* pid tftp => %d %d\n", $pid, $pid2) if($verbose);
  4732. $run{'tftp'}="$pid $pid2";
  4733. }
  4734. }
  4735. elsif($what eq "tftp-ipv6") {
  4736. if($torture && $run{'tftp-ipv6'} &&
  4737. !responsive_tftp_server("", $verbose, "ipv6")) {
  4738. if(stopserver('tftp-ipv6')) {
  4739. return "failed stopping unresponsive TFTP-IPv6 server";
  4740. }
  4741. }
  4742. if(!$run{'tftp-ipv6'}) {
  4743. ($pid, $pid2, $PORT{'tftp6'}) =
  4744. runtftpserver("", $verbose, "ipv6");
  4745. if($pid <= 0) {
  4746. return "failed starting TFTP-IPv6 server";
  4747. }
  4748. printf("* pid tftp-ipv6 => %d %d\n", $pid, $pid2) if($verbose);
  4749. $run{'tftp-ipv6'}="$pid $pid2";
  4750. }
  4751. }
  4752. elsif($what eq "sftp" || $what eq "scp") {
  4753. if(!$run{'ssh'}) {
  4754. ($pid, $pid2, $PORT{'ssh'}) = runsshserver("", $verbose);
  4755. if($pid <= 0) {
  4756. return "failed starting SSH server";
  4757. }
  4758. printf ("* pid ssh => %d %d\n", $pid, $pid2) if($verbose);
  4759. $run{'ssh'}="$pid $pid2";
  4760. }
  4761. }
  4762. elsif($what eq "socks4" || $what eq "socks5" ) {
  4763. if(!$run{'socks'}) {
  4764. ($pid, $pid2, $PORT{"socks"}) = runsocksserver("", $verbose);
  4765. if($pid <= 0) {
  4766. return "failed starting socks server";
  4767. }
  4768. printf ("* pid socks => %d %d\n", $pid, $pid2) if($verbose);
  4769. $run{'socks'}="$pid $pid2";
  4770. }
  4771. }
  4772. elsif($what eq "socks5unix") {
  4773. if(!$run{'socks5unix'}) {
  4774. ($pid, $pid2) = runsocksserver("2", $verbose, "", "unix");
  4775. if($pid <= 0) {
  4776. return "failed starting socks5unix server";
  4777. }
  4778. printf ("* pid socks5unix => %d %d\n", $pid, $pid2) if($verbose);
  4779. $run{'socks5unix'}="$pid $pid2";
  4780. }
  4781. }
  4782. elsif($what eq "mqtt" ) {
  4783. if(!$run{'mqtt'}) {
  4784. ($pid, $pid2) = runmqttserver("", $verbose);
  4785. if($pid <= 0) {
  4786. return "failed starting mqtt server";
  4787. }
  4788. printf ("* pid mqtt => %d %d\n", $pid, $pid2) if($verbose);
  4789. $run{'mqtt'}="$pid $pid2";
  4790. }
  4791. }
  4792. elsif($what eq "http-unix") {
  4793. if($torture && $run{'http-unix'} &&
  4794. !responsive_http_server("http", $verbose, "unix", $HTTPUNIXPATH)) {
  4795. if(stopserver('http-unix')) {
  4796. return "failed stopping unresponsive HTTP-unix server";
  4797. }
  4798. }
  4799. if(!$run{'http-unix'}) {
  4800. my $unused;
  4801. ($pid, $pid2, $unused) =
  4802. runhttpserver("http", $verbose, "unix", $HTTPUNIXPATH);
  4803. if($pid <= 0) {
  4804. return "failed starting HTTP-unix server";
  4805. }
  4806. logmsg sprintf("* pid http-unix => %d %d\n", $pid, $pid2)
  4807. if($verbose);
  4808. $run{'http-unix'}="$pid $pid2";
  4809. }
  4810. }
  4811. elsif($what eq "dict") {
  4812. if(!$run{'dict'}) {
  4813. ($pid, $pid2, $PORT{"dict"}) = rundictserver($verbose, "");
  4814. if($pid <= 0) {
  4815. return "failed starting DICT server";
  4816. }
  4817. logmsg sprintf ("* pid DICT => %d %d\n", $pid, $pid2)
  4818. if($verbose);
  4819. $run{'dict'}="$pid $pid2";
  4820. }
  4821. }
  4822. elsif($what eq "smb") {
  4823. if(!$run{'smb'}) {
  4824. ($pid, $pid2, $PORT{"smb"}) = runsmbserver($verbose, "");
  4825. if($pid <= 0) {
  4826. return "failed starting SMB server";
  4827. }
  4828. logmsg sprintf ("* pid SMB => %d %d\n", $pid, $pid2)
  4829. if($verbose);
  4830. $run{'smb'}="$pid $pid2";
  4831. }
  4832. }
  4833. elsif($what eq "telnet") {
  4834. if(!$run{'telnet'}) {
  4835. ($pid, $pid2, $PORT{"telnet"}) =
  4836. runnegtelnetserver($verbose, "");
  4837. if($pid <= 0) {
  4838. return "failed starting neg TELNET server";
  4839. }
  4840. logmsg sprintf ("* pid neg TELNET => %d %d\n", $pid, $pid2)
  4841. if($verbose);
  4842. $run{'telnet'}="$pid $pid2";
  4843. }
  4844. }
  4845. elsif($what eq "none") {
  4846. logmsg "* starts no server\n" if ($verbose);
  4847. }
  4848. else {
  4849. warn "we don't support a server for $what";
  4850. return "no server for $what";
  4851. }
  4852. }
  4853. return 0;
  4854. }
  4855. ##############################################################################
  4856. # This function makes sure the right set of server is running for the
  4857. # specified test case. This is a useful design when we run single tests as not
  4858. # all servers need to run then!
  4859. #
  4860. # Returns: a string, blank if everything is fine or a reason why it failed
  4861. #
  4862. sub serverfortest {
  4863. my ($testnum)=@_;
  4864. my @what = getpart("client", "server");
  4865. if(!$what[0]) {
  4866. warn "Test case $testnum has no server(s) specified";
  4867. return "no server specified";
  4868. }
  4869. for(my $i = scalar(@what) - 1; $i >= 0; $i--) {
  4870. my $srvrline = $what[$i];
  4871. chomp $srvrline if($srvrline);
  4872. if($srvrline =~ /^(\S+)((\s*)(.*))/) {
  4873. my $server = "${1}";
  4874. my $lnrest = "${2}";
  4875. my $tlsext;
  4876. if($server =~ /^(httptls)(\+)(ext|srp)(\d*)(-ipv6|)$/) {
  4877. $server = "${1}${4}${5}";
  4878. $tlsext = uc("TLS-${3}");
  4879. }
  4880. if(! grep /^\Q$server\E$/, @protocols) {
  4881. if(substr($server,0,5) ne "socks") {
  4882. if($tlsext) {
  4883. return "curl lacks $tlsext support";
  4884. }
  4885. else {
  4886. return "curl lacks $server server support";
  4887. }
  4888. }
  4889. }
  4890. $what[$i] = "$server$lnrest" if($tlsext);
  4891. }
  4892. }
  4893. return &startservers(@what);
  4894. }
  4895. #######################################################################
  4896. # runtimestats displays test-suite run time statistics
  4897. #
  4898. sub runtimestats {
  4899. my $lasttest = $_[0];
  4900. return if(not $timestats);
  4901. logmsg "\nTest suite total running time breakdown per task...\n\n";
  4902. my @timesrvr;
  4903. my @timeprep;
  4904. my @timetool;
  4905. my @timelock;
  4906. my @timevrfy;
  4907. my @timetest;
  4908. my $timesrvrtot = 0.0;
  4909. my $timepreptot = 0.0;
  4910. my $timetooltot = 0.0;
  4911. my $timelocktot = 0.0;
  4912. my $timevrfytot = 0.0;
  4913. my $timetesttot = 0.0;
  4914. my $counter;
  4915. for my $testnum (1 .. $lasttest) {
  4916. if($timesrvrini{$testnum}) {
  4917. $timesrvrtot += $timesrvrend{$testnum} - $timesrvrini{$testnum};
  4918. $timepreptot +=
  4919. (($timetoolini{$testnum} - $timeprepini{$testnum}) -
  4920. ($timesrvrend{$testnum} - $timesrvrini{$testnum}));
  4921. $timetooltot += $timetoolend{$testnum} - $timetoolini{$testnum};
  4922. $timelocktot += $timesrvrlog{$testnum} - $timetoolend{$testnum};
  4923. $timevrfytot += $timevrfyend{$testnum} - $timesrvrlog{$testnum};
  4924. $timetesttot += $timevrfyend{$testnum} - $timeprepini{$testnum};
  4925. push @timesrvr, sprintf("%06.3f %04d",
  4926. $timesrvrend{$testnum} - $timesrvrini{$testnum}, $testnum);
  4927. push @timeprep, sprintf("%06.3f %04d",
  4928. ($timetoolini{$testnum} - $timeprepini{$testnum}) -
  4929. ($timesrvrend{$testnum} - $timesrvrini{$testnum}), $testnum);
  4930. push @timetool, sprintf("%06.3f %04d",
  4931. $timetoolend{$testnum} - $timetoolini{$testnum}, $testnum);
  4932. push @timelock, sprintf("%06.3f %04d",
  4933. $timesrvrlog{$testnum} - $timetoolend{$testnum}, $testnum);
  4934. push @timevrfy, sprintf("%06.3f %04d",
  4935. $timevrfyend{$testnum} - $timesrvrlog{$testnum}, $testnum);
  4936. push @timetest, sprintf("%06.3f %04d",
  4937. $timevrfyend{$testnum} - $timeprepini{$testnum}, $testnum);
  4938. }
  4939. }
  4940. {
  4941. no warnings 'numeric';
  4942. @timesrvr = sort { $b <=> $a } @timesrvr;
  4943. @timeprep = sort { $b <=> $a } @timeprep;
  4944. @timetool = sort { $b <=> $a } @timetool;
  4945. @timelock = sort { $b <=> $a } @timelock;
  4946. @timevrfy = sort { $b <=> $a } @timevrfy;
  4947. @timetest = sort { $b <=> $a } @timetest;
  4948. }
  4949. logmsg "Spent ". sprintf("%08.3f ", $timesrvrtot) .
  4950. "seconds starting and verifying test harness servers.\n";
  4951. logmsg "Spent ". sprintf("%08.3f ", $timepreptot) .
  4952. "seconds reading definitions and doing test preparations.\n";
  4953. logmsg "Spent ". sprintf("%08.3f ", $timetooltot) .
  4954. "seconds actually running test tools.\n";
  4955. logmsg "Spent ". sprintf("%08.3f ", $timelocktot) .
  4956. "seconds awaiting server logs lock removal.\n";
  4957. logmsg "Spent ". sprintf("%08.3f ", $timevrfytot) .
  4958. "seconds verifying test results.\n";
  4959. logmsg "Spent ". sprintf("%08.3f ", $timetesttot) .
  4960. "seconds doing all of the above.\n";
  4961. $counter = 25;
  4962. logmsg "\nTest server starting and verification time per test ".
  4963. sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full");
  4964. logmsg "-time- test\n";
  4965. logmsg "------ ----\n";
  4966. foreach my $txt (@timesrvr) {
  4967. last if((not $fullstats) && (not $counter--));
  4968. logmsg "$txt\n";
  4969. }
  4970. $counter = 10;
  4971. logmsg "\nTest definition reading and preparation time per test ".
  4972. sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full");
  4973. logmsg "-time- test\n";
  4974. logmsg "------ ----\n";
  4975. foreach my $txt (@timeprep) {
  4976. last if((not $fullstats) && (not $counter--));
  4977. logmsg "$txt\n";
  4978. }
  4979. $counter = 25;
  4980. logmsg "\nTest tool execution time per test ".
  4981. sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full");
  4982. logmsg "-time- test\n";
  4983. logmsg "------ ----\n";
  4984. foreach my $txt (@timetool) {
  4985. last if((not $fullstats) && (not $counter--));
  4986. logmsg "$txt\n";
  4987. }
  4988. $counter = 15;
  4989. logmsg "\nTest server logs lock removal time per test ".
  4990. sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full");
  4991. logmsg "-time- test\n";
  4992. logmsg "------ ----\n";
  4993. foreach my $txt (@timelock) {
  4994. last if((not $fullstats) && (not $counter--));
  4995. logmsg "$txt\n";
  4996. }
  4997. $counter = 10;
  4998. logmsg "\nTest results verification time per test ".
  4999. sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full");
  5000. logmsg "-time- test\n";
  5001. logmsg "------ ----\n";
  5002. foreach my $txt (@timevrfy) {
  5003. last if((not $fullstats) && (not $counter--));
  5004. logmsg "$txt\n";
  5005. }
  5006. $counter = 50;
  5007. logmsg "\nTotal time per test ".
  5008. sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full");
  5009. logmsg "-time- test\n";
  5010. logmsg "------ ----\n";
  5011. foreach my $txt (@timetest) {
  5012. last if((not $fullstats) && (not $counter--));
  5013. logmsg "$txt\n";
  5014. }
  5015. logmsg "\n";
  5016. }
  5017. #######################################################################
  5018. # Check options to this test program
  5019. #
  5020. # Special case for CMake: replace '$TFLAGS' by the contents of the
  5021. # environment variable (if any).
  5022. if(@ARGV && $ARGV[-1] eq '$TFLAGS') {
  5023. pop @ARGV;
  5024. push(@ARGV, split(' ', $ENV{'TFLAGS'})) if defined($ENV{'TFLAGS'});
  5025. }
  5026. my $number=0;
  5027. my $fromnum=-1;
  5028. my @testthis;
  5029. while(@ARGV) {
  5030. if ($ARGV[0] eq "-v") {
  5031. # verbose output
  5032. $verbose=1;
  5033. }
  5034. elsif ($ARGV[0] eq "-c") {
  5035. # use this path to curl instead of default
  5036. $DBGCURL=$CURL="\"$ARGV[1]\"";
  5037. shift @ARGV;
  5038. }
  5039. elsif ($ARGV[0] eq "-vc") {
  5040. # use this path to a curl used to verify servers
  5041. # Particularly useful when you introduce a crashing bug somewhere in
  5042. # the development version as then it won't be able to run any tests
  5043. # since it can't verify the servers!
  5044. $VCURL="\"$ARGV[1]\"";
  5045. shift @ARGV;
  5046. }
  5047. elsif ($ARGV[0] eq "-ac") {
  5048. # use this curl only to talk to APIs (currently only CI test APIs)
  5049. $ACURL="\"$ARGV[1]\"";
  5050. shift @ARGV;
  5051. }
  5052. elsif ($ARGV[0] eq "-d") {
  5053. # have the servers display protocol output
  5054. $debugprotocol=1;
  5055. }
  5056. elsif($ARGV[0] eq "-e") {
  5057. # run the tests cases event based if possible
  5058. $run_event_based=1;
  5059. }
  5060. elsif($ARGV[0] eq "-f") {
  5061. # force - run the test case even if listed in DISABLED
  5062. $run_disabeled=1;
  5063. }
  5064. elsif($ARGV[0] eq "-E") {
  5065. # load additional reasons to skip tests
  5066. shift @ARGV;
  5067. my $exclude_file = $ARGV[0];
  5068. open(my $fd, "<", $exclude_file) or die "Couldn't open '$exclude_file': $!";
  5069. while(my $line = <$fd>) {
  5070. next if ($line =~ /^#/);
  5071. chomp $line;
  5072. my ($type, $patterns, $skip_reason) = split(/\s*:\s*/, $line, 3);
  5073. die "Unsupported type: $type\n" if($type !~ /^keyword|test|tool$/);
  5074. foreach my $pattern (split(/,/, $patterns)) {
  5075. if($type =~ /^test$/) {
  5076. # Strip leading zeros in the test number
  5077. $pattern = int($pattern);
  5078. }
  5079. $custom_skip_reasons{$type}{$pattern} = $skip_reason;
  5080. }
  5081. }
  5082. close($fd);
  5083. }
  5084. elsif ($ARGV[0] eq "-g") {
  5085. # run this test with gdb
  5086. $gdbthis=1;
  5087. }
  5088. elsif ($ARGV[0] eq "-gw") {
  5089. # run this test with windowed gdb
  5090. $gdbthis=1;
  5091. $gdbxwin=1;
  5092. }
  5093. elsif($ARGV[0] eq "-s") {
  5094. # short output
  5095. $short=1;
  5096. }
  5097. elsif($ARGV[0] eq "-am") {
  5098. # automake-style output
  5099. $short=1;
  5100. $automakestyle=1;
  5101. }
  5102. elsif($ARGV[0] eq "-n") {
  5103. # no valgrind
  5104. undef $valgrind;
  5105. }
  5106. elsif($ARGV[0] eq "--no-debuginfod") {
  5107. # disable the valgrind debuginfod functionality
  5108. $no_debuginfod = 1;
  5109. }
  5110. elsif ($ARGV[0] eq "-R") {
  5111. # execute in scrambled order
  5112. $scrambleorder=1;
  5113. }
  5114. elsif($ARGV[0] =~ /^-t(.*)/) {
  5115. # torture
  5116. $torture=1;
  5117. my $xtra = $1;
  5118. if($xtra =~ s/(\d+)$//) {
  5119. $tortalloc = $1;
  5120. }
  5121. }
  5122. elsif($ARGV[0] =~ /--shallow=(\d+)/) {
  5123. # Fail no more than this amount per tests when running
  5124. # torture.
  5125. my ($num)=($1);
  5126. $shallow=$num;
  5127. }
  5128. elsif($ARGV[0] =~ /--repeat=(\d+)/) {
  5129. # Repeat-run the given tests this many times
  5130. $repeat = $1;
  5131. }
  5132. elsif($ARGV[0] =~ /--seed=(\d+)/) {
  5133. # Set a fixed random seed (used for -R and --shallow)
  5134. $randseed = $1;
  5135. }
  5136. elsif($ARGV[0] eq "-a") {
  5137. # continue anyway, even if a test fail
  5138. $anyway=1;
  5139. }
  5140. elsif($ARGV[0] eq "-o") {
  5141. shift @ARGV;
  5142. if ($ARGV[0] =~ /^(\w+)=([\w.:\/\[\]-]+)$/) {
  5143. my ($variable, $value) = ($1, $2);
  5144. eval "\$$variable='$value'" or die "Failed to set \$$variable to $value: $@";
  5145. } else {
  5146. die "Failed to parse '-o $ARGV[0]'. May contain unexpected characters.\n";
  5147. }
  5148. }
  5149. elsif($ARGV[0] eq "-p") {
  5150. $postmortem=1;
  5151. }
  5152. elsif($ARGV[0] eq "-P") {
  5153. shift @ARGV;
  5154. $use_external_proxy=1;
  5155. $proxy_address=$ARGV[0];
  5156. }
  5157. elsif($ARGV[0] eq "-L") {
  5158. # require additional library file
  5159. shift @ARGV;
  5160. require $ARGV[0];
  5161. }
  5162. elsif($ARGV[0] eq "-l") {
  5163. # lists the test case names only
  5164. $listonly=1;
  5165. }
  5166. elsif($ARGV[0] eq "-k") {
  5167. # keep stdout and stderr files after tests
  5168. $keepoutfiles=1;
  5169. }
  5170. elsif($ARGV[0] eq "-r") {
  5171. # run time statistics needs Time::HiRes
  5172. if($Time::HiRes::VERSION) {
  5173. keys(%timeprepini) = 1000;
  5174. keys(%timesrvrini) = 1000;
  5175. keys(%timesrvrend) = 1000;
  5176. keys(%timetoolini) = 1000;
  5177. keys(%timetoolend) = 1000;
  5178. keys(%timesrvrlog) = 1000;
  5179. keys(%timevrfyend) = 1000;
  5180. $timestats=1;
  5181. $fullstats=0;
  5182. }
  5183. }
  5184. elsif($ARGV[0] eq "-rf") {
  5185. # run time statistics needs Time::HiRes
  5186. if($Time::HiRes::VERSION) {
  5187. keys(%timeprepini) = 1000;
  5188. keys(%timesrvrini) = 1000;
  5189. keys(%timesrvrend) = 1000;
  5190. keys(%timetoolini) = 1000;
  5191. keys(%timetoolend) = 1000;
  5192. keys(%timesrvrlog) = 1000;
  5193. keys(%timevrfyend) = 1000;
  5194. $timestats=1;
  5195. $fullstats=1;
  5196. }
  5197. }
  5198. elsif($ARGV[0] eq "-rm") {
  5199. # force removal of files by killing locking processes
  5200. $clearlocks=1;
  5201. }
  5202. elsif($ARGV[0] eq "-u") {
  5203. # error instead of warning on server unexpectedly alive
  5204. $err_unexpected=1;
  5205. }
  5206. elsif(($ARGV[0] eq "-h") || ($ARGV[0] eq "--help")) {
  5207. # show help text
  5208. print <<EOHELP
  5209. Usage: runtests.pl [options] [test selection(s)]
  5210. -a continue even if a test fails
  5211. -ac path use this curl only to talk to APIs (currently only CI test APIs)
  5212. -am automake style output PASS/FAIL: [number] [name]
  5213. -c path use this curl executable
  5214. -d display server debug info
  5215. -e event-based execution
  5216. -E file load the specified file to exclude certain tests
  5217. -f forcibly run even if disabled
  5218. -g run the test case with gdb
  5219. -gw run the test case with gdb as a windowed application
  5220. -h this help text
  5221. -k keep stdout and stderr files present after tests
  5222. -L path require an additional perl library file to replace certain functions
  5223. -l list all test case names/descriptions
  5224. -n no valgrind
  5225. --no-debuginfod disable the valgrind debuginfod functionality
  5226. -o variable=value set internal variable to the specified value
  5227. -P proxy use the specified proxy
  5228. -p print log file contents when a test fails
  5229. -R scrambled order (uses the random seed, see --seed)
  5230. -r run time statistics
  5231. -rf full run time statistics
  5232. -rm force removal of files by killing locking processes (Windows only)
  5233. --repeat=[num] run the given tests this many times
  5234. -s short output
  5235. --seed=[num] set the random seed to a fixed number
  5236. --shallow=[num] randomly makes the torture tests "thinner"
  5237. -t[N] torture (simulate function failures); N means fail Nth function
  5238. -u error instead of warning on server unexpectedly alive
  5239. -v verbose output
  5240. -vc path use this curl only to verify the existing servers
  5241. [num] like "5 6 9" or " 5 to 22 " to run those tests only
  5242. [!num] like "!5 !6 !9" to disable those tests
  5243. [~num] like "~5 ~6 ~9" to ignore the result of those tests
  5244. [keyword] like "IPv6" to select only tests containing the key word
  5245. [!keyword] like "!cookies" to disable any tests containing the key word
  5246. [~keyword] like "~cookies" to ignore results of tests containing key word
  5247. EOHELP
  5248. ;
  5249. exit;
  5250. }
  5251. elsif($ARGV[0] =~ /^(\d+)/) {
  5252. $number = $1;
  5253. if($fromnum >= 0) {
  5254. for my $n ($fromnum .. $number) {
  5255. push @testthis, $n;
  5256. }
  5257. $fromnum = -1;
  5258. }
  5259. else {
  5260. push @testthis, $1;
  5261. }
  5262. }
  5263. elsif($ARGV[0] =~ /^to$/i) {
  5264. $fromnum = $number+1;
  5265. }
  5266. elsif($ARGV[0] =~ /^!(\d+)/) {
  5267. $fromnum = -1;
  5268. $disabled{$1}=$1;
  5269. }
  5270. elsif($ARGV[0] =~ /^~(\d+)/) {
  5271. $fromnum = -1;
  5272. $ignored{$1}=$1;
  5273. }
  5274. elsif($ARGV[0] =~ /^!(.+)/) {
  5275. $disabled_keywords{lc($1)}=$1;
  5276. }
  5277. elsif($ARGV[0] =~ /^~(.+)/) {
  5278. $ignored_keywords{lc($1)}=$1;
  5279. }
  5280. elsif($ARGV[0] =~ /^([-[{a-zA-Z].*)/) {
  5281. $enabled_keywords{lc($1)}=$1;
  5282. }
  5283. else {
  5284. print "Unknown option: $ARGV[0]\n";
  5285. exit;
  5286. }
  5287. shift @ARGV;
  5288. }
  5289. delete $ENV{'DEBUGINFOD_URLS'} if($ENV{'DEBUGINFOD_URLS'} && $no_debuginfod);
  5290. if(!$randseed) {
  5291. my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
  5292. localtime(time);
  5293. # seed of the month. December 2019 becomes 201912
  5294. $randseed = ($year+1900)*100 + $mon+1;
  5295. open(C, "$CURL --version 2>/dev/null|") ||
  5296. die "could not get curl version!";
  5297. my @c = <C>;
  5298. close(C);
  5299. # use the first line of output and get the md5 out of it
  5300. my $str = md5($c[0]);
  5301. $randseed += unpack('S', $str); # unsigned 16 bit value
  5302. }
  5303. srand $randseed;
  5304. if(@testthis && ($testthis[0] ne "")) {
  5305. $TESTCASES=join(" ", @testthis);
  5306. }
  5307. if($valgrind) {
  5308. # we have found valgrind on the host, use it
  5309. # verify that we can invoke it fine
  5310. my $code = runclient("valgrind >/dev/null 2>&1");
  5311. if(($code>>8) != 1) {
  5312. #logmsg "Valgrind failure, disable it\n";
  5313. undef $valgrind;
  5314. } else {
  5315. # since valgrind 2.1.x, '--tool' option is mandatory
  5316. # use it, if it is supported by the version installed on the system
  5317. runclient("valgrind --help 2>&1 | grep -- --tool > /dev/null 2>&1");
  5318. if (($? >> 8)==0) {
  5319. $valgrind_tool="--tool=memcheck";
  5320. }
  5321. open(C, "<$CURL");
  5322. my $l = <C>;
  5323. if($l =~ /^\#\!/) {
  5324. # A shell script. This is typically when built with libtool,
  5325. $valgrind="../libtool --mode=execute $valgrind";
  5326. }
  5327. close(C);
  5328. # valgrind 3 renamed the --logfile option to --log-file!!!
  5329. my $ver=join(' ', runclientoutput("valgrind --version"));
  5330. # cut off all but digits and dots
  5331. $ver =~ s/[^0-9.]//g;
  5332. if($ver =~ /^(\d+)/) {
  5333. $ver = $1;
  5334. if($ver >= 3) {
  5335. $valgrind_logfile="--log-file";
  5336. }
  5337. }
  5338. }
  5339. }
  5340. if ($gdbthis) {
  5341. # open the executable curl and read the first 4 bytes of it
  5342. open(CHECK, "<$CURL");
  5343. my $c;
  5344. sysread CHECK, $c, 4;
  5345. close(CHECK);
  5346. if($c eq "#! /") {
  5347. # A shell script. This is typically when built with libtool,
  5348. $libtool = 1;
  5349. $gdb = "../libtool --mode=execute gdb";
  5350. }
  5351. }
  5352. $HTTPUNIXPATH = "http$$.sock"; # HTTP server Unix domain socket path
  5353. $SOCKSUNIXPATH = $pwd."/socks$$.sock"; # HTTP server Unix domain socket path, absolute path
  5354. #######################################################################
  5355. # clear and create logging directory:
  5356. #
  5357. cleardir($LOGDIR);
  5358. mkdir($LOGDIR, 0777);
  5359. #######################################################################
  5360. # initialize some variables
  5361. #
  5362. get_disttests();
  5363. init_serverpidfile_hash();
  5364. #######################################################################
  5365. # Output curl version and host info being tested
  5366. #
  5367. if(!$listonly) {
  5368. checksystem();
  5369. }
  5370. # globally disabled tests
  5371. disabledtests("$TESTDIR/DISABLED");
  5372. #######################################################################
  5373. # Fetch all disabled tests, if there are any
  5374. #
  5375. sub disabledtests {
  5376. my ($file) = @_;
  5377. my @input;
  5378. if(open(D, "<$file")) {
  5379. while(<D>) {
  5380. if(/^ *\#/) {
  5381. # allow comments
  5382. next;
  5383. }
  5384. push @input, $_;
  5385. }
  5386. close(D);
  5387. # preprocess the input to make conditionally disabled tests depending
  5388. # on variables
  5389. my @pp = prepro(0, @input);
  5390. for my $t (@pp) {
  5391. if($t =~ /(\d+)/) {
  5392. my ($n) = $1;
  5393. $disabled{$n}=$n; # disable this test number
  5394. if(! -f "$srcdir/data/test$n") {
  5395. print STDERR "WARNING! Non-existing test $n in $file!\n";
  5396. # fail hard to make user notice
  5397. exit 1;
  5398. }
  5399. logmsg "DISABLED: test $n\n" if ($verbose);
  5400. }
  5401. else {
  5402. print STDERR "$file: rubbish content: $t\n";
  5403. exit 2;
  5404. }
  5405. }
  5406. }
  5407. }
  5408. #######################################################################
  5409. # If 'all' tests are requested, find out all test numbers
  5410. #
  5411. if ( $TESTCASES eq "all") {
  5412. # Get all commands and find out their test numbers
  5413. opendir(DIR, $TESTDIR) || die "can't opendir $TESTDIR: $!";
  5414. my @cmds = grep { /^test([0-9]+)$/ && -f "$TESTDIR/$_" } readdir(DIR);
  5415. closedir(DIR);
  5416. $TESTCASES=""; # start with no test cases
  5417. # cut off everything but the digits
  5418. for(@cmds) {
  5419. $_ =~ s/[a-z\/\.]*//g;
  5420. }
  5421. # sort the numbers from low to high
  5422. foreach my $n (sort { $a <=> $b } @cmds) {
  5423. if($disabled{$n}) {
  5424. # skip disabled test cases
  5425. my $why = "configured as DISABLED";
  5426. $skipped++;
  5427. $skipped{$why}++;
  5428. $teststat[$n]=$why; # store reason for this test case
  5429. next;
  5430. }
  5431. $TESTCASES .= " $n";
  5432. }
  5433. }
  5434. else {
  5435. my $verified="";
  5436. map {
  5437. if (-e "$TESTDIR/test$_") {
  5438. $verified.="$_ ";
  5439. }
  5440. } split(" ", $TESTCASES);
  5441. if($verified eq "") {
  5442. print "No existing test cases were specified\n";
  5443. exit;
  5444. }
  5445. $TESTCASES = $verified;
  5446. }
  5447. if($repeat) {
  5448. my $s;
  5449. for(1 .. $repeat) {
  5450. $s .= $TESTCASES;
  5451. }
  5452. $TESTCASES = $s;
  5453. }
  5454. if($scrambleorder) {
  5455. # scramble the order of the test cases
  5456. my @rand;
  5457. while($TESTCASES) {
  5458. my @all = split(/ +/, $TESTCASES);
  5459. if(!$all[0]) {
  5460. # if the first is blank, shift away it
  5461. shift @all;
  5462. }
  5463. my $r = rand @all;
  5464. push @rand, $all[$r];
  5465. $all[$r]="";
  5466. $TESTCASES = join(" ", @all);
  5467. }
  5468. $TESTCASES = join(" ", @rand);
  5469. }
  5470. # Display the contents of the given file. Line endings are canonicalized
  5471. # and excessively long files are elided
  5472. sub displaylogcontent {
  5473. my ($file)=@_;
  5474. if(open(SINGLE, "<$file")) {
  5475. my $linecount = 0;
  5476. my $truncate;
  5477. my @tail;
  5478. while(my $string = <SINGLE>) {
  5479. $string =~ s/\r\n/\n/g;
  5480. $string =~ s/[\r\f\032]/\n/g;
  5481. $string .= "\n" unless ($string =~ /\n$/);
  5482. $string =~ tr/\n//;
  5483. for my $line (split("\n", $string)) {
  5484. $line =~ s/\s*\!$//;
  5485. if ($truncate) {
  5486. push @tail, " $line\n";
  5487. } else {
  5488. logmsg " $line\n";
  5489. }
  5490. $linecount++;
  5491. $truncate = $linecount > 1000;
  5492. }
  5493. }
  5494. if(@tail) {
  5495. my $tailshow = 200;
  5496. my $tailskip = 0;
  5497. my $tailtotal = scalar @tail;
  5498. if($tailtotal > $tailshow) {
  5499. $tailskip = $tailtotal - $tailshow;
  5500. logmsg "=== File too long: $tailskip lines omitted here\n";
  5501. }
  5502. for($tailskip .. $tailtotal-1) {
  5503. logmsg "$tail[$_]";
  5504. }
  5505. }
  5506. close(SINGLE);
  5507. }
  5508. }
  5509. sub displaylogs {
  5510. my ($testnum)=@_;
  5511. opendir(DIR, "$LOGDIR") ||
  5512. die "can't open dir: $!";
  5513. my @logs = readdir(DIR);
  5514. closedir(DIR);
  5515. logmsg "== Contents of files in the $LOGDIR/ dir after test $testnum\n";
  5516. foreach my $log (sort @logs) {
  5517. if($log =~ /\.(\.|)$/) {
  5518. next; # skip "." and ".."
  5519. }
  5520. if($log =~ /^\.nfs/) {
  5521. next; # skip ".nfs"
  5522. }
  5523. if(($log eq "memdump") || ($log eq "core")) {
  5524. next; # skip "memdump" and "core"
  5525. }
  5526. if((-d "$LOGDIR/$log") || (! -s "$LOGDIR/$log")) {
  5527. next; # skip directory and empty files
  5528. }
  5529. if(($log =~ /^stdout\d+/) && ($log !~ /^stdout$testnum/)) {
  5530. next; # skip stdoutNnn of other tests
  5531. }
  5532. if(($log =~ /^stderr\d+/) && ($log !~ /^stderr$testnum/)) {
  5533. next; # skip stderrNnn of other tests
  5534. }
  5535. if(($log =~ /^upload\d+/) && ($log !~ /^upload$testnum/)) {
  5536. next; # skip uploadNnn of other tests
  5537. }
  5538. if(($log =~ /^curl\d+\.out/) && ($log !~ /^curl$testnum\.out/)) {
  5539. next; # skip curlNnn.out of other tests
  5540. }
  5541. if(($log =~ /^test\d+\.txt/) && ($log !~ /^test$testnum\.txt/)) {
  5542. next; # skip testNnn.txt of other tests
  5543. }
  5544. if(($log =~ /^file\d+\.txt/) && ($log !~ /^file$testnum\.txt/)) {
  5545. next; # skip fileNnn.txt of other tests
  5546. }
  5547. if(($log =~ /^netrc\d+/) && ($log !~ /^netrc$testnum/)) {
  5548. next; # skip netrcNnn of other tests
  5549. }
  5550. if(($log =~ /^trace\d+/) && ($log !~ /^trace$testnum/)) {
  5551. next; # skip traceNnn of other tests
  5552. }
  5553. if(($log =~ /^valgrind\d+/) && ($log !~ /^valgrind$testnum(\..*|)$/)) {
  5554. next; # skip valgrindNnn of other tests
  5555. }
  5556. if(($log =~ /^test$testnum$/)) {
  5557. next; # skip test$testnum since it can be very big
  5558. }
  5559. logmsg "=== Start of file $log\n";
  5560. displaylogcontent("$LOGDIR/$log");
  5561. logmsg "=== End of file $log\n";
  5562. }
  5563. }
  5564. #######################################################################
  5565. # Setup Azure Pipelines Test Run (if running in Azure DevOps)
  5566. #
  5567. if(azure_check_environment()) {
  5568. $AZURE_RUN_ID = azure_create_test_run($ACURL);
  5569. logmsg "Azure Run ID: $AZURE_RUN_ID\n" if ($verbose);
  5570. }
  5571. #######################################################################
  5572. # The main test-loop
  5573. #
  5574. my $failed;
  5575. my $failedign;
  5576. my $testnum;
  5577. my $ok=0;
  5578. my $ign=0;
  5579. my $total=0;
  5580. my $lasttest=0;
  5581. my @at = split(" ", $TESTCASES);
  5582. my $count=0;
  5583. $start = time();
  5584. foreach $testnum (@at) {
  5585. $lasttest = $testnum if($testnum > $lasttest);
  5586. $count++;
  5587. my $error = singletest($run_event_based, $testnum, $count, scalar(@at));
  5588. # update test result in CI services
  5589. if(azure_check_environment() && $AZURE_RUN_ID && $AZURE_RESULT_ID) {
  5590. $AZURE_RESULT_ID = azure_update_test_result($ACURL, $AZURE_RUN_ID, $AZURE_RESULT_ID, $testnum, $error,
  5591. $timeprepini{$testnum}, $timevrfyend{$testnum});
  5592. }
  5593. elsif(appveyor_check_environment()) {
  5594. appveyor_update_test_result($ACURL, $testnum, $error, $timeprepini{$testnum}, $timevrfyend{$testnum});
  5595. }
  5596. if($error < 0) {
  5597. # not a test we can run
  5598. next;
  5599. }
  5600. $total++; # number of tests we've run
  5601. if($error>0) {
  5602. if($error==2) {
  5603. # ignored test failures
  5604. $failedign .= "$testnum ";
  5605. }
  5606. else {
  5607. $failed.= "$testnum ";
  5608. }
  5609. if($postmortem) {
  5610. # display all files in log/ in a nice way
  5611. displaylogs($testnum);
  5612. }
  5613. if($error==2) {
  5614. $ign++; # ignored test result counter
  5615. }
  5616. elsif(!$anyway) {
  5617. # a test failed, abort
  5618. logmsg "\n - abort tests\n";
  5619. last;
  5620. }
  5621. }
  5622. elsif(!$error) {
  5623. $ok++; # successful test counter
  5624. }
  5625. # loop for next test
  5626. }
  5627. my $sofar = time() - $start;
  5628. #######################################################################
  5629. # Finish Azure Pipelines Test Run (if running in Azure DevOps)
  5630. #
  5631. if(azure_check_environment() && $AZURE_RUN_ID) {
  5632. $AZURE_RUN_ID = azure_update_test_run($ACURL, $AZURE_RUN_ID);
  5633. }
  5634. # Tests done, stop the servers
  5635. my $unexpected = stopservers($verbose);
  5636. my $all = $total + $skipped;
  5637. runtimestats($lasttest);
  5638. if($all) {
  5639. logmsg "TESTDONE: $all tests were considered during ".
  5640. sprintf("%.0f", $sofar) ." seconds.\n";
  5641. }
  5642. if($skipped && !$short) {
  5643. my $s=0;
  5644. # Temporary hash to print the restraints sorted by the number
  5645. # of their occurrences
  5646. my %restraints;
  5647. logmsg "TESTINFO: $skipped tests were skipped due to these restraints:\n";
  5648. for(keys %skipped) {
  5649. my $r = $_;
  5650. my $skip_count = $skipped{$r};
  5651. my $log_line = sprintf("TESTINFO: \"%s\" %d time%s (", $r, $skip_count,
  5652. ($skip_count == 1) ? "" : "s");
  5653. # now gather all test case numbers that had this reason for being
  5654. # skipped
  5655. my $c=0;
  5656. my $max = 9;
  5657. for(0 .. scalar @teststat) {
  5658. my $t = $_;
  5659. if($teststat[$t] && ($teststat[$t] eq $r)) {
  5660. if($c < $max) {
  5661. $log_line .= ", " if($c);
  5662. $log_line .= $t;
  5663. }
  5664. $c++;
  5665. }
  5666. }
  5667. if($c > $max) {
  5668. $log_line .= " and ".($c-$max)." more";
  5669. }
  5670. $log_line .= ")\n";
  5671. $restraints{$log_line} = $skip_count;
  5672. }
  5673. foreach my $log_line (sort {$restraints{$b} <=> $restraints{$a}} keys %restraints) {
  5674. logmsg $log_line;
  5675. }
  5676. }
  5677. if($total) {
  5678. if($failedign) {
  5679. logmsg "IGNORED: failed tests: $failedign\n";
  5680. }
  5681. logmsg sprintf("TESTDONE: $ok tests out of $total reported OK: %d%%\n",
  5682. $ok/$total*100);
  5683. if($failed && ($ok != $total)) {
  5684. logmsg "\nTESTFAIL: These test cases failed: $failed\n\n";
  5685. }
  5686. }
  5687. else {
  5688. logmsg "\nTESTFAIL: No tests were performed\n\n";
  5689. if(scalar(keys %enabled_keywords)) {
  5690. logmsg "TESTFAIL: Nothing matched these keywords: ";
  5691. for(keys %enabled_keywords) {
  5692. logmsg "$_ ";
  5693. }
  5694. logmsg "\n";
  5695. }
  5696. }
  5697. if(($total && (($ok+$ign) != $total)) || !$total || $unexpected) {
  5698. exit 1;
  5699. }