netdbtest.pp 155 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232323332343235323632373238323932403241324232433244324532463247324832493250325132523253325432553256325732583259326032613262326332643265326632673268326932703271327232733274327532763277327832793280328132823283328432853286328732883289329032913292329332943295329632973298329933003301330233033304330533063307330833093310331133123313331433153316331733183319332033213322332333243325332633273328332933303331333233333334333533363337333833393340334133423343334433453346334733483349335033513352335333543355335633573358335933603361336233633364336533663367336833693370337133723373337433753376337733783379338033813382338333843385338633873388338933903391339233933394339533963397339833993400340134023403340434053406340734083409341034113412341334143415341634173418341934203421342234233424342534263427342834293430343134323433343434353436343734383439344034413442344334443445344634473448344934503451345234533454345534563457345834593460346134623463346434653466346734683469347034713472347334743475347634773478347934803481348234833484348534863487348834893490349134923493349434953496349734983499350035013502350335043505350635073508350935103511351235133514351535163517351835193520352135223523352435253526352735283529353035313532353335343535353635373538353935403541354235433544354535463547354835493550355135523553355435553556355735583559356035613562356335643565356635673568356935703571357235733574357535763577357835793580358135823583358435853586358735883589359035913592359335943595359635973598359936003601360236033604360536063607360836093610361136123613361436153616361736183619362036213622362336243625362636273628362936303631363236333634363536363637363836393640364136423643364436453646364736483649365036513652365336543655365636573658365936603661366236633664366536663667366836693670367136723673367436753676367736783679368036813682368336843685368636873688368936903691369236933694369536963697369836993700370137023703370437053706370737083709371037113712371337143715371637173718371937203721372237233724372537263727372837293730373137323733373437353736373737383739374037413742374337443745374637473748374937503751375237533754375537563757375837593760376137623763376437653766376737683769377037713772377337743775377637773778377937803781378237833784378537863787378837893790379137923793379437953796379737983799380038013802380338043805380638073808380938103811381238133814381538163817381838193820382138223823382438253826382738283829383038313832383338343835383638373838383938403841384238433844384538463847384838493850385138523853385438553856385738583859386038613862386338643865386638673868386938703871387238733874387538763877387838793880388138823883388438853886388738883889389038913892389338943895389638973898389939003901390239033904390539063907390839093910391139123913391439153916391739183919392039213922392339243925392639273928392939303931393239333934393539363937393839393940394139423943394439453946394739483949395039513952395339543955395639573958395939603961396239633964396539663967396839693970397139723973397439753976397739783979398039813982398339843985398639873988398939903991399239933994399539963997399839994000400140024003400440054006400740084009401040114012401340144015401640174018401940204021402240234024402540264027402840294030403140324033403440354036403740384039404040414042404340444045404640474048404940504051405240534054405540564057405840594060406140624063406440654066406740684069407040714072407340744075407640774078407940804081408240834084408540864087408840894090409140924093409440954096409740984099410041014102410341044105410641074108410941104111411241134114411541164117411841194120412141224123412441254126412741284129413041314132413341344135413641374138413941404141414241434144414541464147414841494150415141524153415441554156415741584159416041614162416341644165416641674168416941704171417241734174417541764177417841794180418141824183418441854186418741884189419041914192419341944195419641974198419942004201420242034204420542064207420842094210421142124213421442154216421742184219422042214222422342244225422642274228422942304231423242334234423542364237423842394240424142424243424442454246424742484249425042514252425342544255425642574258425942604261426242634264426542664267426842694270427142724273427442754276427742784279428042814282428342844285428642874288428942904291429242934294429542964297429842994300430143024303430443054306430743084309431043114312431343144315431643174318431943204321432243234324432543264327432843294330433143324333433443354336433743384339434043414342434343444345434643474348434943504351435243534354435543564357435843594360436143624363436443654366436743684369437043714372437343744375437643774378437943804381438243834384438543864387438843894390439143924393439443954396439743984399440044014402440344044405440644074408440944104411441244134414441544164417441844194420442144224423442444254426442744284429443044314432443344344435443644374438443944404441444244434444444544464447444844494450445144524453445444554456445744584459446044614462446344644465446644674468446944704471447244734474447544764477447844794480448144824483448444854486448744884489449044914492449344944495449644974498449945004501450245034504450545064507450845094510451145124513451445154516451745184519452045214522452345244525452645274528452945304531453245334534453545364537453845394540454145424543454445454546454745484549455045514552455345544555455645574558455945604561456245634564456545664567456845694570457145724573457445754576457745784579458045814582458345844585458645874588458945904591459245934594459545964597459845994600460146024603460446054606460746084609461046114612461346144615
  1. unit netdbtest;
  2. {$mode objfpc}{$H+}
  3. interface
  4. uses
  5. Classes, SysUtils, fpcunit, testregistry, Sockets, math, netdb;
  6. const
  7. FAKETLD = 'doesnotexist';
  8. FAKEDOMAIN = 'fakedomain';
  9. FAKEFQDN=FAKEDOMAIN+'.'+FAKETLD;
  10. type
  11. TDomainCompressionOffset = packed record
  12. nm: String;
  13. offset: Word;
  14. end;
  15. TDomainCompressionTable = Array of TDomainCompressionOffset;
  16. TTwoByteArr = array[0 .. 1] of Byte;
  17. TDNSDomainPointer = packed record
  18. case b: boolean of
  19. true: (ba: TTwoByteArr);
  20. false: (b1,b2: Byte);
  21. end;
  22. TDNSDomainByteStream = packed record
  23. ulabels: Array of byte;
  24. cptr: Word;
  25. end;
  26. TBuffer = Array of Byte;
  27. // can't use dynamic arrays in variant records, so fudge things by
  28. // having between 1 and 5 subsstrings per text RR. it's good enough
  29. // for these tests.
  30. TTextArray = array [1 .. 5] of ShortString;
  31. TFakeQuery = record
  32. nm: ShortString;
  33. qtype, qclass: Word;
  34. end;
  35. TFakeSOA = record
  36. mn,rn: ShortString;
  37. serial,refresh,retry,expire,min: Cardinal;
  38. end;
  39. TFakeMX = record
  40. pref: Word;
  41. exch: ShortString;
  42. end;
  43. TFakeSRV = record
  44. priority, weight, port: Word;
  45. target: ShortString;
  46. end;
  47. TFakeRR = record
  48. RRName : ShortString;
  49. AClass : Word;
  50. TTL : Cardinal;
  51. RDLength : Word;
  52. case Atype: Word of
  53. DNSQRY_A: (ip: THostAddr);
  54. DNSQRY_AAAA: (ip6: THostAddr6);
  55. DNSQRY_CNAME: (cn: ShortString);
  56. DNSQRY_MX: (fmx: TFakeMX);
  57. DNSQRY_NS: (nsh: ShortString);
  58. DNSQRY_PTR: (ptr: ShortString);
  59. DNSQRY_SOA: (fsoa: TFakeSoa);
  60. DNSQRY_TXT: (sstrcount: Byte; txtarr: TTextArray);
  61. DNSQRY_SRV: (fsrv: TFakeSRV);
  62. end;
  63. TRRSection = Array of TFakeRR;
  64. TFakeDNSResponse = record
  65. strtable: TDomainCompressionTable;
  66. compresslabels: Boolean;
  67. hdr: TDNSHeader;
  68. qry: TFakeQuery;
  69. answers, authority, additional: TRRSection;
  70. end;
  71. TRDataWriteRes = packed record
  72. bw, etw: Word;
  73. end;
  74. { TNetDbTest }
  75. TNetDbTest= class(TTestCase)
  76. strict private
  77. tsl: TStringList;
  78. protected
  79. procedure SetUp; override;
  80. procedure TearDown; override;
  81. procedure BuildFakeRR_A(out RR: TFakeRR; nm: String; ttl: Cardinal;
  82. val: String);
  83. procedure BuildFakeRR_AAAA(out RR: TFakeRR; nm: String; ttl: Cardinal;
  84. val: String);
  85. procedure BuildFakeRR_MX(out RR: TFakeRR; nm: String; ttl: Cardinal;
  86. pref: Word; exch: ShortString );
  87. procedure BuildFakeRR_NS(out RR: TFakeRR; nm: String; ttl: Cardinal;
  88. val: String);
  89. procedure BuildFakeRR_PTR(out RR: TFakeRR; nm: String; ttl: Cardinal;
  90. val: String);
  91. procedure BuildFakeRR_CNAME(out RR: TFakeRR; nm: String; ttl: Cardinal;
  92. val: String);
  93. procedure BuildFakeRR_SOA(out RR: TFakeRR; nm: String; ttl: Cardinal;
  94. mn,rn: ShortString; serial,refresh,retry,expire,min: Cardinal);
  95. procedure BuildFakeRR_TXT(out RR: TFakeRR; nm: String; ttl: Cardinal;
  96. n: Byte; txt: TTextArray);
  97. procedure BuildFakeRR_SRV(out RR: TFakeRR; nm: String; ttl: Cardinal;
  98. priority, weight, port: Word; target: ShortString);
  99. procedure CopyBytesTo(var buf: TPayLoad; startidx,destidx,count: Word);
  100. procedure CopyBytesTo(var buf: TPayLoadTCP; startidx,destidx,count: Word);
  101. function WriteNumToBuffer(var buf: TBuffer; var offset: Cardinal;
  102. val: Word): Word;
  103. function WriteNumToBuffer(var buf: TBuffer; var offset: Cardinal;
  104. val: Cardinal): Word;
  105. function WriteNumToBufferN(var buf: TBuffer; var offset: Cardinal;
  106. val: Word): Word;
  107. function WriteNumToBufferN(var buf: TBuffer; var offset: Cardinal;
  108. val: Cardinal): Word;
  109. function WriteMXAsRData(var buf: TBuffer; var offset: Cardinal;
  110. fmx: TFakeMX): TRDataWriteRes;
  111. function WriteSOAasRData(var buf: TBuffer; var offset: Cardinal;
  112. fsoa: TFakeSOA): TRDataWriteRes;
  113. function WriteSOAasRData(var buf: TBuffer; var offset: Cardinal;
  114. fsoa: TFakeSOA; var ctbl: TDomainCompressionTable): TRDataWriteRes;
  115. function WriteAAAAasRData(var buf: TBuffer; var offset: Cardinal;
  116. ip6: THostAddr6): TRDataWriteRes;
  117. function WriteAasRData(var buf: TBuffer; var offset: Cardinal;
  118. ip: THostAddr): TRDataWriteRes;
  119. function WriteSRVasRData(var buf: TBuffer; var offset: Cardinal;
  120. fsrv: TFakeSRV): TRDataWriteRes;
  121. function WriteSRVasRData(var buf: TBuffer; var offset: Cardinal;
  122. fsrv: TFakeSRV; var ctbl: TDomainCompressionTable): TRDataWriteRes;
  123. function WriteMXAsRData(var buf: TBuffer; var offset: Cardinal;
  124. fmx: TFakeMX; var ctbl: TDomainCompressionTable): TRDataWriteRes;
  125. function CalcRdLength(o: TDNSDomainByteStream): Word;
  126. function CalcRdLength(o: TTextArray): Word;
  127. function WriteTextRecAsRData(var buf: TBuffer; var offset: Cardinal;
  128. tt: TTextArray): TRDataWriteRes;
  129. function DomainNameToByteStream(nm: ShortString;
  130. var ctbl: TDomainCompressionTable): TDNSDomainByteStream;
  131. function DomainNameToByteStream(nm: ShortString): TDNSDomainByteStream;
  132. function WriteDNSDomainByteStreamToBuffer(var buf: TBuffer;
  133. var offset: Cardinal; dbs: TDNSDomainByteStream): Word;
  134. function WriteDomainAsRdata(var buf: TBuffer; var offset: Cardinal;
  135. dbs: TDNSDomainByteStream): TRDataWriteRes;
  136. function WriteRRToBuffer(var buf: TBuffer; var offset: Cardinal;
  137. rr: TFakeRR): Word;
  138. function WriteRRToBuffer(var buf: TBuffer; var offset: Cardinal;
  139. rr: TFakeRR; var ctbl: TDomainCompressionTable): Word;
  140. function FakeDNSResponseToByteBuffer(fdr: TFakeDNSResponse;
  141. out buf: TBuffer; compress: Boolean = False): Cardinal;
  142. function BufferToPayload(const buf: TBuffer; out pl: TPayload): Boolean;
  143. function BufferToPayload(const buf: TBuffer; out pl: TPayLoadTCP): Boolean;
  144. function BuildQueryData(fdr: TFakeDNSResponse; out qd: TQueryData;
  145. out qlen: Word; Compress: Boolean = False): Boolean;
  146. function BuildQueryData(fdr: TFakeDNSResponse;
  147. out qd: TQueryDataLengthTCP; out qlen: Word;
  148. Compress: Boolean = False): Boolean;
  149. function BuildTruncatedQueryData(fdr: TFakeDNSResponse; out qd: TQueryData;
  150. out qlen: Word; truncoffset: Word): Boolean;
  151. procedure BuildFakeResponseA(nm: ShortString; out fr: TFakeDNSResponse);
  152. procedure BuildFakeResponseAAAA(nm: ShortString; out fr: TFakeDNSResponse);
  153. procedure BuildFakeResponseMX(nm: ShortString; out fr: TFakeDNSResponse);
  154. procedure BuildFakeResponseSOA(nm: ShortString; out fr: TFakeDNSResponse);
  155. procedure BuildFakeResponseCNAME(nm: ShortString; out fr: TFakeDNSResponse);
  156. procedure BuildFakeResponseNS(nm: ShortString; out fr: TFakeDNSResponse);
  157. procedure BuildFakeResponsePTR(nm: ShortString; out fr: TFakeDNSResponse);
  158. procedure BuildFakeResponseTXT(nm: ShortString; out fr: TFakeDNSResponse);
  159. procedure BuildFakeResponseSRV(nm: ShortString; out fr: TFakeDNSResponse);
  160. published
  161. procedure TestBuildPayloadSimple;
  162. procedure TestBuildPayloadSimpleEmpty;
  163. procedure TestBuildPayloadSimpleEndDot;
  164. procedure TestBuildPayloadSimpleStartDot;
  165. procedure TestBuildPayloadSimpleMultipleDot;
  166. { * straightforward tests for the api with valid data. Have to test each
  167. * known RR type with both TCP and UDP buffer functions, and with and
  168. * without compression of domain names.
  169. * No network calls will be made. These tests hit all functions for
  170. * processing dns requests except network functions.}
  171. procedure TestDnsQueryUDP_A;
  172. procedure TestDnsQueryTCP_A;
  173. procedure TestDnsQueryCompressUDP_A;
  174. procedure TestDnsQueryCompressTCP_A;
  175. procedure TestDnsQueryUDP_AAAA;
  176. procedure TestDnsQueryTCP_AAAA;
  177. procedure TestDnsQueryCompressUDP_AAAA;
  178. procedure TestDnsQueryCompressTCP_AAAA;
  179. procedure TestDnsQueryUDP_MX;
  180. procedure TestDnsQueryTCP_MX;
  181. procedure TestDnsQueryCompressUDP_MX;
  182. procedure TestDnsQueryCompressTCP_MX;
  183. procedure TestDnsQueryUDP_SOA;
  184. procedure TestDnsQueryTCP_SOA;
  185. procedure TestDnsQueryCompressUDP_SOA;
  186. procedure TestDnsQueryCompressTCP_SOA;
  187. procedure TestDnsQueryUDP_CNAME;
  188. procedure TestDnsQueryTCP_CNAME;
  189. procedure TestDnsQueryCompressUDP_CNAME;
  190. procedure TestDnsQueryCompressTCP_CNAME;
  191. procedure TestDnsQueryUDP_NS;
  192. procedure TestDnsQueryTCP_NS;
  193. procedure TestDnsQueryCompressUDP_NS;
  194. procedure TestDnsQueryCompressTCP_NS;
  195. procedure TestDnsQueryUDP_PTR;
  196. procedure TestDnsQueryTCP_PTR;
  197. procedure TestDnsQueryCompressUDP_PTR;
  198. procedure TestDnsQueryCompressTCP_PTR;
  199. procedure TestDnsQueryUDP_TXT;
  200. procedure TestDnsQueryTCP_TXT;
  201. procedure TestDnsQueryCompressUDP_TXT;
  202. procedure TestDnsQueryCompressTCP_TXT;
  203. procedure TestDnsQueryUDP_SRV;
  204. procedure TestDnsQueryTCP_SRV;
  205. procedure TestDnsQueryCompressUDP_SRV;
  206. procedure TestDnsQueryCompressTCP_SRV;
  207. {
  208. * Tests with invalid input data. These attempt to simulate a hostile
  209. * dns server returning deliberately invalid data in an attempt to
  210. * cause a buffer overflow, memory corruption, or DDOS.
  211. }
  212. // buffer truncated so RRs have invalid types.
  213. procedure TestDnsQueryTruncateRR_UDP_A;
  214. {
  215. * Tests of DNSRRGet* functions where RR is near the end of the buffer,
  216. * testing both when the RR just fits, and when it doesn't.
  217. }
  218. procedure TestDnsRRBufferEdgeA;
  219. procedure TestDnsRRBufferPastEdgeA;
  220. procedure TestDnsRRBufferEdgeAAAA;
  221. procedure TestDNsRRBufferPastEdgeAAAA;
  222. procedure TestDnsRRBufferEdgeMX;
  223. procedure TestDnsRRBufferPastEdgeMX;
  224. procedure TestDnsRRBufferEdgeSOA;
  225. procedure TestDnsRRBufferPastEdgeSOA;
  226. procedure TestDnsRRBufferEdgeSRV;
  227. procedure TestDnsRRBufferPastEdgeSRV;
  228. procedure TestDnsRRBufferEdgeCNAME;
  229. procedure TestDnsRRBufferPastEdgeCNAME;
  230. procedure TestDnsRRBufferEdgeNS;
  231. procedure TestDnsRRBufferPastEdgeNS;
  232. procedure TestDnsRRBufferEdgePTR;
  233. procedure TestDnsRRBufferPastEdgePTR;
  234. procedure TestDnsRRBufferEdgeTXT;
  235. procedure TestDnsRRBufferPastEdgeTXT;
  236. {
  237. * the TCP variants. identical code, but qd variable is a different type
  238. * and so different paths get followed in netdb.
  239. }
  240. procedure TestDnsRRBufferEdgeTCPA;
  241. procedure TestDnsRRBufferPastEdgeTCPA;
  242. procedure TestDnsRRBufferEdgeTCPAAAA;
  243. procedure TestDNsRRBufferPastEdgeTCPAAAA;
  244. procedure TestDnsRRBufferEdgeTCPMX;
  245. procedure TestDnsRRBufferPastEdgeTCPMX;
  246. procedure TestDnsRRBufferEdgeTCPSOA;
  247. procedure TestDnsRRBufferPastEdgeTCPSOA;
  248. procedure TestDnsRRBufferEdgeTCPSRV;
  249. procedure TestDnsRRBufferPastEdgeTCPSRV;
  250. procedure TestDnsRRBufferEdgeTCPCNAME;
  251. procedure TestDnsRRBufferPastEdgeTCPCNAME;
  252. procedure TestDnsRRBufferEdgeTCPNS;
  253. procedure TestDnsRRBufferPastEdgeTCPNS;
  254. procedure TestDnsRRBufferEdgeTCPPTR;
  255. procedure TestDnsRRBufferPastEdgeTCPPTR;
  256. procedure TestDnsRRBufferEdgeTCPTXT;
  257. procedure TestDnsRRBufferPastEdgeTCPTXT;
  258. // Testing of NextNameRR at buffer edge and beyond. this differs from
  259. // the above tests in that they tests DNSGet* at the edge, but NextNameRR
  260. // is never called to read at the edge in those functions.
  261. // Because NextNameRR does nothing that is specific to RR types it's
  262. // not necessary to test with each type of RR.
  263. procedure TestNextNameRREdgeA;
  264. procedure TestNextNameRRPastEdgeA;
  265. procedure TestNextNameRREdgeTCPA;
  266. procedure TestNextNameRRPastEdgeTCPA;
  267. {
  268. * Test GetRRrecords at and beyond buffer boundaries.
  269. }
  270. procedure TestGetRRrecordsInvalidStart;
  271. procedure TestGetRRrecordsInvalidStartTCP;
  272. {
  273. Tests for GetFixlenStr
  274. }
  275. procedure TestGetFixLenStrSimple;
  276. procedure TestGetFixLenStrSimpleTCP;
  277. procedure TestGetFixLenStrSimpleAtEdge;
  278. procedure TestGetFixLenStrSimpleTCPAtEdge;
  279. procedure TestGetFixLenStrSimplePastEdge;
  280. procedure TestGetFixLenStrSimpleTCPPastEdge;
  281. {
  282. * Test stringfromlabel with buffer edges and beyond. Its behaviour
  283. * at present is to drop any label that would exceed the buffer boundary
  284. * but still return any other labels successfully received.
  285. * Some of the previous tests already verify what happens with a label
  286. * that occurs on the edge. See the tests for TestDnsRRBufferEdgeSRV
  287. * and TestDnsRRBufferEdgeTCPSRV, TestDnsRRBufferEdgeCNAME, etc.
  288. }
  289. // read a label starting at the end of the buffer where the count is
  290. // greater than 0.
  291. procedure TestStringFromLabelCountAsLastByte;
  292. procedure TestStringFromLabelCountAsLastByteTCP;
  293. // compressed label
  294. procedure TestStringFromLabelCompress;
  295. procedure TestStringFromLabelCompressTCP;
  296. // another compressed label test, this time with one uncompressed label
  297. procedure TestStringFromLabelCompressWithUncompressedLabel;
  298. // as above, but on the tcp payload buffer
  299. procedure TestStringFromLabelCompressWithUncompressedLabelTCP;
  300. // compressed label at the edge of the buffer
  301. procedure TestStringFromLabelCompressEndBuffer;
  302. // compressed label at the edge of the tcp buffer
  303. procedure TestStringFromLabelCompressEndBufferTCP;
  304. // test stringfromlabel when last byte is 192. 192 is the signal
  305. // that the next byte is a pointer offset, but of course there's
  306. // no next byte.
  307. procedure TestStringFromLabelCompressSplit;
  308. // repeat using TCP buffer variant
  309. procedure TestStringFromLabelCompressSplitTCP;
  310. // test that stringfromlabel rejects pointers that go forward. per
  311. // rfc 1035, pointers must go backward.
  312. procedure TestStringFromLabelCompressPtrFwd;
  313. procedure TestStringFromLabelCompressPtrFwdTCP;
  314. // fill buffer with 192, pointer marker, then try stringfromlabel on it.
  315. procedure TestStringFromLabelCompressAllPtrStart;
  316. procedure TestStringFromLabelCompressAllPtrStartTCP;
  317. // test string from label where second byte is 0.
  318. procedure TestStringFromLabelCompressedZero;
  319. procedure TestStringFromLabelCompressedZeroTCP;
  320. // test whether an infinite loop can be triggered.
  321. procedure TestStringFromLabelInfiniteLoop;
  322. procedure TestStringFromLabelInfiniteLoopTCP;
  323. // test short domain less than 12 chars. this tests that dns pointer
  324. // calculations in stringfromlabel are correct
  325. procedure TestCompressShortDomain;
  326. procedure TestCompressShortDomainTCP;
  327. end;
  328. implementation
  329. procedure dump_payload(const pl: TBuffer);
  330. var
  331. idx,llen: Cardinal;
  332. begin
  333. idx := 0;
  334. llen := 0;
  335. for idx := 0 to Length(pl) - 1 do
  336. begin
  337. write('['+inttostr(idx)+'] '+IntToHex(pl[idx],2));
  338. if (pl[idx] > 48) and (pl[idx] < 123) then
  339. write(' ' + chr(pl[idx]))
  340. else
  341. write(' .');
  342. write(' ');
  343. Inc(llen);
  344. if llen >= 6 then
  345. begin
  346. llen := 0;
  347. writeln();
  348. end;
  349. end;
  350. if llen > 0 then
  351. begin
  352. writeln();
  353. end;
  354. end;
  355. procedure dump_payload(const pl: TPayload; count: Word);
  356. var
  357. idx,llen: Cardinal;
  358. begin
  359. idx := 0;
  360. llen := 0;
  361. for idx := 0 to count - 1 do
  362. begin
  363. write('['+inttostr(idx)+'] '+IntToHex(pl[idx],2));
  364. if (pl[idx] > 48) and (pl[idx] < 123) then
  365. write(' ' + chr(pl[idx]))
  366. else
  367. write(' .');
  368. write(' ');
  369. Inc(llen);
  370. if llen >= 6 then
  371. begin
  372. llen := 0;
  373. writeln();
  374. end;
  375. end;
  376. if llen > 0 then
  377. begin
  378. writeln();
  379. end;
  380. end;
  381. function LookupStr(ls: String; stt: TDomainCompressionTable; out idx: Word): Boolean;
  382. var
  383. so: TDomainCompressionOffset;
  384. begin
  385. Result := False;
  386. for so in stt do
  387. begin
  388. if ls = so.nm then
  389. begin
  390. Result := True;
  391. idx := so.offset;
  392. exit;
  393. end;
  394. end;
  395. end;
  396. function AddStr(ls: String; var stt: TDomainCompressionTable; idx: Word): Boolean;
  397. var
  398. so: TDomainCompressionOffset;
  399. begin
  400. so.nm := ls;
  401. so.offset := idx;
  402. SetLength(stt, Length(stt)+1);
  403. stt[Length(stt)-1] := so;
  404. Result := True;
  405. end;
  406. function GetDnsDomainPointer(offset: Word): TDNSDomainPointer;
  407. begin
  408. Result.b1 := 0;
  409. Result.b2 := 0;
  410. // dns comp. ptr can't be > 2 ** 14 or 16383
  411. if offset > 16383 then exit;
  412. Result.b1 := (offset SHR 8) OR 192;
  413. Result.b2 := (offset AND $00FF);
  414. end;
  415. procedure DomainNameToLabels(const dmn: String; var labels: TStringList);
  416. begin
  417. labels.Clear;
  418. labels.Delimiter := '.';
  419. labels.StrictDelimiter := True;
  420. labels.DelimitedText := dmn;
  421. end;
  422. procedure TNetDbTest.BuildFakeRR_A(out RR: TFakeRR; nm: String; ttl: Cardinal;
  423. val: String);
  424. begin
  425. RR.RRName := nm;
  426. RR.Atype := DNSQRY_A;
  427. RR.AClass := 1;
  428. RR.TTL := ttl;
  429. RR.ip := StrToNetAddr(val);
  430. RR.RDLength := 4;
  431. end;
  432. procedure TNetDbTest.BuildFakeRR_AAAA(out RR: TFakeRR; nm: String;
  433. ttl: Cardinal; val: String);
  434. begin
  435. RR.RRName := nm;
  436. RR.Atype := DNSQRY_AAAA;
  437. RR.AClass := 1;
  438. RR.TTL := ttl;
  439. RR.ip6 := StrToNetAddr6(val);
  440. RR.RDLength := 16;
  441. end;
  442. procedure TNetDbTest.BuildFakeRR_MX(out RR: TFakeRR; nm: String; ttl: Cardinal;
  443. pref: Word; exch: ShortString );
  444. begin
  445. RR.RRName := nm;
  446. RR.Atype := DNSQRY_MX;
  447. RR.AClass := 1;
  448. RR.TTL := ttl;
  449. RR.fmx.pref := pref;
  450. RR.fmx.exch := exch;
  451. end;
  452. procedure TNetDbTest.BuildFakeRR_NS(out RR: TFakeRR; nm: String; ttl: Cardinal;
  453. val: String);
  454. begin
  455. RR.RRName := nm;
  456. RR.Atype := DNSQRY_NS;
  457. RR.AClass := 1;
  458. RR.TTL := ttl;
  459. RR.nsh := val;
  460. end;
  461. procedure TNetDbTest.BuildFakeRR_PTR(out RR: TFakeRR; nm: String; ttl: Cardinal;
  462. val: String);
  463. begin
  464. RR.RRName := nm;
  465. RR.Atype := DNSQRY_PTR;
  466. RR.AClass := 1;
  467. RR.TTL := ttl;
  468. RR.ptr := val;
  469. end;
  470. procedure TNetDbTest.BuildFakeRR_CNAME(out RR: TFakeRR; nm: String;
  471. ttl: Cardinal; val: String);
  472. begin
  473. RR.RRName := nm;
  474. RR.Atype := DNSQRY_CNAME;
  475. RR.AClass := 1;
  476. RR.TTL := ttl;
  477. RR.cn := val;
  478. end;
  479. procedure TNetDbTest.BuildFakeRR_SOA(out RR: TFakeRR; nm: String; ttl: Cardinal;
  480. mn,rn: ShortString; serial,refresh,retry,expire,min: Cardinal);
  481. begin
  482. RR.RRName := nm;
  483. RR.Atype := DNSQRY_SOA;
  484. RR.AClass := 1;
  485. RR.TTL := ttl;
  486. RR.fsoa.mn := mn;
  487. RR.fsoa.rn := rn;
  488. RR.fsoa.serial := serial;
  489. RR.fsoa.refresh := refresh;
  490. RR.fsoa.retry := retry;
  491. RR.fsoa.expire := expire;
  492. RR.fsoa.min := min;
  493. end;
  494. procedure TNetDbTest.BuildFakeRR_TXT(out RR: TFakeRR; nm: String; ttl: Cardinal;
  495. n: Byte; txt: TTextArray);
  496. var
  497. idx: Byte;
  498. begin
  499. RR.RRName := nm;
  500. RR.Atype := DNSQRY_TXT;
  501. RR.AClass := 1;
  502. RR.TTL := ttl;
  503. RR.sstrcount := n;
  504. RR.txtarr[1] := '';
  505. RR.txtarr[2] := '';
  506. RR.txtarr[3] := '';
  507. RR.txtarr[4] := '';
  508. RR.txtarr[5] := '';
  509. for idx := Low(txt) to Min(n, High(txt)) do
  510. RR.txtarr[idx] := txt[idx];
  511. end;
  512. procedure TNetDbTest.BuildFakeRR_SRV(out RR: TFakeRR; nm: String; ttl: Cardinal;
  513. priority, weight, port: Word; target: ShortString);
  514. begin
  515. RR.RRName := nm;
  516. RR.Atype := DNSQRY_SRV;
  517. RR.AClass := 1;
  518. RR.TTL := ttl;
  519. RR.fsrv.priority := priority;
  520. RR.fsrv.weight := weight;
  521. RR.fsrv.port := port;
  522. RR.fsrv.target := target;
  523. end;
  524. function TNetDbTest.CalcRdLength(o: TTextArray): Word;
  525. var
  526. tmps: ShortString;
  527. begin
  528. Result := 0;
  529. for tmps in o do
  530. begin
  531. if tmps = '' then break;
  532. Result := Result + Length(tmps)+1; // don't forget length byte!
  533. end;
  534. end;
  535. function TNetDbTest.WriteAasRData(var buf: TBuffer; var offset: Cardinal;
  536. ip: THostAddr): TRDataWriteRes;
  537. var
  538. s,l: Word;
  539. begin
  540. s := offset;
  541. l := SizeOf(ip.s_addr);
  542. Result.etw := l + 2; //rdlength +2 for length itself
  543. // rdlength
  544. WriteNumToBuffer(buf, offset, l);
  545. // rr data
  546. WriteNumToBufferN(buf, offset, ip.s_addr);
  547. Result.bw := offset - s;
  548. end;
  549. function TNetDbTest.WriteSRVasRData(var buf: TBuffer; var offset: Cardinal;
  550. fsrv: TFakeSRV): TRDataWriteRes;
  551. var
  552. s, l: Word;
  553. dmbs: TDNSDomainByteStream;
  554. begin
  555. s := offset;
  556. dmbs := DomainNameToByteStream(fsrv.target);
  557. l := CalcRdLength(dmbs) + SizeOf(Word) * 3;
  558. Result.etw := l + 2; //rdlength +2 for length byte
  559. // rdlength
  560. WriteNumToBuffer(buf, offset, l);
  561. // RR data
  562. WriteNumToBuffer(buf, offset, fsrv.priority);
  563. WriteNumToBuffer(buf, offset, fsrv.weight);
  564. WriteNumToBuffer(buf, offset, fsrv.port);
  565. WriteDNSDomainByteStreamToBuffer(buf, offset, dmbs);
  566. Result.bw := offset - s;
  567. end;
  568. function TNetDbTest.WriteSRVasRData(var buf: TBuffer; var offset: Cardinal;
  569. fsrv: TFakeSRV; var ctbl: TDomainCompressionTable): TRDataWriteRes;
  570. var
  571. s, l: Word;
  572. dmbs: TDNSDomainByteStream;
  573. begin
  574. s := offset;
  575. dmbs := DomainNameToByteStream(fsrv.target, ctbl);
  576. l := CalcRdLength(dmbs) + SizeOf(Word) * 3;
  577. Result.etw := l + 2; //rdlength +2 for length byte
  578. // rdlength
  579. WriteNumToBuffer(buf, offset, l);
  580. // RR data
  581. WriteNumToBuffer(buf, offset, fsrv.priority);
  582. WriteNumToBuffer(buf, offset, fsrv.weight);
  583. WriteNumToBuffer(buf, offset, fsrv.port);
  584. WriteDNSDomainByteStreamToBuffer(buf, offset, dmbs);
  585. Result.bw := offset - s;
  586. end;
  587. function TNetDbTest.WriteMXAsRData(var buf: TBuffer; var offset: Cardinal;
  588. fmx: TFakeMX; var ctbl: TDomainCompressionTable): TRDataWriteRes;
  589. var
  590. s, l: Word;
  591. dmbs: TDNSDomainByteStream;
  592. begin
  593. s := offset;
  594. dmbs := DomainNameToByteStream(fmx.exch, ctbl);
  595. l := SizeOf(fmx.pref) + CalcRdLength(dmbs);
  596. Result.etw := l + 2; // we'll write rdlength bytes+2 bytes for length itself.
  597. // rdlength
  598. WriteNumToBuffer(buf, offset, l);
  599. // RR data
  600. // pref
  601. WriteNumToBuffer(buf, offset, fmx.pref);
  602. // exchange
  603. WriteDNSDomainByteStreamToBuffer(buf, offset, dmbs);
  604. Result.bw := offset - s;
  605. end;
  606. function TNetDbTest.CalcRdLength(o: TDNSDomainByteStream): Word;
  607. begin
  608. Result := Length(o.ulabels);
  609. if o.cptr > 0 then Inc(Result,2);
  610. end;
  611. function TNetDbTest.WriteAAAAasRData(var buf: TBuffer; var offset: Cardinal;
  612. ip6: THostAddr6): TRDataWriteRes;
  613. var
  614. s,l: Word;
  615. begin
  616. s := offset;
  617. l := SizeOf(ip6.u6_addr32);
  618. Result.etw := l + 2; //rdlength + 2 for length itself
  619. // rdlength
  620. WriteNumToBuffer(buf, offset, l);
  621. // rr data
  622. Move(ip6.s6_addr, buf[offset], l);
  623. Inc(offset, l);
  624. Result.bw := offset - s;
  625. end;
  626. function TNetDbTest.WriteSOAasRData(var buf: TBuffer; var offset: Cardinal;
  627. fsoa: TFakeSOA): TRDataWriteRes;
  628. var
  629. s, l: Word;
  630. dmbsmn, dmbsrn: TDNSDomainByteStream;
  631. begin
  632. s := offset;
  633. dmbsmn := DomainNameToByteStream(fsoa.mn);
  634. dmbsrn := DomainNameToByteStream(fsoa.rn);
  635. l := CalcRdLength(dmbsmn) + CalcRdLength(dmbsrn) + (SizeOf(Cardinal) * 5);
  636. Result.etw := l + 2; // rdlength bytes + 2 for length itself
  637. // rdlength
  638. WriteNumToBuffer(buf, offset, l);
  639. // rr data
  640. WriteDNSDomainByteStreamToBuffer(buf, offset, dmbsmn);
  641. WriteDNSDomainByteStreamToBuffer(buf, offset, dmbsrn);
  642. WriteNumToBuffer(buf, offset, fsoa.serial);
  643. WriteNumToBuffer(buf, offset, fsoa.refresh);
  644. WriteNumToBuffer(buf, offset, fsoa.retry);
  645. WriteNumToBuffer(buf, offset, fsoa.expire);
  646. WriteNumToBuffer(buf, offset, fsoa.min);
  647. Result.bw := offset - s;
  648. end;
  649. function TNetDbTest.WriteSOAasRData(var buf: TBuffer; var offset: Cardinal;
  650. fsoa: TFakeSOA; var ctbl: TDomainCompressionTable): TRDataWriteRes;
  651. var
  652. s, l: Word;
  653. dmbsmn, dmbsrn: TDNSDomainByteStream;
  654. begin
  655. s := offset;
  656. dmbsmn := DomainNameToByteStream(fsoa.mn, ctbl);
  657. dmbsrn := DomainNameToByteStream(fsoa.rn, ctbl);
  658. l := CalcRdLength(dmbsmn) + CalcRdLength(dmbsrn) + (SizeOf(Cardinal) * 5);
  659. Result.etw := l + 2; // rdlength bytes + 2 for length itself
  660. // rdlength
  661. WriteNumToBuffer(buf, offset, l);
  662. // rr data
  663. WriteDNSDomainByteStreamToBuffer(buf, offset, dmbsmn);
  664. WriteDNSDomainByteStreamToBuffer(buf, offset, dmbsrn);
  665. WriteNumToBuffer(buf, offset, fsoa.serial);
  666. WriteNumToBuffer(buf, offset, fsoa.refresh);
  667. WriteNumToBuffer(buf, offset, fsoa.retry);
  668. WriteNumToBuffer(buf, offset, fsoa.expire);
  669. WriteNumToBuffer(buf, offset, fsoa.min);
  670. Result.bw := offset - s;
  671. end;
  672. function TNetDbTest.WriteMXAsRData(var buf: TBuffer; var offset: Cardinal;
  673. fmx: TFakeMX): TRDataWriteRes;
  674. var
  675. s, l: Word;
  676. dmbs: TDNSDomainByteStream;
  677. begin
  678. Result.bw := 0;
  679. s := offset;
  680. dmbs := DomainNameToByteStream(fmx.exch);
  681. l := SizeOf(fmx.pref) + CalcRdLength(dmbs);
  682. Result.etw := l + 2; // we'll write rdlength + 2 bytes for the length itself.
  683. // rdlength
  684. WriteNumToBuffer(buf, offset, l);
  685. // RR data
  686. // pref
  687. WriteNumToBuffer(buf, offset, fmx.pref);
  688. // exchange
  689. dmbs := DomainNameToByteStream(fmx.exch);
  690. WriteDNSDomainByteStreamToBuffer(buf, offset, dmbs);
  691. Result.bw := offset - s;
  692. end;
  693. function TNetDbTest.WriteTextRecAsRData(var buf: TBuffer; var offset: Cardinal;
  694. tt: TTextArray): TRDataWriteRes;
  695. var
  696. s, l: Word;
  697. ws: ShortString;
  698. begin
  699. s := offset;
  700. l := CalcRdLength(tt);
  701. Result.etw := l + 2; // rdlength +2 for length itself
  702. // rdlength
  703. WriteNumToBuffer(buf, offset, l);
  704. for ws in tt do
  705. begin
  706. if ws = '' then break;
  707. Move(ws, buf[offset], Length(ws)+1);
  708. Inc(offset,Length(ws)+1);
  709. end;
  710. Result.bw := offset - s;
  711. end;
  712. {
  713. Convert a domain name into a byte stream. Compression is supported using the
  714. supplied compression table.
  715. }
  716. function TNetDbTest.DomainNameToByteStream(nm: ShortString;
  717. var ctbl: TDomainCompressionTable): TDNSDomainByteStream;
  718. var
  719. dmn: ShortString;
  720. offset,cmpoffset: Word;
  721. ptrseen: Boolean = False;
  722. begin
  723. SetLength(Result.ulabels, 0);
  724. Result.cptr := 0;
  725. offset := 0;
  726. if nm = '' then exit;
  727. DomainNameToLabels(nm, tsl);
  728. if tsl.Count = 0 then exit;
  729. dmn := '';
  730. cmpoffset := 0;
  731. {
  732. for a domain a.b.c, using the lookup table,
  733. -> lookup (a.b.c), if not found, add to table,
  734. -> lookup (b.c), if not found, add to table,
  735. -> lookup (c), if not found, add to table,
  736. buf if any label domain is found, add the pointer to the buffer and stop.
  737. }
  738. repeat
  739. dmn := tsl.DelimitedText;
  740. ptrseen := LookupStr(dmn, ctbl, cmpoffset);
  741. if ptrseen then
  742. begin
  743. // found the domain name. add a pointer, then we're done. Per RFC1035,
  744. // section 4.1.4, a domain name is either a series of labels, a pointer,
  745. // or a series of labels ending with a pointer. There's just one pointer
  746. // for a domain name.
  747. Result.cptr := cmpoffset;
  748. break;
  749. end
  750. else
  751. begin
  752. // add the last full domain we looked up, not the working label,
  753. // to the compression lookup table. E.g, add a.b.c rather than a.
  754. // Add 12 for the dns header, which our buffer doesn't include, but
  755. // api methods like stringfromlabel adjust offsets to account for it.
  756. if Length(dmn) > 0 then AddStr(dmn, ctbl, offset+12);
  757. // write the label to the buffer
  758. dmn := tsl[0];
  759. tsl.Delete(0);
  760. SetLength(Result.ulabels, (Length(Result.ulabels) + Length(dmn)+1));
  761. Result.ulabels[offset] := Length(dmn);
  762. Inc(offset);
  763. Move(dmn[1], Result.ulabels[offset], Length(dmn));
  764. Inc(offset, Length(dmn));
  765. end;
  766. until tsl.Count = 0;
  767. // if we didn't see a pointer then we have to write a 0. see rfc1035, s4.1.4.
  768. if not ptrseen then
  769. begin
  770. SetLength(Result.ulabels, Length(Result.ulabels) + 1);
  771. Result.ulabels[offset] := 0;
  772. Inc(offset);
  773. end;
  774. end;
  775. {
  776. This version of DomainNameToByteStream doesn't compress.
  777. }
  778. function TNetDbTest.DomainNameToByteStream(nm: ShortString
  779. ): TDNSDomainByteStream;
  780. var
  781. dmn: ShortString;
  782. offset: Word;
  783. begin
  784. SetLength(Result.ulabels, 0);
  785. Result.cptr := 0;
  786. offset := 0;
  787. if nm = '' then exit;
  788. DomainNameToLabels(nm, tsl);
  789. if tsl.Count = 0 then exit;
  790. for dmn in tsl do
  791. begin
  792. SetLength(Result.ulabels, (Length(Result.ulabels) + Length(dmn)+1));
  793. Result.ulabels[offset] := Length(dmn);
  794. Inc(offset);
  795. Move(dmn[1], Result.ulabels[offset], Length(dmn));
  796. Inc(offset, Length(dmn));
  797. end;
  798. SetLength(Result.ulabels, Length(Result.ulabels) + 1);
  799. Result.ulabels[offset] := 0;
  800. end;
  801. function TNetDbTest.WriteDNSDomainByteStreamToBuffer(var buf: TBuffer;
  802. var offset: Cardinal; dbs: TDNSDomainByteStream): Word;
  803. var
  804. p: TDNSDomainPointer;
  805. so: Word;
  806. begin
  807. Result := 0;
  808. // no label, no pointer, no write for you.
  809. if (Length(dbs.ulabels) = 0) and (dbs.cptr = 0) then exit;
  810. if (offset + CalcRdLength(dbs)) > Length(buf) then exit;
  811. so := offset;
  812. // labels can be empty, in which case we're writing just a pointer.
  813. if Length(dbs.ulabels) > 0 then
  814. begin
  815. Move(dbs.ulabels[0], buf[offset], Length(dbs.ulabels));
  816. Inc(offset, Length(dbs.ulabels));
  817. end;
  818. if dbs.cptr > 0 then
  819. begin
  820. p := GetDnsDomainPointer(dbs.cptr);
  821. Move(p.ba, buf[offset], Length(p.ba));
  822. Inc(offset, Min(Length(p.ba), (Length(buf) - offset)));
  823. end;
  824. Result := offset - so;
  825. end;
  826. {
  827. Write a domain name as RDATA. This means an RDLength (Word) and the
  828. domain labels.
  829. }
  830. function TNetDbTest.WriteDomainAsRdata(var buf: TBuffer; var offset: Cardinal;
  831. dbs: TDNSDomainByteStream): TRDataWriteRes;
  832. var
  833. s,l: Word;
  834. begin
  835. l := CalcRdLength(dbs);
  836. Result.etw := l + 2;
  837. s := offset;
  838. WriteNumToBuffer(buf, offset,l);
  839. WriteDNSDomainByteStreamToBuffer(buf, offset, dbs);
  840. Result.bw := offset - s;
  841. end;
  842. procedure TNetDbTest.BuildFakeResponseA(nm: ShortString; out
  843. fr: TFakeDNSResponse);
  844. begin
  845. // metadata
  846. SetLength(fr.strtable, 0);
  847. // start by building a fake header.
  848. fr.hdr.ID[0] := 12;
  849. fr.hdr.ID[1] := 34;
  850. fr.hdr.flags1 := QF_QR or QF_RD;
  851. fr.hdr.flags2 := 0;
  852. fr.hdr.qdcount := 1;
  853. fr.hdr.ancount := 2;
  854. fr.hdr.nscount := 0;
  855. fr.hdr.arcount := 0;
  856. // Next is the query part
  857. fr.qry.nm := nm;
  858. fr.qry.qclass := 1;
  859. fr.qry.qtype := DNSQRY_A;
  860. // now the answer RRs
  861. SetLength(fr.answers,2);
  862. BuildFakeRR_A(fr.answers[0], nm, 300, '127.0.0.1');
  863. BuildFakeRR_A(fr.answers[1], nm, 215, '127.0.5.1');
  864. end;
  865. procedure TNetDbTest.BuildFakeResponseAAAA(nm: ShortString; out
  866. fr: TFakeDNSResponse);
  867. begin
  868. // metadata
  869. SetLength(fr.strtable, 0);
  870. // start by building a fake header.
  871. fr.hdr.ID[0] := 12;
  872. fr.hdr.ID[1] := 34;
  873. fr.hdr.flags1 := QF_QR or QF_RD;
  874. fr.hdr.flags2 := 0;
  875. fr.hdr.qdcount := 1;
  876. fr.hdr.ancount := 2;
  877. fr.hdr.nscount := 0;
  878. fr.hdr.arcount := 0;
  879. // Next is the query part
  880. fr.qry.nm := nm;
  881. fr.qry.qclass := 1;
  882. fr.qry.qtype := DNSQRY_AAAA;
  883. // now the answer RRs
  884. SetLength(fr.answers,2);
  885. BuildFakeRR_AAAA(fr.answers[0], nm, 300, 'fe80::3b92:3429:ff16:a3e4');
  886. BuildFakeRR_AAAA(fr.answers[1], nm, 215, 'fe80::92e6:baff:fe44:ffbb');
  887. end;
  888. procedure TNetDbTest.BuildFakeResponseMX(nm: ShortString; out
  889. fr: TFakeDNSResponse);
  890. begin
  891. // metadata
  892. SetLength(fr.strtable, 0);
  893. // start by building a fake header.
  894. fr.hdr.ID[0] := 12;
  895. fr.hdr.ID[1] := 34;
  896. fr.hdr.flags1 := QF_QR or QF_RD;
  897. fr.hdr.flags2 := 0;
  898. fr.hdr.qdcount := 1;
  899. fr.hdr.ancount := 1;
  900. fr.hdr.nscount := 0;
  901. fr.hdr.arcount := 2;
  902. // Next is the query part
  903. fr.qry.nm := nm;
  904. fr.qry.qclass := 1;
  905. fr.qry.qtype := DNSQRY_MX;
  906. // now the answer RRs
  907. SetLength(fr.answers,1);
  908. BuildFakeRR_MX(fr.answers[0], nm, 0, 10, 'mailer.'+FAKEFQDN);
  909. // now an additional rr with the A record for the above.
  910. SetLength(fr.additional, 2);
  911. BuildFakeRR_A(fr.additional[0], 'mailer.'+FAKEFQDN, 0,
  912. '172.16.27.238');
  913. BuildFakeRR_AAAA(fr.additional[1], 'mailer.'+FAKEFQDN, 0,
  914. 'fe80::3b92:3429:ff16:a3e4');
  915. end;
  916. procedure TNetDbTest.BuildFakeResponseSOA(nm: ShortString; out
  917. fr: TFakeDNSResponse);
  918. begin
  919. // metadata
  920. SetLength(fr.strtable, 0);
  921. // start by building a fake header.
  922. fr.hdr.ID[0] := 12;
  923. fr.hdr.ID[1] := 34;
  924. fr.hdr.flags1 := QF_QR or QF_RD;
  925. fr.hdr.flags2 := 0;
  926. fr.hdr.qdcount := 1;
  927. fr.hdr.ancount := 1;
  928. fr.hdr.nscount := 0;
  929. fr.hdr.arcount := 0;
  930. // Next is the query part
  931. fr.qry.nm := nm;
  932. fr.qry.qclass := 1;
  933. fr.qry.qtype := DNSQRY_SOA;
  934. // now the answer RRs
  935. SetLength(fr.answers,1);
  936. BuildFakeRR_SOA(fr.answers[0],FAKEFQDN,33,
  937. 'mn.'+FAKEFQDN,'rn.'+FAKEFQDN,76543210,
  938. 123,456,789,60);
  939. end;
  940. procedure TNetDbTest.BuildFakeResponseCNAME(nm: ShortString; out
  941. fr: TFakeDNSResponse);
  942. begin
  943. // metadata
  944. SetLength(fr.strtable, 0);
  945. // start by building a fake header.
  946. fr.hdr.ID[0] := 12;
  947. fr.hdr.ID[1] := 34;
  948. fr.hdr.flags1 := QF_QR or QF_RD;
  949. fr.hdr.flags2 := 0;
  950. fr.hdr.qdcount := 1;
  951. fr.hdr.ancount := 1;
  952. fr.hdr.nscount := 0;
  953. fr.hdr.arcount := 0;
  954. // Next is the query part
  955. fr.qry.nm := nm;
  956. fr.qry.qclass := 1;
  957. fr.qry.qtype := DNSQRY_CNAME;
  958. // now the answer RRs
  959. SetLength(fr.answers,1);
  960. BuildFakeRR_CNAME(fr.answers[0], nm, 300, 'fakecname.'+FAKEFQDN);
  961. end;
  962. procedure TNetDbTest.BuildFakeResponseNS(nm: ShortString; out
  963. fr: TFakeDNSResponse);
  964. begin
  965. // metadata
  966. SetLength(fr.strtable, 0);
  967. // start by building a fake header.
  968. fr.hdr.ID[0] := 12;
  969. fr.hdr.ID[1] := 34;
  970. fr.hdr.flags1 := QF_QR or QF_RD;
  971. fr.hdr.flags2 := 0;
  972. fr.hdr.qdcount := 1;
  973. fr.hdr.ancount := 1;
  974. fr.hdr.nscount := 0;
  975. fr.hdr.arcount := 0;
  976. // Next is the query part
  977. fr.qry.nm := nm;
  978. fr.qry.qclass := 1;
  979. fr.qry.qtype := DNSQRY_NS;
  980. // now the answer RRs
  981. SetLength(fr.answers,1);
  982. BuildFakeRR_NS(fr.answers[0], nm, 300, 'fakens.'+FAKEFQDN);
  983. end;
  984. procedure TNetDbTest.BuildFakeResponsePTR(nm: ShortString; out
  985. fr: TFakeDNSResponse);
  986. begin
  987. // metadata
  988. SetLength(fr.strtable, 0);
  989. // start by building a fake header.
  990. fr.hdr.ID[0] := 12;
  991. fr.hdr.ID[1] := 34;
  992. fr.hdr.flags1 := QF_QR or QF_RD;
  993. fr.hdr.flags2 := 0;
  994. fr.hdr.qdcount := 1;
  995. fr.hdr.ancount := 1;
  996. fr.hdr.nscount := 0;
  997. fr.hdr.arcount := 0;
  998. // Next is the query part
  999. fr.qry.nm := nm;
  1000. fr.qry.qclass := 1;
  1001. fr.qry.qtype := DNSQRY_PTR;
  1002. // now the answer RRs
  1003. SetLength(fr.answers,1);
  1004. BuildFakeRR_PTR(fr.answers[0], nm, 300, 'fakeptrans.'+FAKEFQDN);
  1005. end;
  1006. procedure TNetDbTest.BuildFakeResponseTXT(nm: ShortString; out
  1007. fr: TFakeDNSResponse);
  1008. var
  1009. txtarr: TTextArray;
  1010. begin
  1011. // metadata
  1012. SetLength(fr.strtable, 0);
  1013. // start by building a fake header.
  1014. fr.hdr.ID[0] := 12;
  1015. fr.hdr.ID[1] := 34;
  1016. fr.hdr.flags1 := QF_QR or QF_RD;
  1017. fr.hdr.flags2 := 0;
  1018. fr.hdr.qdcount := 1;
  1019. fr.hdr.ancount := 1;
  1020. fr.hdr.nscount := 0;
  1021. fr.hdr.arcount := 0;
  1022. // Next is the query part
  1023. fr.qry.nm := nm;
  1024. fr.qry.qclass := 1;
  1025. fr.qry.qtype := DNSQRY_TXT;
  1026. txtarr[1] := 'v=spf1 mx a:lists.'+FAKEFQDN;
  1027. txtarr[2] := 'Always look on the bright side of life!';
  1028. // now the answer RRs
  1029. SetLength(fr.answers,1);
  1030. BuildFakeRR_TXT(fr.answers[0], nm, 300, 2, txtarr);
  1031. end;
  1032. procedure TNetDbTest.BuildFakeResponseSRV(nm: ShortString; out
  1033. fr: TFakeDNSResponse);
  1034. begin
  1035. // metadata
  1036. SetLength(fr.strtable, 0);
  1037. // start by building a fake header.
  1038. fr.hdr.ID[0] := 12;
  1039. fr.hdr.ID[1] := 34;
  1040. fr.hdr.flags1 := QF_QR or QF_RD;
  1041. fr.hdr.flags2 := 0;
  1042. fr.hdr.qdcount := 1;
  1043. fr.hdr.ancount := 1;
  1044. fr.hdr.nscount := 0;
  1045. fr.hdr.arcount := 0;
  1046. // Next is the query part
  1047. fr.qry.nm := nm;
  1048. fr.qry.qclass := 1;
  1049. fr.qry.qtype := DNSQRY_SRV;
  1050. // now the answer RRs
  1051. SetLength(fr.answers,1);
  1052. BuildFakeRR_SRV(fr.answers[0],FAKEFQDN,3300,22,44,2201,'_this._that._other');
  1053. end;
  1054. {
  1055. Test that BuildPayload puts the right values into the payload buffer.
  1056. }
  1057. procedure TNetDbTest.TestBuildPayloadSimple;
  1058. var
  1059. Q: TQueryData;
  1060. R, I,J,el: Integer;
  1061. S: String;
  1062. begin
  1063. R := BuildPayLoad(Q, FAKEFQDN, DNSQRY_A, 1);
  1064. // this is the expected length. Essentially, for each label, len(label)+1,
  1065. // then 4 bytes for the qclass and qtype, and 1 more for a 0 byte.
  1066. // rather than hardwire the length we calculate it so that no matter
  1067. // what the fake domain the test passes.
  1068. el := (Length(FAKEDOMAIN)+1)+(Length(FAKETLD)+1)+5;
  1069. AssertEquals('Payload byte count wrong:', el, R);
  1070. I := 0;
  1071. J := 0;
  1072. S := stringfromlabel(Q.Payload,I);
  1073. AssertEquals('Wrong domain name returned:',FAKEFQDN, S);
  1074. Move(Q.Payload[I],J,SizeOf(Word));
  1075. AssertEquals('Wrong query type', DNSQRY_A, NToHs(J));
  1076. Inc(I,2);
  1077. Move(Q.Payload[I],J,SizeOf(Word));
  1078. AssertEquals('Wrong class', 1, NToHs(J));
  1079. end;
  1080. {
  1081. Test building a payload with an empty str.
  1082. }
  1083. procedure TNetDbTest.TestBuildPayloadSimpleEmpty;
  1084. var
  1085. Q: TQueryData;
  1086. R: Integer;
  1087. begin
  1088. R := BuildPayLoad(Q, '', DNSQRY_A, 1);
  1089. AssertEquals('Payload byte count wrong:',-1, R);
  1090. end;
  1091. {
  1092. Test BuildQuery with a label that ends in a dot. This should be allowed.
  1093. A dot at the end is an empty label but we must not count its 0 byte twice.
  1094. }
  1095. procedure TNetDbTest.TestBuildPayloadSimpleEndDot;
  1096. var
  1097. Q: TQueryData;
  1098. R,el: Integer;
  1099. begin
  1100. // this is the expected length. Essentially, for each label, len(label)+1,
  1101. // then 4 bytes for the qclass and qtype, and 1 more for a 0 byte.
  1102. // rather than hardwire the length we calculate it so that no matter
  1103. // what the fake domain the test passes.
  1104. el := (Length(FAKEDOMAIN)+1)+(Length(FAKETLD)+1)+5;
  1105. R := BuildPayLoad(Q, FAKEFQDN+'.', DNSQRY_A, 1);
  1106. AssertEquals('Payload byte count wrong:',el, R);
  1107. end;
  1108. {
  1109. Test BuildPayload with a label that starts with a dot. This should be
  1110. rejected outright.
  1111. }
  1112. procedure TNetDbTest.TestBuildPayloadSimpleStartDot;
  1113. var
  1114. Q: TQueryData;
  1115. R: Integer;
  1116. begin
  1117. R := BuildPayLoad(Q, '.'+FAKEFQDN, DNSQRY_A, 1);
  1118. AssertEquals('Payload byte count wrong:',-1, R);
  1119. end;
  1120. {
  1121. Test BuildPayload with multiple dots (empty labels) in the middle of the domain
  1122. name. This should be rejected outright.
  1123. }
  1124. procedure TNetDbTest.TestBuildPayloadSimpleMultipleDot;
  1125. var
  1126. Q: TQueryData;
  1127. R: Integer;
  1128. begin
  1129. R := BuildPayLoad(Q, FAKEDOMAIN+'.....'+FAKETLD, DNSQRY_A, 1);
  1130. AssertEquals('Payload byte count wrong:',-1, R);
  1131. end;
  1132. procedure TNetDbTest.TestDnsQueryUDP_A;
  1133. var
  1134. fakeresp: TFakeDNSResponse;
  1135. qd: TQueryData;
  1136. anslen, ansstart: Word;
  1137. RRArr: TRRNameDataArray;
  1138. ip: THostAddr;
  1139. begin
  1140. BuildFakeResponseA(FAKEFQDN, fakeresp);
  1141. AssertTrue('Unable to convert fake dns response to querydata',
  1142. BuildQueryData(fakeresp, qd, anslen));
  1143. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  1144. ansstart := SkipAnsQueries(qd, anslen);
  1145. AssertEquals('Wrong number of A records.', 2, qd.h.ancount);
  1146. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  1147. AssertEquals('Wrong number of resource records.', 2, Length(RRArr));
  1148. AssertEquals('RR 0 is not an A RR.',DNSQRY_A, RRarr[0].RRMeta.Atype);
  1149. AssertEquals('RR 1 is not an A RR.', DNSQRY_A, RRarr[1].RRMeta.Atype);
  1150. AssertEquals('Wrong A record name for RR 0', FAKEFQDN,
  1151. RRArr[0].RRName);
  1152. AssertEquals('Wrong A record name for RR 1', FAKEFQDN,
  1153. RRArr[1].RRName);
  1154. AssertTrue('Did not get RR A data.', DNSRRGetA(RRArr[0], qd.Payload, ip));
  1155. AssertEquals('Wrong ip for A.', '127.0.0.1', HostAddrToStr(ip));
  1156. AssertTrue('Did not get RR A data.', DNSRRGetA(RRArr[1], qd.Payload, ip));
  1157. AssertEquals('Wrong ip for A.', '127.0.5.1', HostAddrToStr(ip));
  1158. end;
  1159. procedure TNetDbTest.TestDnsQueryTCP_A;
  1160. var
  1161. fakeresp: TFakeDNSResponse;
  1162. qd: TQueryDataLengthTCP;
  1163. anslen, ansstart: Word;
  1164. RRArr: TRRNameDataArray;
  1165. ip: THostAddr;
  1166. begin
  1167. BuildFakeResponseA(FAKEFQDN, fakeresp);
  1168. AssertTrue('Unable to convert fake dns response to querydata',
  1169. BuildQueryData(fakeresp, qd, anslen));
  1170. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  1171. ansstart := SkipAnsQueries(qd, anslen);
  1172. AssertEquals('Wrong number of A records.', 2, qd.h.ancount);
  1173. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  1174. AssertEquals('Wrong number of resource records.', 2, Length(RRArr));
  1175. AssertEquals('RR 0 is not an A RR.',DNSQRY_A, RRarr[0].RRMeta.Atype);
  1176. AssertEquals('RR 1 is not an A RR.', DNSQRY_A, RRarr[1].RRMeta.Atype);
  1177. AssertEquals('Wrong A record name for RR 0', FAKEFQDN,
  1178. RRArr[0].RRName);
  1179. AssertEquals('Wrong A record name for RR 1', FAKEFQDN,
  1180. RRArr[1].RRName);
  1181. AssertTrue('Did not get RR A data.', DNSRRGetA(RRArr[0], qd.Payload, ip));
  1182. AssertEquals('Wrong ip for A.', '127.0.0.1', HostAddrToStr(ip));
  1183. AssertTrue('Did not get RR A data.', DNSRRGetA(RRArr[1], qd.Payload, ip));
  1184. AssertEquals('Wrong ip for A.', '127.0.5.1', HostAddrToStr(ip));
  1185. end;
  1186. procedure TNetDbTest.TestDnsQueryCompressUDP_A;
  1187. var
  1188. fakeresp: TFakeDNSResponse;
  1189. qd: TQueryData;
  1190. anslen, ansstart: Word;
  1191. RRArr: TRRNameDataArray;
  1192. ip: THostAddr;
  1193. begin
  1194. BuildFakeResponseA(FAKEFQDN, fakeresp);
  1195. AssertTrue('Unable to convert fake dns response to compressed querydata',
  1196. BuildQueryData(fakeresp, qd, anslen, True));
  1197. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  1198. ansstart := SkipAnsQueries(qd, anslen);
  1199. AssertEquals('Wrong number of A records.', 2, qd.h.ancount);
  1200. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  1201. AssertEquals('Wrong number of resource records.', 2, Length(RRArr));
  1202. AssertEquals('RR 0 is not an A RR.',DNSQRY_A, RRarr[0].RRMeta.Atype);
  1203. AssertEquals('RR 1 is not an A RR.', DNSQRY_A, RRarr[1].RRMeta.Atype);
  1204. AssertEquals('Wrong A record name for RR 0', FAKEFQDN,
  1205. RRArr[0].RRName);
  1206. AssertEquals('Wrong A record name for RR 1', FAKEFQDN,
  1207. RRArr[1].RRName);
  1208. AssertTrue('Did not get RR A data.', DNSRRGetA(RRArr[0], qd.Payload, ip));
  1209. AssertEquals('Wrong ip for A.', '127.0.0.1', HostAddrToStr(ip));
  1210. AssertTrue('Did not get RR A data.', DNSRRGetA(RRArr[1], qd.Payload, ip));
  1211. AssertEquals('Wrong ip for A.', '127.0.5.1', HostAddrToStr(ip));
  1212. end;
  1213. procedure TNetDbTest.TestDnsQueryCompressTCP_A;
  1214. var
  1215. fakeresp: TFakeDNSResponse;
  1216. qd: TQueryDataLengthTCP;
  1217. anslen, ansstart: Word;
  1218. RRArr: TRRNameDataArray;
  1219. ip: THostAddr;
  1220. begin
  1221. BuildFakeResponseA(FAKEFQDN, fakeresp);
  1222. AssertTrue('Unable to convert fake dns response to compressed querydata',
  1223. BuildQueryData(fakeresp, qd, anslen, True));
  1224. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  1225. ansstart := SkipAnsQueries(qd, anslen);
  1226. AssertEquals('Wrong number of A records.', 2, qd.h.ancount);
  1227. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  1228. AssertEquals('Wrong number of resource records.', 2, Length(RRArr));
  1229. AssertEquals('RR 0 is not an A RR.',DNSQRY_A, RRarr[0].RRMeta.Atype);
  1230. AssertEquals('RR 1 is not an A RR.', DNSQRY_A, RRarr[1].RRMeta.Atype);
  1231. AssertEquals('Wrong A record name for RR 0', FAKEFQDN,
  1232. RRArr[0].RRName);
  1233. AssertEquals('Wrong A record name for RR 1', FAKEFQDN,
  1234. RRArr[1].RRName);
  1235. AssertTrue('Did not get RR A data.', DNSRRGetA(RRArr[0], qd.Payload, ip));
  1236. AssertEquals('Wrong ip for A.', '127.0.0.1', HostAddrToStr(ip));
  1237. AssertTrue('Did not get RR A data.', DNSRRGetA(RRArr[1], qd.Payload, ip));
  1238. AssertEquals('Wrong ip for A.', '127.0.5.1', HostAddrToStr(ip));
  1239. end;
  1240. procedure TNetDbTest.TestDnsQueryUDP_AAAA;
  1241. var
  1242. fakeresp: TFakeDNSResponse;
  1243. qd: TQueryData;
  1244. anslen, ansstart: Word;
  1245. RRArr: TRRNameDataArray;
  1246. ip: THostAddr6;
  1247. begin
  1248. BuildFakeResponseAAAA(FAKEFQDN, fakeresp);
  1249. AssertTrue('Unable to convert fake dns response to querydata',
  1250. BuildQueryData(fakeresp, qd, anslen));
  1251. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  1252. ansstart := SkipAnsQueries(qd, anslen);
  1253. AssertEquals('Wrong number of AAAA records.', 2, qd.h.ancount);
  1254. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  1255. AssertEquals('Wrong number of resource records.', 2, Length(RRArr));
  1256. AssertEquals('RR 0 is not an AAAA RR.',DNSQRY_AAAA, RRarr[0].RRMeta.Atype);
  1257. AssertEquals('RR 1 is not an AAAA RR.', DNSQRY_AAAA, RRarr[1].RRMeta.Atype);
  1258. AssertEquals('Wrong AAAA record name for RR 0', FAKEFQDN,
  1259. RRArr[0].RRName);
  1260. AssertEquals('Wrong AAAA record name for RR 1', FAKEFQDN,
  1261. RRArr[1].RRName);
  1262. AssertTrue('Did not get RR AAAA data.', DNSRRGetAAAA(RRArr[0], qd.Payload, ip));
  1263. AssertEquals('Wrong ip for AAAA.', 'FE80::3B92:3429:FF16:A3E4', HostAddrToStr6(ip));
  1264. AssertTrue('Did not get RR AAAA data.', DNSRRGetAAAA(RRArr[1], qd.Payload, ip));
  1265. AssertEquals('Wrong ip for AAAA.', 'FE80::92E6:BAFF:FE44:FFBB', HostAddrToStr6(ip));
  1266. end;
  1267. procedure TNetDbTest.TestDnsQueryTCP_AAAA;
  1268. var
  1269. fakeresp: TFakeDNSResponse;
  1270. qd: TQueryDataLengthTCP;
  1271. anslen, ansstart: Word;
  1272. RRArr: TRRNameDataArray;
  1273. ip: THostAddr6;
  1274. begin
  1275. BuildFakeResponseAAAA(FAKEFQDN, fakeresp);
  1276. AssertTrue('Unable to convert fake dns response to querydata',
  1277. BuildQueryData(fakeresp, qd, anslen));
  1278. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  1279. ansstart := SkipAnsQueries(qd, anslen);
  1280. AssertEquals('Wrong number of AAAA records.', 2, qd.h.ancount);
  1281. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  1282. AssertEquals('Wrong number of resource records.', 2, Length(RRArr));
  1283. AssertEquals('RR 0 is not an AAAA RR.',DNSQRY_AAAA, RRarr[0].RRMeta.Atype);
  1284. AssertEquals('RR 1 is not an AAAA RR.', DNSQRY_AAAA, RRarr[1].RRMeta.Atype);
  1285. AssertEquals('Wrong AAAA record name for RR 0', FAKEFQDN,
  1286. RRArr[0].RRName);
  1287. AssertEquals('Wrong AAAA record name for RR 1', FAKEFQDN,
  1288. RRArr[1].RRName);
  1289. AssertTrue('Did not get RR AAAA data.', DNSRRGetAAAA(RRArr[0],
  1290. qd.Payload, ip));
  1291. AssertEquals('Wrong ip for AAAA.', 'FE80::3B92:3429:FF16:A3E4',
  1292. HostAddrToStr6(ip));
  1293. AssertTrue('Did not get RR AAAA data.', DNSRRGetAAAA(RRArr[1],
  1294. qd.Payload, ip));
  1295. AssertEquals('Wrong ip for AAAA.', 'FE80::92E6:BAFF:FE44:FFBB',
  1296. HostAddrToStr6(ip));
  1297. end;
  1298. procedure TNetDbTest.TestDnsQueryCompressUDP_AAAA;
  1299. var
  1300. fakeresp: TFakeDNSResponse;
  1301. qd: TQueryData;
  1302. anslen, ansstart: Word;
  1303. RRArr: TRRNameDataArray;
  1304. ip: THostAddr6;
  1305. begin
  1306. BuildFakeResponseAAAA(FAKEFQDN, fakeresp);
  1307. AssertTrue('Unable to convert fake dns response to compressed querydata',
  1308. BuildQueryData(fakeresp, qd, anslen, True));
  1309. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  1310. ansstart := SkipAnsQueries(qd, anslen);
  1311. AssertEquals('Wrong number of AAAA records.', 2, qd.h.ancount);
  1312. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  1313. AssertEquals('Wrong number of resource records.', 2, Length(RRArr));
  1314. AssertEquals('RR 0 is not an AAAA RR.',DNSQRY_AAAA, RRarr[0].RRMeta.Atype);
  1315. AssertEquals('RR 1 is not an AAAA RR.', DNSQRY_AAAA, RRarr[1].RRMeta.Atype);
  1316. AssertEquals('Wrong AAAA record name for RR 0', FAKEFQDN,
  1317. RRArr[0].RRName);
  1318. AssertEquals('Wrong AAAA record name for RR 1', FAKEFQDN,
  1319. RRArr[1].RRName);
  1320. AssertTrue('Did not get RR AAAA data.', DNSRRGetAAAA(RRArr[0],
  1321. qd.Payload, ip));
  1322. AssertEquals('Wrong ip for AAAA.', 'FE80::3B92:3429:FF16:A3E4',
  1323. HostAddrToStr6(ip));
  1324. AssertTrue('Did not get RR AAAA data.', DNSRRGetAAAA(RRArr[1],
  1325. qd.Payload, ip));
  1326. AssertEquals('Wrong ip for AAAA.', 'FE80::92E6:BAFF:FE44:FFBB',
  1327. HostAddrToStr6(ip));
  1328. end;
  1329. procedure TNetDbTest.TestDnsQueryCompressTCP_AAAA;
  1330. var
  1331. fakeresp: TFakeDNSResponse;
  1332. qd: TQueryDataLengthTCP;
  1333. anslen, ansstart: Word;
  1334. RRArr: TRRNameDataArray;
  1335. ip: THostAddr6;
  1336. begin
  1337. BuildFakeResponseAAAA(FAKEFQDN, fakeresp);
  1338. AssertTrue('Unable to convert fake dns response to compressed querydata',
  1339. BuildQueryData(fakeresp, qd, anslen, True));
  1340. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  1341. ansstart := SkipAnsQueries(qd, anslen);
  1342. AssertEquals('Wrong number of AAAA records.', 2, qd.h.ancount);
  1343. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  1344. AssertEquals('Wrong number of resource records.', 2, Length(RRArr));
  1345. AssertEquals('RR 0 is not an AAAA RR.',DNSQRY_AAAA, RRarr[0].RRMeta.Atype);
  1346. AssertEquals('RR 1 is not an AAAA RR.', DNSQRY_AAAA, RRarr[1].RRMeta.Atype);
  1347. AssertEquals('Wrong AAAA record name for RR 0', FAKEFQDN,
  1348. RRArr[0].RRName);
  1349. AssertEquals('Wrong AAAA record name for RR 1', FAKEFQDN,
  1350. RRArr[1].RRName);
  1351. AssertTrue('Did not get RR AAAA data.', DNSRRGetAAAA(RRArr[0],
  1352. qd.Payload, ip));
  1353. AssertEquals('Wrong ip for AAAA.', 'FE80::3B92:3429:FF16:A3E4',
  1354. HostAddrToStr6(ip));
  1355. AssertTrue('Did not get RR AAAA data.', DNSRRGetAAAA(RRArr[1],
  1356. qd.Payload, ip));
  1357. AssertEquals('Wrong ip for AAAA.', 'FE80::92E6:BAFF:FE44:FFBB',
  1358. HostAddrToStr6(ip));
  1359. end;
  1360. procedure TNetDbTest.TestDnsQueryUDP_MX;
  1361. var
  1362. fakeresp: TFakeDNSResponse;
  1363. qd: TQueryData;
  1364. anslen, ansstart: Word;
  1365. RRArr: TRRNameDataArray;
  1366. mxrec: TDNSRR_MX;
  1367. ip: THostAddr;
  1368. ip6: THostAddr6;
  1369. begin
  1370. BuildFakeResponseMX(FAKEFQDN, fakeresp);
  1371. AssertTrue('Unable to convert fake dns response to querydata',
  1372. BuildQueryData(fakeresp, qd, anslen));
  1373. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  1374. ansstart := SkipAnsQueries(qd, anslen);
  1375. AssertEquals('Wrong number of MX records.', 1, qd.h.ancount);
  1376. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  1377. AssertEquals('Wrong number of resource records.', 1, Length(RRArr));
  1378. AssertEquals('RR 0 is not an MX RR.',DNSQRY_MX, RRarr[0].RRMeta.Atype);
  1379. AssertEquals('Wrong record name for RR 0', FAKEFQDN,
  1380. RRArr[0].RRName);
  1381. AssertTrue('Did not get RR MX data.', DNSRRGetMX(RRArr[0], qd.Payload, mxrec));
  1382. AssertEquals('Wrong MX hostname', 'mailer.'+FAKEFQDN,
  1383. mxrec.exchange);
  1384. AssertEquals('Wrong MX preference', 10, mxrec.preference);
  1385. AssertEquals('Should be 2 additional RR records.',2,NToHs(qd.h.arcount));
  1386. RRArr := GetRRrecords(qd.Payload, ansstart, NToHs(qd.h.arcount));
  1387. AssertEquals('Wrong number of resource records.', 2, Length(RRArr));
  1388. AssertEquals('RR 0 is not an A RR.',DNSQRY_A, RRarr[0].RRMeta.Atype);
  1389. AssertEquals('RR 1 is not an AAAA RR.', DNSQRY_AAAA, RRarr[1].RRMeta.Atype);
  1390. AssertTrue('Did not get RR A data.', DNSRRGetA(RRArr[0], qd.Payload, ip));
  1391. AssertTrue('Did not get RR AAAA data.', DNSRRGetAAAA(RRArr[1], qd.Payload, ip6));
  1392. AssertEquals('Wrong ip for A.', '172.16.27.238', HostAddrToStr(ip));
  1393. AssertEquals('Wrong ip for AAAA.', 'FE80::3B92:3429:FF16:A3E4',
  1394. HostAddrToStr6(ip6));
  1395. end;
  1396. procedure TNetDbTest.TestDnsQueryTCP_MX;
  1397. var
  1398. fakeresp: TFakeDNSResponse;
  1399. qd: TQueryDataLengthTCP;
  1400. anslen, ansstart: Word;
  1401. RRArr: TRRNameDataArray;
  1402. mxrec: TDNSRR_MX;
  1403. ip: THostAddr;
  1404. ip6: THostAddr6;
  1405. begin
  1406. BuildFakeResponseMX(FAKEFQDN, fakeresp);
  1407. AssertTrue('Unable to convert fake dns response to querydata',
  1408. BuildQueryData(fakeresp, qd, anslen));
  1409. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  1410. ansstart := SkipAnsQueries(qd, anslen);
  1411. AssertEquals('Wrong number of MX records.', 1, qd.h.ancount);
  1412. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  1413. AssertEquals('Wrong number of resource records.', 1, Length(RRArr));
  1414. AssertEquals('RR 0 is not an MX RR.',DNSQRY_MX, RRarr[0].RRMeta.Atype);
  1415. AssertEquals('Wrong record name for RR 0', FAKEFQDN,
  1416. RRArr[0].RRName);
  1417. AssertTrue('Did not get RR MX data.', DNSRRGetMX(RRArr[0], qd.Payload, mxrec));
  1418. AssertEquals('Wrong MX hostname', 'mailer.'+FAKEFQDN,
  1419. mxrec.exchange);
  1420. AssertEquals('Wrong MX preference', 10, mxrec.preference);
  1421. AssertEquals('Should be 2 additional RR records.',2,NToHs(qd.h.arcount));
  1422. RRArr := GetRRrecords(qd.Payload, ansstart, NToHs(qd.h.arcount));
  1423. AssertEquals('Wrong number of resource records.', 2, Length(RRArr));
  1424. AssertEquals('RR 0 is not an A RR.',DNSQRY_A, RRarr[0].RRMeta.Atype);
  1425. AssertEquals('RR 1 is not an AAAA RR.', DNSQRY_AAAA, RRarr[1].RRMeta.Atype);
  1426. AssertTrue('Did not get RR A data.', DNSRRGetA(RRArr[0], qd.Payload, ip));
  1427. AssertTrue('Did not get RR AAAA data.', DNSRRGetAAAA(RRArr[1], qd.Payload, ip6));
  1428. AssertEquals('Wrong ip for A.', '172.16.27.238', HostAddrToStr(ip));
  1429. AssertEquals('Wrong ip for AAAA.', 'FE80::3B92:3429:FF16:A3E4',
  1430. HostAddrToStr6(ip6));
  1431. end;
  1432. procedure TNetDbTest.TestDnsQueryCompressUDP_MX;
  1433. var
  1434. fakeresp: TFakeDNSResponse;
  1435. qd: TQueryData;
  1436. anslen, ansstart: Word;
  1437. RRArr: TRRNameDataArray;
  1438. mxrec: TDNSRR_MX;
  1439. ip: THostAddr;
  1440. ip6: THostAddr6;
  1441. begin
  1442. BuildFakeResponseMX(FAKEFQDN, fakeresp);
  1443. AssertTrue('Unable to convert fake dns response to compressed querydata',
  1444. BuildQueryData(fakeresp, qd, anslen, True));
  1445. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  1446. ansstart := SkipAnsQueries(qd, anslen);
  1447. AssertEquals('Wrong number of MX records.', 1, qd.h.ancount);
  1448. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  1449. AssertEquals('Wrong number of resource records.', 1, Length(RRArr));
  1450. AssertEquals('RR 0 is not an MX RR.',DNSQRY_MX, RRarr[0].RRMeta.Atype);
  1451. AssertEquals('Wrong record name for RR 0', FAKEFQDN,
  1452. RRArr[0].RRName);
  1453. AssertTrue('Did not get RR MX data.', DNSRRGetMX(RRArr[0], qd.Payload, mxrec));
  1454. AssertEquals('Wrong MX hostname', 'mailer.'+FAKEFQDN,
  1455. mxrec.exchange);
  1456. AssertEquals('Wrong MX preference', 10, mxrec.preference);
  1457. AssertEquals('Should be 2 additional RR records.',2,NToHs(qd.h.arcount));
  1458. RRArr := GetRRrecords(qd.Payload, ansstart, NToHs(qd.h.arcount));
  1459. AssertEquals('Wrong number of resource records.', 2, Length(RRArr));
  1460. AssertEquals('RR 0 is not an A RR.',DNSQRY_A, RRarr[0].RRMeta.Atype);
  1461. AssertEquals('RR 1 is not an AAAA RR.', DNSQRY_AAAA, RRarr[1].RRMeta.Atype);
  1462. AssertTrue('Did not get RR A data.', DNSRRGetA(RRArr[0], qd.Payload, ip));
  1463. AssertTrue('Did not get RR AAAA data.', DNSRRGetAAAA(RRArr[1], qd.Payload,
  1464. ip6));
  1465. AssertEquals('Wrong ip for A.', '172.16.27.238', HostAddrToStr(ip));
  1466. AssertEquals('Wrong ip for AAAA.', 'FE80::3B92:3429:FF16:A3E4',
  1467. HostAddrToStr6(ip6));
  1468. end;
  1469. procedure TNetDbTest.TestDnsQueryCompressTCP_MX;
  1470. var
  1471. fakeresp: TFakeDNSResponse;
  1472. qd: TQueryDataLengthTCP;
  1473. anslen, ansstart: Word;
  1474. RRArr: TRRNameDataArray;
  1475. mxrec: TDNSRR_MX;
  1476. ip: THostAddr;
  1477. ip6: THostAddr6;
  1478. begin
  1479. BuildFakeResponseMX(FAKEFQDN, fakeresp);
  1480. AssertTrue('Unable to convert fake dns response to compressed querydata',
  1481. BuildQueryData(fakeresp, qd, anslen, True));
  1482. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  1483. ansstart := SkipAnsQueries(qd, anslen);
  1484. AssertEquals('Wrong number of MX records.', 1, qd.h.ancount);
  1485. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  1486. AssertEquals('Wrong number of resource records.', 1, Length(RRArr));
  1487. AssertEquals('RR 0 is not an MX RR.',DNSQRY_MX, RRarr[0].RRMeta.Atype);
  1488. AssertEquals('Wrong record name for RR 0', FAKEFQDN,
  1489. RRArr[0].RRName);
  1490. AssertTrue('Did not get RR MX data.', DNSRRGetMX(RRArr[0], qd.Payload, mxrec));
  1491. AssertEquals('Wrong MX hostname', 'mailer.'+FAKEFQDN,
  1492. mxrec.exchange);
  1493. AssertEquals('Wrong MX preference', 10, mxrec.preference);
  1494. AssertEquals('Should be 2 additional RR records.',2,NToHs(qd.h.arcount));
  1495. RRArr := GetRRrecords(qd.Payload, ansstart, NToHs(qd.h.arcount));
  1496. AssertEquals('Wrong number of resource records.', 2, Length(RRArr));
  1497. AssertEquals('RR 0 is not an A RR.',DNSQRY_A, RRarr[0].RRMeta.Atype);
  1498. AssertEquals('RR 1 is not an AAAA RR.', DNSQRY_AAAA, RRarr[1].RRMeta.Atype);
  1499. AssertTrue('Did not get RR A data.', DNSRRGetA(RRArr[0], qd.Payload, ip));
  1500. AssertTrue('Did not get RR AAAA data.', DNSRRGetAAAA(RRArr[1], qd.Payload,
  1501. ip6));
  1502. AssertEquals('Wrong ip for A.', '172.16.27.238', HostAddrToStr(ip));
  1503. AssertEquals('Wrong ip for AAAA.', 'FE80::3B92:3429:FF16:A3E4',
  1504. HostAddrToStr6(ip6));
  1505. end;
  1506. procedure TNetDbTest.TestDnsQueryUDP_SOA;
  1507. var
  1508. fakeresp: TFakeDNSResponse;
  1509. qd: TQueryData;
  1510. anslen, ansstart: Word;
  1511. RRArr: TRRNameDataArray;
  1512. soarec: TDNSRR_SOA;
  1513. begin
  1514. BuildFakeResponseSOA(FAKEFQDN, fakeresp);
  1515. AssertTrue('Unable to convert fake dns response to querydata',
  1516. BuildQueryData(fakeresp, qd, anslen));
  1517. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  1518. ansstart := SkipAnsQueries(qd, anslen);
  1519. AssertEquals('Wrong number of SOA records.', 1, qd.h.ancount);
  1520. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  1521. AssertEquals('Wrong number of resource records.', 1, Length(RRArr));
  1522. AssertEquals('RR 0 is not an SOA RR.',DNSQRY_SOA, RRarr[0].RRMeta.Atype);
  1523. AssertEquals('Wrong record name for RR 0', FAKEFQDN,
  1524. RRArr[0].RRName);
  1525. AssertTrue('Did not get RR SOA data.', DNSRRGetSOA(RRArr[0], qd.Payload,
  1526. soarec));
  1527. AssertEquals('Wrong mname hostname', 'mn.'+FAKEFQDN,
  1528. soarec.mname);
  1529. AssertEquals('Wrong rname hostname', 'rn.'+FAKEFQDN,
  1530. soarec.rname);
  1531. AssertEquals('Wrong SOA serial', 76543210, soarec.serial);
  1532. AssertEquals('Wrong SOA refresh', 123, soarec.refresh);
  1533. AssertEquals('Wrong SOA retry', 456, soarec.retry);
  1534. AssertEquals('Wrong SOA expire', 789, soarec.expire);
  1535. AssertEquals('Wrong SOA min', 60, soarec.min);
  1536. end;
  1537. procedure TNetDbTest.TestDnsQueryTCP_SOA;
  1538. var
  1539. fakeresp: TFakeDNSResponse;
  1540. qd: TQueryDataLengthTCP;
  1541. anslen, ansstart: Word;
  1542. RRArr: TRRNameDataArray;
  1543. soarec: TDNSRR_SOA;
  1544. begin
  1545. BuildFakeResponseSOA(FAKEFQDN, fakeresp);
  1546. AssertTrue('Unable to convert fake dns response to querydata',
  1547. BuildQueryData(fakeresp, qd, anslen));
  1548. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  1549. ansstart := SkipAnsQueries(qd, anslen);
  1550. AssertEquals('Wrong number of SOA records.', 1, qd.h.ancount);
  1551. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  1552. AssertEquals('Wrong number of resource records.', 1, Length(RRArr));
  1553. AssertEquals('RR 0 is not an SOA RR.',DNSQRY_SOA, RRarr[0].RRMeta.Atype);
  1554. AssertEquals('Wrong record name for RR 0', FAKEFQDN,
  1555. RRArr[0].RRName);
  1556. AssertTrue('Did not get RR SOA data.', DNSRRGetSOA(RRArr[0], qd.Payload,
  1557. soarec));
  1558. AssertEquals('Wrong mname hostname', 'mn.'+FAKEFQDN,
  1559. soarec.mname);
  1560. AssertEquals('Wrong rname hostname', 'rn.'+FAKEFQDN,
  1561. soarec.rname);
  1562. AssertEquals('Wrong SOA serial', 76543210, soarec.serial);
  1563. AssertEquals('Wrong SOA refresh', 123, soarec.refresh);
  1564. AssertEquals('Wrong SOA retry', 456, soarec.retry);
  1565. AssertEquals('Wrong SOA expire', 789, soarec.expire);
  1566. AssertEquals('Wrong SOA min', 60, soarec.min);
  1567. end;
  1568. procedure TNetDbTest.TestDnsQueryCompressUDP_SOA;
  1569. var
  1570. fakeresp: TFakeDNSResponse;
  1571. qd: TQueryData;
  1572. anslen, ansstart: Word;
  1573. RRArr: TRRNameDataArray;
  1574. soarec: TDNSRR_SOA;
  1575. begin
  1576. BuildFakeResponseSOA(FAKEFQDN, fakeresp);
  1577. AssertTrue('Unable to convert fake dns response to querydata',
  1578. BuildQueryData(fakeresp, qd, anslen, True));
  1579. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  1580. ansstart := SkipAnsQueries(qd, anslen);
  1581. AssertEquals('Wrong number of SOA records.', 1, qd.h.ancount);
  1582. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  1583. AssertEquals('Wrong number of resource records.', 1, Length(RRArr));
  1584. AssertEquals('RR 0 is not an SOA RR.',DNSQRY_SOA, RRarr[0].RRMeta.Atype);
  1585. AssertEquals('Wrong record name for RR 0', FAKEFQDN,
  1586. RRArr[0].RRName);
  1587. AssertTrue('Did not get RR SOA data.', DNSRRGetSOA(RRArr[0], qd.Payload,
  1588. soarec));
  1589. AssertEquals('Wrong mname hostname', 'mn.'+FAKEFQDN,
  1590. soarec.mname);
  1591. AssertEquals('Wrong rname hostname', 'rn.'+FAKEFQDN,
  1592. soarec.rname);
  1593. AssertEquals('Wrong SOA serial', 76543210, soarec.serial);
  1594. AssertEquals('Wrong SOA refresh', 123, soarec.refresh);
  1595. AssertEquals('Wrong SOA retry', 456, soarec.retry);
  1596. AssertEquals('Wrong SOA expire', 789, soarec.expire);
  1597. AssertEquals('Wrong SOA min', 60, soarec.min);
  1598. end;
  1599. procedure TNetDbTest.TestDnsQueryCompressTCP_SOA;
  1600. var
  1601. fakeresp: TFakeDNSResponse;
  1602. qd: TQueryDataLengthTCP;
  1603. anslen, ansstart: Word;
  1604. RRArr: TRRNameDataArray;
  1605. soarec: TDNSRR_SOA;
  1606. begin
  1607. BuildFakeResponseSOA(FAKEFQDN, fakeresp);
  1608. AssertTrue('Unable to convert fake dns response to compressed querydata',
  1609. BuildQueryData(fakeresp, qd, anslen, True));
  1610. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  1611. ansstart := SkipAnsQueries(qd, anslen);
  1612. AssertEquals('Wrong number of SOA records.', 1, qd.h.ancount);
  1613. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  1614. AssertEquals('Wrong number of resource records.', 1, Length(RRArr));
  1615. AssertEquals('RR 0 is not an SOA RR.',DNSQRY_SOA, RRarr[0].RRMeta.Atype);
  1616. AssertEquals('Wrong record name for RR 0', FAKEFQDN,
  1617. RRArr[0].RRName);
  1618. AssertTrue('Did not get RR SOA data.', DNSRRGetSOA(RRArr[0], qd.Payload,
  1619. soarec));
  1620. AssertEquals('Wrong mname hostname', 'mn.'+FAKEFQDN,
  1621. soarec.mname);
  1622. AssertEquals('Wrong rname hostname', 'rn.'+FAKEFQDN,
  1623. soarec.rname);
  1624. AssertEquals('Wrong SOA serial', 76543210, soarec.serial);
  1625. AssertEquals('Wrong SOA refresh', 123, soarec.refresh);
  1626. AssertEquals('Wrong SOA retry', 456, soarec.retry);
  1627. AssertEquals('Wrong SOA expire', 789, soarec.expire);
  1628. AssertEquals('Wrong SOA min', 60, soarec.min);
  1629. end;
  1630. procedure TNetDbTest.TestDnsQueryUDP_CNAME;
  1631. var
  1632. fakeresp: TFakeDNSResponse;
  1633. qd: TQueryData;
  1634. anslen, ansstart: Word;
  1635. RRArr: TRRNameDataArray;
  1636. s: TDNSDomainName;
  1637. begin
  1638. BuildFakeResponseCNAME(FAKEFQDN, fakeresp);
  1639. AssertTrue('Unable to convert fake dns response to querydata',
  1640. BuildQueryData(fakeresp, qd, anslen));
  1641. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  1642. ansstart := SkipAnsQueries(qd, anslen);
  1643. AssertEquals('Wrong number of CNAME records.', 1, qd.h.ancount);
  1644. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  1645. AssertEquals('Wrong number of resource records.', 1, Length(RRArr));
  1646. AssertEquals('RR 0 is not an CNAME RR.',DNSQRY_CNAME, RRarr[0].RRMeta.Atype);
  1647. AssertEquals('Wrong CNAME record name for RR 0', FAKEFQDN,
  1648. RRArr[0].RRName);
  1649. AssertTrue('Did not get RR CNAME data.', DNSRRGetCNAME(RRArr[0], qd.Payload, s));
  1650. AssertEquals('Wrong CNAME.', 'fakecname.'+FAKEFQDN, s);
  1651. end;
  1652. procedure TNetDbTest.TestDnsQueryTCP_CNAME;
  1653. var
  1654. fakeresp: TFakeDNSResponse;
  1655. qd: TQueryDataLengthTCP;
  1656. anslen, ansstart: Word;
  1657. RRArr: TRRNameDataArray;
  1658. s: TDNSDomainName;
  1659. begin
  1660. BuildFakeResponseCNAME(FAKEFQDN, fakeresp);
  1661. AssertTrue('Unable to convert fake dns response to querydata',
  1662. BuildQueryData(fakeresp, qd, anslen));
  1663. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  1664. ansstart := SkipAnsQueries(qd, anslen);
  1665. AssertEquals('Wrong number of CNAME records.', 1, qd.h.ancount);
  1666. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  1667. AssertEquals('Wrong number of resource records.', 1, Length(RRArr));
  1668. AssertEquals('RR 0 is not an CNAME RR.',DNSQRY_CNAME, RRarr[0].RRMeta.Atype);
  1669. AssertEquals('Wrong CNAME record name for RR 0', FAKEFQDN,
  1670. RRArr[0].RRName);
  1671. AssertTrue('Did not get RR CNAME data.', DNSRRGetCNAME(RRArr[0], qd.Payload, s));
  1672. AssertEquals('Wrong CNAME.', 'fakecname.'+FAKEFQDN, s);
  1673. end;
  1674. procedure TNetDbTest.TestDnsQueryCompressUDP_CNAME;
  1675. var
  1676. fakeresp: TFakeDNSResponse;
  1677. qd: TQueryDataLengthTCP;
  1678. anslen, ansstart: Word;
  1679. RRArr: TRRNameDataArray;
  1680. s: TDNSDomainName;
  1681. begin
  1682. BuildFakeResponseCNAME(FAKEFQDN, fakeresp);
  1683. AssertTrue('Unable to convert fake dns response to compressed querydata',
  1684. BuildQueryData(fakeresp, qd, anslen, True));
  1685. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  1686. ansstart := SkipAnsQueries(qd, anslen);
  1687. AssertEquals('Wrong number of CNAME records.', 1, qd.h.ancount);
  1688. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  1689. AssertEquals('Wrong number of resource records.', 1, Length(RRArr));
  1690. AssertEquals('RR 0 is not an CNAME RR.',DNSQRY_CNAME, RRarr[0].RRMeta.Atype);
  1691. AssertEquals('Wrong CNAME record name for RR 0', FAKEFQDN,
  1692. RRArr[0].RRName);
  1693. AssertTrue('Did not get RR CNAME data.', DNSRRGetCNAME(RRArr[0], qd.Payload, s));
  1694. AssertEquals('Wrong CNAME.', 'fakecname.'+FAKEFQDN, s);
  1695. end;
  1696. procedure TNetDbTest.TestDnsQueryCompressTCP_CNAME;
  1697. var
  1698. fakeresp: TFakeDNSResponse;
  1699. qd: TQueryDataLengthTCP;
  1700. anslen, ansstart: Word;
  1701. RRArr: TRRNameDataArray;
  1702. s: TDNSDomainName;
  1703. begin
  1704. BuildFakeResponseCNAME(FAKEFQDN, fakeresp);
  1705. AssertTrue('Unable to convert fake dns response to compressed querydata',
  1706. BuildQueryData(fakeresp, qd, anslen, True));
  1707. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  1708. ansstart := SkipAnsQueries(qd, anslen);
  1709. AssertEquals('Wrong number of CNAME records.', 1, qd.h.ancount);
  1710. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  1711. AssertEquals('Wrong number of resource records.', 1, Length(RRArr));
  1712. AssertEquals('RR 0 is not an CNAME RR.',DNSQRY_CNAME, RRarr[0].RRMeta.Atype);
  1713. AssertEquals('Wrong CNAME record name for RR 0', FAKEFQDN,
  1714. RRArr[0].RRName);
  1715. AssertTrue('Did not get RR CNAME data.', DNSRRGetCNAME(RRArr[0], qd.Payload,
  1716. s));
  1717. AssertEquals('Wrong CNAME.', 'fakecname.'+FAKEFQDN, s);
  1718. end;
  1719. procedure TNetDbTest.TestDnsQueryUDP_NS;
  1720. var
  1721. fakeresp: TFakeDNSResponse;
  1722. qd: TQueryData;
  1723. anslen, ansstart: Word;
  1724. RRArr: TRRNameDataArray;
  1725. s: TDNSDomainName;
  1726. begin
  1727. BuildFakeResponseNS(FAKEFQDN, fakeresp);
  1728. AssertTrue('Unable to convert fake dns response to querydata',
  1729. BuildQueryData(fakeresp, qd, anslen));
  1730. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  1731. ansstart := SkipAnsQueries(qd, anslen);
  1732. AssertEquals('Wrong number of NS records.', 1, qd.h.ancount);
  1733. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  1734. AssertEquals('Wrong number of resource records.', 1, Length(RRArr));
  1735. AssertEquals('RR 0 is not an NS RR.',DNSQRY_NS, RRarr[0].RRMeta.Atype);
  1736. AssertEquals('Wrong NS record name for RR 0', FAKEFQDN,
  1737. RRArr[0].RRName);
  1738. AssertTrue('Did not get RR NS data.', DNSRRGetNS(RRArr[0], qd.Payload, s));
  1739. AssertEquals('Wrong NS.', 'fakens.'+FAKEFQDN, s);
  1740. end;
  1741. procedure TNetDbTest.TestDnsQueryTCP_NS;
  1742. var
  1743. fakeresp: TFakeDNSResponse;
  1744. qd: TQueryDataLengthTCP;
  1745. anslen, ansstart: Word;
  1746. RRArr: TRRNameDataArray;
  1747. s: TDNSDomainName;
  1748. begin
  1749. BuildFakeResponseNS(FAKEFQDN, fakeresp);
  1750. AssertTrue('Unable to convert fake dns response to querydata',
  1751. BuildQueryData(fakeresp, qd, anslen));
  1752. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  1753. ansstart := SkipAnsQueries(qd, anslen);
  1754. AssertEquals('Wrong number of NS records.', 1, qd.h.ancount);
  1755. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  1756. AssertEquals('Wrong number of resource records.', 1, Length(RRArr));
  1757. AssertEquals('RR 0 is not an NS RR.',DNSQRY_NS, RRarr[0].RRMeta.Atype);
  1758. AssertEquals('Wrong NS record name for RR 0', FAKEFQDN,
  1759. RRArr[0].RRName);
  1760. AssertTrue('Did not get RR NS data.', DNSRRGetNS(RRArr[0], qd.Payload, s));
  1761. AssertEquals('Wrong NS.', 'fakens.'+FAKEFQDN, s);
  1762. end;
  1763. procedure TNetDbTest.TestDnsQueryCompressUDP_NS;
  1764. var
  1765. fakeresp: TFakeDNSResponse;
  1766. qd: TQueryData;
  1767. anslen, ansstart: Word;
  1768. RRArr: TRRNameDataArray;
  1769. s: TDNSDomainName;
  1770. begin
  1771. BuildFakeResponseNS(FAKEFQDN, fakeresp);
  1772. AssertTrue('Unable to convert fake dns response to compressed querydata',
  1773. BuildQueryData(fakeresp, qd, anslen, True));
  1774. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  1775. ansstart := SkipAnsQueries(qd, anslen);
  1776. AssertEquals('Wrong number of NS records.', 1, qd.h.ancount);
  1777. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  1778. AssertEquals('Wrong number of resource records.', 1, Length(RRArr));
  1779. AssertEquals('RR 0 is not an NS RR.',DNSQRY_NS, RRarr[0].RRMeta.Atype);
  1780. AssertEquals('Wrong NS record name for RR 0', FAKEFQDN,
  1781. RRArr[0].RRName);
  1782. AssertTrue('Did not get RR NS data.', DNSRRGetNS(RRArr[0], qd.Payload, s));
  1783. AssertEquals('Wrong NS.', 'fakens.'+FAKEFQDN, s);
  1784. end;
  1785. procedure TNetDbTest.TestDnsQueryCompressTCP_NS;
  1786. var
  1787. fakeresp: TFakeDNSResponse;
  1788. qd: TQueryDataLengthTCP;
  1789. anslen, ansstart: Word;
  1790. RRArr: TRRNameDataArray;
  1791. s: TDNSDomainName;
  1792. begin
  1793. BuildFakeResponseNS(FAKEFQDN, fakeresp);
  1794. AssertTrue('Unable to convert fake dns response to compressed querydata',
  1795. BuildQueryData(fakeresp, qd, anslen, True));
  1796. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  1797. ansstart := SkipAnsQueries(qd, anslen);
  1798. AssertEquals('Wrong number of NS records.', 1, qd.h.ancount);
  1799. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  1800. AssertEquals('Wrong number of resource records.', 1, Length(RRArr));
  1801. AssertEquals('RR 0 is not an NS RR.',DNSQRY_NS, RRarr[0].RRMeta.Atype);
  1802. AssertEquals('Wrong NS record name for RR 0', FAKEFQDN,
  1803. RRArr[0].RRName);
  1804. AssertTrue('Did not get RR NS data.', DNSRRGetNS(RRArr[0], qd.Payload, s));
  1805. AssertEquals('Wrong NS.', 'fakens.'+FAKEFQDN, s);
  1806. end;
  1807. procedure TNetDbTest.TestDnsQueryUDP_PTR;
  1808. var
  1809. fakeresp: TFakeDNSResponse;
  1810. qd: TQueryData;
  1811. anslen, ansstart: Word;
  1812. RRArr: TRRNameDataArray;
  1813. s: TDNSDomainName;
  1814. begin
  1815. // the str passed in to this function doesn't really matter, but using
  1816. // a proper in-addr.arpa domain helps keep it clear what we're testing.
  1817. BuildFakeResponsePTR('0.5.0.127.in-addr.arpa', fakeresp);
  1818. AssertTrue('Unable to convert fake dns response to querydata',
  1819. BuildQueryData(fakeresp, qd, anslen));
  1820. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  1821. ansstart := SkipAnsQueries(qd, anslen);
  1822. AssertEquals('Wrong number of PTR records.', 1, qd.h.ancount);
  1823. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  1824. AssertEquals('Wrong number of resource records.', 1, Length(RRArr));
  1825. AssertEquals('RR 0 is not an PTR RR.',DNSQRY_PTR, RRarr[0].RRMeta.Atype);
  1826. AssertEquals('Wrong PTR record name for RR 0', '0.5.0.127.in-addr.arpa',
  1827. RRArr[0].RRName);
  1828. AssertTrue('Did not get RR PTR data.', DNSRRGetPTR(RRArr[0], qd.Payload, s));
  1829. AssertEquals('Wrong PTR.', 'fakeptrans.'+FAKEFQDN, s);
  1830. end;
  1831. procedure TNetDbTest.TestDnsQueryTCP_PTR;
  1832. var
  1833. fakeresp: TFakeDNSResponse;
  1834. qd: TQueryDataLengthTCP;
  1835. anslen, ansstart: Word;
  1836. RRArr: TRRNameDataArray;
  1837. s: TDNSDomainName;
  1838. begin
  1839. // the str passed in to this function doesn't really matter, but using
  1840. // a proper in-addr.arpa domain helps keep it clear what we're testing.
  1841. BuildFakeResponsePTR('0.5.0.127.in-addr.arpa', fakeresp);
  1842. AssertTrue('Unable to convert fake dns response to querydata',
  1843. BuildQueryData(fakeresp, qd, anslen));
  1844. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  1845. ansstart := SkipAnsQueries(qd, anslen);
  1846. AssertEquals('Wrong number of PTR records.', 1, qd.h.ancount);
  1847. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  1848. AssertEquals('Wrong number of resource records.', 1, Length(RRArr));
  1849. AssertEquals('RR 0 is not an PTR RR.',DNSQRY_PTR, RRarr[0].RRMeta.Atype);
  1850. AssertEquals('Wrong PTR record name for RR 0', '0.5.0.127.in-addr.arpa',
  1851. RRArr[0].RRName);
  1852. AssertTrue('Did not get RR PTR data.', DNSRRGetPTR(RRArr[0], qd.Payload, s));
  1853. AssertEquals('Wrong PTR.', 'fakeptrans.'+FAKEFQDN, s);
  1854. end;
  1855. procedure TNetDbTest.TestDnsQueryCompressUDP_PTR;
  1856. var
  1857. fakeresp: TFakeDNSResponse;
  1858. qd: TQueryData;
  1859. anslen, ansstart: Word;
  1860. RRArr: TRRNameDataArray;
  1861. s: TDNSDomainName;
  1862. begin
  1863. // the str passed in to this function doesn't really matter, but using
  1864. // a proper in-addr.arpa domain helps keep it clear what we're testing.
  1865. BuildFakeResponsePTR('0.5.0.127.in-addr.arpa', fakeresp);
  1866. AssertTrue('Unable to convert fake dns response to compressed querydata',
  1867. BuildQueryData(fakeresp, qd, anslen, True));
  1868. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  1869. ansstart := SkipAnsQueries(qd, anslen);
  1870. AssertEquals('Wrong number of PTR records.', 1, qd.h.ancount);
  1871. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  1872. AssertEquals('Wrong number of resource records.', 1, Length(RRArr));
  1873. AssertEquals('RR 0 is not an PTR RR.',DNSQRY_PTR, RRarr[0].RRMeta.Atype);
  1874. AssertEquals('Wrong PTR record name for RR 0', '0.5.0.127.in-addr.arpa',
  1875. RRArr[0].RRName);
  1876. AssertTrue('Did not get RR PTR data.', DNSRRGetPTR(RRArr[0], qd.Payload, s));
  1877. AssertEquals('Wrong PTR.', 'fakeptrans.'+FAKEFQDN, s);
  1878. end;
  1879. procedure TNetDbTest.TestDnsQueryCompressTCP_PTR;
  1880. var
  1881. fakeresp: TFakeDNSResponse;
  1882. qd: TQueryDataLengthTCP;
  1883. anslen, ansstart: Word;
  1884. RRArr: TRRNameDataArray;
  1885. s: TDNSDomainName;
  1886. begin
  1887. // the str passed in to this function doesn't really matter, but using
  1888. // a proper in-addr.arpa domain helps keep it clear what we're testing.
  1889. BuildFakeResponsePTR('0.5.0.127.in-addr.arpa', fakeresp);
  1890. AssertTrue('Unable to convert fake dns response to compressed querydata',
  1891. BuildQueryData(fakeresp, qd, anslen, True));
  1892. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  1893. ansstart := SkipAnsQueries(qd, anslen);
  1894. AssertEquals('Wrong number of PTR records.', 1, qd.h.ancount);
  1895. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  1896. AssertEquals('Wrong number of resource records.', 1, Length(RRArr));
  1897. AssertEquals('RR 0 is not an PTR RR.',DNSQRY_PTR, RRarr[0].RRMeta.Atype);
  1898. AssertEquals('Wrong PTR record name for RR 0', '0.5.0.127.in-addr.arpa',
  1899. RRArr[0].RRName);
  1900. AssertTrue('Did not get RR PTR data.', DNSRRGetPTR(RRArr[0], qd.Payload, s));
  1901. AssertEquals('Wrong PTR.', 'fakeptrans.'+FAKEFQDN, s);
  1902. end;
  1903. procedure TNetDbTest.TestDnsQueryUDP_TXT;
  1904. var
  1905. fakeresp: TFakeDNSResponse;
  1906. qd: TQueryData;
  1907. anslen, ansstart: Word;
  1908. RRArr: TRRNameDataArray;
  1909. s: AnsiString;
  1910. begin
  1911. s := '';
  1912. BuildFakeResponseTXT(FAKEFQDN, fakeresp);
  1913. AssertTrue('Unable to convert fake dns response to querydata',
  1914. BuildQueryData(fakeresp, qd, anslen));
  1915. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  1916. ansstart := SkipAnsQueries(qd, anslen);
  1917. AssertEquals('Wrong number of TXT records.', 1, qd.h.ancount);
  1918. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  1919. AssertEquals('Wrong number of resource records.', 1, Length(RRArr));
  1920. AssertEquals('RR 0 is not a TXT RR.',DNSQRY_TXT, RRarr[0].RRMeta.Atype);
  1921. AssertEquals('Wrong TXT record name for RR 0', FAKEFQDN,
  1922. RRArr[0].RRName);
  1923. AssertTrue('Did not get RR TXT data.', DNSRRGetText(RRArr[0], qd.Payload, s));
  1924. AssertEquals(
  1925. 'v=spf1 mx a:lists.'+FAKEFQDN+'Always look on the bright side of life!',
  1926. s);
  1927. end;
  1928. procedure TNetDbTest.TestDnsQueryTCP_TXT;
  1929. var
  1930. fakeresp: TFakeDNSResponse;
  1931. qd: TQueryDataLengthTCP;
  1932. anslen, ansstart: Word;
  1933. RRArr: TRRNameDataArray;
  1934. s: AnsiString;
  1935. begin
  1936. s := '';
  1937. BuildFakeResponseTXT(FAKEFQDN, fakeresp);
  1938. AssertTrue('Unable to convert fake dns response to querydata',
  1939. BuildQueryData(fakeresp, qd, anslen));
  1940. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  1941. ansstart := SkipAnsQueries(qd, anslen);
  1942. AssertEquals('Wrong number of TXT records.', 1, qd.h.ancount);
  1943. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  1944. AssertEquals('Wrong number of resource records.', 1, Length(RRArr));
  1945. AssertEquals('RR 0 is not a TXT RR.',DNSQRY_TXT, RRarr[0].RRMeta.Atype);
  1946. AssertEquals('Wrong TXT record name for RR 0', FAKEFQDN,
  1947. RRArr[0].RRName);
  1948. AssertTrue('Did not get RR TXT data.', DNSRRGetText(RRArr[0], qd.Payload, s));
  1949. AssertEquals(
  1950. 'v=spf1 mx a:lists.'+FAKEFQDN+'Always look on the bright side of life!',
  1951. s);
  1952. end;
  1953. procedure TNetDbTest.TestDnsQueryCompressUDP_TXT;
  1954. var
  1955. fakeresp: TFakeDNSResponse;
  1956. qd: TQueryData;
  1957. anslen, ansstart: Word;
  1958. RRArr: TRRNameDataArray;
  1959. s: AnsiString;
  1960. begin
  1961. s := '';
  1962. BuildFakeResponseTXT(FAKEFQDN, fakeresp);
  1963. AssertTrue('Unable to convert fake dns response to compressed querydata',
  1964. BuildQueryData(fakeresp, qd, anslen, True));
  1965. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  1966. ansstart := SkipAnsQueries(qd, anslen);
  1967. AssertEquals('Wrong number of TXT records.', 1, qd.h.ancount);
  1968. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  1969. AssertEquals('Wrong number of resource records.', 1, Length(RRArr));
  1970. AssertEquals('RR 0 is not a TXT RR.',DNSQRY_TXT, RRarr[0].RRMeta.Atype);
  1971. AssertEquals('Wrong TXT record name for RR 0', FAKEFQDN,
  1972. RRArr[0].RRName);
  1973. AssertTrue('Did not get RR TXT data.', DNSRRGetText(RRArr[0], qd.Payload, s));
  1974. AssertEquals(
  1975. 'v=spf1 mx a:lists.'+FAKEFQDN+'Always look on the bright side of life!',
  1976. s);
  1977. end;
  1978. procedure TNetDbTest.TestDnsQueryCompressTCP_TXT;
  1979. var
  1980. fakeresp: TFakeDNSResponse;
  1981. qd: TQueryDataLengthTCP;
  1982. anslen, ansstart: Word;
  1983. RRArr: TRRNameDataArray;
  1984. s: AnsiString;
  1985. begin
  1986. s := '';
  1987. BuildFakeResponseTXT(FAKEFQDN, fakeresp);
  1988. AssertTrue('Unable to convert fake dns response to compressed querydata',
  1989. BuildQueryData(fakeresp, qd, anslen, True));
  1990. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  1991. ansstart := SkipAnsQueries(qd, anslen);
  1992. AssertEquals('Wrong number of TXT records.', 1, qd.h.ancount);
  1993. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  1994. AssertEquals('Wrong number of resource records.', 1, Length(RRArr));
  1995. AssertEquals('RR 0 is not a TXT RR.',DNSQRY_TXT, RRarr[0].RRMeta.Atype);
  1996. AssertEquals('Wrong TXT record name for RR 0', FAKEFQDN,
  1997. RRArr[0].RRName);
  1998. AssertTrue('Did not get RR TXT data.', DNSRRGetText(RRArr[0], qd.Payload, s));
  1999. AssertEquals(
  2000. 'v=spf1 mx a:lists.'+FAKEFQDN+'Always look on the bright side of life!',
  2001. s);
  2002. end;
  2003. procedure TNetDbTest.TestDnsQueryUDP_SRV;
  2004. var
  2005. fakeresp: TFakeDNSResponse;
  2006. qd: TQueryData;
  2007. anslen, ansstart: Word;
  2008. RRArr: TRRNameDataArray;
  2009. srvrec: TDNSRR_SRV;
  2010. begin
  2011. BuildFakeResponseSRV(FAKEFQDN, fakeresp);
  2012. AssertTrue('Unable to convert fake dns response to querydata',
  2013. BuildQueryData(fakeresp, qd, anslen));
  2014. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  2015. ansstart := SkipAnsQueries(qd, anslen);
  2016. AssertEquals('Wrong number of SRV records.', 1, qd.h.ancount);
  2017. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  2018. AssertEquals('Wrong number of resource records.', 1, Length(RRArr));
  2019. AssertEquals('RR 0 is not an SRV RR.',DNSQRY_SRV, RRarr[0].RRMeta.Atype);
  2020. AssertEquals('Wrong record name for RR 0', FAKEFQDN,
  2021. RRArr[0].RRName);
  2022. AssertTrue('Did not get RR SRV data.', DNSRRGetSRV(RRArr[0], qd.Payload,
  2023. srvrec));
  2024. AssertEquals('Wrong SRV priority', 22, srvrec.priority);
  2025. AssertEquals('Wrong SRV weight', 44, srvrec.weight);
  2026. AssertEquals('Wrong SRV port', 2201, srvrec.port);
  2027. AssertEquals('Wrong SRV hostname', '_this._that._other', srvrec.target);
  2028. end;
  2029. procedure TNetDbTest.TestDnsQueryTCP_SRV;
  2030. var
  2031. fakeresp: TFakeDNSResponse;
  2032. qd: TQueryDataLengthTCP;
  2033. anslen, ansstart: Word;
  2034. RRArr: TRRNameDataArray;
  2035. srvrec: TDNSRR_SRV;
  2036. begin
  2037. BuildFakeResponseSRV(FAKEFQDN, fakeresp);
  2038. AssertTrue('Unable to convert fake dns response to querydata',
  2039. BuildQueryData(fakeresp, qd, anslen));
  2040. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  2041. ansstart := SkipAnsQueries(qd, anslen);
  2042. AssertEquals('Wrong number of SRV records.', 1, qd.h.ancount);
  2043. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  2044. AssertEquals('Wrong number of resource records.', 1, Length(RRArr));
  2045. AssertEquals('RR 0 is not an SRV RR.',DNSQRY_SRV, RRarr[0].RRMeta.Atype);
  2046. AssertEquals('Wrong record name for RR 0', FAKEFQDN,
  2047. RRArr[0].RRName);
  2048. AssertTrue('Did not get RR SOA data.', DNSRRGetSRV(RRArr[0], qd.Payload,
  2049. srvrec));
  2050. AssertEquals('Wrong SRV priority', 22, srvrec.priority);
  2051. AssertEquals('Wrong SRV weight', 44, srvrec.weight);
  2052. AssertEquals('Wrong SRV port', 2201, srvrec.port);
  2053. AssertEquals('Wrong SRV hostname', '_this._that._other', srvrec.target);
  2054. end;
  2055. procedure TNetDbTest.TestDnsQueryCompressUDP_SRV;
  2056. var
  2057. fakeresp: TFakeDNSResponse;
  2058. qd: TQueryData;
  2059. anslen, ansstart: Word;
  2060. RRArr: TRRNameDataArray;
  2061. srvrec: TDNSRR_SRV;
  2062. begin
  2063. BuildFakeResponseSRV(FAKEFQDN, fakeresp);
  2064. AssertTrue('Unable to convert fake dns response to compressed querydata',
  2065. BuildQueryData(fakeresp, qd, anslen, True));
  2066. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  2067. ansstart := SkipAnsQueries(qd, anslen);
  2068. AssertEquals('Wrong number of SRV records.', 1, qd.h.ancount);
  2069. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  2070. AssertEquals('Wrong number of resource records.', 1, Length(RRArr));
  2071. AssertEquals('RR 0 is not an SRV RR.',DNSQRY_SRV, RRarr[0].RRMeta.Atype);
  2072. AssertEquals('Wrong record name for RR 0', FAKEFQDN,
  2073. RRArr[0].RRName);
  2074. AssertTrue('Did not get RR SRV data.', DNSRRGetSRV(RRArr[0], qd.Payload,
  2075. srvrec));
  2076. AssertEquals('Wrong SRV priority', 22, srvrec.priority);
  2077. AssertEquals('Wrong SRV weight', 44, srvrec.weight);
  2078. AssertEquals('Wrong SRV port', 2201, srvrec.port);
  2079. AssertEquals('Wrong SRV hostname', '_this._that._other', srvrec.target);
  2080. end;
  2081. procedure TNetDbTest.TestDnsQueryCompressTCP_SRV;
  2082. var
  2083. fakeresp: TFakeDNSResponse;
  2084. qd: TQueryDataLengthTCP;
  2085. anslen, ansstart: Word;
  2086. RRArr: TRRNameDataArray;
  2087. srvrec: TDNSRR_SRV;
  2088. begin
  2089. BuildFakeResponseSRV(FAKEFQDN, fakeresp);
  2090. AssertTrue('Unable to convert fake dns response to compressed querydata',
  2091. BuildQueryData(fakeresp, qd, anslen, True));
  2092. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  2093. ansstart := SkipAnsQueries(qd, anslen);
  2094. AssertEquals('Wrong number of SRV records.', 1, qd.h.ancount);
  2095. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  2096. AssertEquals('Wrong number of resource records.', 1, Length(RRArr));
  2097. AssertEquals('RR 0 is not an SRV RR.',DNSQRY_SRV, RRarr[0].RRMeta.Atype);
  2098. AssertEquals('Wrong record name for RR 0', FAKEFQDN,
  2099. RRArr[0].RRName);
  2100. AssertTrue('Did not get RR SOA data.', DNSRRGetSRV(RRArr[0], qd.Payload,
  2101. srvrec));
  2102. AssertEquals('Wrong SRV priority', 22, srvrec.priority);
  2103. AssertEquals('Wrong SRV weight', 44, srvrec.weight);
  2104. AssertEquals('Wrong SRV port', 2201, srvrec.port);
  2105. AssertEquals('Wrong SRV hostname', '_this._that._other', srvrec.target);
  2106. end;
  2107. {
  2108. This test is of debatable value, as it only detects truncation if the buffer
  2109. contents are zeroed which gives an invalid RR type.
  2110. }
  2111. procedure TNetDbTest.TestDnsQueryTruncateRR_UDP_A;
  2112. var
  2113. fakeresp: TFakeDNSResponse;
  2114. qd: TQueryData;
  2115. anslen, ansstart: Word;
  2116. RRArr: TRRNameDataArray;
  2117. begin
  2118. BuildFakeResponseA(FAKEFQDN, fakeresp);
  2119. AssertTrue('Unable to convert fake dns response to querydata',
  2120. BuildTruncatedQueryData(fakeresp, qd, anslen,40));
  2121. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  2122. ansstart := SkipAnsQueries(qd, anslen);
  2123. // the header says there are 2 A records, but it's a trap!
  2124. AssertEquals('Wrong number of A records.', 2, qd.h.ancount);
  2125. // truncation of buffer means this call returns 0 RRs.
  2126. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  2127. AssertEquals('Wrong number of RRs', 0, Length(RRArr));
  2128. end;
  2129. procedure TNetDbTest.TestDnsRRBufferEdgeA;
  2130. var
  2131. fakeresp: TFakeDNSResponse;
  2132. qd: TQueryData;
  2133. anslen, ansstart: Word;
  2134. RRArr: TRRNameDataArray;
  2135. ip: THostAddr;
  2136. begin
  2137. BuildFakeResponseA(FAKEFQDN, fakeresp);
  2138. AssertTrue('Unable to convert fake dns response to querydata',
  2139. BuildQueryData(fakeresp, qd, anslen));
  2140. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  2141. ansstart := SkipAnsQueries(qd, anslen);
  2142. AssertEquals('Wrong number of A records.', 2, qd.h.ancount);
  2143. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  2144. // Change start position for RR[0] to end of buffer - 4
  2145. RRArr[0].RDataSt := Length(qd.Payload) - RRArr[0].RRMeta.RDLength;
  2146. qd.Payload[Length(qd.Payload)-1] := $AA; // sentinel marker we can look for
  2147. AssertTrue('Did not get RR A data.', DNSRRGetA(RRArr[0], qd.Payload, ip));
  2148. AssertEquals('Wrong ip for A.', '0.0.0.170', HostAddrToStr(ip));
  2149. end;
  2150. procedure TNetDbTest.TestDnsRRBufferPastEdgeA;
  2151. var
  2152. fakeresp: TFakeDNSResponse;
  2153. qd: TQueryData;
  2154. anslen, ansstart: Word;
  2155. RRArr: TRRNameDataArray;
  2156. ip: THostAddr;
  2157. begin
  2158. BuildFakeResponseA(FAKEFQDN, fakeresp);
  2159. AssertTrue('Unable to convert fake dns response to querydata',
  2160. BuildQueryData(fakeresp, qd, anslen));
  2161. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  2162. ansstart := SkipAnsQueries(qd, anslen);
  2163. AssertEquals('Wrong number of A records.', 2, qd.h.ancount);
  2164. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  2165. // Change start position for RR[0] to end of buffer - 3
  2166. RRArr[0].RDataSt := Length(qd.Payload) - (RRArr[0].RRMeta.RDLength - 3);
  2167. AssertFalse('Got RR A data.', DNSRRGetA(RRArr[0], qd.Payload, ip));
  2168. end;
  2169. {
  2170. Test that we read the AAAA right at the buffer edge, with the last byte
  2171. being a special value we can test for.
  2172. }
  2173. procedure TNetDbTest.TestDnsRRBufferEdgeAAAA;
  2174. var
  2175. fakeresp: TFakeDNSResponse;
  2176. qd: TQueryData;
  2177. anslen, ansstart: Word;
  2178. RRArr: TRRNameDataArray;
  2179. ip: THostAddr6;
  2180. begin
  2181. BuildFakeResponseAAAA(FAKEFQDN, fakeresp);
  2182. AssertTrue('Unable to convert fake dns response to querydata',
  2183. BuildQueryData(fakeresp, qd, anslen));
  2184. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  2185. ansstart := SkipAnsQueries(qd, anslen);
  2186. AssertEquals('Wrong number of AAAA records.', 2, qd.h.ancount);
  2187. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  2188. // Change start position for RR[0]
  2189. RRArr[0].RDataSt := Length(qd.Payload) - SizeOf(THostAddr6);
  2190. qd.Payload[Length(qd.Payload)-1] := $AA;
  2191. AssertTrue('Got RR AAAA data.', DNSRRGetAAAA(RRArr[0], qd.Payload, ip));
  2192. AssertEquals($AA, ip.u6_addr8[15]);
  2193. end;
  2194. {
  2195. Attempt to read an AAAA that goes past the end of the buffer.
  2196. }
  2197. procedure TNetDbTest.TestDNsRRBufferPastEdgeAAAA;
  2198. var
  2199. fakeresp: TFakeDNSResponse;
  2200. qd: TQueryData;
  2201. anslen, ansstart: Word;
  2202. RRArr: TRRNameDataArray;
  2203. ip: THostAddr6;
  2204. begin
  2205. BuildFakeResponseAAAA(FAKEFQDN, fakeresp);
  2206. AssertTrue('Unable to convert fake dns response to querydata',
  2207. BuildQueryData(fakeresp, qd, anslen));
  2208. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  2209. ansstart := SkipAnsQueries(qd, anslen);
  2210. AssertEquals('Wrong number of AAAA records.', 2, qd.h.ancount);
  2211. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  2212. // Change start position for RR[0]. attempting to read 16 bytes
  2213. // from this position will pass the end of the buffer.
  2214. RRArr[0].RDataSt := Length(qd.Payload) - (SizeOf(THostAddr6)-1);
  2215. qd.Payload[Length(qd.Payload)-1] := $AA;
  2216. AssertFalse('Got RR AAAA data.', DNSRRGetAAAA(RRArr[0], qd.Payload, ip));
  2217. end;
  2218. {
  2219. Test reading an MX RR that terminates on the last byte of the buffer.
  2220. }
  2221. procedure TNetDbTest.TestDnsRRBufferEdgeMX;
  2222. var
  2223. fakeresp: TFakeDNSResponse;
  2224. qd: TQueryData;
  2225. anslen, ansstart, oldstart: Word;
  2226. RRArr: TRRNameDataArray;
  2227. fmx: TDNSRR_MX;
  2228. begin
  2229. BuildFakeResponseMX(FAKEFQDN, fakeresp);
  2230. AssertTrue('Unable to convert fake dns response to querydata',
  2231. BuildQueryData(fakeresp, qd, anslen));
  2232. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  2233. ansstart := SkipAnsQueries(qd, anslen);
  2234. AssertEquals('Wrong number of MX records.', 1, qd.h.ancount);
  2235. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  2236. // move the MX RR bytes to the end of the payload buffer.
  2237. oldstart := RRArr[0].RDataSt;
  2238. RRArr[0].RDataSt := Length(qd.Payload) - RRArr[0].RRMeta.RDLength;
  2239. CopyBytesTo(qd.Payload, oldstart, RRArr[0].RDataSt, RRArr[0].RRMeta.RDLength);
  2240. AssertTrue('Got RR MX data.', DNSRRGetMX(RRArr[0], qd.Payload, fmx));
  2241. AssertEquals('Wrong MX hostname', 'mailer.'+FAKEFQDN,
  2242. fmx.exchange);
  2243. AssertEquals('Wrong MX preference', 10, fmx.preference);
  2244. end;
  2245. procedure TNetDbTest.TestDnsRRBufferPastEdgeMX;
  2246. var
  2247. fakeresp: TFakeDNSResponse;
  2248. qd: TQueryData;
  2249. anslen, ansstart, oldstart: Word;
  2250. RRArr: TRRNameDataArray;
  2251. fmx: TDNSRR_MX;
  2252. begin
  2253. BuildFakeResponseMX(FAKEFQDN, fakeresp);
  2254. AssertTrue('Unable to convert fake dns response to querydata',
  2255. BuildQueryData(fakeresp, qd, anslen));
  2256. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  2257. ansstart := SkipAnsQueries(qd, anslen);
  2258. AssertEquals('Wrong number of MX records.', 1, qd.h.ancount);
  2259. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  2260. // move the MX RR bytes to the end of the payload buffer. We omit the last
  2261. // 2 bytes of the MX to attempt to trick the code into reading past the buffer
  2262. // edge.
  2263. oldstart := RRArr[0].RDataSt;
  2264. RRArr[0].RDataSt := Length(qd.Payload) - (RRArr[0].RRMeta.RDLength - 2);
  2265. CopyBytesTo(qd.Payload, oldstart, RRArr[0].RDataSt,
  2266. (RRArr[0].RRMeta.RDLength-2));
  2267. AssertTrue('Got RR MX data.', DNSRRGetMX(RRArr[0], qd.Payload, fmx));
  2268. // stringfromlabel should drop the last label, so the result should be just
  2269. // missing the tld.
  2270. AssertEquals('Wrong MX hostname', 'mailer.'+FAKEDOMAIN,
  2271. fmx.exchange);
  2272. AssertEquals('Wrong MX preference', 10, fmx.preference);
  2273. end;
  2274. procedure TNetDbTest.TestDnsRRBufferEdgeSOA;
  2275. var
  2276. fakeresp: TFakeDNSResponse;
  2277. qd: TQueryData;
  2278. anslen, ansstart, oldstart: Word;
  2279. RRArr: TRRNameDataArray;
  2280. soarec: TDNSRR_SOA;
  2281. begin
  2282. BuildFakeResponseSOA(FAKEFQDN, fakeresp);
  2283. AssertTrue('Unable to convert fake dns response to querydata',
  2284. BuildQueryData(fakeresp, qd, anslen));
  2285. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  2286. ansstart := SkipAnsQueries(qd, anslen);
  2287. AssertEquals('Wrong number of SOA records.', 1, qd.h.ancount);
  2288. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  2289. AssertEquals('Wrong number of resource records.', 1, Length(RRArr));
  2290. AssertEquals('RR 0 is not an SOA RR.',DNSQRY_SOA, RRarr[0].RRMeta.Atype);
  2291. // move the SOA RR bytes to the end of the payload buffer.
  2292. oldstart := RRArr[0].RDataSt;
  2293. RRArr[0].RDataSt := Length(qd.Payload) - RRArr[0].RRMeta.RDLength;
  2294. CopyBytesTo(qd.Payload, oldstart, RRArr[0].RDataSt, RRArr[0].RRMeta.RDLength);
  2295. AssertTrue('Did not get RR SOA data.', DNSRRGetSOA(RRArr[0], qd.Payload,
  2296. soarec));
  2297. AssertEquals('Wrong mname hostname', 'mn.'+FAKEFQDN,
  2298. soarec.mname);
  2299. AssertEquals('Wrong rname hostname', 'rn.'+FAKEFQDN,
  2300. soarec.rname);
  2301. AssertEquals('Wrong SOA serial', 76543210, soarec.serial);
  2302. AssertEquals('Wrong SOA refresh', 123, soarec.refresh);
  2303. AssertEquals('Wrong SOA retry', 456, soarec.retry);
  2304. AssertEquals('Wrong SOA expire', 789, soarec.expire);
  2305. AssertEquals('Wrong SOA min', 60, soarec.min);
  2306. end;
  2307. procedure TNetDbTest.TestDnsRRBufferPastEdgeSOA;
  2308. var
  2309. fakeresp: TFakeDNSResponse;
  2310. qd: TQueryData;
  2311. anslen, ansstart, oldstart: Word;
  2312. RRArr: TRRNameDataArray;
  2313. soarec: TDNSRR_SOA;
  2314. begin
  2315. BuildFakeResponseSOA(FAKEFQDN, fakeresp);
  2316. AssertTrue('Unable to convert fake dns response to querydata',
  2317. BuildQueryData(fakeresp, qd, anslen));
  2318. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  2319. ansstart := SkipAnsQueries(qd, anslen);
  2320. AssertEquals('Wrong number of SOA records.', 1, qd.h.ancount);
  2321. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  2322. AssertEquals('Wrong number of resource records.', 1, Length(RRArr));
  2323. AssertEquals('RR 0 is not an SOA RR.',DNSQRY_SOA, RRarr[0].RRMeta.Atype);
  2324. // move the SOA RR bytes to the end of the payload buffer.
  2325. oldstart := RRArr[0].RDataSt;
  2326. RRArr[0].RDataSt := Length(qd.Payload) - (RRArr[0].RRMeta.RDLength-1);
  2327. CopyBytesTo(qd.Payload, oldstart, RRArr[0].RDataSt,
  2328. (RRArr[0].RRMeta.RDLength-1));
  2329. AssertFalse('Got RR SOA data.', DNSRRGetSOA(RRArr[0], qd.Payload,
  2330. soarec));
  2331. end;
  2332. procedure TNetDbTest.TestDnsRRBufferEdgeSRV;
  2333. var
  2334. fakeresp: TFakeDNSResponse;
  2335. qd: TQueryData;
  2336. anslen, ansstart, oldstart: Word;
  2337. RRArr: TRRNameDataArray;
  2338. srvrec: TDNSRR_SRV;
  2339. begin
  2340. BuildFakeResponseSRV(FAKEFQDN, fakeresp);
  2341. AssertTrue('Unable to convert fake dns response to querydata',
  2342. BuildQueryData(fakeresp, qd, anslen));
  2343. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  2344. ansstart := SkipAnsQueries(qd, anslen);
  2345. AssertEquals('Wrong number of SRV records.', 1, qd.h.ancount);
  2346. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  2347. AssertEquals('Wrong number of resource records.', 1, Length(RRArr));
  2348. AssertEquals('RR 0 is not an SRV RR.',DNSQRY_SRV, RRarr[0].RRMeta.Atype);
  2349. // move the SRV RR bytes to the end of the payload buffer.
  2350. oldstart := RRArr[0].RDataSt;
  2351. RRArr[0].RDataSt := Length(qd.Payload) - RRArr[0].RRMeta.RDLength;
  2352. CopyBytesTo(qd.Payload, oldstart, RRArr[0].RDataSt, RRArr[0].RRMeta.RDLength);
  2353. AssertTrue('Did not get RR SRV data.', DNSRRGetSRV(RRArr[0], qd.Payload,
  2354. srvrec));
  2355. AssertEquals('Wrong SRV priority', 22, srvrec.priority);
  2356. AssertEquals('Wrong SRV weight', 44, srvrec.weight);
  2357. AssertEquals('Wrong SRV port', 2201, srvrec.port);
  2358. AssertEquals('Wrong SRV hostname', '_this._that._other', srvrec.target);
  2359. end;
  2360. procedure TNetDbTest.TestDnsRRBufferPastEdgeSRV;
  2361. var
  2362. fakeresp: TFakeDNSResponse;
  2363. qd: TQueryData;
  2364. anslen, ansstart, oldstart: Word;
  2365. RRArr: TRRNameDataArray;
  2366. srvrec: TDNSRR_SRV;
  2367. begin
  2368. BuildFakeResponseSRV(FAKEFQDN, fakeresp);
  2369. AssertTrue('Unable to convert fake dns response to querydata',
  2370. BuildQueryData(fakeresp, qd, anslen));
  2371. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  2372. ansstart := SkipAnsQueries(qd, anslen);
  2373. AssertEquals('Wrong number of SRV records.', 1, qd.h.ancount);
  2374. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  2375. AssertEquals('Wrong number of resource records.', 1, Length(RRArr));
  2376. AssertEquals('RR 0 is not an SRV RR.',DNSQRY_SRV, RRarr[0].RRMeta.Atype);
  2377. // move the SRV RR bytes to the end of the payload buffer. ensure that
  2378. // we're one byte short to try and trick the code into reading past the
  2379. // end of the buffer.
  2380. oldstart := RRArr[0].RDataSt;
  2381. RRArr[0].RDataSt := Length(qd.Payload) - (RRArr[0].RRMeta.RDLength - 1);
  2382. CopyBytesTo(qd.Payload, oldstart, RRArr[0].RDataSt,
  2383. (RRArr[0].RRMeta.RDLength - 1));
  2384. AssertFalse('Got RR SRV data.', DNSRRGetSRV(RRArr[0], qd.Payload,
  2385. srvrec));
  2386. end;
  2387. procedure TNetDbTest.TestDnsRRBufferEdgeCNAME;
  2388. var
  2389. fakeresp: TFakeDNSResponse;
  2390. qd: TQueryData;
  2391. anslen, ansstart, oldstart: Word;
  2392. RRArr: TRRNameDataArray;
  2393. s: TDNSDomainName;
  2394. begin
  2395. BuildFakeResponseCNAME(FAKEFQDN, fakeresp);
  2396. AssertTrue('Unable to convert fake dns response to querydata',
  2397. BuildQueryData(fakeresp, qd, anslen));
  2398. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  2399. ansstart := SkipAnsQueries(qd, anslen);
  2400. AssertEquals('Wrong number of CNAME records.', 1, qd.h.ancount);
  2401. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  2402. AssertEquals('Wrong number of resource records.', 1, Length(RRArr));
  2403. AssertEquals('RR 0 is not an CNAME RR.',DNSQRY_CNAME, RRarr[0].RRMeta.Atype);
  2404. // move the cname to the end of the buffer.
  2405. oldstart := RRArr[0].RDataSt;
  2406. RRArr[0].RDataSt := Length(qd.Payload) - RRArr[0].RRMeta.RDLength;
  2407. CopyBytesTo(qd.Payload, oldstart, RRArr[0].RDataSt, RRArr[0].RRMeta.RDLength);
  2408. AssertTrue('Did not get RR CNAME data.', DNSRRGetCNAME(RRArr[0], qd.Payload, s));
  2409. AssertEquals('Wrong CNAME.', 'fakecname.'+FAKEFQDN, s);
  2410. end;
  2411. {
  2412. Test retrieving a cname when the actual string is longer than rdlength says it
  2413. is. The bytes in the payload buffer try to point past the end of the buffer.
  2414. }
  2415. procedure TNetDbTest.TestDnsRRBufferPastEdgeCNAME;
  2416. var
  2417. fakeresp: TFakeDNSResponse;
  2418. qd: TQueryData;
  2419. anslen, ansstart, oldstart: Word;
  2420. RRArr: TRRNameDataArray;
  2421. s: TDNSDomainName;
  2422. begin
  2423. BuildFakeResponseCNAME(FAKEFQDN, fakeresp);
  2424. AssertTrue('Unable to convert fake dns response to querydata',
  2425. BuildQueryData(fakeresp, qd, anslen));
  2426. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  2427. ansstart := SkipAnsQueries(qd, anslen);
  2428. AssertEquals('Wrong number of CNAME records.', 1, qd.h.ancount);
  2429. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  2430. AssertEquals('Wrong number of resource records.', 1, Length(RRArr));
  2431. AssertEquals('RR 0 is not an CNAME RR.',DNSQRY_CNAME, RRarr[0].RRMeta.Atype);
  2432. // move the cname to the end of the buffer. we drop two bytes off the end of
  2433. // the cname, because there's a 0 byte at the end of a label if not a ptr.
  2434. // now, the last label's size is greater than the number of bytes left in
  2435. // the buffer.
  2436. oldstart := RRArr[0].RDataSt;
  2437. RRArr[0].RDataSt := Length(qd.Payload) - (RRArr[0].RRMeta.RDLength-2);
  2438. CopyBytesTo(qd.Payload, oldstart, RRArr[0].RDataSt,
  2439. (RRArr[0].RRMeta.RDLength-2));
  2440. // lie about the rdlength too!
  2441. Dec(RRArr[0].RRMeta.RDLength,2);
  2442. AssertTrue('Did not get RR CNAME data.', DNSRRGetCNAME(RRArr[0], qd.Payload, s));
  2443. // last label will get removed, leaving just the domain part.
  2444. AssertEquals('Wrong CNAME.', 'fakecname.'+FAKEDOMAIN, s);
  2445. end;
  2446. {
  2447. Test retrieving an NS RR when it's at the end of the payload buffer.
  2448. }
  2449. procedure TNetDbTest.TestDnsRRBufferEdgeNS;
  2450. var
  2451. fakeresp: TFakeDNSResponse;
  2452. qd: TQueryData;
  2453. anslen, ansstart, oldstart: Word;
  2454. RRArr: TRRNameDataArray;
  2455. s: TDNSDomainName;
  2456. begin
  2457. BuildFakeResponseNS(FAKEFQDN, fakeresp);
  2458. AssertTrue('Unable to convert fake dns response to querydata',
  2459. BuildQueryData(fakeresp, qd, anslen));
  2460. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  2461. ansstart := SkipAnsQueries(qd, anslen);
  2462. AssertEquals('Wrong number of NS records.', 1, qd.h.ancount);
  2463. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  2464. AssertEquals('Wrong number of resource records.', 1, Length(RRArr));
  2465. AssertEquals('RR 0 is not an NS RR.',DNSQRY_NS, RRarr[0].RRMeta.Atype);
  2466. AssertEquals('Wrong NS record name for RR 0', FAKEFQDN,
  2467. RRArr[0].RRName);
  2468. // move the ns to the end of the buffer.
  2469. oldstart := RRArr[0].RDataSt;
  2470. RRArr[0].RDataSt := Length(qd.Payload) - RRArr[0].RRMeta.RDLength;
  2471. CopyBytesTo(qd.Payload, oldstart, RRArr[0].RDataSt, RRArr[0].RRMeta.RDLength);
  2472. AssertTrue('Did not get RR NS data.', DNSRRGetNS(RRArr[0], qd.Payload, s));
  2473. AssertEquals('Wrong NS.', 'fakens.'+FAKEFQDN, s);
  2474. end;
  2475. procedure TNetDbTest.TestDnsRRBufferPastEdgeNS;
  2476. var
  2477. fakeresp: TFakeDNSResponse;
  2478. qd: TQueryData;
  2479. anslen, ansstart, oldstart: Word;
  2480. RRArr: TRRNameDataArray;
  2481. s: TDNSDomainName;
  2482. begin
  2483. BuildFakeResponseNS(FAKEFQDN, fakeresp);
  2484. AssertTrue('Unable to convert fake dns response to querydata',
  2485. BuildQueryData(fakeresp, qd, anslen));
  2486. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  2487. ansstart := SkipAnsQueries(qd, anslen);
  2488. AssertEquals('Wrong number of NS records.', 1, qd.h.ancount);
  2489. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  2490. AssertEquals('Wrong number of resource records.', 1, Length(RRArr));
  2491. AssertEquals('RR 0 is not an NS RR.',DNSQRY_NS, RRarr[0].RRMeta.Atype);
  2492. // move the ns to the end of the buffer. we drop two bytes off the end of
  2493. // the ns, because there's a 0 byte at the end of a label if not a ptr.
  2494. // now, the last label's size is greater than the number of bytes left in
  2495. // the buffer.
  2496. oldstart := RRArr[0].RDataSt;
  2497. RRArr[0].RDataSt := Length(qd.Payload) - (RRArr[0].RRMeta.RDLength-2);
  2498. CopyBytesTo(qd.Payload, oldstart, RRArr[0].RDataSt,
  2499. (RRArr[0].RRMeta.RDLength-2));
  2500. // lie about the rdlength too!
  2501. Dec(RRArr[0].RRMeta.RDLength,2);
  2502. AssertTrue('Did not get RR NS data.', DNSRRGetNS(RRArr[0], qd.Payload, s));
  2503. // last label will get removed, leaving just the domain part.
  2504. AssertEquals('Wrong NS.', 'fakens.'+FAKEDOMAIN, s);
  2505. end;
  2506. procedure TNetDbTest.TestDnsRRBufferEdgePTR;
  2507. var
  2508. fakeresp: TFakeDNSResponse;
  2509. qd: TQueryData;
  2510. anslen, ansstart, oldstart: Word;
  2511. RRArr: TRRNameDataArray;
  2512. s: TDNSDomainName;
  2513. begin
  2514. // the str passed in to this function doesn't really matter, but using
  2515. // a proper in-addr.arpa domain helps keep it clear what we're testing.
  2516. BuildFakeResponsePTR('0.5.0.127.in-addr.arpa', fakeresp);
  2517. AssertTrue('Unable to convert fake dns response to querydata',
  2518. BuildQueryData(fakeresp, qd, anslen));
  2519. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  2520. ansstart := SkipAnsQueries(qd, anslen);
  2521. AssertEquals('Wrong number of PTR records.', 1, qd.h.ancount);
  2522. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  2523. AssertEquals('Wrong number of resource records.', 1, Length(RRArr));
  2524. AssertEquals('RR 0 is not an PTR RR.',DNSQRY_PTR, RRarr[0].RRMeta.Atype);
  2525. AssertEquals('Wrong PTR record name for RR 0', '0.5.0.127.in-addr.arpa',
  2526. RRArr[0].RRName);
  2527. // move the ptr to the end of the buffer.
  2528. oldstart := RRArr[0].RDataSt;
  2529. RRArr[0].RDataSt := Length(qd.Payload) - RRArr[0].RRMeta.RDLength;
  2530. CopyBytesTo(qd.Payload, oldstart, RRArr[0].RDataSt, RRArr[0].RRMeta.RDLength);
  2531. AssertTrue('Did not get RR PTR data.', DNSRRGetPTR(RRArr[0], qd.Payload, s));
  2532. AssertEquals('Wrong PTR.', 'fakeptrans.'+FAKEFQDN, s);
  2533. end;
  2534. procedure TNetDbTest.TestDnsRRBufferPastEdgePTR;
  2535. var
  2536. fakeresp: TFakeDNSResponse;
  2537. qd: TQueryData;
  2538. anslen, ansstart, oldstart: Word;
  2539. RRArr: TRRNameDataArray;
  2540. s: TDNSDomainName;
  2541. begin
  2542. // the str passed in to this function doesn't really matter, but using
  2543. // a proper in-addr.arpa domain helps keep it clear what we're testing.
  2544. BuildFakeResponsePTR('0.5.0.127.in-addr.arpa', fakeresp);
  2545. AssertTrue('Unable to convert fake dns response to querydata',
  2546. BuildQueryData(fakeresp, qd, anslen));
  2547. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  2548. ansstart := SkipAnsQueries(qd, anslen);
  2549. AssertEquals('Wrong number of PTR records.', 1, qd.h.ancount);
  2550. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  2551. AssertEquals('Wrong number of resource records.', 1, Length(RRArr));
  2552. AssertEquals('RR 0 is not an PTR RR.',DNSQRY_PTR, RRarr[0].RRMeta.Atype);
  2553. AssertEquals('Wrong PTR record name for RR 0', '0.5.0.127.in-addr.arpa',
  2554. RRArr[0].RRName);
  2555. // move the ns to the end of the buffer. we drop two bytes off the end of
  2556. // the ns, because there's a 0 byte at the end of a label if not a ptr.
  2557. // now, the last label's size is greater than the number of bytes left in
  2558. // the buffer.
  2559. oldstart := RRArr[0].RDataSt;
  2560. RRArr[0].RDataSt := Length(qd.Payload) - (RRArr[0].RRMeta.RDLength-2);
  2561. CopyBytesTo(qd.Payload, oldstart, RRArr[0].RDataSt,
  2562. (RRArr[0].RRMeta.RDLength-2));
  2563. // lie about the rdlength too!
  2564. Dec(RRArr[0].RRMeta.RDLength,2);
  2565. AssertTrue('Did not get RR PTR data.', DNSRRGetPTR(RRArr[0], qd.Payload, s));
  2566. // last label will get removed, leaving just the domain part.
  2567. AssertEquals('Wrong PTR.', 'fakeptrans.'+FAKEDOMAIN, s);
  2568. end;
  2569. {
  2570. Test reading a text record right at the edge of the payload buffer.
  2571. }
  2572. procedure TNetDbTest.TestDnsRRBufferEdgeTXT;
  2573. var
  2574. fakeresp: TFakeDNSResponse;
  2575. qd: TQueryData;
  2576. anslen, ansstart,oldstart: Word;
  2577. RRArr: TRRNameDataArray;
  2578. s: AnsiString;
  2579. begin
  2580. s := '';
  2581. BuildFakeResponseTXT(FAKEFQDN, fakeresp);
  2582. AssertTrue('Unable to convert fake dns response to querydata',
  2583. BuildQueryData(fakeresp, qd, anslen));
  2584. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  2585. ansstart := SkipAnsQueries(qd, anslen);
  2586. AssertEquals('Wrong number of TXT records.', 1, qd.h.ancount);
  2587. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  2588. AssertEquals('Wrong number of resource records.', 1, Length(RRArr));
  2589. AssertEquals('RR 0 is not a TXT RR.',DNSQRY_TXT, RRarr[0].RRMeta.Atype);
  2590. AssertEquals('Wrong TXT record name for RR 0', FAKEFQDN,
  2591. RRArr[0].RRName);
  2592. // Move the text record to the end of the buffer
  2593. oldstart := RRArr[0].RDataSt;
  2594. RRArr[0].RDataSt := Length(qd.Payload) - RRArr[0].RRMeta.RDLength;
  2595. CopyBytesTo(qd.Payload, oldstart, RRArr[0].RDataSt, RRArr[0].RRMeta.RDLength);
  2596. AssertTrue('Did not get RR TXT data.', DNSRRGetText(RRArr[0], qd.Payload, s));
  2597. AssertEquals(
  2598. 'v=spf1 mx a:lists.'+FAKEFQDN+'Always look on the bright side of life!',
  2599. s);
  2600. end;
  2601. {
  2602. Try reading a TXT record that points past the end of the payload buffer.
  2603. }
  2604. procedure TNetDbTest.TestDnsRRBufferPastEdgeTXT;
  2605. var
  2606. fakeresp: TFakeDNSResponse;
  2607. qd: TQueryData;
  2608. anslen, ansstart,oldstart: Word;
  2609. RRArr: TRRNameDataArray;
  2610. s: AnsiString;
  2611. begin
  2612. s := '';
  2613. BuildFakeResponseTXT(FAKEFQDN, fakeresp);
  2614. AssertTrue('Unable to convert fake dns response to querydata',
  2615. BuildQueryData(fakeresp, qd, anslen));
  2616. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  2617. ansstart := SkipAnsQueries(qd, anslen);
  2618. AssertEquals('Wrong number of TXT records.', 1, qd.h.ancount);
  2619. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  2620. AssertEquals('Wrong number of resource records.', 1, Length(RRArr));
  2621. AssertEquals('RR 0 is not a TXT RR.',DNSQRY_TXT, RRarr[0].RRMeta.Atype);
  2622. AssertEquals('Wrong TXT record name for RR 0', FAKEFQDN,
  2623. RRArr[0].RRName);
  2624. // Move the text record to the end of the buffer, cutting off the last
  2625. // 2 bytes. this means the length byte for the second string will point
  2626. // past the end of the buffer.
  2627. oldstart := RRArr[0].RDataSt;
  2628. RRArr[0].RDataSt := Length(qd.Payload) - (RRArr[0].RRMeta.RDLength - 2);
  2629. CopyBytesTo(qd.Payload, oldstart, RRArr[0].RDataSt,
  2630. (RRArr[0].RRMeta.RDLength - 2));
  2631. AssertFalse('Did not get RR TXT data.',
  2632. DNSRRGetText(RRArr[0], qd.Payload, s));
  2633. end;
  2634. procedure TNetDbTest.TestDnsRRBufferEdgeTCPA;
  2635. var
  2636. fakeresp: TFakeDNSResponse;
  2637. qd: TQueryDataLengthTCP;
  2638. anslen, ansstart: Word;
  2639. RRArr: TRRNameDataArray;
  2640. ip: THostAddr;
  2641. begin
  2642. BuildFakeResponseA(FAKEFQDN, fakeresp);
  2643. AssertTrue('Unable to convert fake dns response to querydata',
  2644. BuildQueryData(fakeresp, qd, anslen));
  2645. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  2646. ansstart := SkipAnsQueries(qd, anslen);
  2647. AssertEquals('Wrong number of A records.', 2, qd.h.ancount);
  2648. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  2649. // Change start position for RR[0] to end of buffer - 4
  2650. RRArr[0].RDataSt := Length(qd.Payload) - RRArr[0].RRMeta.RDLength;
  2651. qd.Payload[Length(qd.Payload)-1] := $AA; // sentinel marker we can look for
  2652. AssertTrue('Did not get RR A data.', DNSRRGetA(RRArr[0], qd.Payload, ip));
  2653. AssertEquals('Wrong ip for A.', '0.0.0.170', HostAddrToStr(ip));
  2654. end;
  2655. procedure TNetDbTest.TestDnsRRBufferPastEdgeTCPA;
  2656. var
  2657. fakeresp: TFakeDNSResponse;
  2658. qd: TQueryDataLengthTCP;
  2659. anslen, ansstart: Word;
  2660. RRArr: TRRNameDataArray;
  2661. ip: THostAddr;
  2662. begin
  2663. BuildFakeResponseA(FAKEFQDN, fakeresp);
  2664. AssertTrue('Unable to convert fake dns response to querydata',
  2665. BuildQueryData(fakeresp, qd, anslen));
  2666. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  2667. ansstart := SkipAnsQueries(qd, anslen);
  2668. AssertEquals('Wrong number of A records.', 2, qd.h.ancount);
  2669. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  2670. // Change start position for RR[0] to end of buffer - 3
  2671. RRArr[0].RDataSt := Length(qd.Payload) - (RRArr[0].RRMeta.RDLength - 2);
  2672. AssertFalse('Got RR A data.', DNSRRGetA(RRArr[0], qd.Payload, ip));
  2673. end;
  2674. procedure TNetDbTest.TestDnsRRBufferEdgeTCPAAAA;
  2675. var
  2676. fakeresp: TFakeDNSResponse;
  2677. qd: TQueryData;
  2678. anslen, ansstart: Word;
  2679. RRArr: TRRNameDataArray;
  2680. ip: THostAddr6;
  2681. begin
  2682. BuildFakeResponseAAAA(FAKEFQDN, fakeresp);
  2683. AssertTrue('Unable to convert fake dns response to querydata',
  2684. BuildQueryData(fakeresp, qd, anslen));
  2685. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  2686. ansstart := SkipAnsQueries(qd, anslen);
  2687. AssertEquals('Wrong number of AAAA records.', 2, qd.h.ancount);
  2688. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  2689. // Change start position for RR[0]
  2690. RRArr[0].RDataSt := Length(qd.Payload) - SizeOf(THostAddr6);
  2691. qd.Payload[Length(qd.Payload)-1] := $AA;
  2692. AssertTrue('Got RR AAAA data.', DNSRRGetAAAA(RRArr[0], qd.Payload, ip));
  2693. AssertEquals($AA, ip.u6_addr8[15]);
  2694. end;
  2695. procedure TNetDbTest.TestDNsRRBufferPastEdgeTCPAAAA;
  2696. var
  2697. fakeresp: TFakeDNSResponse;
  2698. qd: TQueryDataLengthTCP;
  2699. anslen, ansstart: Word;
  2700. RRArr: TRRNameDataArray;
  2701. ip: THostAddr6;
  2702. begin
  2703. BuildFakeResponseAAAA(FAKEFQDN, fakeresp);
  2704. AssertTrue('Unable to convert fake dns response to querydata',
  2705. BuildQueryData(fakeresp, qd, anslen));
  2706. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  2707. ansstart := SkipAnsQueries(qd, anslen);
  2708. AssertEquals('Wrong number of AAAA records.', 2, qd.h.ancount);
  2709. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  2710. // Change start position for RR[0]. attempting to read 16 bytes
  2711. // from this position will pass the end of the buffer.
  2712. RRArr[0].RDataSt := Length(qd.Payload) - (SizeOf(THostAddr6)-1);
  2713. AssertFalse('Got RR AAAA data.', DNSRRGetAAAA(RRArr[0], qd.Payload, ip));
  2714. end;
  2715. procedure TNetDbTest.TestDnsRRBufferEdgeTCPMX;
  2716. var
  2717. fakeresp: TFakeDNSResponse;
  2718. qd: TQueryDataLengthTCP;
  2719. anslen, ansstart, oldstart: Word;
  2720. RRArr: TRRNameDataArray;
  2721. fmx: TDNSRR_MX;
  2722. begin
  2723. BuildFakeResponseMX(FAKEFQDN, fakeresp);
  2724. AssertTrue('Unable to convert fake dns response to querydata',
  2725. BuildQueryData(fakeresp, qd, anslen));
  2726. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  2727. ansstart := SkipAnsQueries(qd, anslen);
  2728. AssertEquals('Wrong number of MX records.', 1, qd.h.ancount);
  2729. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  2730. // move the MX RR bytes to the end of the payload buffer.
  2731. oldstart := RRArr[0].RDataSt;
  2732. RRArr[0].RDataSt := Length(qd.Payload) - RRArr[0].RRMeta.RDLength;
  2733. CopyBytesTo(qd.Payload, oldstart, RRArr[0].RDataSt, RRArr[0].RRMeta.RDLength);
  2734. AssertTrue('Got RR MX data.', DNSRRGetMX(RRArr[0], qd.Payload, fmx));
  2735. AssertEquals('Wrong MX hostname', 'mailer.'+FAKEFQDN,
  2736. fmx.exchange);
  2737. AssertEquals('Wrong MX preference', 10, fmx.preference);
  2738. end;
  2739. procedure TNetDbTest.TestDnsRRBufferPastEdgeTCPMX;
  2740. var
  2741. fakeresp: TFakeDNSResponse;
  2742. qd: TQueryDataLengthTCP;
  2743. anslen, ansstart, oldstart: Word;
  2744. RRArr: TRRNameDataArray;
  2745. fmx: TDNSRR_MX;
  2746. begin
  2747. BuildFakeResponseMX(FAKEFQDN, fakeresp);
  2748. AssertTrue('Unable to convert fake dns response to querydata',
  2749. BuildQueryData(fakeresp, qd, anslen));
  2750. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  2751. ansstart := SkipAnsQueries(qd, anslen);
  2752. AssertEquals('Wrong number of MX records.', 1, qd.h.ancount);
  2753. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  2754. // move the MX RR bytes to the end of the payload buffer. We omit the last
  2755. // 2 bytes of the MX to attempt to trick the code into reading past the buffer
  2756. // edge.
  2757. oldstart := RRArr[0].RDataSt;
  2758. RRArr[0].RDataSt := Length(qd.Payload) - (RRArr[0].RRMeta.RDLength - 2);
  2759. CopyBytesTo(qd.Payload, oldstart, RRArr[0].RDataSt,
  2760. (RRArr[0].RRMeta.RDLength-2));
  2761. AssertTrue('Got RR MX data.', DNSRRGetMX(RRArr[0], qd.Payload, fmx));
  2762. // stringfromlabel should drop the last label, so the result should be just
  2763. // missing the tld.
  2764. AssertEquals('Wrong MX hostname', 'mailer.'+FAKEDOMAIN,
  2765. fmx.exchange);
  2766. AssertEquals('Wrong MX preference', 10, fmx.preference);
  2767. end;
  2768. procedure TNetDbTest.TestDnsRRBufferEdgeTCPSOA;
  2769. var
  2770. fakeresp: TFakeDNSResponse;
  2771. qd: TQueryDataLengthTCP;
  2772. anslen, ansstart, oldstart: Word;
  2773. RRArr: TRRNameDataArray;
  2774. soarec: TDNSRR_SOA;
  2775. begin
  2776. BuildFakeResponseSOA(FAKEFQDN, fakeresp);
  2777. AssertTrue('Unable to convert fake dns response to querydata',
  2778. BuildQueryData(fakeresp, qd, anslen));
  2779. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  2780. ansstart := SkipAnsQueries(qd, anslen);
  2781. AssertEquals('Wrong number of SOA records.', 1, qd.h.ancount);
  2782. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  2783. AssertEquals('Wrong number of resource records.', 1, Length(RRArr));
  2784. AssertEquals('RR 0 is not an SOA RR.',DNSQRY_SOA, RRarr[0].RRMeta.Atype);
  2785. // move the SOA RR bytes to the end of the payload buffer.
  2786. oldstart := RRArr[0].RDataSt;
  2787. RRArr[0].RDataSt := Length(qd.Payload) - RRArr[0].RRMeta.RDLength;
  2788. CopyBytesTo(qd.Payload, oldstart, RRArr[0].RDataSt, RRArr[0].RRMeta.RDLength);
  2789. AssertTrue('Did not get RR SOA data.', DNSRRGetSOA(RRArr[0], qd.Payload,
  2790. soarec));
  2791. AssertEquals('Wrong mname hostname', 'mn.'+FAKEFQDN,
  2792. soarec.mname);
  2793. AssertEquals('Wrong rname hostname', 'rn.'+FAKEFQDN,
  2794. soarec.rname);
  2795. AssertEquals('Wrong SOA serial', 76543210, soarec.serial);
  2796. AssertEquals('Wrong SOA refresh', 123, soarec.refresh);
  2797. AssertEquals('Wrong SOA retry', 456, soarec.retry);
  2798. AssertEquals('Wrong SOA expire', 789, soarec.expire);
  2799. AssertEquals('Wrong SOA min', 60, soarec.min);
  2800. end;
  2801. procedure TNetDbTest.TestDnsRRBufferPastEdgeTCPSOA;
  2802. var
  2803. fakeresp: TFakeDNSResponse;
  2804. qd: TQueryDataLengthTCP;
  2805. anslen, ansstart, oldstart: Word;
  2806. RRArr: TRRNameDataArray;
  2807. soarec: TDNSRR_SOA;
  2808. begin
  2809. BuildFakeResponseSOA(FAKEFQDN, fakeresp);
  2810. AssertTrue('Unable to convert fake dns response to querydata',
  2811. BuildQueryData(fakeresp, qd, anslen));
  2812. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  2813. ansstart := SkipAnsQueries(qd, anslen);
  2814. AssertEquals('Wrong number of SOA records.', 1, qd.h.ancount);
  2815. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  2816. AssertEquals('Wrong number of resource records.', 1, Length(RRArr));
  2817. AssertEquals('RR 0 is not an SOA RR.',DNSQRY_SOA, RRarr[0].RRMeta.Atype);
  2818. // move the SOA RR bytes to the end of the payload buffer.
  2819. oldstart := RRArr[0].RDataSt;
  2820. RRArr[0].RDataSt := Length(qd.Payload) - (RRArr[0].RRMeta.RDLength-1);
  2821. CopyBytesTo(qd.Payload, oldstart, RRArr[0].RDataSt,
  2822. (RRArr[0].RRMeta.RDLength-1));
  2823. AssertFalse('Got RR SOA data.', DNSRRGetSOA(RRArr[0], qd.Payload,
  2824. soarec));
  2825. end;
  2826. procedure TNetDbTest.TestDnsRRBufferEdgeTCPSRV;
  2827. var
  2828. fakeresp: TFakeDNSResponse;
  2829. qd: TQueryDataLengthTCP;
  2830. anslen, ansstart, oldstart: Word;
  2831. RRArr: TRRNameDataArray;
  2832. srvrec: TDNSRR_SRV;
  2833. begin
  2834. BuildFakeResponseSRV(FAKEFQDN, fakeresp);
  2835. AssertTrue('Unable to convert fake dns response to querydata',
  2836. BuildQueryData(fakeresp, qd, anslen));
  2837. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  2838. ansstart := SkipAnsQueries(qd, anslen);
  2839. AssertEquals('Wrong number of SRV records.', 1, qd.h.ancount);
  2840. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  2841. AssertEquals('Wrong number of resource records.', 1, Length(RRArr));
  2842. AssertEquals('RR 0 is not an SRV RR.',DNSQRY_SRV, RRarr[0].RRMeta.Atype);
  2843. // move the SRV RR bytes to the end of the payload buffer.
  2844. oldstart := RRArr[0].RDataSt;
  2845. RRArr[0].RDataSt := Length(qd.Payload) - RRArr[0].RRMeta.RDLength;
  2846. CopyBytesTo(qd.Payload, oldstart, RRArr[0].RDataSt, RRArr[0].RRMeta.RDLength);
  2847. AssertTrue('Did not get RR SRV data.', DNSRRGetSRV(RRArr[0], qd.Payload,
  2848. srvrec));
  2849. AssertEquals('Wrong SRV priority', 22, srvrec.priority);
  2850. AssertEquals('Wrong SRV weight', 44, srvrec.weight);
  2851. AssertEquals('Wrong SRV port', 2201, srvrec.port);
  2852. AssertEquals('Wrong SRV hostname', '_this._that._other', srvrec.target);
  2853. end;
  2854. procedure TNetDbTest.TestDnsRRBufferPastEdgeTCPSRV;
  2855. var
  2856. fakeresp: TFakeDNSResponse;
  2857. qd: TQueryDataLengthTCP;
  2858. anslen, ansstart, oldstart: Word;
  2859. RRArr: TRRNameDataArray;
  2860. srvrec: TDNSRR_SRV;
  2861. begin
  2862. BuildFakeResponseSRV(FAKEFQDN, fakeresp);
  2863. AssertTrue('Unable to convert fake dns response to querydata',
  2864. BuildQueryData(fakeresp, qd, anslen));
  2865. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  2866. ansstart := SkipAnsQueries(qd, anslen);
  2867. AssertEquals('Wrong number of SRV records.', 1, qd.h.ancount);
  2868. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  2869. AssertEquals('Wrong number of resource records.', 1, Length(RRArr));
  2870. AssertEquals('RR 0 is not an SRV RR.',DNSQRY_SRV, RRarr[0].RRMeta.Atype);
  2871. // move the SRV RR bytes to the end of the payload buffer. ensure that
  2872. // we're one byte short to try and trick the code into reading past the
  2873. // end of the buffer.
  2874. oldstart := RRArr[0].RDataSt;
  2875. RRArr[0].RDataSt := Length(qd.Payload) - (RRArr[0].RRMeta.RDLength - 1);
  2876. CopyBytesTo(qd.Payload, oldstart, RRArr[0].RDataSt,
  2877. (RRArr[0].RRMeta.RDLength - 1));
  2878. AssertFalse('Got RR SRV data.', DNSRRGetSRV(RRArr[0], qd.Payload,
  2879. srvrec));
  2880. end;
  2881. procedure TNetDbTest.TestDnsRRBufferEdgeTCPCNAME;
  2882. var
  2883. fakeresp: TFakeDNSResponse;
  2884. qd: TQueryDataLengthTCP;
  2885. anslen, ansstart, oldstart: Word;
  2886. RRArr: TRRNameDataArray;
  2887. s: TDNSDomainName;
  2888. begin
  2889. BuildFakeResponseCNAME(FAKEFQDN, fakeresp);
  2890. AssertTrue('Unable to convert fake dns response to querydata',
  2891. BuildQueryData(fakeresp, qd, anslen));
  2892. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  2893. ansstart := SkipAnsQueries(qd, anslen);
  2894. AssertEquals('Wrong number of CNAME records.', 1, qd.h.ancount);
  2895. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  2896. AssertEquals('Wrong number of resource records.', 1, Length(RRArr));
  2897. AssertEquals('RR 0 is not an CNAME RR.',DNSQRY_CNAME, RRarr[0].RRMeta.Atype);
  2898. // move the cname to the end of the buffer.
  2899. oldstart := RRArr[0].RDataSt;
  2900. RRArr[0].RDataSt := Length(qd.Payload) - RRArr[0].RRMeta.RDLength;
  2901. CopyBytesTo(qd.Payload, oldstart, RRArr[0].RDataSt, RRArr[0].RRMeta.RDLength);
  2902. AssertTrue('Did not get RR CNAME data.', DNSRRGetCNAME(RRArr[0], qd.Payload, s));
  2903. AssertEquals('Wrong CNAME.', 'fakecname.'+FAKEFQDN, s);
  2904. end;
  2905. procedure TNetDbTest.TestDnsRRBufferPastEdgeTCPCNAME;
  2906. var
  2907. fakeresp: TFakeDNSResponse;
  2908. qd: TQueryDataLengthTCP;
  2909. anslen, ansstart, oldstart: Word;
  2910. RRArr: TRRNameDataArray;
  2911. s: TDNSDomainName;
  2912. begin
  2913. BuildFakeResponseCNAME(FAKEFQDN, fakeresp);
  2914. AssertTrue('Unable to convert fake dns response to querydata',
  2915. BuildQueryData(fakeresp, qd, anslen));
  2916. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  2917. ansstart := SkipAnsQueries(qd, anslen);
  2918. AssertEquals('Wrong number of CNAME records.', 1, qd.h.ancount);
  2919. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  2920. AssertEquals('Wrong number of resource records.', 1, Length(RRArr));
  2921. AssertEquals('RR 0 is not an CNAME RR.',DNSQRY_CNAME, RRarr[0].RRMeta.Atype);
  2922. // move the cname to the end of the buffer. we drop two bytes off the end of
  2923. // the cname, because there's a 0 byte at the end of a label if not a ptr.
  2924. // now, the last label's size is greater than the number of bytes left in
  2925. // the buffer.
  2926. oldstart := RRArr[0].RDataSt;
  2927. RRArr[0].RDataSt := Length(qd.Payload) - (RRArr[0].RRMeta.RDLength-2);
  2928. CopyBytesTo(qd.Payload, oldstart, RRArr[0].RDataSt,
  2929. (RRArr[0].RRMeta.RDLength-2));
  2930. // lie about the rdlength too!
  2931. Dec(RRArr[0].RRMeta.RDLength,2);
  2932. AssertTrue('Did not get RR CNAME data.', DNSRRGetCNAME(RRArr[0], qd.Payload, s));
  2933. // last label will get removed, leaving just the domain part.
  2934. AssertEquals('Wrong CNAME.', 'fakecname.'+FAKEDOMAIN, s);
  2935. end;
  2936. procedure TNetDbTest.TestDnsRRBufferEdgeTCPNS;
  2937. var
  2938. fakeresp: TFakeDNSResponse;
  2939. qd: TQueryDataLengthTCP;
  2940. anslen, ansstart, oldstart: Word;
  2941. RRArr: TRRNameDataArray;
  2942. s: TDNSDomainName;
  2943. begin
  2944. BuildFakeResponseNS(FAKEFQDN, fakeresp);
  2945. AssertTrue('Unable to convert fake dns response to querydata',
  2946. BuildQueryData(fakeresp, qd, anslen));
  2947. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  2948. ansstart := SkipAnsQueries(qd, anslen);
  2949. AssertEquals('Wrong number of NS records.', 1, qd.h.ancount);
  2950. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  2951. AssertEquals('Wrong number of resource records.', 1, Length(RRArr));
  2952. AssertEquals('RR 0 is not an NS RR.',DNSQRY_NS, RRarr[0].RRMeta.Atype);
  2953. AssertEquals('Wrong NS record name for RR 0', FAKEFQDN,
  2954. RRArr[0].RRName);
  2955. // move the ns to the end of the buffer.
  2956. oldstart := RRArr[0].RDataSt;
  2957. RRArr[0].RDataSt := Length(qd.Payload) - RRArr[0].RRMeta.RDLength;
  2958. CopyBytesTo(qd.Payload, oldstart, RRArr[0].RDataSt, RRArr[0].RRMeta.RDLength);
  2959. AssertTrue('Did not get RR NS data.', DNSRRGetNS(RRArr[0], qd.Payload, s));
  2960. AssertEquals('Wrong NS.', 'fakens.'+FAKEFQDN, s);
  2961. end;
  2962. procedure TNetDbTest.TestDnsRRBufferPastEdgeTCPNS;
  2963. var
  2964. fakeresp: TFakeDNSResponse;
  2965. qd: TQueryDataLengthTCP;
  2966. anslen, ansstart, oldstart: Word;
  2967. RRArr: TRRNameDataArray;
  2968. s: TDNSDomainName;
  2969. begin
  2970. BuildFakeResponseNS(FAKEFQDN, fakeresp);
  2971. AssertTrue('Unable to convert fake dns response to querydata',
  2972. BuildQueryData(fakeresp, qd, anslen));
  2973. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  2974. ansstart := SkipAnsQueries(qd, anslen);
  2975. AssertEquals('Wrong number of NS records.', 1, qd.h.ancount);
  2976. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  2977. AssertEquals('Wrong number of resource records.', 1, Length(RRArr));
  2978. AssertEquals('RR 0 is not an NS RR.',DNSQRY_NS, RRarr[0].RRMeta.Atype);
  2979. // move the ns to the end of the buffer. we drop two bytes off the end of
  2980. // the ns, because there's a 0 byte at the end of a label if not a ptr.
  2981. // now, the last label's size is greater than the number of bytes left in
  2982. // the buffer.
  2983. oldstart := RRArr[0].RDataSt;
  2984. RRArr[0].RDataSt := Length(qd.Payload) - (RRArr[0].RRMeta.RDLength-2);
  2985. CopyBytesTo(qd.Payload, oldstart, RRArr[0].RDataSt,
  2986. (RRArr[0].RRMeta.RDLength-2));
  2987. // lie about the rdlength too!
  2988. Dec(RRArr[0].RRMeta.RDLength,2);
  2989. AssertTrue('Did not get RR NS data.', DNSRRGetNS(RRArr[0], qd.Payload, s));
  2990. // last label will get removed, leaving just the domain part.
  2991. AssertEquals('Wrong NS.', 'fakens.'+FAKEDOMAIN, s);
  2992. end;
  2993. procedure TNetDbTest.TestDnsRRBufferEdgeTCPPTR;
  2994. var
  2995. fakeresp: TFakeDNSResponse;
  2996. qd: TQueryDataLengthTCP;
  2997. anslen, ansstart, oldstart: Word;
  2998. RRArr: TRRNameDataArray;
  2999. s: TDNSDomainName;
  3000. begin
  3001. // the str passed in to this function doesn't really matter, but using
  3002. // a proper in-addr.arpa domain helps keep it clear what we're testing.
  3003. BuildFakeResponsePTR('0.5.0.127.in-addr.arpa', fakeresp);
  3004. AssertTrue('Unable to convert fake dns response to querydata',
  3005. BuildQueryData(fakeresp, qd, anslen));
  3006. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  3007. ansstart := SkipAnsQueries(qd, anslen);
  3008. AssertEquals('Wrong number of PTR records.', 1, qd.h.ancount);
  3009. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  3010. AssertEquals('Wrong number of resource records.', 1, Length(RRArr));
  3011. AssertEquals('RR 0 is not an PTR RR.',DNSQRY_PTR, RRarr[0].RRMeta.Atype);
  3012. AssertEquals('Wrong PTR record name for RR 0', '0.5.0.127.in-addr.arpa',
  3013. RRArr[0].RRName);
  3014. // move the ptr to the end of the buffer.
  3015. oldstart := RRArr[0].RDataSt;
  3016. RRArr[0].RDataSt := Length(qd.Payload) - RRArr[0].RRMeta.RDLength;
  3017. CopyBytesTo(qd.Payload, oldstart, RRArr[0].RDataSt, RRArr[0].RRMeta.RDLength);
  3018. AssertTrue('Did not get RR PTR data.', DNSRRGetPTR(RRArr[0], qd.Payload, s));
  3019. AssertEquals('Wrong PTR.', 'fakeptrans.'+FAKEFQDN, s);
  3020. end;
  3021. procedure TNetDbTest.TestDnsRRBufferPastEdgeTCPPTR;
  3022. var
  3023. fakeresp: TFakeDNSResponse;
  3024. qd: TQueryDataLengthTCP;
  3025. anslen, ansstart, oldstart: Word;
  3026. RRArr: TRRNameDataArray;
  3027. s: TDNSDomainName;
  3028. begin
  3029. // the str passed in to this function doesn't really matter, but using
  3030. // a proper in-addr.arpa domain helps keep it clear what we're testing.
  3031. BuildFakeResponsePTR('0.5.0.127.in-addr.arpa', fakeresp);
  3032. AssertTrue('Unable to convert fake dns response to querydata',
  3033. BuildQueryData(fakeresp, qd, anslen));
  3034. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  3035. ansstart := SkipAnsQueries(qd, anslen);
  3036. AssertEquals('Wrong number of PTR records.', 1, qd.h.ancount);
  3037. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  3038. AssertEquals('Wrong number of resource records.', 1, Length(RRArr));
  3039. AssertEquals('RR 0 is not an PTR RR.',DNSQRY_PTR, RRarr[0].RRMeta.Atype);
  3040. AssertEquals('Wrong PTR record name for RR 0', '0.5.0.127.in-addr.arpa',
  3041. RRArr[0].RRName);
  3042. // move the ns to the end of the buffer. we drop two bytes off the end of
  3043. // the ns, because there's a 0 byte at the end of a label if not a ptr.
  3044. // now, the last label's size is greater than the number of bytes left in
  3045. // the buffer.
  3046. oldstart := RRArr[0].RDataSt;
  3047. RRArr[0].RDataSt := Length(qd.Payload) - (RRArr[0].RRMeta.RDLength-2);
  3048. CopyBytesTo(qd.Payload, oldstart, RRArr[0].RDataSt,
  3049. (RRArr[0].RRMeta.RDLength-2));
  3050. // lie about the rdlength too!
  3051. Dec(RRArr[0].RRMeta.RDLength,2);
  3052. AssertTrue('Did not get RR PTR data.', DNSRRGetPTR(RRArr[0], qd.Payload, s));
  3053. // last label will get removed, leaving just the domain part.
  3054. AssertEquals('Wrong PTR.', 'fakeptrans.'+FAKEDOMAIN, s);
  3055. end;
  3056. procedure TNetDbTest.TestDnsRRBufferEdgeTCPTXT;
  3057. var
  3058. fakeresp: TFakeDNSResponse;
  3059. qd: TQueryDataLengthTCP;
  3060. anslen, ansstart,oldstart: Word;
  3061. RRArr: TRRNameDataArray;
  3062. s: AnsiString;
  3063. begin
  3064. s := '';
  3065. BuildFakeResponseTXT(FAKEFQDN, fakeresp);
  3066. AssertTrue('Unable to convert fake dns response to querydata',
  3067. BuildQueryData(fakeresp, qd, anslen));
  3068. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  3069. ansstart := SkipAnsQueries(qd, anslen);
  3070. AssertEquals('Wrong number of TXT records.', 1, qd.h.ancount);
  3071. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  3072. AssertEquals('Wrong number of resource records.', 1, Length(RRArr));
  3073. AssertEquals('RR 0 is not a TXT RR.',DNSQRY_TXT, RRarr[0].RRMeta.Atype);
  3074. AssertEquals('Wrong TXT record name for RR 0', FAKEFQDN,
  3075. RRArr[0].RRName);
  3076. // Move the text record to the end of the buffer
  3077. oldstart := RRArr[0].RDataSt;
  3078. RRArr[0].RDataSt := Length(qd.Payload) - RRArr[0].RRMeta.RDLength;
  3079. CopyBytesTo(qd.Payload, oldstart, RRArr[0].RDataSt, RRArr[0].RRMeta.RDLength);
  3080. AssertTrue('Did not get RR TXT data.', DNSRRGetText(RRArr[0], qd.Payload, s));
  3081. AssertEquals(
  3082. 'v=spf1 mx a:lists.'+FAKEFQDN+'Always look on the bright side of life!',
  3083. s);
  3084. end;
  3085. procedure TNetDbTest.TestDnsRRBufferPastEdgeTCPTXT;
  3086. var
  3087. fakeresp: TFakeDNSResponse;
  3088. qd: TQueryDataLengthTCP;
  3089. anslen, ansstart,oldstart: Word;
  3090. RRArr: TRRNameDataArray;
  3091. s: AnsiString;
  3092. begin
  3093. s := '';
  3094. BuildFakeResponseTXT(FAKEFQDN, fakeresp);
  3095. AssertTrue('Unable to convert fake dns response to querydata',
  3096. BuildQueryData(fakeresp, qd, anslen));
  3097. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  3098. ansstart := SkipAnsQueries(qd, anslen);
  3099. AssertEquals('Wrong number of TXT records.', 1, qd.h.ancount);
  3100. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  3101. AssertEquals('Wrong number of resource records.', 1, Length(RRArr));
  3102. AssertEquals('RR 0 is not a TXT RR.',DNSQRY_TXT, RRarr[0].RRMeta.Atype);
  3103. AssertEquals('Wrong TXT record name for RR 0', FAKEFQDN,
  3104. RRArr[0].RRName);
  3105. // Move the text record to the end of the buffer, cutting off the last
  3106. // 2 bytes. this means the length byte for the second string will point
  3107. // past the end of the buffer.
  3108. oldstart := RRArr[0].RDataSt;
  3109. RRArr[0].RDataSt := Length(qd.Payload) - (RRArr[0].RRMeta.RDLength - 2);
  3110. CopyBytesTo(qd.Payload, oldstart, RRArr[0].RDataSt,
  3111. (RRArr[0].RRMeta.RDLength - 2));
  3112. AssertFalse('Did not get RR TXT data.',
  3113. DNSRRGetText(RRArr[0], qd.Payload, s));
  3114. end;
  3115. {
  3116. Test that NextNameRR correctly reads an RR on the edge of the buffer.
  3117. }
  3118. procedure TNetDbTest.TestNextNameRREdgeA;
  3119. var
  3120. fakeresp: TFakeDNSResponse;
  3121. qd: TQueryData;
  3122. anslen, ansstart: Word;
  3123. rrn: TRRNameData;
  3124. ip: THostAddr;
  3125. t: Cardinal;
  3126. begin
  3127. BuildFakeResponseA(FAKEFQDN, fakeresp);
  3128. AssertTrue('Unable to convert fake dns response to querydata',
  3129. BuildQueryData(fakeresp, qd, anslen));
  3130. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  3131. ansstart := SkipAnsQueries(qd, anslen);
  3132. // get an RR from its normal position. need this to calculate the length.
  3133. AssertTrue('NextNameRR should succeed.',
  3134. NextNameRR(qd.Payload, ansstart, rrn));
  3135. // calculate the size in bytes of the rr so we can copy it to the end
  3136. // of the payload buffer
  3137. t := (rrn.RDataSt + rrn.RRMeta.RDLength) - ansstart;
  3138. CopyBytesTo(qd.Payload,ansstart,Length(qd.Payload)-t, t);
  3139. AssertTrue('NextNameRR should succeed.',
  3140. NextNameRR(qd.Payload, Length(qd.Payload)-t, rrn));
  3141. AssertEquals(DNSQRY_A, rrn.RRMeta.Atype);
  3142. AssertEquals(300, rrn.RRMeta.TTL);
  3143. AssertTrue(DNSRRGetA(rrn, qd.Payload, ip));
  3144. AssertEquals('Wrong ip for A.', '127.0.0.1', HostAddrToStr(ip));
  3145. end;
  3146. {
  3147. Try to trick NextNameRR into reading past the end of the payload buffer.
  3148. }
  3149. procedure TNetDbTest.TestNextNameRRPastEdgeA;
  3150. var
  3151. fakeresp: TFakeDNSResponse;
  3152. qd: TQueryData;
  3153. anslen, ansstart: Word;
  3154. rrn: TRRNameData;
  3155. t: Cardinal;
  3156. begin
  3157. BuildFakeResponseA(FAKEFQDN, fakeresp);
  3158. AssertTrue('Unable to convert fake dns response to querydata',
  3159. BuildQueryData(fakeresp, qd, anslen));
  3160. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  3161. ansstart := SkipAnsQueries(qd, anslen);
  3162. // get an RR from its normal position. need this to calculate the length.
  3163. AssertTrue('NextNameRR should succeed.',
  3164. NextNameRR(qd.Payload, ansstart, rrn));
  3165. // calculate the size in bytes of the rr so we can copy it to the end
  3166. // of the payload buffer
  3167. t := (rrn.RDataSt + rrn.RRMeta.RDLength) - ansstart;
  3168. // copy the bytes, but leave off the last one. leave the rdlength unchanged.
  3169. CopyBytesTo(qd.Payload,ansstart,Length(qd.Payload)-(t-1), t-1);
  3170. AssertFalse('NextNameRR should fail.',
  3171. NextNameRR(qd.Payload, Length(qd.Payload)-(t-1), rrn));
  3172. end;
  3173. procedure TNetDbTest.TestNextNameRREdgeTCPA;
  3174. var
  3175. fakeresp: TFakeDNSResponse;
  3176. qd: TQueryDataLengthTCP;
  3177. anslen, ansstart: Word;
  3178. rrn: TRRNameData;
  3179. ip: THostAddr;
  3180. t: Cardinal;
  3181. begin
  3182. BuildFakeResponseA(FAKEFQDN, fakeresp);
  3183. AssertTrue('Unable to convert fake dns response to querydata',
  3184. BuildQueryData(fakeresp, qd, anslen));
  3185. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  3186. ansstart := SkipAnsQueries(qd, anslen);
  3187. // get an RR from its normal position. need this to calculate the length.
  3188. AssertTrue('NextNameRR should succeed.',
  3189. NextNameRR(qd.Payload, ansstart, rrn));
  3190. // calculate the size in bytes of the rr so we can copy it to the end
  3191. // of the payload buffer
  3192. t := (rrn.RDataSt + rrn.RRMeta.RDLength) - ansstart;
  3193. CopyBytesTo(qd.Payload,ansstart,Length(qd.Payload)-t, t);
  3194. AssertTrue('NextNameRR should succeed.',
  3195. NextNameRR(qd.Payload, Length(qd.Payload)-t, rrn));
  3196. AssertEquals(DNSQRY_A, rrn.RRMeta.Atype);
  3197. AssertEquals(300, rrn.RRMeta.TTL);
  3198. AssertTrue(DNSRRGetA(rrn, qd.Payload, ip));
  3199. AssertEquals('Wrong ip for A.', '127.0.0.1', HostAddrToStr(ip));
  3200. end;
  3201. procedure TNetDbTest.TestNextNameRRPastEdgeTCPA;
  3202. var
  3203. fakeresp: TFakeDNSResponse;
  3204. qd: TQueryDataLengthTCP;
  3205. anslen, ansstart: Word;
  3206. rrn: TRRNameData;
  3207. t: Cardinal;
  3208. begin
  3209. BuildFakeResponseA(FAKEFQDN, fakeresp);
  3210. AssertTrue('Unable to convert fake dns response to querydata',
  3211. BuildQueryData(fakeresp, qd, anslen));
  3212. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  3213. ansstart := SkipAnsQueries(qd, anslen);
  3214. // get an RR from its normal position. need this to calculate the length.
  3215. AssertTrue('NextNameRR should succeed.',
  3216. NextNameRR(qd.Payload, ansstart, rrn));
  3217. // calculate the size in bytes of the rr so we can copy it to the end
  3218. // of the payload buffer
  3219. t := (rrn.RDataSt + rrn.RRMeta.RDLength) - ansstart;
  3220. // copy the bytes, but leave off the last one. leave the rdlength unchanged.
  3221. CopyBytesTo(qd.Payload,ansstart,Length(qd.Payload)-(t-1), t-1);
  3222. AssertFalse('NextNameRR should fail.',
  3223. NextNameRR(qd.Payload, Length(qd.Payload)-(t-1), rrn));
  3224. end;
  3225. {
  3226. Call GetRRrecords with a start position past the end of the buffer.
  3227. }
  3228. procedure TNetDbTest.TestGetRRrecordsInvalidStart;
  3229. var
  3230. fakeresp: TFakeDNSResponse;
  3231. qd: TQueryData;
  3232. anslen, ansstart: Word;
  3233. RRArr: TRRNameDataArray;
  3234. begin
  3235. BuildFakeResponseA(FAKEFQDN, fakeresp);
  3236. AssertTrue('Unable to convert fake dns response to querydata',
  3237. BuildQueryData(fakeresp, qd, anslen));
  3238. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  3239. ansstart := High(Word);
  3240. anslen := High(Word);
  3241. AssertEquals('Wrong number of A records.', 2, qd.h.ancount);
  3242. RRArr := GetRRrecords(qd.Payload, ansstart, anslen);
  3243. AssertEquals(0, Length(RRArr));
  3244. end;
  3245. procedure TNetDbTest.TestGetRRrecordsInvalidStartTCP;
  3246. var
  3247. fakeresp: TFakeDNSResponse;
  3248. qd: TQueryDataLengthTCP;
  3249. anslen, ansstart: Word;
  3250. RRArr: TRRNameDataArray;
  3251. begin
  3252. BuildFakeResponseA(FAKEFQDN, fakeresp);
  3253. AssertTrue('Unable to convert fake dns response to querydata',
  3254. BuildQueryData(fakeresp, qd, anslen));
  3255. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  3256. ansstart := High(Word);
  3257. anslen := High(Word);
  3258. AssertEquals('Wrong number of A records.', 2, qd.h.ancount);
  3259. RRArr := GetRRrecords(qd.Payload, ansstart, anslen);
  3260. AssertEquals(0, Length(RRArr));
  3261. end;
  3262. procedure TNetDbTest.TestGetFixLenStrSimple;
  3263. const
  3264. s = 'another fine mess';
  3265. var
  3266. buf: TBuffer;
  3267. pl: TPayload;
  3268. tr: TTextArray;
  3269. offset: Cardinal;
  3270. res: ShortString;
  3271. begin
  3272. tr[1] := s;
  3273. tr[2] := '';
  3274. tr[3] := '';
  3275. tr[4] := '';
  3276. tr[5] := '';
  3277. SetLength(buf, 1024);
  3278. offset := 0;
  3279. WriteTextRecAsRData(buf, offset, tr);
  3280. SetLength(buf, offset);
  3281. BufferToPayload(buf, pl);
  3282. // rdlength is word, so len byte for str is at offset 2 and str starts
  3283. // at offset 3.
  3284. GetFixlenStr(pl, 3, pl[2], res);
  3285. AssertEquals(s, res);
  3286. end;
  3287. procedure TNetDbTest.TestGetFixLenStrSimpleTCP;
  3288. const
  3289. s = 'another fine mess';
  3290. var
  3291. buf: TBuffer;
  3292. pl: TPayLoadTCP;
  3293. tr: TTextArray;
  3294. offset: Cardinal;
  3295. res: ShortString;
  3296. begin
  3297. tr[1] := s;
  3298. tr[2] := '';
  3299. tr[3] := '';
  3300. tr[4] := '';
  3301. tr[5] := '';
  3302. SetLength(buf, 1024);
  3303. offset := 0;
  3304. WriteTextRecAsRData(buf, offset, tr);
  3305. SetLength(buf, offset);
  3306. BufferToPayload(buf, pl);
  3307. // rdlength is word, so len byte for str is at offset 2 and str starts
  3308. // at offset 3.
  3309. GetFixlenStr(pl, 3, pl[2], res);
  3310. AssertEquals(s, res);
  3311. end;
  3312. procedure TNetDbTest.TestGetFixLenStrSimpleAtEdge;
  3313. const
  3314. s = 'another fine mess';
  3315. var
  3316. buf: TBuffer;
  3317. pl: TPayload;
  3318. tr: TTextArray;
  3319. offset,n: Cardinal;
  3320. res: ShortString;
  3321. begin
  3322. tr[1] := s;
  3323. tr[2] := '';
  3324. tr[3] := '';
  3325. tr[4] := '';
  3326. tr[5] := '';
  3327. SetLength(buf, Length(pl));
  3328. offset := Length(pl) - (Length(s)+3);
  3329. n := offset+2;
  3330. WriteTextRecAsRData(buf, offset, tr);
  3331. SetLength(buf, offset);
  3332. BufferToPayload(buf, pl);
  3333. GetFixlenStr(pl, n+1, pl[n], res);
  3334. AssertEquals(s, res);
  3335. end;
  3336. procedure TNetDbTest.TestGetFixLenStrSimpleTCPAtEdge;
  3337. const
  3338. s = 'another fine mess';
  3339. var
  3340. buf: TBuffer;
  3341. pl: TPayLoadTCP;
  3342. tr: TTextArray;
  3343. offset,n: Cardinal;
  3344. res: ShortString;
  3345. begin
  3346. tr[1] := s;
  3347. tr[2] := '';
  3348. tr[3] := '';
  3349. tr[4] := '';
  3350. tr[5] := '';
  3351. SetLength(buf, Length(pl));
  3352. offset := Length(pl) - (Length(s)+3);
  3353. n := offset+2;
  3354. WriteTextRecAsRData(buf, offset, tr);
  3355. SetLength(buf, offset);
  3356. BufferToPayload(buf, pl);
  3357. GetFixlenStr(pl, n+1, pl[n], res);
  3358. AssertEquals(s, res);
  3359. end;
  3360. {
  3361. Test GetFixLenStr where len would take string past edge of buffer.
  3362. }
  3363. procedure TNetDbTest.TestGetFixLenStrSimplePastEdge;
  3364. var
  3365. pl: TPayLoadTCP;
  3366. res: ShortString;
  3367. begin
  3368. pl[Length(pl) - 2] := 30;
  3369. pl[Length(pl) - 1] := Ord('a');
  3370. GetFixlenStr(pl, Length(pl)-1, pl[Length(pl)-2], res);
  3371. AssertEquals('', res);
  3372. end;
  3373. procedure TNetDbTest.TestGetFixLenStrSimpleTCPPastEdge;
  3374. var
  3375. pl: TPayLoadTCP;
  3376. res: ShortString;
  3377. begin
  3378. pl[Length(pl) - 2] := 30;
  3379. pl[Length(pl) - 1] := Ord('a');
  3380. GetFixlenStr(pl, Length(pl)-1, pl[Length(pl)-2], res);
  3381. AssertEquals('', res);
  3382. end;
  3383. {
  3384. read a label at the end of the buffer where the last byte is a count
  3385. greater than 0. this is to try and trick stringfromlabel into reading past
  3386. the end of the buffer.
  3387. }
  3388. procedure TNetDbTest.TestStringFromLabelCountAsLastByte;
  3389. var
  3390. fakeresp: TFakeDNSResponse;
  3391. qd: TQueryData;
  3392. anslen, ansstart, oldstart: Word;
  3393. RRArr: TRRNameDataArray;
  3394. s: TDNSDomainName;
  3395. startpos: Longint;
  3396. begin
  3397. // we can use any of CNAME, NS or PTR because these RRs are just a single
  3398. // domain name or series of labels.
  3399. BuildFakeResponseNS(FAKEFQDN, fakeresp);
  3400. AssertTrue('Unable to convert fake dns response to querydata',
  3401. BuildQueryData(fakeresp, qd, anslen));
  3402. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  3403. ansstart := SkipAnsQueries(qd, anslen);
  3404. AssertEquals('Wrong number of NS records.', 1, qd.h.ancount);
  3405. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  3406. AssertEquals('Wrong number of resource records.', 1, Length(RRArr));
  3407. AssertEquals('RR 0 is not an NS RR.',DNSQRY_NS, RRarr[0].RRMeta.Atype);
  3408. // move the ns to the end of the buffer.
  3409. oldstart := RRArr[0].RDataSt;
  3410. RRArr[0].RDataSt := Length(qd.Payload) - RRArr[0].RRMeta.RDLength;
  3411. CopyBytesTo(qd.Payload, oldstart, RRArr[0].RDataSt, RRArr[0].RRMeta.RDLength);
  3412. // Set the last byte in the buffer to a high count
  3413. qd.Payload[Length(qd.Payload)-1] := 63; // must be less than 64
  3414. // need this var because stringfromlabel expects a longint that's a var type.
  3415. startpos := RRarr[0].RDataSt;
  3416. s := stringfromlabel(qd.Payload, startpos);
  3417. AssertEquals('fakens.'+FAKEFQDN, s);
  3418. AssertEquals(Length(qd.Payload), startpos);
  3419. end;
  3420. procedure TNetDbTest.TestStringFromLabelCountAsLastByteTCP;
  3421. var
  3422. fakeresp: TFakeDNSResponse;
  3423. qd: TQueryDataLengthTCP;
  3424. anslen, ansstart, oldstart: Word;
  3425. RRArr: TRRNameDataArray;
  3426. s: TDNSDomainName;
  3427. startpos: Longint;
  3428. begin
  3429. // we can use any of CNAME, NS or PTR because these RRs are just a single
  3430. // domain name or series of labels.
  3431. BuildFakeResponseNS(FAKEFQDN, fakeresp);
  3432. AssertTrue('Unable to convert fake dns response to querydata',
  3433. BuildQueryData(fakeresp, qd, anslen));
  3434. AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h));
  3435. ansstart := SkipAnsQueries(qd, anslen);
  3436. AssertEquals('Wrong number of NS records.', 1, qd.h.ancount);
  3437. RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount);
  3438. AssertEquals('Wrong number of resource records.', 1, Length(RRArr));
  3439. AssertEquals('RR 0 is not an NS RR.',DNSQRY_NS, RRarr[0].RRMeta.Atype);
  3440. // move the ns to the end of the buffer.
  3441. oldstart := RRArr[0].RDataSt;
  3442. RRArr[0].RDataSt := Length(qd.Payload) - RRArr[0].RRMeta.RDLength;
  3443. CopyBytesTo(qd.Payload, oldstart, RRArr[0].RDataSt, RRArr[0].RRMeta.RDLength);
  3444. // Set the last byte in the buffer to a high count
  3445. qd.Payload[Length(qd.Payload)-1] := 63; // must be less than 64
  3446. // need this var because stringfromlabel expects a longint that's a var type.
  3447. startpos := RRarr[0].RDataSt;
  3448. s := stringfromlabel(qd.Payload, startpos);
  3449. AssertEquals('fakens.'+FAKEFQDN, s);
  3450. AssertEquals(Length(qd.Payload), startpos);
  3451. end;
  3452. procedure TNetDbTest.TestStringFromLabelCompress;
  3453. var
  3454. buf: TBuffer;
  3455. stt: TDomainCompressionTable;
  3456. offset: Cardinal;
  3457. offset2: Longint;
  3458. pl: TPayload;
  3459. s: String;
  3460. dmbs: TDNSDomainByteStream;
  3461. begin
  3462. SetLength(buf, 1024);
  3463. SetLength(stt,0);
  3464. offset := 0;
  3465. // initial str is uncompressed because compress table empty
  3466. dmbs := DomainNameToByteStream(FAKEFQDN, stt);
  3467. WriteDNSDomainByteStreamToBuffer(buf, offset, dmbs);
  3468. offset2 := offset;
  3469. // write same domain, this time we get compression.
  3470. dmbs := DomainNameToByteStream(FAKEFQDN, stt);
  3471. WriteDNSDomainByteStreamToBuffer(buf, offset, dmbs);
  3472. BufferToPayload(buf,pl);
  3473. s := stringfromlabel(pl, offset2);
  3474. AssertEquals(FAKEFQDN,s);
  3475. end;
  3476. procedure TNetDbTest.TestStringFromLabelCompressTCP;
  3477. var
  3478. buf: TBuffer;
  3479. stt: TDomainCompressionTable;
  3480. offset: Cardinal;
  3481. offset2: Longint;
  3482. pl: TPayLoadTCP;
  3483. s: String;
  3484. dmbs: TDNSDomainByteStream;
  3485. begin
  3486. SetLength(buf, 1024);
  3487. SetLength(stt,0);
  3488. offset := 0;
  3489. // initial str is uncompressed because compress table empty
  3490. dmbs := DomainNameToByteStream(FAKEFQDN, stt);
  3491. WriteDNSDomainByteStreamToBuffer(buf, offset, dmbs);
  3492. offset2 := offset;
  3493. // write same domain, this time we get compression.
  3494. dmbs := DomainNameToByteStream(FAKEFQDN, stt);
  3495. WriteDNSDomainByteStreamToBuffer(buf, offset, dmbs);
  3496. BufferToPayload(buf,pl);
  3497. s := stringfromlabel(pl, offset2);
  3498. AssertEquals(FAKEFQDN,s);
  3499. end;
  3500. procedure TNetDbTest.TestStringFromLabelCompressWithUncompressedLabel;
  3501. var
  3502. buf: TBuffer;
  3503. dmbs: TDNSDomainByteStream;
  3504. offset: Cardinal;
  3505. so: Longint;
  3506. stt: TDomainCompressionTable;
  3507. len: Word;
  3508. pl: TPayload;
  3509. s: String;
  3510. begin
  3511. SetLength(buf, 1024);
  3512. SetLength(stt,0);
  3513. // compress table empty so no compression here.
  3514. dmbs := DomainNameToByteStream(FAKEFQDN, stt);
  3515. offset := 0;
  3516. WriteDNSDomainByteStreamToBuffer(buf, offset, dmbs);
  3517. so := offset;
  3518. // should get compression on FAKEFQDN but label "foo" is written as full label.
  3519. dmbs := DomainNameToByteStream('foo.' + FAKEFQDN, stt);
  3520. len := CalcRdLength(dmbs);
  3521. // len is 4 for 'foo' (including its length byte) and 2 for the pointer.
  3522. AssertEquals(6, len);
  3523. WriteDNSDomainByteStreamToBuffer(buf, offset, dmbs);
  3524. BufferToPayload(buf,pl);
  3525. s := stringfromlabel(pl, so);
  3526. AssertEquals('foo.'+FAKEFQDN,s);
  3527. end;
  3528. procedure TNetDbTest.TestStringFromLabelCompressWithUncompressedLabelTCP;
  3529. var
  3530. buf: TBuffer;
  3531. dmbs: TDNSDomainByteStream;
  3532. offset: Cardinal;
  3533. so: Longint;
  3534. stt: TDomainCompressionTable;
  3535. len: Word;
  3536. pl: TPayLoadTCP;
  3537. s: String;
  3538. begin
  3539. SetLength(buf, 1024);
  3540. SetLength(stt,0);
  3541. // compress table empty so no compression here.
  3542. dmbs := DomainNameToByteStream(FAKEFQDN, stt);
  3543. offset := 0;
  3544. WriteDNSDomainByteStreamToBuffer(buf, offset, dmbs);
  3545. so := offset;
  3546. // should get compression on FAKEFQDN but label "foo" is written as full label.
  3547. dmbs := DomainNameToByteStream('foo.' + FAKEFQDN, stt);
  3548. len := CalcRdLength(dmbs);
  3549. // len is 4 for 'foo' (including its length byte) and 2 for the pointer.
  3550. AssertEquals(6, len);
  3551. WriteDNSDomainByteStreamToBuffer(buf, offset, dmbs);
  3552. BufferToPayload(buf,pl);
  3553. s := stringfromlabel(pl, so);
  3554. AssertEquals('foo.'+FAKEFQDN,s);
  3555. end;
  3556. {
  3557. Test stringfromlabel with a compressed label at the end of the buffer.
  3558. }
  3559. procedure TNetDbTest.TestStringFromLabelCompressEndBuffer;
  3560. var
  3561. buf: TBuffer;
  3562. stt: TDomainCompressionTable;
  3563. offset: Cardinal;
  3564. offset2: Longint;
  3565. pl: TPayload;
  3566. s: String;
  3567. dmbs: TDNSDomainByteStream;
  3568. begin
  3569. SetLength(buf, 1024);
  3570. SetLength(stt,0);
  3571. offset := 0;
  3572. // initial str is uncompressed because compress table empty
  3573. dmbs := DomainNameToByteStream(FAKEFQDN, stt);
  3574. WriteDNSDomainByteStreamToBuffer(buf, offset, dmbs);
  3575. offset2 := offset;
  3576. // write same domain, this time we get compression.
  3577. dmbs := DomainNameToByteStream(FAKEFQDN, stt);
  3578. // write the pointer at the end of the payload buffer
  3579. offset := Length(pl) - 2;
  3580. WriteDNSDomainByteStreamToBuffer(buf, offset, dmbs);
  3581. BufferToPayload(buf,pl);
  3582. // read back the label.
  3583. offset2 := Length(pl) - 2;
  3584. s := stringfromlabel(pl, offset2);
  3585. AssertEquals(FAKEFQDN,s);
  3586. end;
  3587. procedure TNetDbTest.TestStringFromLabelCompressEndBufferTCP;
  3588. var
  3589. buf: TBuffer;
  3590. stt: TDomainCompressionTable;
  3591. offset: Cardinal;
  3592. offset2: Longint;
  3593. pl: TPayLoadTCP;
  3594. s: String;
  3595. dmbs: TDNSDomainByteStream;
  3596. begin
  3597. SetLength(buf, Length(pl));
  3598. SetLength(stt,0);
  3599. offset := 0;
  3600. // initial str is uncompressed because compress table empty
  3601. dmbs := DomainNameToByteStream(FAKEFQDN, stt);
  3602. WriteDNSDomainByteStreamToBuffer(buf, offset, dmbs);
  3603. offset2 := offset;
  3604. // write same domain, this time we get compression.
  3605. dmbs := DomainNameToByteStream(FAKEFQDN, stt);
  3606. // write the pointer at the end of the payload buffer
  3607. offset := Length(pl) - 2;
  3608. WriteDNSDomainByteStreamToBuffer(buf, offset, dmbs);
  3609. BufferToPayload(buf,pl);
  3610. // read back the label.
  3611. offset2 := Length(pl) - 2;
  3612. s := stringfromlabel(pl, offset2);
  3613. AssertEquals(FAKEFQDN,s);
  3614. end;
  3615. procedure TNetDbTest.TestStringFromLabelCompressSplit;
  3616. var
  3617. pl: TPayload;
  3618. s: String;
  3619. offset: Longint;
  3620. begin
  3621. // fill the buffer with 'A' so that we'll know if stringfromlabel read any
  3622. // of it.
  3623. FillByte(pl, Length(pl), 65);
  3624. offset := Length(pl) - 1;
  3625. pl[offset] := 192;
  3626. s := stringfromlabel(pl, offset);
  3627. AssertEquals('', s);
  3628. end;
  3629. procedure TNetDbTest.TestStringFromLabelCompressSplitTCP;
  3630. var
  3631. pl: TPayLoadTCP;
  3632. s: String;
  3633. offset: Longint;
  3634. begin
  3635. // fill the buffer with 'A' so that we'll know if stringfromlabel read any
  3636. // of it.
  3637. FillByte(pl, Length(pl), 65);
  3638. offset := Length(pl) - 1;
  3639. pl[offset] := 192;
  3640. s := stringfromlabel(pl, offset);
  3641. AssertEquals('', s);
  3642. end;
  3643. procedure TNetDbTest.TestStringFromLabelCompressPtrFwd;
  3644. var
  3645. pl: TPayload;
  3646. s: String;
  3647. offset: Longint;
  3648. ptr: TDNSDomainPointer;
  3649. begin
  3650. FillByte(pl, Length(pl), 0);
  3651. Move('foo', pl[21], 3);
  3652. pl[20] := 3;
  3653. ptr := GetDnsDomainPointer(32); // offset 20 + 12 for the header
  3654. offset := 0;
  3655. pl[offset] := ptr.b1;
  3656. pl[offset+1] := ptr.b2;
  3657. s := stringfromlabel(pl, offset);
  3658. AssertEquals('', s);
  3659. end;
  3660. procedure TNetDbTest.TestStringFromLabelCompressPtrFwdTCP;
  3661. var
  3662. pl: TPayLoadTCP;
  3663. s: String;
  3664. offset: Longint;
  3665. ptr: TDNSDomainPointer;
  3666. begin
  3667. FillByte(pl, Length(pl), 0);
  3668. Move('foo', pl[21], 3);
  3669. pl[20] := 3;
  3670. ptr := GetDnsDomainPointer(32); // offset 20 + 12 for the header
  3671. offset := 0;
  3672. pl[offset] := ptr.b1;
  3673. pl[offset+1] := ptr.b2;
  3674. s := stringfromlabel(pl, offset);
  3675. AssertEquals('', s);
  3676. end;
  3677. procedure TNetDbTest.TestStringFromLabelCompressAllPtrStart;
  3678. var
  3679. pl: TPayload;
  3680. s: String;
  3681. offset: Longint;
  3682. begin
  3683. FillByte(pl, Length(pl), 192);
  3684. offset := 0;
  3685. s := stringfromlabel(pl, offset);
  3686. AssertEquals('', s);
  3687. end;
  3688. procedure TNetDbTest.TestStringFromLabelCompressAllPtrStartTCP;
  3689. var
  3690. pl: TPayLoadTCP;
  3691. s: String;
  3692. offset: Longint;
  3693. begin
  3694. FillByte(pl, Length(pl), 192);
  3695. offset := 0;
  3696. s := stringfromlabel(pl, offset);
  3697. AssertEquals('', s);
  3698. end;
  3699. {
  3700. Test what happens when pointer is 0.
  3701. }
  3702. procedure TNetDbTest.TestStringFromLabelCompressedZero;
  3703. var
  3704. pl: TPayLoad;
  3705. s: String;
  3706. offset: Longint;
  3707. ptr: TDNSDomainPointer;
  3708. begin
  3709. FillByte(pl, Length(pl), 0);
  3710. pl[0] := 1;
  3711. pl[1] := Ord('a');
  3712. ptr := GetDnsDomainPointer(0);
  3713. offset := 5;
  3714. pl[offset] := ptr.b1;
  3715. pl[offset+1] := ptr.b2;
  3716. s := stringfromlabel(pl, offset);
  3717. AssertEquals('', s);
  3718. end;
  3719. {
  3720. Test what happens when pointer is 0.
  3721. }
  3722. procedure TNetDbTest.TestStringFromLabelCompressedZeroTCP;
  3723. var
  3724. pl: TPayLoadTCP;
  3725. s: String;
  3726. offset: Longint;
  3727. ptr: TDNSDomainPointer;
  3728. begin
  3729. FillByte(pl, Length(pl), 0);
  3730. pl[0] := 1;
  3731. pl[1] := Ord('a');
  3732. ptr := GetDnsDomainPointer(0);
  3733. offset := 5;
  3734. pl[offset] := ptr.b1;
  3735. pl[offset+1] := ptr.b2;
  3736. s := stringfromlabel(pl, offset);
  3737. AssertEquals('', s);
  3738. end;
  3739. procedure TNetDbTest.TestStringFromLabelInfiniteLoop;
  3740. var
  3741. buf: TBuffer;
  3742. stt: TDomainCompressionTable;
  3743. offset: Cardinal;
  3744. offset2: Longint;
  3745. pl: TPayload;
  3746. s: String;
  3747. dmbs: TDNSDomainByteStream;
  3748. ptr: TDNSDomainPointer;
  3749. begin
  3750. SetLength(buf, 1024);
  3751. SetLength(stt,0);
  3752. offset := 0;
  3753. // initial str is uncompressed because compress table empty
  3754. dmbs := DomainNameToByteStream(FAKEFQDN, stt);
  3755. WriteDNSDomainByteStreamToBuffer(buf, offset, dmbs);
  3756. ptr := GetDnsDomainPointer(12);
  3757. // offset now points to 0 byte at end of label. We're overwriting that
  3758. // 0 so that stringfromlabel will be tricked into a loop.
  3759. Dec(offset);
  3760. Move(ptr.ba, buf[offset], 2);
  3761. BufferToPayload(buf,pl);
  3762. offset2 := 0;
  3763. s := stringfromlabel(pl, offset2);
  3764. // if stringfromlabel returns at all then the test passed.
  3765. end;
  3766. procedure TNetDbTest.TestStringFromLabelInfiniteLoopTCP;
  3767. var
  3768. buf: TBuffer;
  3769. stt: TDomainCompressionTable;
  3770. offset: Cardinal;
  3771. offset2: Longint;
  3772. pl: TPayLoadTCP;
  3773. s: String;
  3774. dmbs: TDNSDomainByteStream;
  3775. ptr: TDNSDomainPointer;
  3776. begin
  3777. SetLength(buf, 1024);
  3778. SetLength(stt,0);
  3779. offset := 0;
  3780. // initial str is uncompressed because compress table empty
  3781. dmbs := DomainNameToByteStream(FAKEFQDN, stt);
  3782. WriteDNSDomainByteStreamToBuffer(buf, offset, dmbs);
  3783. ptr := GetDnsDomainPointer(12);
  3784. // offset now points to 0 byte at end of label. We're overwriting that
  3785. // 0 so that stringfromlabel will be tricked into a loop.
  3786. Dec(offset);
  3787. Move(ptr.ba, buf[offset], 2);
  3788. BufferToPayload(buf,pl);
  3789. offset2 := 0;
  3790. s := stringfromlabel(pl, offset2);
  3791. // if stringfromlabel returns at all then the test passed.
  3792. end;
  3793. procedure TNetDbTest.TestCompressShortDomain;
  3794. const
  3795. shortdomain = 'a.b';
  3796. var
  3797. buf: TBuffer;
  3798. stt: TDomainCompressionTable;
  3799. offset: Cardinal;
  3800. offset2: Longint;
  3801. pl: TPayload;
  3802. s: String;
  3803. dmbs: TDNSDomainByteStream;
  3804. begin
  3805. SetLength(buf, 1024);
  3806. SetLength(stt,0);
  3807. offset := 0;
  3808. // initial str is uncompressed because compress table empty
  3809. dmbs := DomainNameToByteStream(shortdomain, stt);
  3810. WriteDNSDomainByteStreamToBuffer(buf, offset, dmbs);
  3811. offset2 := offset;
  3812. // second str is compressed
  3813. dmbs := DomainNameToByteStream(shortdomain, stt);
  3814. WriteDNSDomainByteStreamToBuffer(buf, offset, dmbs);
  3815. BufferToPayload(buf,pl);
  3816. s := stringfromlabel(pl, offset2);
  3817. AssertEquals(shortdomain, s);
  3818. end;
  3819. procedure TNetDbTest.TestCompressShortDomainTCP;
  3820. const
  3821. shortdomain = 'a.b';
  3822. var
  3823. buf: TBuffer;
  3824. stt: TDomainCompressionTable;
  3825. offset: Cardinal;
  3826. offset2: Longint;
  3827. pl: TPayLoadTCP;
  3828. s: String;
  3829. dmbs: TDNSDomainByteStream;
  3830. begin
  3831. SetLength(buf, 1024);
  3832. SetLength(stt,0);
  3833. offset := 0;
  3834. // initial str is uncompressed because compress table empty
  3835. dmbs := DomainNameToByteStream(shortdomain, stt);
  3836. WriteDNSDomainByteStreamToBuffer(buf, offset, dmbs);
  3837. offset2 := offset;
  3838. // second str is compressed
  3839. dmbs := DomainNameToByteStream(shortdomain, stt);
  3840. WriteDNSDomainByteStreamToBuffer(buf, offset, dmbs);
  3841. BufferToPayload(buf,pl);
  3842. s := stringfromlabel(pl, offset2);
  3843. AssertEquals(shortdomain, s);
  3844. end;
  3845. procedure TNetDbTest.SetUp;
  3846. begin
  3847. tsl := TStringList.Create;
  3848. end;
  3849. procedure TNetDbTest.TearDown;
  3850. begin
  3851. tsl.Free;
  3852. end;
  3853. procedure TNetDbTest.CopyBytesTo(var buf: TPayLoad; startidx, destidx,
  3854. count: Word);
  3855. begin
  3856. // no tests for overlapping source and dest.
  3857. if ((startidx+count) > Length(buf)) or ((destidx+count) > Length(buf)) then
  3858. exit;
  3859. Move(buf[startidx], buf[destidx], count);
  3860. end;
  3861. procedure TNetDbTest.CopyBytesTo(var buf: TPayLoadTCP; startidx, destidx,
  3862. count: Word);
  3863. begin
  3864. // no tests for overlapping source and dest.
  3865. if ((startidx+count) > Length(buf)) or ((destidx+count) > Length(buf)) then
  3866. exit;
  3867. Move(buf[startidx], buf[destidx], count);
  3868. end;
  3869. function TNetDbTest.WriteNumToBuffer(var buf: TBuffer; var offset: Cardinal;
  3870. val: Word): Word;
  3871. begin
  3872. Result := 0;
  3873. if (offset + SizeOf(val)) > Length(buf) then exit;
  3874. Move(HToNs(val), buf[offset], SizeOf(val));
  3875. Inc(offset, SizeOf(val));
  3876. Result := SizeOf(val);
  3877. end;
  3878. function TNetDbTest.WriteNumToBuffer(var buf: TBuffer; var offset: Cardinal;
  3879. val: Cardinal): Word;
  3880. begin
  3881. Result := 0;
  3882. if (offset + SizeOf(val)) > Length(buf) then exit;
  3883. Move(HToNl(val), buf[offset], SizeOf(val));
  3884. Inc(offset, SizeOf(val));
  3885. Result := SizeOf(val);
  3886. end;
  3887. {
  3888. Write a number to the buffer without converting it to network byte order.
  3889. }
  3890. function TNetDbTest.WriteNumToBufferN(var buf: TBuffer; var offset: Cardinal;
  3891. val: Word): Word;
  3892. begin
  3893. Result := 0;
  3894. if (offset + SizeOf(val)) > Length(buf) then exit;
  3895. Move(val, buf[offset], SizeOf(val));
  3896. Inc(offset, SizeOf(val));
  3897. Result := SizeOf(val);
  3898. end;
  3899. {
  3900. Write a number to the buffer without converting it to network byte order.
  3901. }
  3902. function TNetDbTest.WriteNumToBufferN(var buf: TBuffer; var offset: Cardinal;
  3903. val: Cardinal): Word;
  3904. begin
  3905. Result := 0;
  3906. if (offset + SizeOf(val)) > Length(buf) then exit;
  3907. Move(val, buf[offset], SizeOf(val));
  3908. Inc(offset, SizeOf(val));
  3909. Result := SizeOf(val);
  3910. end;
  3911. {
  3912. Write an RR to the byte buffer. No compression of domain names will occur.
  3913. }
  3914. function TNetDbTest.WriteRRToBuffer(var buf: TBuffer; var offset: Cardinal;
  3915. rr: TFakeRR): Word;
  3916. var
  3917. s,etw: Word;
  3918. dmbs: TDNSDomainByteStream;
  3919. res: TRDataWriteRes;
  3920. begin
  3921. etw := 0;
  3922. s := offset;
  3923. // write the RR Name
  3924. dmbs := DomainNameToByteStream(rr.RRName);
  3925. etw := CalcRdLength(dmbs);
  3926. if WriteDNSDomainByteStreamToBuffer(buf, offset, dmbs) < etw
  3927. then
  3928. Fail('Cannot write RR name to buffer at offset '+ inttostr(offset));
  3929. if (offset + SizeOf(rr.Atype) + SizeOf(rr.AClass) + SizeOf(rr.TTL)) >
  3930. Length(buf)
  3931. then
  3932. Fail('Not enough space to add RR type,class,ttl at offset '+ inttostr(offset));
  3933. // Write the RR type, class and TTL.
  3934. WriteNumToBuffer(buf, offset,rr.Atype);
  3935. WriteNumToBuffer(buf, offset, rr.AClass);
  3936. WriteNumToBuffer(buf, offset, rr.TTL);
  3937. // now the RR data, which is type specific. Each type-specific method
  3938. // also writes the RDLength word, so we have to account for 2 additional
  3939. // bytes.
  3940. case rr.Atype of
  3941. DNSQRY_A:
  3942. res := WriteAasRData(buf, offset, rr.ip);
  3943. DNSQRY_AAAA:
  3944. res := WriteAAAAasRData(buf, offset, rr.ip6);
  3945. DNSQRY_SOA:
  3946. res := WriteSOAasRData(buf, offset, rr.fsoa);
  3947. DNSQRY_MX:
  3948. res := WriteMXAsRData(buf, offset, rr.fmx);
  3949. DNSQRY_NS:
  3950. begin
  3951. dmbs := DomainNameToByteStream(rr.nsh);
  3952. res := WriteDomainAsRdata(buf,offset,dmbs);
  3953. end;
  3954. DNSQRY_PTR:
  3955. begin
  3956. dmbs := DomainNameToByteStream(rr.nsh);
  3957. res := WriteDomainAsRdata(buf,offset,dmbs);
  3958. end;
  3959. DNSQRY_CNAME:
  3960. begin
  3961. dmbs := DomainNameToByteStream(rr.cn);
  3962. res := WriteDomainAsRdata(buf,offset,dmbs);
  3963. end;
  3964. DNSQRY_TXT:
  3965. res := WriteTextRecAsRData(buf, offset, rr.txtarr);
  3966. DNSQRY_SRV:
  3967. res := WriteSRVasRData(buf, offset, rr.fsrv);
  3968. else
  3969. Fail('Called to handle RR type '+inttostr(rr.Atype)+
  3970. ' but no code to handle it.');
  3971. end;
  3972. if res.bw < res.etw then
  3973. Fail('Unable to write RR of type ' +inttostr(RR.Atype) +
  3974. ', name "' + rr.RRName + '" to buffer at offset '+inttostr(offset)+
  3975. '. Wrote '+inttostr(res.bw)+' bytes, expected to write '+
  3976. inttostr(res.etw)+' bytes.');
  3977. Result := offset - s;
  3978. end;
  3979. {
  3980. Write an RR to the output buffer, with compression of domain names turned on.
  3981. }
  3982. function TNetDbTest.WriteRRToBuffer(var buf: TBuffer; var offset: Cardinal;
  3983. rr: TFakeRR; var ctbl: TDomainCompressionTable): Word;
  3984. var
  3985. s, etw: Word;
  3986. dmbs: TDNSDomainByteStream;
  3987. res: TRDataWriteRes;
  3988. begin
  3989. etw := 0;
  3990. s := offset;
  3991. // write the RR Name
  3992. dmbs := DomainNameToByteStream(rr.RRName, ctbl);
  3993. etw := CalcRdLength(dmbs);
  3994. if WriteDNSDomainByteStreamToBuffer(buf, offset, dmbs) < etw
  3995. then
  3996. Fail('Cannot write RR name to buffer at offset '+ inttostr(offset));
  3997. if (offset + SizeOf(rr.Atype) + SizeOf(rr.AClass) + SizeOf(rr.TTL)) >
  3998. Length(buf)
  3999. then
  4000. Fail('Not enough space to add RR type,class,ttl at offset '+ inttostr(offset));
  4001. // Write the RR type, class and TTL.
  4002. WriteNumToBuffer(buf, offset,rr.Atype);
  4003. WriteNumToBuffer(buf, offset, rr.AClass);
  4004. WriteNumToBuffer(buf, offset, rr.TTL);
  4005. // now the RR data, which is type specific. Each type-specific method
  4006. // also writes the RDLength word, so we have to account for 2 additional
  4007. // bytes.
  4008. case rr.Atype of
  4009. DNSQRY_A:
  4010. begin
  4011. res := WriteAasRData(buf, offset, rr.ip);
  4012. end;
  4013. DNSQRY_AAAA:
  4014. begin
  4015. res := WriteAAAAasRData(buf, offset, rr.ip6);
  4016. end;
  4017. DNSQRY_SOA:
  4018. begin
  4019. res := WriteSOAasRData(buf, offset, rr.fsoa);
  4020. end;
  4021. DNSQRY_MX:
  4022. begin
  4023. res := WriteMXAsRData(buf, offset, rr.fmx, ctbl);
  4024. end;
  4025. DNSQRY_NS:
  4026. begin
  4027. dmbs := DomainNameToByteStream(rr.nsh, ctbl);
  4028. res := WriteDomainAsRdata(buf,offset,dmbs);
  4029. end;
  4030. DNSQRY_PTR:
  4031. begin
  4032. dmbs := DomainNameToByteStream(rr.nsh, ctbl);
  4033. res := WriteDomainAsRdata(buf,offset,dmbs);
  4034. end;
  4035. DNSQRY_CNAME:
  4036. begin
  4037. dmbs := DomainNameToByteStream(rr.cn, ctbl);
  4038. res := WriteDomainAsRdata(buf,offset,dmbs);
  4039. end;
  4040. DNSQRY_TXT:
  4041. begin
  4042. res := WriteTextRecAsRData(buf, offset, rr.txtarr);
  4043. end;
  4044. DNSQRY_SRV:
  4045. begin
  4046. res := WriteSRVasRData(buf, offset, rr.fsrv);
  4047. end;
  4048. else
  4049. Fail('Called to handle RR type '+inttostr(rr.Atype)+
  4050. ' but no code to handle it.');
  4051. end;
  4052. if res.bw < res.etw then
  4053. Fail('Unable to write RR of type ' +inttostr(RR.Atype) +
  4054. ', name "' + rr.RRName + '" to buffer at offset '+inttostr(offset)+
  4055. '. Wrote '+inttostr(res.bw)+' bytes, expected to write '+
  4056. inttostr(res.etw)+' bytes.');
  4057. Result := offset - s;
  4058. end;
  4059. {
  4060. Turn a fake DNS response into a payload buffer. This is a byte buffer minus the
  4061. DNS header. That is, the buffer begins with the question part of the response,
  4062. after which comes the RRs of the answers, authority, and additional sections.
  4063. }
  4064. function TNetDbTest.FakeDNSResponseToByteBuffer(fdr: TFakeDNSResponse; out
  4065. buf: TBuffer; compress: Boolean): Cardinal;
  4066. var
  4067. offset: Cardinal;
  4068. rr: TFakeRR;
  4069. dbs: TDNSDomainByteStream;
  4070. begin
  4071. // plenty of room for our test responses. could precalculate this, but there's
  4072. // no benefit. The return value of this function is the length of the
  4073. // DNS reply, which we get for free since we have to track our offset into
  4074. // the buffer as we write it.
  4075. SetLength(buf, 2048);
  4076. offset := 0;
  4077. if compress then
  4078. dbs := DomainNameToByteStream(fdr.qry.nm,fdr.strtable)
  4079. else
  4080. dbs := DomainNameToByteStream(fdr.qry.nm);
  4081. // The question section consists of the dns query name, the qtype and
  4082. // qclass.
  4083. if WriteDNSDomainByteStreamToBuffer(buf, offset, dbs) < CalcRdLength(dbs)
  4084. then
  4085. Fail('Cannot write name to buffer at offset '+ inttostr(offset));
  4086. WriteNumToBuffer(buf, offset, fdr.qry.qtype);
  4087. WriteNumToBuffer(buf, offset, fdr.qry.qclass);
  4088. // Now the answer sections.
  4089. for rr in fdr.answers do
  4090. if compress then
  4091. WriteRRToBuffer(buf, offset, rr, fdr.strtable)
  4092. else
  4093. WriteRRToBuffer(buf, offset, rr);
  4094. for rr in fdr.authority do
  4095. if compress then
  4096. WriteRRToBuffer(buf, offset, rr, fdr.strtable)
  4097. else
  4098. WriteRRToBuffer(buf, offset, rr);
  4099. for rr in fdr.additional do
  4100. if compress then
  4101. WriteRRToBuffer(buf, offset, rr, fdr.strtable)
  4102. else
  4103. WriteRRToBuffer(buf, offset, rr);
  4104. SetLength(buf, offset);
  4105. Result := offset;
  4106. end;
  4107. {
  4108. Generate a TPayload buffer, a fixed-length array of byte, from the TBuffer
  4109. type, which is a variable-length array of byte.
  4110. }
  4111. function TNetDbTest.BufferToPayload(const buf: TBuffer;
  4112. out pl: TPayload): Boolean;
  4113. begin
  4114. Result := False;
  4115. FillChar(pl,Length(pl),0);
  4116. Move(buf[0], pl[0], Min(Length(pl),Length(buf)));
  4117. Result := True;
  4118. end;
  4119. function TNetDbTest.BufferToPayload(const buf: TBuffer;
  4120. out pl: TPayLoadTCP): Boolean;
  4121. begin
  4122. Result := False;
  4123. FillChar(pl,Length(pl),0);
  4124. Move(buf[0], pl[0], Min(Length(pl),Length(buf)));
  4125. Result := True;
  4126. end;
  4127. function TNetDbTest.BuildQueryData(fdr: TFakeDNSResponse; out qd: TQueryData;
  4128. out qlen: Word; Compress: Boolean = False): Boolean;
  4129. var
  4130. buf: TBuffer;
  4131. begin
  4132. qlen := FakeDNSResponseToByteBuffer(fdr, buf, Compress);
  4133. qd.h.ancount := HToNs(fdr.hdr.ancount);
  4134. qd.h.arcount := HToNs(fdr.hdr.arcount);
  4135. qd.h.nscount := HToNs(fdr.hdr.nscount);
  4136. qd.h.qdcount := HToNs(fdr.hdr.qdcount);
  4137. qd.h.flags1 := fdr.hdr.flags1;
  4138. qd.h.flags2 := fdr.hdr.flags2;
  4139. qd.h.id[0] := fdr.hdr.id[0];
  4140. qd.h.id[1] := fdr.hdr.id[1];
  4141. Result := BufferToPayload(buf, qd.Payload);
  4142. end;
  4143. function TNetDbTest.BuildQueryData(fdr: TFakeDNSResponse; out
  4144. qd: TQueryDataLengthTCP; out qlen: Word; Compress: Boolean = False): Boolean;
  4145. var
  4146. buf: TBuffer;
  4147. begin
  4148. qlen := FakeDNSResponseToByteBuffer(fdr, buf, Compress);
  4149. qd.h.ancount := HToNs(fdr.hdr.ancount);
  4150. qd.h.arcount := HToNs(fdr.hdr.arcount);
  4151. qd.h.nscount := HToNs(fdr.hdr.nscount);
  4152. qd.h.qdcount := HToNs(fdr.hdr.qdcount);
  4153. qd.h.flags1 := fdr.hdr.flags1;
  4154. qd.h.flags2 := fdr.hdr.flags2;
  4155. qd.h.id[0] := fdr.hdr.id[0];
  4156. qd.h.id[1] := fdr.hdr.id[1];
  4157. Result := BufferToPayload(buf, qd.Payload);
  4158. end;
  4159. {
  4160. Create a deliberately invalid DNS response to test our API's ability to cope
  4161. with invalid data without causing memory corruption.
  4162. After building a valid DNS response as normal, we truncate it at the given
  4163. offset.}
  4164. function TNetDbTest.BuildTruncatedQueryData(fdr: TFakeDNSResponse; out
  4165. qd: TQueryData; out qlen: Word; truncoffset: Word): Boolean;
  4166. var
  4167. buf: TBuffer;
  4168. begin
  4169. qlen := FakeDNSResponseToByteBuffer(fdr, buf);
  4170. qd.h.ancount := HToNs(fdr.hdr.ancount);
  4171. qd.h.arcount := HToNs(fdr.hdr.arcount);
  4172. qd.h.nscount := HToNs(fdr.hdr.nscount);
  4173. qd.h.qdcount := HToNs(fdr.hdr.qdcount);
  4174. qd.h.flags1 := fdr.hdr.flags1;
  4175. qd.h.flags2 := fdr.hdr.flags2;
  4176. qd.h.id[0] := fdr.hdr.id[0];
  4177. qd.h.id[1] := fdr.hdr.id[1];
  4178. SetLength(buf, truncoffset);
  4179. Result := BufferToPayload(buf, qd.Payload);
  4180. end;
  4181. initialization
  4182. RegisterTest(TNetDbTest);
  4183. end.