diff options
author | nickysn <nickysn@3ad0048d-3df7-0310-abae-a5850022a9f2> | 2021-01-30 22:29:44 +0000 |
---|---|---|
committer | nickysn <nickysn@3ad0048d-3df7-0310-abae-a5850022a9f2> | 2021-01-30 22:29:44 +0000 |
commit | 442f014d5c957381208bfb5ce46528f351505787 (patch) | |
tree | 0d4acf326b195376b170eaca6b4b112a5f96c163 | |
parent | e49c331a7b16e22f168b5e21060d4a62e3cf340f (diff) | |
parent | 86797a513f7e0aa500c2cac8cf2721c694802faa (diff) | |
download | fpc-442f014d5c957381208bfb5ce46528f351505787.tar.gz |
* synchronized with trunk
git-svn-id: https://svn.freepascal.org/svn/fpc/branches/wasm@48460 3ad0048d-3df7-0310-abae-a5850022a9f2
-rw-r--r-- | packages/fcl-base/src/eventlog.pp | 64 | ||||
-rw-r--r-- | packages/fcl-net/src/netdb.pp | 1117 | ||||
-rw-r--r-- | packages/fcl-net/tests/netdbtest.pp | 4615 | ||||
-rw-r--r-- | packages/fcl-net/tests/tresolvertests.pp | 28 | ||||
-rw-r--r-- | rtl/i386/cpu.pp | 5 | ||||
-rw-r--r-- | rtl/unix/sysutils.pp | 18 | ||||
-rw-r--r-- | tests/Makefile | 2 | ||||
-rw-r--r-- | tests/Makefile.fpc | 2 | ||||
-rw-r--r-- | tests/test/units/sysutils/tfileage.pp | 10 |
9 files changed, 5782 insertions, 79 deletions
diff --git a/packages/fcl-base/src/eventlog.pp b/packages/fcl-base/src/eventlog.pp index a72bbd1f93..24492b54ea 100644 --- a/packages/fcl-base/src/eventlog.pp +++ b/packages/fcl-base/src/eventlog.pp @@ -23,9 +23,10 @@ uses SysUtils,Classes; Type TEventLog = Class; - TLogType = (ltSystem,ltFile); + TLogType = (ltSystem,ltFile,ltStdOut,ltStdErr); TLogCodeEvent = Procedure (Sender : TObject; Var Code : DWord) of Object; TLogCategoryEvent = Procedure (Sender : TObject; Var Code : Word) of Object; + TLogMessageEvent = Procedure (Sender : TObject; EventType : TEventType; Const Msg : String) of Object; TEventLog = Class(TComponent) Private @@ -44,6 +45,7 @@ Type FOnGetCustomCategory : TLogCategoryEvent; FOnGetCustomEventID : TLogCodeEvent; FOnGetCustomEvent : TLogCodeEvent; + FOnLogMessage: TLogMessageEvent; FPaused : Boolean; procedure SetActive(const Value: Boolean); procedure SetIdentification(const Value: String); @@ -52,16 +54,20 @@ Type procedure DeActivateLog; procedure ActivateFileLog; procedure SetFileName(const Value: String); + procedure ActivateIOLog; procedure ActivateSystemLog; function DefaultFileName: String; + function FormatLogMessage(EventType : TEventType; const Msg: String): String; procedure WriteFileLog(EventType : TEventType; const Msg: String); procedure WriteSystemLog(EventType: TEventType; const Msg: String); + procedure WriteIOLog(EventType: TEventType; const Msg: String; var OutFile: TextFile); procedure DeActivateFileLog; procedure DeActivateSystemLog; procedure CheckIdentification; Procedure DoGetCustomEventID(Var Code : DWord); Procedure DoGetCustomEventCategory(Var Code : Word); Procedure DoGetCustomEvent(Var Code : DWord); + Procedure DoLogMessage(EventType : TEventType; const Msg: String); Protected Procedure CheckInactive; Procedure EnsureActive; @@ -101,6 +107,7 @@ Type Property OnGetCustomCategory : TLogCategoryEvent Read FOnGetCustomCategory Write FOnGetCustomCategory; Property OnGetCustomEventID : TLogCodeEvent Read FOnGetCustomEventID Write FOnGetCustomEventID; Property OnGetCustomEvent : TLogCodeEvent Read FOnGetCustomEvent Write FOnGetCustomEvent; + Property OnLogMessage : TLogMessageEvent read FOnLogMessage write FOnLogMessage; Property Paused : Boolean Read FPaused Write FPaused; End; @@ -114,6 +121,8 @@ Resourcestring SLogDebug = 'Debug'; SLogCustom = 'Custom (%d)'; SErrLogFailedMsg = 'Failed to log entry (Error: %s)'; + SErrLogOpenStdOut = 'Standard Output not available for logging'; + SErrLogOpenStdErr = 'Standard Error not available for logging'; implementation @@ -201,20 +210,31 @@ begin Case FlogType of ltFile : WriteFileLog(EventType,Msg); ltSystem : WriteSystemLog(EventType,Msg); + ltStdOut : WriteIOLog(EventType,Msg,StdOut); + ltStdErr : WriteIOLog(EventType,Msg,StdErr); end; + DoLogMessage(EventType, Msg); end; -procedure TEventLog.WriteFileLog(EventType : TEventType; const Msg : String); - +function TEventLog.FormatLogMessage(EventType : TEventType; const Msg: String): String; Var - S,TS,T : String; + TS,T : String; begin If FTimeStampFormat='' then FTimeStampFormat:='yyyy-mm-dd hh:nn:ss.zzz'; TS:=FormatDateTime(FTimeStampFormat,Now); T:=EventTypeToString(EventType); - S:=Format('%s [%s %s] %s%s',[Identification,TS,T,Msg,LineEnding]); + Result:=Format('%s [%s %s] %s',[Identification,TS,T,Msg]); +end; + +procedure TEventLog.WriteFileLog(EventType : TEventType; const Msg : String); + +Var + S : String; + +begin + S:=FormatLogMessage(EventType, Msg)+LineEnding; try FStream.WriteBuffer(S[1],Length(S)); S:=''; @@ -226,6 +246,11 @@ begin Raise ELogError.CreateFmt(SErrLogFailedMsg,[S]); end; +procedure TEventLog.WriteIOLog(EventType: TEventType; const Msg: String; var OutFile: TextFile); +begin + Writeln(OutFile,FormatLogMessage(EventType,Msg)); +end; + procedure TEventLog.Log(const Fmt: String; Args: array of const); begin Log(Format(Fmt,Args)); @@ -249,6 +274,8 @@ begin Case FLogType of ltFile : ActivateFileLog; ltSystem : ActivateSystemLog; + ltStdOut, + ltStdErr : ActivateIOLog; end; end; @@ -258,6 +285,8 @@ begin Case FLogType of ltFile : DeActivateFileLog; ltSystem : DeActivateSystemLog; + { nothing to do here } + ltStdOut,ltStdErr : ; end; end; @@ -279,6 +308,24 @@ begin FStream.Seek(0,soFromEnd); end; +Procedure TEventLog.ActivateIOLog; + +var + errmsg: String; + m: LongInt; + +begin + if FLogtype = ltStdOut then begin + m := TextRec(StdOut).Mode; + errmsg := SErrLogOpenStdOut; + end else begin + m := TextRec(StdErr).Mode; + errmsg := SErrLogOpenStdErr; + end; + if (m <> fmOutput) and (m <> fmAppend) then + raise ELogError.Create(errmsg); +end; + Procedure TEventLog.DeActivateFileLog; begin @@ -354,6 +401,13 @@ begin FOnGetCustomEvent(Self,Code); end; +Procedure TEventLog.DoLogMessage(EventType : TEventType; const Msg: String); + +begin + If Assigned(FOnLogMessage) then + FOnLogMessage(Self,EventType,Msg); +end; + destructor TEventLog.Destroy; begin diff --git a/packages/fcl-net/src/netdb.pp b/packages/fcl-net/src/netdb.pp index 583d3e899b..b945990e69 100644 --- a/packages/fcl-net/src/netdb.pp +++ b/packages/fcl-net/src/netdb.pp @@ -84,11 +84,37 @@ Const MaxRecursion = 10; MaxIP4Mapped = 10; + { from http://www.iana.org/assignments/dns-parameters } + DNSQRY_A = 1; // name to IP address + DNSQRY_AAAA = 28; // name to IP6 address + DNSQRY_A6 = 38; // name to IP6 (new) + DNSQRY_PTR = 12; // IP address to name + DNSQRY_MX = 15; // name to MX + DNSQRY_TXT = 16; // name to TXT + DNSQRY_CNAME = 5; + DNSQRY_SOA = 6; + DNSQRY_NS = 2; + DNSQRY_SRV = 33; + + // Flags 1 + QF_QR = $80; + QF_OPCODE = $78; + QF_AA = $04; + QF_TC = $02; // Truncated. + QF_RD = $01; + + // Flags 2 + QF_RA = $80; + QF_Z = $70; + QF_RCODE = $0F; + var EtcPath: string; {$endif FPC_USE_LIBC} Type + TDNSRcode = (rcNoError, rcFormatError,rcServFail,rcNXDomain, + rcNotImpl,rcRefused,rcReserved,rcInvalid); TDNSServerArray = Array of THostAddr; TServiceEntry = record Name : String; @@ -134,6 +160,66 @@ Type end; {$ifndef FPC_USE_LIBC} + +Type + TPayLoad = Array[0..511] of Byte; + TPayLoadTCP = Array[0 .. 65535] of Byte; + + TDNSHeader = packed Record + id : Array[0..1] of Byte; + flags1 : Byte; + flags2 : Byte; + qdcount : word; + ancount : word; + nscount : word; + arcount : word; + end; + + TQueryData = packed Record + h: TDNSHeader; + Payload : TPayLoad; + end; + + TQueryDataLength = packed record + length: Word; + hpl: TQueryData; + end; + + TQueryDataLengthTCP = packed Record + length: Word; + h: TDNSHeader; + Payload : TPayLoadTCP; + end; + + PRRData = ^TRRData; + TRRData = Packed record // RR record + Atype : Word; // Answer type + AClass : Word; + TTL : Cardinal; + RDLength : Word; + end; + + TRRNameData = packed record + RRName : ShortString; + RRMeta : TRRData; + RDataSt : Word; + end; + TRRNameDataArray = array of TRRNameData; + + TDNSDomainName = ShortString; + TDNSRR_SOA = packed record + mname, rname: TDNSDomainName; + serial,refresh,retry,expire,min: Cardinal; + end; + TDNSRR_MX = packed record + preference: Word; + exchange: TDNSDomainName; + end; + TDNSRR_SRV = packed record + priority, weight, port: Word; + target: TDNSDomainName; + end; + Var DNSServers : TDNSServerArray; DNSOptions : String; @@ -189,6 +275,82 @@ Function GetProtocolByNumber(proto: Integer; Var H : TProtocolEntry) : boolean; Function ProcessHosts(FileName : String) : PHostListEntry; Function FreeHostsList(var List : PHostListEntry) : Integer; Procedure HostsListToArray(var List : PHostListEntry; Var Hosts : THostEntryArray; FreeList : Boolean); + +Procedure CheckResolveFile; +Function Query(Resolver : Integer; Var Qry,Ans : TQueryData; QryLen : Integer; Var AnsLen : Integer) : Boolean; +function QueryTCP(Resolver : Integer; Var Qry: TQueryDataLength; + var Ans: TQueryDataLengthTCP; QryLen : Integer; Var AnsLen : Integer) : Boolean; +Function BuildPayLoad(Var Q : TQueryData; Name : String; RR : Word; QClass : Word) : Integer; +Function BuildPayLoadTCP(Var Q : TQueryDataLength; Name : String; RR : Word; QClass : Word) : Integer; + +Function SkipAnsQueries(Var Ans : TQueryData; L : Integer) : integer; +Function SkipAnsQueries(Var Ans : TQueryDataLengthTCP; L : Integer) : integer; + +function stringfromlabel(pl: TPayLoad; var start: Integer): string; +function stringfromlabel(pl: TPayLoadTCP; var start: Integer): string; +Function CheckAnswer(Const Qry : TDNSHeader; Var Ans : TDNSHeader) : Boolean; +function IsValidAtype(atype: Word): Boolean; + +function IsTruncated(R: TDNSHeader): Boolean; +function GetRcode(R: TDNSHeader): TDNSRcode; +function GetFixlenStr(pl: TPayLoad; startidx: Cardinal; len: Byte; + out res: ShortString): Byte; +function GetFixlenStr(pl: TPayLoadTCP; startidx: Cardinal; len: Byte; + out res: ShortString): Byte; + +function NextNameRR(const pl: TPayLoadTCP; start: Word; + out RRName: TRRNameData): Boolean; +function NextNameRR(const pl: TPayLoad; start: Word; + out RRName: TRRNameData): Boolean; + +function GetRRrecords(const pl: TPayloadTCP; var Start: Word; Count: Word): + TRRNameDataArray; +function GetRRrecords(const pl: TPayload; var Start: Word; Count: Word): + TRRNameDataArray; + +function DnsLookup(dn: String; qtype: Word; out Ans: TQueryData; + out AnsLen: Longint): Boolean; +function DnsLookup(dn: String; qtype: Word; out Ans: TQueryDataLengthTCP; + out AnsLen: Longint): Boolean; + +function DNSRRGetA(const RR: TRRNameData; const pl: TPayLoadTCP; + out IP: THostAddr): Boolean; +function DNSRRGetA(const RR: TRRNameData; const pl: TPayLoad; + out IP: THostAddr): Boolean; +function DNSRRGetCNAME(const RR: TRRNameData; const pl: TPayLoad; + out cn: TDNSDomainName): Boolean; +function DNSRRGetCNAME(const RR: TRRNameData; const pl: TPayLoadTCP; + out cn: TDNSDomainName): Boolean; +function DNSRRGetAAAA(const RR: TRRNameData; const pl: TPayLoadTCP; + out IP: THostAddr6): Boolean; +function DNSRRGetAAAA(const RR: TRRNameData; const pl: TPayLoad; + out IP: THostAddr6): Boolean; +function DNSRRGetNS(const RR: TRRNameData; const pl: TPayLoadTCP; + out NSName: TDNSDomainName): Boolean; +function DNSRRGetNS(const RR: TRRNameData; const pl: TPayLoad; + out NSName: TDNSDomainName): Boolean; +function DNSRRGetSOA(const RR: TRRNameData; const pl: TPayLoadTCP; + out dnssoa: TDNSRR_SOA): Boolean; +function DNSRRGetSOA(const RR: TRRNameData; const pl: TPayLoad; + out dnssoa: TDNSRR_SOA): Boolean; +function DNSRRGetText(const RR: TRRNameData; const pl: TPayLoad; + out dnstext: AnsiString): Boolean; +function DNSRRGetText(const RR: TRRNameData; const pl: TPayLoadTCP; + out dnstext: AnsiString): Boolean; +function DNSRRGetMX(const RR: TRRNameData; const pl: TPayLoadTCP; + out MX: TDNSRR_MX): Boolean; +function DNSRRGetMX(const RR: TRRNameData; const pl: TPayLoad; + out MX: TDNSRR_MX): Boolean; +function DNSRRGetPTR(const RR: TRRNameData; const pl: TPayLoadTCP; + out ptr: TDNSDomainName): Boolean; +function DNSRRGetPTR(const RR: TRRNameData; const pl: TPayLoad; + out ptr: TDNSDomainName): Boolean; +function DNSRRGetSRV(const RR: TRRNameData; const pl: TPayload; + out srv: TDNSRR_SRV): Boolean; +function DNSRRGetSRV(const RR: TRRNameData; const pl: TPayloadTCP; + out srv: TDNSRR_SRV): Boolean; + + {$endif FPC_USE_LIBC} Implementation @@ -201,54 +363,14 @@ uses sysutils; {$ifndef FPC_USE_LIBC} +type + TTCPSocketResult = (srTimeout,srPartial,srSocketClose,srOK); + var DefaultDomainListArr : array of string; NDots: Integer; -const - { from http://www.iana.org/assignments/dns-parameters } - DNSQRY_A = 1; // name to IP address - DNSQRY_AAAA = 28; // name to IP6 address - DNSQRY_A6 = 38; // name to IP6 (new) - DNSQRY_PTR = 12; // IP address to name - DNSQRY_MX = 15; // name to MX - DNSQRY_TXT = 16; // name to TXT - DNSQRY_CNAME = 5; - - // Flags 1 - QF_QR = $80; - QF_OPCODE = $78; - QF_AA = $04; - QF_TC = $02; // Truncated. - QF_RD = $01; - - // Flags 2 - QF_RA = $80; - QF_Z = $70; - QF_RCODE = $0F; - - -Type - TPayLoad = Array[0..511] of Byte; - TQueryData = packed Record - id : Array[0..1] of Byte; - flags1 : Byte; - flags2 : Byte; - qdcount : word; - ancount : word; - nscount : word; - arcount : word; - Payload : TPayLoad; - end; - - PRRData = ^TRRData; - TRRData = Packed record // RR record - Atype : Word; // Answer type - AClass : Word; - TTL : Cardinal; - RDLength : Word; - end; { --------------------------------------------------------------------- Some Parsing routines @@ -685,9 +807,10 @@ Var begin Result:=-1; - If length(Name)>506 then + If (Length(Name) = 0) or (length(Name)>506) then Exit; - Result:=0; + + Result:=0; P:=@Q.Payload[0]; Repeat L:=Pos('.',Name); @@ -695,6 +818,17 @@ begin S:=Length(Name) else S:=L-1; + // empty label is invalid, unless it's a dot at the end. + if (S = 0) then + begin + if (Length(Name) > 0) then + begin + Result := -1; + exit; + end + else + break; // empty label at end, break out for final 0 length byte. + end; P[Result]:=S; Move(Name[1],P[Result+1],S); Inc(Result,S+1); @@ -710,7 +844,23 @@ begin Inc(Result,2); end; +{Construct a TCP query payload from the given name, rr and qclass. The + principal difference between the TCP and UDP payloads is the two-octet + length field in the TCP payload. The UDP payload has no length field. + See RFC-1035, section 4.2.2. + + Returns the length of the constructed payload, which doesn't include + the header or the length field.} +function BuildPayLoadTCP(var Q: TQueryDataLength; Name: String; RR: Word; + QClass: Word): Integer; +var + l: Word; +begin + l := BuildPayLoad(Q.hpl, Name, RR, QClass); + Q.length := htons(l + SizeOf(Q.hpl.h)); + Result := l; +end; Function NextRR(Const PayLoad : TPayLoad;Var Start : LongInt; AnsLen : LongInt; Var RR : TRRData) : Boolean; @@ -783,9 +933,8 @@ end; { --------------------------------------------------------------------- QueryData handling functions ---------------------------------------------------------------------} - -Function CheckAnswer(Const Qry : TQueryData; Var Ans : TQueryData) : Boolean; +function CheckAnswer(const Qry: TDNSHeader; var Ans: TDNSHeader): Boolean; begin Result:=False; With Ans do @@ -797,7 +946,7 @@ begin If (Flags1 and QF_QR)=0 then exit; if (Flags1 and QF_OPCODE)<>0 then - exit; + exit; if (Flags2 and QF_RCODE)<>0 then exit; // Number of answers ? @@ -808,6 +957,586 @@ begin end; end; +{ + Check that Atype is valid. These are the DNSQRY_? params we support. See the + definitions at the top of this unit for the names. + Deliberately excluding axfr (252), mailb (253), maila (254), and * (255). +} +function IsValidAtype(atype: Word): Boolean; +begin + Result := False; + case atype of + 1 .. 16, 28, 33: Result := True; + end; +end; + +function IsTruncated(R: TDNSHeader): Boolean; +begin + Result := ((R.flags1 and QF_TC) > 0); +end; + +function GetRcode(R: TDNSHeader): TDNSRcode; +var + rcode_n: Byte; +begin + rcode_n := (R.flags2 and QF_RCODE); + case rcode_n of + 0: Result := rcNoError; + 1: Result := rcFormatError; + 2: Result := rcServFail; + 3: Result := rcNXDomain; + 4: Result := rcNotImpl; + 5: Result := rcRefused; + 6 .. 15: Result := rcReserved; + else + Result := rcInvalid; + end; +end; + +function GetFixlenStr(pl: TPayLoad; startidx: Cardinal; len: Byte; out + res: ShortString): Byte; +begin + Result := 0; + res := ''; + if (startidx + len) > Length(pl) then exit; + SetLength(res, len); + Move(pl[startidx], res[1], len); + Result := len; +end; + +function GetFixlenStr(pl: TPayLoadTCP; startidx: Cardinal; len: Byte; + out res: ShortString): Byte; +begin + Result := 0; + res := ''; + if (startidx + len) > Length(pl) then exit; + SetLength(res, len); + Move(pl[startidx], res[1], len); + Result := len; +end; + +function NextNameRR(const pl: TPayLoadTCP; start: Word; out RRName: TRRNameData + ): Boolean; +var + I : Integer; + PA : PRRData; + +begin + Result:=False; + I:=Start; + if (Length(pl) - I) < (SizeOf(TRRData)+2) then exit; + RRName.RRName := stringfromlabel(pl, I); + if (Length(pl) - I) < (SizeOf(TRRData)) then exit; + + PA:=PRRData(@pl[I]); + RRName.RRMeta := PA^; + RRName.RRMeta.AClass := NToHs(RRName.RRMeta.AClass); + RRName.RRMeta.Atype := NToHs(RRName.RRMeta.Atype); + if not IsValidAtype(RRName.RRMeta.Atype) then + exit; + RRName.RRMeta.RDLength := NToHs(RRName.RRMeta.RDLength); + RRName.RRMeta.TTL := NToHl(RRName.RRMeta.TTL); + RRName.RDataSt := I+SizeOf(TRRData); + // verify that start + rdlength is within the buffer boundary. + if RRName.RDataSt + RRName.RRMeta.RDLength > Length(pl) then exit; + Result := True; +end; + +function NextNameRR(const pl: TPayLoad; start: Word; out RRName: TRRNameData + ): Boolean; +var + I : Integer; + PA : PRRData; + +begin + Result:=False; + I:=Start; + if (Length(pl) - I) < (SizeOf(TRRData)+2) then exit; + RRName.RRName := stringfromlabel(pl, I); + if (Length(pl) - I) < (SizeOf(TRRData)) then exit; + + PA:=PRRData(@pl[I]); + RRName.RRMeta := PA^; + RRName.RRMeta.AClass := NToHs(RRName.RRMeta.AClass); + RRName.RRMeta.Atype := NToHs(RRName.RRMeta.Atype); + if not IsValidAtype(RRName.RRMeta.Atype) then + exit; + + RRName.RRMeta.RDLength := NToHs(RRName.RRMeta.RDLength); + RRName.RRMeta.TTL := NToHl(RRName.RRMeta.TTL); + RRName.RDataSt := I+SizeOf(TRRData); + // verify that start + rdlength is within the buffer boundary. + if RRName.RDataSt + RRName.RRMeta.RDLength > Length(pl) then exit; + Result := True; +end; + +function GetRRrecords(const pl: TPayloadTCP; var Start: Word; Count: Word + ): TRRNameDataArray; +var + I, Total: Word; + B: Boolean; + RRN: TRRNameData; + +begin + I:=0; + Total := 0; + SetLength(Result,Count); + while (I < Count) do + begin + B := NextNameRR(pl, Start, RRN); + if not B then break; + Inc(Total); + Result[I] := RRN; + Inc(I); + Start := RRN.RDataSt+RRN.RRMeta.RDLength; + end; + if Total < Count then SetLength(Result,Total); +end; + +function GetRRrecords(const pl: TPayload; var Start: Word; Count: Word + ): TRRNameDataArray; +var + I, Total: Word; + B: Boolean; + RRN: TRRNameData; + +begin + I:=0; + Total := 0; + SetLength(Result,Count); + while (I < Count) do + begin + B := NextNameRR(pl, Start, RRN); + if not B then break; + Inc(Total); + Result[I] := RRN; + Inc(I); + Start := RRN.RDataSt+RRN.RRMeta.RDLength; + end; + if Total < Count then SetLength(Result,Total); +end; + +function DnsLookup(dn: String; qtype: Word; out Ans: TQueryData; out + AnsLen: Longint): Boolean; +var + Qry: TQueryData; + QryLen: Longint; + idx: Word; +begin + Result := False; + AnsLen := -2; + + CheckResolveFile; + if Length(DNSServers) = 0 then + exit; + + QryLen := BuildPayLoad(Qry, dn, qtype, 1); + if QryLen <= 0 then exit; + + AnsLen := -1; + { Try the query at each configured resolver in turn, until one of them + returns an answer. We check for AnsLen > -1 because we need to distinguish + between failure to connect and the server saying it doesn't know or can't + answer. If AnsLen = -1 then we failed to connect. If AnsLen >= 0 but qr + = False, then we connected but the server returned an error code.} + idx := 0; + repeat + Result := Query(idx,Qry,Ans,QryLen,AnsLen); + Inc(idx); + until (idx > High(DNSServers)) or (Result = True) or (AnsLen >= 0); +end; + +function DnsLookup(dn: String; qtype: Word; out Ans: TQueryDataLengthTCP; out + AnsLen: Longint): Boolean; +var + Qry: TQueryDataLength; + QryLen: Longint; + idx: Word; + +begin + Result := False; + AnsLen := -2; + + CheckResolveFile; + if Length(DNSServers) = 0 then + exit; + + QryLen:=BuildPayLoadTCP(Qry, dn, qtype, 1); + if QryLen <= 0 then exit; + AnsLen := -1; + + { Try the query at each configured resolver in turn, until one of them + returns an answer. We check for AnsLen > -1 because we need to distinguish + between failure to connect and the server saying it doesn't know or can't + answer. If AnsLen = -1 then we failed to connect. If AnsLen >= 0 but qr + = False, then we connected but the server returned an error code.} + idx := 0; + repeat + Result := QueryTCP(idx,Qry,Ans,QryLen,AnsLen); + Inc(idx); + until (idx > High(DNSServers)) or (Result = True) or (AnsLen >= 0); +end; + +function DNSRRGetA(const RR: TRRNameData; const pl: TPayLoadTCP; out + IP: THostAddr): Boolean; +begin + IP.s_addr := 0; + Result := False; + if RR.RRMeta.Atype <> DNSQRY_A then exit; + if (Length(pl) - RR.RDataSt) < 4 then exit; + Move(pl[RR.RDataSt], IP, SizeOf(THostAddr)); + IP.s_addr := NToHl(IP.s_addr); + Result := True; +end; + +function DNSRRGetA(const RR: TRRNameData; const pl: TPayLoad; out IP: THostAddr + ): Boolean; +begin + IP.s_addr := 0; + Result := False; + if RR.RRMeta.Atype <> DNSQRY_A then exit; + if (Length(pl) - RR.RDataSt) < 4 then exit; + Move(pl[RR.RDataSt], IP, SizeOf(THostAddr)); + IP.s_addr := NToHl(IP.s_addr); + Result := True; +end; + +function DNSRRGetCNAME(const RR: TRRNameData; const pl: TPayLoad; out + cn: TDNSDomainName): Boolean; +var + n: Integer; +begin + Result := False; + cn := ''; + if RR.RRMeta.Atype <> DNSQRY_CNAME then exit; + n := RR.RDataSt; + if (RR.RDataSt + RR.RRMeta.RDLength) > Length(pl) then exit; + cn := stringfromlabel(pl, n); + Result := True; +end; + +function DNSRRGetCNAME(const RR: TRRNameData; const pl: TPayLoadTCP; out + cn: TDNSDomainName): Boolean; +var + n: Integer; +begin + Result := False; + cn := ''; + if RR.RRMeta.Atype <> DNSQRY_CNAME then exit; + n := RR.RDataSt; + if (n + RR.RRMeta.rdlength) > Length(pl) then exit; + cn := stringfromlabel(pl, n); + Result := True; +end; + +function DNSRRGetAAAA(const RR: TRRNameData; const pl: TPayLoadTCP; out + IP: THostAddr6): Boolean; +begin + IP.s6_addr32[0] := 0; + IP.s6_addr32[1] := 0; + IP.s6_addr32[2] := 0; + IP.s6_addr32[3] := 0; + Result := False; + if RR.RRMeta.Atype <> DNSQRY_AAAA then exit; + if (RR.RDataSt + SizeOf(THostAddr6)) > Length(pl) then exit; + Move(pl[RR.RDataSt],IP,SizeOf(THostAddr6)); + Result := True; +end; + +function DNSRRGetAAAA(const RR: TRRNameData; const pl: TPayLoad; out + IP: THostAddr6): Boolean; +begin + IP.s6_addr32[0] := 0; + IP.s6_addr32[1] := 0; + IP.s6_addr32[2] := 0; + IP.s6_addr32[3] := 0; + Result := False; + if RR.RRMeta.Atype <> DNSQRY_AAAA then exit; + if (RR.RDataSt + SizeOf(THostAddr6)) > Length(pl) then exit; + Move(pl[RR.RDataSt],IP,SizeOf(THostAddr6)); + Result := True; +end; + +function DNSRRGetNS(const RR: TRRNameData; const pl: TPayLoadTCP; out + NSName: TDNSDomainName): Boolean; +var + n: LongInt; +begin + NSName := ''; + Result := False; + if RR.RRMeta.Atype <> DNSQRY_NS then exit; + if (RR.RDataSt + RR.RRMeta.RDLength) > Length(pl) then exit; + n := RR.RDataSt; + NSName := stringfromlabel(pl, n); + Result := True; +end; + +function DNSRRGetNS(const RR: TRRNameData; const pl: TPayLoad; out + NSName: TDNSDomainName): Boolean; +var + n: LongInt; +begin + NSName := ''; + Result := False; + if RR.RRMeta.Atype <> DNSQRY_NS then exit; + if (RR.RDataSt + RR.RRMeta.RDLength) > Length(pl) then exit; + n := RR.RDataSt; + NSName := stringfromlabel(pl, n); + Result := True; +end; + +function DNSRRGetSOA(const RR: TRRNameData; const pl: TPayLoadTCP; out + dnssoa: TDNSRR_SOA): Boolean; +var + idx: Integer; +begin + // can't trust the counts we've been given, so check that we never + // exceed the end of the payload buffer. + idx := RR.RDataSt; + Result := False; + if RR.RRMeta.Atype <> DNSQRY_SOA then exit; + dnssoa.mname := stringfromlabel(pl, idx); + if idx >= Length(pl) then exit; + + dnssoa.rname := stringfromlabel(pl, idx); + + if (idx + (SizeOf(Cardinal) * 5)) > Length(pl) then exit; + Move(pl[idx],dnssoa.serial,SizeOf(Cardinal)); + Inc(idx, SizeOf(Cardinal)); + Move(pl[idx], dnssoa.refresh, SizeOf(Cardinal)); + Inc(idx, SizeOf(Cardinal)); + Move(pl[idx], dnssoa.retry, SizeOf(Cardinal)); + Inc(idx, SizeOf(Cardinal)); + Move(pl[idx], dnssoa.expire, SizeOf(Cardinal)); + Inc(idx, SizeOf(Cardinal)); + Move(pl[idx], dnssoa.min, SizeOf(Cardinal)); + Result := True; + dnssoa.serial := NToHl(dnssoa.serial); + dnssoa.min := NToHl(dnssoa.min); + dnssoa.expire := NToHl(dnssoa.expire); + dnssoa.refresh := NToHl(dnssoa.refresh); + dnssoa.retry := NToHl(dnssoa.retry); +end; + +function DNSRRGetSOA(const RR: TRRNameData; const pl: TPayLoad; out + dnssoa: TDNSRR_SOA): Boolean; +var + idx: Integer; +begin + // can't trust the counts we've been given, so check that we never + // exceed the end of the payload buffer. + idx := RR.RDataSt; + Result := False; + if RR.RRMeta.Atype <> DNSQRY_SOA then exit; + dnssoa.mname := stringfromlabel(pl, idx); + if idx >= Length(pl) then exit; + + dnssoa.rname := stringfromlabel(pl, idx); + + if (idx + (SizeOf(Cardinal) * 5)) > Length(pl) then exit; + Move(pl[idx],dnssoa.serial,SizeOf(Cardinal)); + Inc(idx, SizeOf(Cardinal)); + Move(pl[idx], dnssoa.refresh, SizeOf(Cardinal)); + Inc(idx, SizeOf(Cardinal)); + Move(pl[idx], dnssoa.retry, SizeOf(Cardinal)); + Inc(idx, SizeOf(Cardinal)); + Move(pl[idx], dnssoa.expire, SizeOf(Cardinal)); + Inc(idx, SizeOf(Cardinal)); + Move(pl[idx], dnssoa.min, SizeOf(Cardinal)); + Result := True; + dnssoa.serial := NToHl(dnssoa.serial); + dnssoa.min := NToHl(dnssoa.min); + dnssoa.expire := NToHl(dnssoa.expire); + dnssoa.refresh := NToHl(dnssoa.refresh); + dnssoa.retry := NToHl(dnssoa.retry); +end; + +function DNSRRGetText(const RR: TRRNameData; const pl: TPayLoad; out + dnstext: AnsiString): Boolean; +var + wrk: ShortString; + idx: LongInt; + l: Byte; +begin + Result := False; + dnstext := ''; + if RR.RRMeta.Atype <> DNSQRY_TXT then exit; + wrk := ''; + + idx := RR.RDataSt; + if (Length(pl) - idx) < 2 then exit; + + repeat + l := GetFixlenStr(pl, idx+1, pl[idx], wrk); + if l = 0 then exit; // count would send us past end of buffer + dnstext := dnstext + wrk; + Inc(idx, l+1); + until (idx >= (RR.RDataSt + RR.RRMeta.RDLength)) or ((Length(pl) - idx) < 2); + Result := True; +end; + +function DNSRRGetText(const RR: TRRNameData; const pl: TPayLoadTCP; out + dnstext: AnsiString): Boolean; +var + wrk: ShortString; + idx: LongInt; + l: Byte; +begin + Result := False; + dnstext := ''; + if RR.RRMeta.Atype <> DNSQRY_TXT then exit; + wrk := ''; + + idx := RR.RDataSt; + if (Length(pl) - idx) < 2 then exit; + + repeat + l := GetFixlenStr(pl, idx+1, pl[idx], wrk); + if l = 0 then exit; // count would send us past end of buffer + dnstext := dnstext + wrk; + Inc(idx, l+1); + until (idx >= (RR.RDataSt + RR.RRMeta.RDLength)) or ((Length(pl) - idx) < 2); + Result := True; +end; + +function DNSRRGetMX(const RR: TRRNameData; const pl: TPayLoadTCP; out + MX: TDNSRR_MX): Boolean; +var + idx: Integer; +begin + Result := False; + MX.preference := 0; + MX.exchange := ''; + if RR.RRMeta.Atype <> DNSQRY_MX then exit; + idx := RR.RDataSt; + if idx + SizeOf(Word) >= Length(pl) then exit; + Move(pl[idx],MX.preference, SizeOf(Word)); + Inc(idx, SizeOf(Word)); + if (Length(pl) - idx) < 2 then exit; + MX.exchange := stringfromlabel(pl, idx); + MX.preference := NToHs(MX.preference); + Result := True; +end; + +function DNSRRGetMX(const RR: TRRNameData; const pl: TPayLoad; out MX: TDNSRR_MX + ): Boolean; +var + idx: Integer; +begin + Result := False; + MX.preference := 0; + MX.exchange := ''; + if RR.RRMeta.Atype <> DNSQRY_MX then exit; + idx := RR.RDataSt; + if idx + SizeOf(Word) >= Length(pl) then exit; + Move(pl[idx],MX.preference, SizeOf(Word)); + Inc(idx, SizeOf(Word)); + if (Length(pl) - idx) < 2 then exit; + MX.exchange := stringfromlabel(pl, idx); + MX.preference := NToHs(MX.preference); + Result := True; +end; + +function DNSRRGetPTR(const RR: TRRNameData; const pl: TPayLoadTCP; out + ptr: TDNSDomainName): Boolean; +var + n: Integer; +begin + Result := False; + ptr := ''; + if RR.RRMeta.Atype <> DNSQRY_PTR then exit; + n := RR.RDataSt; + if (n + RR.RRMeta.RDLength) > Length(pl) then exit; + ptr := stringfromlabel(pl, n); + Result := True; +end; + +function DNSRRGetPTR(const RR: TRRNameData; const pl: TPayLoad; out + ptr: TDNSDomainName): Boolean; +var + n: Integer; +begin + Result := False; + ptr := ''; + if RR.RRMeta.Atype <> DNSQRY_PTR then exit; + n := RR.RDataSt; + if (n + RR.RRMeta.RDLength) > Length(pl) then exit; + ptr := stringfromlabel(pl, n); + Result := True; +end; + +function DNSRRGetSRV(const RR: TRRNameData; const pl: TPayload; out + srv: TDNSRR_SRV): Boolean; +var + idx: Integer; +begin + Result := False; + srv.priority := 0; + srv.weight := 0; + srv.port := 0; + srv.target := ''; + if RR.RRMeta.Atype <> DNSQRY_SRV then exit; + + idx := RR.RDataSt; + if idx + RR.RRMeta.RDLength > Length(pl) then exit; + + Move(pl[idx], srv.priority, SizeOf(Word)); + Inc(idx, SizeOf(Word)); + if (Length(pl) - idx) < 2 then exit; + + Move(pl[idx], srv.weight, SizeOf(Word)); + Inc(idx, SizeOf(Word)); + if (Length(pl) - idx) < 2 then exit; + + Move(pl[idx], srv.port, SizeOf(Word)); + Inc(idx, SizeOf(Word)); + if (Length(pl) - idx) < 2 then exit; + + srv.target := stringfromlabel(pl, idx); + + srv.priority := NToHs(srv.priority); + srv.weight := NToHs(srv.weight); + srv.port := NToHs(srv.port); + + Result := True; +end; + +function DNSRRGetSRV(const RR: TRRNameData; const pl: TPayloadTCP; out + srv: TDNSRR_SRV): Boolean; +var + idx: Integer; +begin + Result := False; + srv.priority := 0; + srv.weight := 0; + srv.port := 0; + srv.target := ''; + if RR.RRMeta.Atype <> DNSQRY_SRV then exit; + + idx := RR.RDataSt; + if idx + RR.RRMeta.RDLength > Length(pl) then exit; + + Move(pl[idx], srv.priority, SizeOf(Word)); + Inc(idx, SizeOf(Word)); + if (Length(pl) - idx) < 2 then exit; + + Move(pl[idx], srv.weight, SizeOf(Word)); + Inc(idx, SizeOf(Word)); + if (Length(pl) - idx) < 2 then exit; + + Move(pl[idx], srv.port, SizeOf(Word)); + Inc(idx, SizeOf(Word)); + if (Length(pl) - idx) < 2 then exit; + + srv.target := stringfromlabel(pl, idx); + + srv.priority := NToHs(srv.priority); + srv.weight := NToHs(srv.weight); + srv.port := NToHs(srv.port); + + Result := True; +end; + Function SkipAnsQueries(Var Ans : TQueryData; L : Integer) : integer; Var @@ -817,10 +1546,10 @@ begin Result:=0; With Ans do begin - qdcount := htons(qdcount); + h.qdcount := htons(h.qdcount); i:=0; q:=0; - While (Q<qdcount) and (i<l) do + While (Q<h.qdcount) and (i<l) do begin If Payload[i]>63 then begin @@ -842,6 +1571,39 @@ begin end; end; +function SkipAnsQueries(var Ans: TQueryDataLengthTCP; L: Integer): integer; +var + Q,I : Integer; + +begin + Result:=0; + With Ans do + begin + h.qdcount := htons(h.qdcount); + i:=0; + q:=0; + While (Q<h.qdcount) and (i<l) do + begin + If Payload[i]>63 then + begin + Inc(I,6); + Inc(Q); + end + else + begin + If Payload[i]=0 then + begin + inc(q); + Inc(I,5); + end + else + Inc(I,Payload[i]+1); + end; + end; + Result:=I; + end; +end; + { --------------------------------------------------------------------- DNS Query functions. ---------------------------------------------------------------------} @@ -857,7 +1619,7 @@ Var begin Result:=False; - With Qry do + With Qry.h do begin ID[0]:=Random(256); ID[1]:=Random(256); @@ -890,39 +1652,256 @@ begin AL:=SizeOf(SA); L:=fprecvfrom(Sock,@ans,SizeOf(Ans),0,@SA,@AL); fpclose(Sock); - // Check lenght answer and fields in header data. - If (L<12) or not CheckAnswer(Qry,Ans) Then + + if L < 12 then exit; + // Return Payload length. + Anslen:=L-12; + // even though we may still return false to indicate an error, if AnsLen + // is >= 0 then the caller knows the dns server responded. + If not CheckAnswer(Qry.h,Ans.h) Then exit; - // Return Payload length. - Anslen:=L-12; - Result:=True; + Result:=True; + //end; end; -function stringfromlabel(pl: TPayLoad; start: integer): string; +function FetchDNSResponse(sock: Cint; out len: ssize_t; + out Ans: TQueryDataLengthTCP): TTCPSocketResult; var - l,i: integer; + respsize: Word; + L: ssize_t; + +begin + Result := srOK; + len := 0; + + // peek into the socket buffer and see if a full message is waiting. + L := fprecv(sock, @Ans, SizeOf(Ans), MSG_PEEK); + if L = 0 then + begin + Result := srSocketClose; + exit; + end; + // The first two bytes of a DNS TCP payload is the number of octets in the + // response, excluding the two bytes of length. This lets us see if we've + // received the full response. + respsize := NToHs(Ans.length); + if (L < 2) or (L < (respsize + SizeOf(Ans.length))) then + begin + Result := srPartial; + exit; + end; + + // The full DNS response is waiting in the buffer. Get it now. + len := fprecv(sock, @Ans, SizeOf(Ans), 0); +end; + +function QueryTCP(Resolver: Integer; var Qry: TQueryDataLength; + var Ans: TQueryDataLengthTCP; QryLen: Integer; var AnsLen: Integer): Boolean; +Var + SA : TInetSockAddr; + Sock : cint; + L: ssize_t; + RTO : Longint; + ReadFDS : TFDSet; + count: Integer; + sendsize: ssize_t; + respsize: Word; + resp: TTCPSocketResult; + tstart: QWord; + +begin + tstart := GetTickCount64; + Result:=False; + With Qry.hpl.h do + begin + ID[0]:=Random(256); + ID[1]:=Random(256); + Flags1:=QF_RD; + Flags2:=0; + qdcount:=htons(1); // was 1 shl 8; + ancount:=0; + nscount:=0; + arcount:=0; + end; + Sock:=FpSocket(AF_INET,SOCK_STREAM,0); + If Sock=-1 then + exit; + With SA do + begin + sin_family:=AF_INET; + sin_port:=htons(DNSport); + sin_addr.s_addr:=cardinal(DNSServers[Resolver]); // octets already in net order + end; + + // connect to the resolver + if (fpconnect(Sock, @SA, SizeOf(SA)) <> 0) then + exit; + + // send the query to the resolver + sendsize := QryLen + SizeOf(Qry.hpl.h) + SizeOf(Qry.length); + count := fpsend(Sock,@Qry,sendsize,0); + if count < sendsize then + begin + fpclose(Sock); + exit; + end; + + // tell other side we're done writing. + fpshutdown(Sock, SHUT_WR); + + RTO := 5000; + fpFD_ZERO(ReadFDS); + fpFD_Set(sock,ReadFDS); + + // select to wait for data + if fpSelect(sock+1, @ReadFDS, Nil, Nil, RTO)<=0 then + begin + // timed out, nothing received. + fpclose(sock); + exit; + end; + + // for partial responses, keep trying until all data received or the + // timeout period has elapsed. the timeout period includes the time + // spent waiting on select. + resp := FetchDNSResponse(Sock, L, Ans); + while (resp = srPartial) and ((GetTickCount64 - tstart) < RTO) do + begin + // need to sleep to avoid high cpu. 50ms means a 5 second timeout will + // make up to 100 calls to FetchDNSResponse. + Sleep(50); + resp := FetchDNSResponse(Sock, L, Ans); + end; + + fpclose(sock); + if resp <> srOK then exit; + + // Set AnsLen to be the size of the payload minus the header. + Anslen := L-SizeOf(Qry.hpl.h); + // if the final check finds problems with the answer, we'll return false + // but AnsLen being >=0 will let the caller know that the server did + // respond, but either declined to answer or couldn't. + If not CheckAnswer(Qry.hpl.h,Ans.h) then + exit; + Result:=True; +end; + +{ +Read a string from the payload buffer. Handles compressed as well as +regular labels. On termination start points to the character after the +end of the str. +} + +function stringfromlabel(pl: TPayLoad; var start: Integer): string; +var + l,i,n,lc: integer; + ptr: Word; + ptrseen: Boolean = False; begin result := ''; l := 0; i := 0; + n := start; + // Label counter. Per rfc1035, s. 3.1, each label is at least 2 bytes and the + // max length for a domain is 255, so there can't be more than 127 labels. + // This helps to short-circuit loops in label pointers. + lc := 0; repeat - l := ord(pl[start]); + // each iteration of this loop is for one label. whether a pointer or a + // regular label, we need 2 bytes headroom minimum. + if n > (Length(pl) - 2) then break; + l := ord(pl[n]); { compressed reply } while (l >= 192) do begin - { the -12 is because of the reply header length } - start := (l and not(192)) shl 8 + ord(pl[start+1]) - 12; - l := ord(pl[start]); + if not ptrseen then start := n + 2; + ptrseen := True; + ptr := (l and not(192)) shl 8 + ord(pl[n+1]); + {ptr must point backward and be >= 12 (for the dns header.} + if (ptr >= (n+12)) or (ptr < 12) then l := 0 // l=0 causes loop to exit + else + begin + { the -12 is because of the reply header length. we do the decrement + here to avoid overflowing if ptr < 12.} + n := ptr - 12; + l := ord(pl[n]); + end; + end; + // check we point inside the buffer + if (n+l+1) > Length(pl) then l := 0; + if l <> 0 then begin + setlength(result,length(result)+l); + move(pl[n+1],result[i+1],l); + result := result + '.'; + inc(n,l); inc(n); + inc(i,l); inc(i); + if n > start then start := n; + end; + Inc(lc); // label count + until (l = 0) or (lc > 127); + // per rfc1035, section 4.1.4, a domain name may be represented by + // either a sequence of labels followed by 0, or a pointer, or a series + // of labels followed by a pointer. If there's a pointer there's no 0 to + // skip over when calculating the final index. + if not ptrseen then Inc(start); // jump past the 0. + if (Length(result) > 0) and (result[length(result)] = '.') then + setlength(result,length(result)-1); +end; + +function stringfromlabel(pl: TPayLoadTCP; var start: Integer): string; +var + l,i,n,lc: integer; + ptr: Word; + ptrseen: Boolean = False; +begin + result := ''; + l := 0; + i := 0; + n := start; + // Label counter. Per rfc1035, s. 3.1, each label is at least 2 bytes and the + // max length for a domain is 255, so there can't be more than 127 labels. + // This helps to short-circuit loops in label pointers. + lc := 0; + repeat + // each iteration of this loop is for one label. whether a pointer or a + // regular label, we need 2 bytes headroom minimum. + if n > (Length(pl) - 2) then break; + l := ord(pl[n]); + { compressed reply } + while (l >= 192) do + begin + if not ptrseen then start := n + 2; + ptrseen := True; + ptr := (l and not(192)) shl 8 + ord(pl[n+1]); + {ptr must point backward and be >= 12 (for the dns header.} + if (ptr >= (n+12)) or (ptr < 12) then l := 0 // l=0 causes loop to exit + else + begin + { the -12 is because of the reply header length. we do the decrement + here to avoid overflowing if ptr < 12.} + n := ptr - 12; + l := ord(pl[n]); + end; end; + // check we point inside the buffer + if (n+l+1) > Length(pl) then l := 0; if l <> 0 then begin setlength(result,length(result)+l); - move(pl[start+1],result[i+1],l); + move(pl[n+1],result[i+1],l); result := result + '.'; - inc(start,l); inc(start); + inc(n,l); inc(n); inc(i,l); inc(i); + if n > start then start := n; end; - until l = 0; - if result[length(result)] = '.' then setlength(result,length(result)-1); + Inc(lc); // label count + until (l = 0) or (lc > 127); + // per rfc1035, section 4.1.4, a domain name may be represented by + // either a sequence of labels followed by 0, or a pointer, or a series + // of labels followed by a pointer. If there's a pointer there's no 0 to + // skip over when calculating the final index. + if not ptrseen then Inc(start); // jump past the 0. + if (Length(result) > 0) and (result[length(result)] = '.') then + setlength(result,length(result)-1); end; Function ResolveNameAt(Resolver : Integer; HostName : String; Var Addresses : Array of THostAddr; Recurse: Integer) : Integer; @@ -941,7 +1920,7 @@ begin else begin AnsStart:=SkipAnsQueries(Ans,AnsLen); - MaxAnswer:=Ans.AnCount-1; + MaxAnswer:=Ans.h.AnCount-1; If MaxAnswer>High(Addresses) then MaxAnswer:=High(Addresses); I:=0; @@ -1022,7 +2001,7 @@ begin end else begin AnsStart:=SkipAnsQueries(Ans,AnsLen); - MaxAnswer:=Ans.AnCount-1; + MaxAnswer:=Ans.h.AnCount-1; If MaxAnswer>High(Addresses) then MaxAnswer:=High(Addresses); I:=0; @@ -1085,7 +2064,7 @@ begin else begin AnsStart:=SkipAnsQueries(Ans,AnsLen); - MaxAnswer:=Ans.AnCount-1; + MaxAnswer:=Ans.h.AnCount-1; If MaxAnswer>High(Names) then MaxAnswer:=High(Names); I:=0; diff --git a/packages/fcl-net/tests/netdbtest.pp b/packages/fcl-net/tests/netdbtest.pp new file mode 100644 index 0000000000..4a70bc76fa --- /dev/null +++ b/packages/fcl-net/tests/netdbtest.pp @@ -0,0 +1,4615 @@ +unit netdbtest; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, fpcunit, testregistry, Sockets, math, netdb; + +const + FAKETLD = 'doesnotexist'; + FAKEDOMAIN = 'fakedomain'; + + FAKEFQDN=FAKEDOMAIN+'.'+FAKETLD; + +type + TDomainCompressionOffset = packed record + nm: String; + offset: Word; + end; + TDomainCompressionTable = Array of TDomainCompressionOffset; + + TTwoByteArr = array[0 .. 1] of Byte; + TDNSDomainPointer = packed record + case b: boolean of + true: (ba: TTwoByteArr); + false: (b1,b2: Byte); + end; + + TDNSDomainByteStream = packed record + ulabels: Array of byte; + cptr: Word; + end; + + TBuffer = Array of Byte; + + // can't use dynamic arrays in variant records, so fudge things by + // having between 1 and 5 subsstrings per text RR. it's good enough + // for these tests. + TTextArray = array [1 .. 5] of ShortString; + + TFakeQuery = record + nm: ShortString; + qtype, qclass: Word; + end; + + TFakeSOA = record + mn,rn: ShortString; + serial,refresh,retry,expire,min: Cardinal; + end; + TFakeMX = record + pref: Word; + exch: ShortString; + end; + TFakeSRV = record + priority, weight, port: Word; + target: ShortString; + end; + + TFakeRR = record + RRName : ShortString; + AClass : Word; + TTL : Cardinal; + RDLength : Word; + case Atype: Word of + DNSQRY_A: (ip: THostAddr); + DNSQRY_AAAA: (ip6: THostAddr6); + DNSQRY_CNAME: (cn: ShortString); + DNSQRY_MX: (fmx: TFakeMX); + DNSQRY_NS: (nsh: ShortString); + DNSQRY_PTR: (ptr: ShortString); + DNSQRY_SOA: (fsoa: TFakeSoa); + DNSQRY_TXT: (sstrcount: Byte; txtarr: TTextArray); + DNSQRY_SRV: (fsrv: TFakeSRV); + end; + + TRRSection = Array of TFakeRR; + + TFakeDNSResponse = record + strtable: TDomainCompressionTable; + compresslabels: Boolean; + hdr: TDNSHeader; + qry: TFakeQuery; + answers, authority, additional: TRRSection; + end; + + TRDataWriteRes = packed record + bw, etw: Word; + end; + + { TNetDbTest } + + TNetDbTest= class(TTestCase) + strict private + tsl: TStringList; + protected + procedure SetUp; override; + procedure TearDown; override; + + procedure BuildFakeRR_A(out RR: TFakeRR; nm: String; ttl: Cardinal; + val: String); + procedure BuildFakeRR_AAAA(out RR: TFakeRR; nm: String; ttl: Cardinal; + val: String); + procedure BuildFakeRR_MX(out RR: TFakeRR; nm: String; ttl: Cardinal; + pref: Word; exch: ShortString ); + procedure BuildFakeRR_NS(out RR: TFakeRR; nm: String; ttl: Cardinal; + val: String); + procedure BuildFakeRR_PTR(out RR: TFakeRR; nm: String; ttl: Cardinal; + val: String); + procedure BuildFakeRR_CNAME(out RR: TFakeRR; nm: String; ttl: Cardinal; + val: String); + procedure BuildFakeRR_SOA(out RR: TFakeRR; nm: String; ttl: Cardinal; + mn,rn: ShortString; serial,refresh,retry,expire,min: Cardinal); + procedure BuildFakeRR_TXT(out RR: TFakeRR; nm: String; ttl: Cardinal; + n: Byte; txt: TTextArray); + procedure BuildFakeRR_SRV(out RR: TFakeRR; nm: String; ttl: Cardinal; + priority, weight, port: Word; target: ShortString); + + procedure CopyBytesTo(var buf: TPayLoad; startidx,destidx,count: Word); + procedure CopyBytesTo(var buf: TPayLoadTCP; startidx,destidx,count: Word); + + function WriteNumToBuffer(var buf: TBuffer; var offset: Cardinal; + val: Word): Word; + function WriteNumToBuffer(var buf: TBuffer; var offset: Cardinal; + val: Cardinal): Word; + + function WriteNumToBufferN(var buf: TBuffer; var offset: Cardinal; + val: Word): Word; + function WriteNumToBufferN(var buf: TBuffer; var offset: Cardinal; + val: Cardinal): Word; + + function WriteMXAsRData(var buf: TBuffer; var offset: Cardinal; + fmx: TFakeMX): TRDataWriteRes; + function WriteSOAasRData(var buf: TBuffer; var offset: Cardinal; + fsoa: TFakeSOA): TRDataWriteRes; + function WriteSOAasRData(var buf: TBuffer; var offset: Cardinal; + fsoa: TFakeSOA; var ctbl: TDomainCompressionTable): TRDataWriteRes; + function WriteAAAAasRData(var buf: TBuffer; var offset: Cardinal; + ip6: THostAddr6): TRDataWriteRes; + function WriteAasRData(var buf: TBuffer; var offset: Cardinal; + ip: THostAddr): TRDataWriteRes; + + function WriteSRVasRData(var buf: TBuffer; var offset: Cardinal; + fsrv: TFakeSRV): TRDataWriteRes; + function WriteSRVasRData(var buf: TBuffer; var offset: Cardinal; + fsrv: TFakeSRV; var ctbl: TDomainCompressionTable): TRDataWriteRes; + + function WriteMXAsRData(var buf: TBuffer; var offset: Cardinal; + fmx: TFakeMX; var ctbl: TDomainCompressionTable): TRDataWriteRes; + + function CalcRdLength(o: TDNSDomainByteStream): Word; + function CalcRdLength(o: TTextArray): Word; + function WriteTextRecAsRData(var buf: TBuffer; var offset: Cardinal; + tt: TTextArray): TRDataWriteRes; + + function DomainNameToByteStream(nm: ShortString; + var ctbl: TDomainCompressionTable): TDNSDomainByteStream; + function DomainNameToByteStream(nm: ShortString): TDNSDomainByteStream; + + function WriteDNSDomainByteStreamToBuffer(var buf: TBuffer; + var offset: Cardinal; dbs: TDNSDomainByteStream): Word; + + function WriteDomainAsRdata(var buf: TBuffer; var offset: Cardinal; + dbs: TDNSDomainByteStream): TRDataWriteRes; + + function WriteRRToBuffer(var buf: TBuffer; var offset: Cardinal; + rr: TFakeRR): Word; + function WriteRRToBuffer(var buf: TBuffer; var offset: Cardinal; + rr: TFakeRR; var ctbl: TDomainCompressionTable): Word; + function FakeDNSResponseToByteBuffer(fdr: TFakeDNSResponse; + out buf: TBuffer; compress: Boolean = False): Cardinal; + function BufferToPayload(const buf: TBuffer; out pl: TPayload): Boolean; + function BufferToPayload(const buf: TBuffer; out pl: TPayLoadTCP): Boolean; + + function BuildQueryData(fdr: TFakeDNSResponse; out qd: TQueryData; + out qlen: Word; Compress: Boolean = False): Boolean; + + function BuildQueryData(fdr: TFakeDNSResponse; + out qd: TQueryDataLengthTCP; out qlen: Word; + Compress: Boolean = False): Boolean; + + function BuildTruncatedQueryData(fdr: TFakeDNSResponse; out qd: TQueryData; + out qlen: Word; truncoffset: Word): Boolean; + + procedure BuildFakeResponseA(nm: ShortString; out fr: TFakeDNSResponse); + procedure BuildFakeResponseAAAA(nm: ShortString; out fr: TFakeDNSResponse); + procedure BuildFakeResponseMX(nm: ShortString; out fr: TFakeDNSResponse); + procedure BuildFakeResponseSOA(nm: ShortString; out fr: TFakeDNSResponse); + procedure BuildFakeResponseCNAME(nm: ShortString; out fr: TFakeDNSResponse); + procedure BuildFakeResponseNS(nm: ShortString; out fr: TFakeDNSResponse); + procedure BuildFakeResponsePTR(nm: ShortString; out fr: TFakeDNSResponse); + procedure BuildFakeResponseTXT(nm: ShortString; out fr: TFakeDNSResponse); + procedure BuildFakeResponseSRV(nm: ShortString; out fr: TFakeDNSResponse); + + published + procedure TestBuildPayloadSimple; + procedure TestBuildPayloadSimpleEmpty; + procedure TestBuildPayloadSimpleEndDot; + procedure TestBuildPayloadSimpleStartDot; + procedure TestBuildPayloadSimpleMultipleDot; + + { * straightforward tests for the api with valid data. Have to test each + * known RR type with both TCP and UDP buffer functions, and with and + * without compression of domain names. + * No network calls will be made. These tests hit all functions for + * processing dns requests except network functions.} + procedure TestDnsQueryUDP_A; + procedure TestDnsQueryTCP_A; + procedure TestDnsQueryCompressUDP_A; + procedure TestDnsQueryCompressTCP_A; + + procedure TestDnsQueryUDP_AAAA; + procedure TestDnsQueryTCP_AAAA; + procedure TestDnsQueryCompressUDP_AAAA; + procedure TestDnsQueryCompressTCP_AAAA; + + procedure TestDnsQueryUDP_MX; + procedure TestDnsQueryTCP_MX; + procedure TestDnsQueryCompressUDP_MX; + procedure TestDnsQueryCompressTCP_MX; + + procedure TestDnsQueryUDP_SOA; + procedure TestDnsQueryTCP_SOA; + procedure TestDnsQueryCompressUDP_SOA; + procedure TestDnsQueryCompressTCP_SOA; + + procedure TestDnsQueryUDP_CNAME; + procedure TestDnsQueryTCP_CNAME; + procedure TestDnsQueryCompressUDP_CNAME; + procedure TestDnsQueryCompressTCP_CNAME; + + procedure TestDnsQueryUDP_NS; + procedure TestDnsQueryTCP_NS; + procedure TestDnsQueryCompressUDP_NS; + procedure TestDnsQueryCompressTCP_NS; + + procedure TestDnsQueryUDP_PTR; + procedure TestDnsQueryTCP_PTR; + procedure TestDnsQueryCompressUDP_PTR; + procedure TestDnsQueryCompressTCP_PTR; + + procedure TestDnsQueryUDP_TXT; + procedure TestDnsQueryTCP_TXT; + procedure TestDnsQueryCompressUDP_TXT; + procedure TestDnsQueryCompressTCP_TXT; + + procedure TestDnsQueryUDP_SRV; + procedure TestDnsQueryTCP_SRV; + procedure TestDnsQueryCompressUDP_SRV; + procedure TestDnsQueryCompressTCP_SRV; + + { + * Tests with invalid input data. These attempt to simulate a hostile + * dns server returning deliberately invalid data in an attempt to + * cause a buffer overflow, memory corruption, or DDOS. + } + + // buffer truncated so RRs have invalid types. + procedure TestDnsQueryTruncateRR_UDP_A; + + { + * Tests of DNSRRGet* functions where RR is near the end of the buffer, + * testing both when the RR just fits, and when it doesn't. + } + procedure TestDnsRRBufferEdgeA; + procedure TestDnsRRBufferPastEdgeA; + procedure TestDnsRRBufferEdgeAAAA; + procedure TestDNsRRBufferPastEdgeAAAA; + procedure TestDnsRRBufferEdgeMX; + procedure TestDnsRRBufferPastEdgeMX; + procedure TestDnsRRBufferEdgeSOA; + procedure TestDnsRRBufferPastEdgeSOA; + procedure TestDnsRRBufferEdgeSRV; + procedure TestDnsRRBufferPastEdgeSRV; + procedure TestDnsRRBufferEdgeCNAME; + procedure TestDnsRRBufferPastEdgeCNAME; + procedure TestDnsRRBufferEdgeNS; + procedure TestDnsRRBufferPastEdgeNS; + procedure TestDnsRRBufferEdgePTR; + procedure TestDnsRRBufferPastEdgePTR; + procedure TestDnsRRBufferEdgeTXT; + procedure TestDnsRRBufferPastEdgeTXT; + + + { + * the TCP variants. identical code, but qd variable is a different type + * and so different paths get followed in netdb. + } + procedure TestDnsRRBufferEdgeTCPA; + procedure TestDnsRRBufferPastEdgeTCPA; + procedure TestDnsRRBufferEdgeTCPAAAA; + procedure TestDNsRRBufferPastEdgeTCPAAAA; + procedure TestDnsRRBufferEdgeTCPMX; + procedure TestDnsRRBufferPastEdgeTCPMX; + procedure TestDnsRRBufferEdgeTCPSOA; + procedure TestDnsRRBufferPastEdgeTCPSOA; + procedure TestDnsRRBufferEdgeTCPSRV; + procedure TestDnsRRBufferPastEdgeTCPSRV; + procedure TestDnsRRBufferEdgeTCPCNAME; + procedure TestDnsRRBufferPastEdgeTCPCNAME; + procedure TestDnsRRBufferEdgeTCPNS; + procedure TestDnsRRBufferPastEdgeTCPNS; + procedure TestDnsRRBufferEdgeTCPPTR; + procedure TestDnsRRBufferPastEdgeTCPPTR; + procedure TestDnsRRBufferEdgeTCPTXT; + procedure TestDnsRRBufferPastEdgeTCPTXT; + + // Testing of NextNameRR at buffer edge and beyond. this differs from + // the above tests in that they tests DNSGet* at the edge, but NextNameRR + // is never called to read at the edge in those functions. + // Because NextNameRR does nothing that is specific to RR types it's + // not necessary to test with each type of RR. + + procedure TestNextNameRREdgeA; + procedure TestNextNameRRPastEdgeA; + procedure TestNextNameRREdgeTCPA; + procedure TestNextNameRRPastEdgeTCPA; + + { + * Test GetRRrecords at and beyond buffer boundaries. + } + procedure TestGetRRrecordsInvalidStart; + procedure TestGetRRrecordsInvalidStartTCP; + + { + Tests for GetFixlenStr + } + procedure TestGetFixLenStrSimple; + procedure TestGetFixLenStrSimpleTCP; + procedure TestGetFixLenStrSimpleAtEdge; + procedure TestGetFixLenStrSimpleTCPAtEdge; + procedure TestGetFixLenStrSimplePastEdge; + procedure TestGetFixLenStrSimpleTCPPastEdge; + + + { + * Test stringfromlabel with buffer edges and beyond. Its behaviour + * at present is to drop any label that would exceed the buffer boundary + * but still return any other labels successfully received. + + * Some of the previous tests already verify what happens with a label + * that occurs on the edge. See the tests for TestDnsRRBufferEdgeSRV + * and TestDnsRRBufferEdgeTCPSRV, TestDnsRRBufferEdgeCNAME, etc. + } + + // read a label starting at the end of the buffer where the count is + // greater than 0. + procedure TestStringFromLabelCountAsLastByte; + procedure TestStringFromLabelCountAsLastByteTCP; + + // compressed label + procedure TestStringFromLabelCompress; + procedure TestStringFromLabelCompressTCP; + // another compressed label test, this time with one uncompressed label + procedure TestStringFromLabelCompressWithUncompressedLabel; + // as above, but on the tcp payload buffer + procedure TestStringFromLabelCompressWithUncompressedLabelTCP; + // compressed label at the edge of the buffer + procedure TestStringFromLabelCompressEndBuffer; + // compressed label at the edge of the tcp buffer + procedure TestStringFromLabelCompressEndBufferTCP; + // test stringfromlabel when last byte is 192. 192 is the signal + // that the next byte is a pointer offset, but of course there's + // no next byte. + procedure TestStringFromLabelCompressSplit; + // repeat using TCP buffer variant + procedure TestStringFromLabelCompressSplitTCP; + // test that stringfromlabel rejects pointers that go forward. per + // rfc 1035, pointers must go backward. + procedure TestStringFromLabelCompressPtrFwd; + procedure TestStringFromLabelCompressPtrFwdTCP; + // fill buffer with 192, pointer marker, then try stringfromlabel on it. + procedure TestStringFromLabelCompressAllPtrStart; + procedure TestStringFromLabelCompressAllPtrStartTCP; + + // test string from label where second byte is 0. + procedure TestStringFromLabelCompressedZero; + procedure TestStringFromLabelCompressedZeroTCP; + + // test whether an infinite loop can be triggered. + procedure TestStringFromLabelInfiniteLoop; + procedure TestStringFromLabelInfiniteLoopTCP; + + // test short domain less than 12 chars. this tests that dns pointer + // calculations in stringfromlabel are correct + procedure TestCompressShortDomain; + procedure TestCompressShortDomainTCP; + end; + +implementation + +procedure dump_payload(const pl: TBuffer); +var + idx,llen: Cardinal; +begin + idx := 0; + llen := 0; + for idx := 0 to Length(pl) - 1 do + begin + write('['+inttostr(idx)+'] '+IntToHex(pl[idx],2)); + if (pl[idx] > 48) and (pl[idx] < 123) then + write(' ' + chr(pl[idx])) + else + write(' .'); + write(' '); + Inc(llen); + if llen >= 6 then + begin + llen := 0; + writeln(); + end; + end; + if llen > 0 then + begin + writeln(); + end; +end; + +procedure dump_payload(const pl: TPayload; count: Word); +var + idx,llen: Cardinal; +begin + idx := 0; + llen := 0; + for idx := 0 to count - 1 do + begin + write('['+inttostr(idx)+'] '+IntToHex(pl[idx],2)); + if (pl[idx] > 48) and (pl[idx] < 123) then + write(' ' + chr(pl[idx])) + else + write(' .'); + write(' '); + Inc(llen); + if llen >= 6 then + begin + llen := 0; + writeln(); + end; + end; + if llen > 0 then + begin + writeln(); + end; +end; + +function LookupStr(ls: String; stt: TDomainCompressionTable; out idx: Word): Boolean; +var + so: TDomainCompressionOffset; +begin + Result := False; + for so in stt do + begin + if ls = so.nm then + begin + Result := True; + idx := so.offset; + exit; + end; + end; +end; + +function AddStr(ls: String; var stt: TDomainCompressionTable; idx: Word): Boolean; +var + so: TDomainCompressionOffset; +begin + so.nm := ls; + so.offset := idx; + SetLength(stt, Length(stt)+1); + stt[Length(stt)-1] := so; + Result := True; +end; + +function GetDnsDomainPointer(offset: Word): TDNSDomainPointer; +begin + Result.b1 := 0; + Result.b2 := 0; + // dns comp. ptr can't be > 2 ** 14 or 16383 + if offset > 16383 then exit; + Result.b1 := (offset SHR 8) OR 192; + Result.b2 := (offset AND $00FF); +end; + +procedure DomainNameToLabels(const dmn: String; var labels: TStringList); +begin + labels.Clear; + labels.Delimiter := '.'; + labels.StrictDelimiter := True; + labels.DelimitedText := dmn; +end; + +procedure TNetDbTest.BuildFakeRR_A(out RR: TFakeRR; nm: String; ttl: Cardinal; + val: String); +begin + RR.RRName := nm; + RR.Atype := DNSQRY_A; + RR.AClass := 1; + RR.TTL := ttl; + RR.ip := StrToNetAddr(val); + RR.RDLength := 4; +end; + +procedure TNetDbTest.BuildFakeRR_AAAA(out RR: TFakeRR; nm: String; + ttl: Cardinal; val: String); +begin + RR.RRName := nm; + RR.Atype := DNSQRY_AAAA; + RR.AClass := 1; + RR.TTL := ttl; + RR.ip6 := StrToNetAddr6(val); + RR.RDLength := 16; +end; + +procedure TNetDbTest.BuildFakeRR_MX(out RR: TFakeRR; nm: String; ttl: Cardinal; + pref: Word; exch: ShortString ); +begin + RR.RRName := nm; + RR.Atype := DNSQRY_MX; + RR.AClass := 1; + RR.TTL := ttl; + RR.fmx.pref := pref; + RR.fmx.exch := exch; +end; + +procedure TNetDbTest.BuildFakeRR_NS(out RR: TFakeRR; nm: String; ttl: Cardinal; + val: String); +begin + RR.RRName := nm; + RR.Atype := DNSQRY_NS; + RR.AClass := 1; + RR.TTL := ttl; + RR.nsh := val; +end; + +procedure TNetDbTest.BuildFakeRR_PTR(out RR: TFakeRR; nm: String; ttl: Cardinal; + val: String); +begin + RR.RRName := nm; + RR.Atype := DNSQRY_PTR; + RR.AClass := 1; + RR.TTL := ttl; + RR.ptr := val; +end; + +procedure TNetDbTest.BuildFakeRR_CNAME(out RR: TFakeRR; nm: String; + ttl: Cardinal; val: String); +begin + RR.RRName := nm; + RR.Atype := DNSQRY_CNAME; + RR.AClass := 1; + RR.TTL := ttl; + RR.cn := val; +end; + +procedure TNetDbTest.BuildFakeRR_SOA(out RR: TFakeRR; nm: String; ttl: Cardinal; + mn,rn: ShortString; serial,refresh,retry,expire,min: Cardinal); +begin + RR.RRName := nm; + RR.Atype := DNSQRY_SOA; + RR.AClass := 1; + RR.TTL := ttl; + RR.fsoa.mn := mn; + RR.fsoa.rn := rn; + RR.fsoa.serial := serial; + RR.fsoa.refresh := refresh; + RR.fsoa.retry := retry; + RR.fsoa.expire := expire; + RR.fsoa.min := min; +end; + +procedure TNetDbTest.BuildFakeRR_TXT(out RR: TFakeRR; nm: String; ttl: Cardinal; + n: Byte; txt: TTextArray); +var + idx: Byte; +begin + RR.RRName := nm; + RR.Atype := DNSQRY_TXT; + RR.AClass := 1; + RR.TTL := ttl; + RR.sstrcount := n; + RR.txtarr[1] := ''; + RR.txtarr[2] := ''; + RR.txtarr[3] := ''; + RR.txtarr[4] := ''; + RR.txtarr[5] := ''; + for idx := Low(txt) to Min(n, High(txt)) do + RR.txtarr[idx] := txt[idx]; +end; + +procedure TNetDbTest.BuildFakeRR_SRV(out RR: TFakeRR; nm: String; ttl: Cardinal; + priority, weight, port: Word; target: ShortString); +begin + RR.RRName := nm; + RR.Atype := DNSQRY_SRV; + RR.AClass := 1; + RR.TTL := ttl; + RR.fsrv.priority := priority; + RR.fsrv.weight := weight; + RR.fsrv.port := port; + RR.fsrv.target := target; +end; + +function TNetDbTest.CalcRdLength(o: TTextArray): Word; +var + tmps: ShortString; +begin + Result := 0; + for tmps in o do + begin + if tmps = '' then break; + Result := Result + Length(tmps)+1; // don't forget length byte! + end; +end; + +function TNetDbTest.WriteAasRData(var buf: TBuffer; var offset: Cardinal; + ip: THostAddr): TRDataWriteRes; +var + s,l: Word; +begin + s := offset; + l := SizeOf(ip.s_addr); + Result.etw := l + 2; //rdlength +2 for length itself + // rdlength + WriteNumToBuffer(buf, offset, l); + // rr data + WriteNumToBufferN(buf, offset, ip.s_addr); + Result.bw := offset - s; +end; + +function TNetDbTest.WriteSRVasRData(var buf: TBuffer; var offset: Cardinal; + fsrv: TFakeSRV): TRDataWriteRes; +var + s, l: Word; + dmbs: TDNSDomainByteStream; +begin + s := offset; + dmbs := DomainNameToByteStream(fsrv.target); + l := CalcRdLength(dmbs) + SizeOf(Word) * 3; + Result.etw := l + 2; //rdlength +2 for length byte + + // rdlength + WriteNumToBuffer(buf, offset, l); + + // RR data + WriteNumToBuffer(buf, offset, fsrv.priority); + WriteNumToBuffer(buf, offset, fsrv.weight); + WriteNumToBuffer(buf, offset, fsrv.port); + WriteDNSDomainByteStreamToBuffer(buf, offset, dmbs); + Result.bw := offset - s; +end; + +function TNetDbTest.WriteSRVasRData(var buf: TBuffer; var offset: Cardinal; + fsrv: TFakeSRV; var ctbl: TDomainCompressionTable): TRDataWriteRes; +var + s, l: Word; + dmbs: TDNSDomainByteStream; +begin + s := offset; + dmbs := DomainNameToByteStream(fsrv.target, ctbl); + l := CalcRdLength(dmbs) + SizeOf(Word) * 3; + Result.etw := l + 2; //rdlength +2 for length byte + + // rdlength + WriteNumToBuffer(buf, offset, l); + + // RR data + WriteNumToBuffer(buf, offset, fsrv.priority); + WriteNumToBuffer(buf, offset, fsrv.weight); + WriteNumToBuffer(buf, offset, fsrv.port); + WriteDNSDomainByteStreamToBuffer(buf, offset, dmbs); + Result.bw := offset - s; +end; + +function TNetDbTest.WriteMXAsRData(var buf: TBuffer; var offset: Cardinal; + fmx: TFakeMX; var ctbl: TDomainCompressionTable): TRDataWriteRes; +var + s, l: Word; + dmbs: TDNSDomainByteStream; +begin + s := offset; + dmbs := DomainNameToByteStream(fmx.exch, ctbl); + l := SizeOf(fmx.pref) + CalcRdLength(dmbs); + Result.etw := l + 2; // we'll write rdlength bytes+2 bytes for length itself. + + // rdlength + WriteNumToBuffer(buf, offset, l); + + // RR data + // pref + WriteNumToBuffer(buf, offset, fmx.pref); + // exchange + WriteDNSDomainByteStreamToBuffer(buf, offset, dmbs); + Result.bw := offset - s; +end; + +function TNetDbTest.CalcRdLength(o: TDNSDomainByteStream): Word; +begin + Result := Length(o.ulabels); + if o.cptr > 0 then Inc(Result,2); +end; + +function TNetDbTest.WriteAAAAasRData(var buf: TBuffer; var offset: Cardinal; + ip6: THostAddr6): TRDataWriteRes; +var + s,l: Word; +begin + s := offset; + l := SizeOf(ip6.u6_addr32); + Result.etw := l + 2; //rdlength + 2 for length itself + // rdlength + WriteNumToBuffer(buf, offset, l); + // rr data + Move(ip6.s6_addr, buf[offset], l); + Inc(offset, l); + Result.bw := offset - s; +end; + +function TNetDbTest.WriteSOAasRData(var buf: TBuffer; var offset: Cardinal; + fsoa: TFakeSOA): TRDataWriteRes; +var + s, l: Word; + dmbsmn, dmbsrn: TDNSDomainByteStream; +begin + s := offset; + dmbsmn := DomainNameToByteStream(fsoa.mn); + dmbsrn := DomainNameToByteStream(fsoa.rn); + l := CalcRdLength(dmbsmn) + CalcRdLength(dmbsrn) + (SizeOf(Cardinal) * 5); + + Result.etw := l + 2; // rdlength bytes + 2 for length itself + + // rdlength + WriteNumToBuffer(buf, offset, l); + + // rr data + WriteDNSDomainByteStreamToBuffer(buf, offset, dmbsmn); + WriteDNSDomainByteStreamToBuffer(buf, offset, dmbsrn); + + WriteNumToBuffer(buf, offset, fsoa.serial); + WriteNumToBuffer(buf, offset, fsoa.refresh); + WriteNumToBuffer(buf, offset, fsoa.retry); + WriteNumToBuffer(buf, offset, fsoa.expire); + WriteNumToBuffer(buf, offset, fsoa.min); + + Result.bw := offset - s; +end; + +function TNetDbTest.WriteSOAasRData(var buf: TBuffer; var offset: Cardinal; + fsoa: TFakeSOA; var ctbl: TDomainCompressionTable): TRDataWriteRes; +var + s, l: Word; + dmbsmn, dmbsrn: TDNSDomainByteStream; +begin + s := offset; + dmbsmn := DomainNameToByteStream(fsoa.mn, ctbl); + dmbsrn := DomainNameToByteStream(fsoa.rn, ctbl); + l := CalcRdLength(dmbsmn) + CalcRdLength(dmbsrn) + (SizeOf(Cardinal) * 5); + Result.etw := l + 2; // rdlength bytes + 2 for length itself + + // rdlength + WriteNumToBuffer(buf, offset, l); + + // rr data + WriteDNSDomainByteStreamToBuffer(buf, offset, dmbsmn); + WriteDNSDomainByteStreamToBuffer(buf, offset, dmbsrn); + + WriteNumToBuffer(buf, offset, fsoa.serial); + WriteNumToBuffer(buf, offset, fsoa.refresh); + WriteNumToBuffer(buf, offset, fsoa.retry); + WriteNumToBuffer(buf, offset, fsoa.expire); + WriteNumToBuffer(buf, offset, fsoa.min); + + Result.bw := offset - s; +end; + +function TNetDbTest.WriteMXAsRData(var buf: TBuffer; var offset: Cardinal; + fmx: TFakeMX): TRDataWriteRes; +var + s, l: Word; + dmbs: TDNSDomainByteStream; +begin + Result.bw := 0; + s := offset; + dmbs := DomainNameToByteStream(fmx.exch); + l := SizeOf(fmx.pref) + CalcRdLength(dmbs); + Result.etw := l + 2; // we'll write rdlength + 2 bytes for the length itself. + + // rdlength + WriteNumToBuffer(buf, offset, l); + + // RR data + // pref + WriteNumToBuffer(buf, offset, fmx.pref); + // exchange + dmbs := DomainNameToByteStream(fmx.exch); + WriteDNSDomainByteStreamToBuffer(buf, offset, dmbs); + Result.bw := offset - s; +end; + +function TNetDbTest.WriteTextRecAsRData(var buf: TBuffer; var offset: Cardinal; + tt: TTextArray): TRDataWriteRes; +var + s, l: Word; + ws: ShortString; +begin + s := offset; + l := CalcRdLength(tt); + Result.etw := l + 2; // rdlength +2 for length itself + // rdlength + WriteNumToBuffer(buf, offset, l); + + for ws in tt do + begin + if ws = '' then break; + Move(ws, buf[offset], Length(ws)+1); + Inc(offset,Length(ws)+1); + end; + + Result.bw := offset - s; +end; + +{ +Convert a domain name into a byte stream. Compression is supported using the +supplied compression table. +} +function TNetDbTest.DomainNameToByteStream(nm: ShortString; + var ctbl: TDomainCompressionTable): TDNSDomainByteStream; +var + dmn: ShortString; + offset,cmpoffset: Word; + ptrseen: Boolean = False; +begin + SetLength(Result.ulabels, 0); + Result.cptr := 0; + offset := 0; + + if nm = '' then exit; + DomainNameToLabels(nm, tsl); + if tsl.Count = 0 then exit; + + dmn := ''; + cmpoffset := 0; + + { + for a domain a.b.c, using the lookup table, + -> lookup (a.b.c), if not found, add to table, + -> lookup (b.c), if not found, add to table, + -> lookup (c), if not found, add to table, + + buf if any label domain is found, add the pointer to the buffer and stop. + } + repeat + dmn := tsl.DelimitedText; + ptrseen := LookupStr(dmn, ctbl, cmpoffset); + if ptrseen then + begin + // found the domain name. add a pointer, then we're done. Per RFC1035, + // section 4.1.4, a domain name is either a series of labels, a pointer, + // or a series of labels ending with a pointer. There's just one pointer + // for a domain name. + Result.cptr := cmpoffset; + break; + end + else + begin + // add the last full domain we looked up, not the working label, + // to the compression lookup table. E.g, add a.b.c rather than a. + // Add 12 for the dns header, which our buffer doesn't include, but + // api methods like stringfromlabel adjust offsets to account for it. + if Length(dmn) > 0 then AddStr(dmn, ctbl, offset+12); + // write the label to the buffer + dmn := tsl[0]; + tsl.Delete(0); + SetLength(Result.ulabels, (Length(Result.ulabels) + Length(dmn)+1)); + Result.ulabels[offset] := Length(dmn); + Inc(offset); + Move(dmn[1], Result.ulabels[offset], Length(dmn)); + Inc(offset, Length(dmn)); + end; + until tsl.Count = 0; + + // if we didn't see a pointer then we have to write a 0. see rfc1035, s4.1.4. + if not ptrseen then + begin + SetLength(Result.ulabels, Length(Result.ulabels) + 1); + Result.ulabels[offset] := 0; + Inc(offset); + end; +end; + +{ +This version of DomainNameToByteStream doesn't compress. +} +function TNetDbTest.DomainNameToByteStream(nm: ShortString + ): TDNSDomainByteStream; +var + dmn: ShortString; + offset: Word; +begin + SetLength(Result.ulabels, 0); + Result.cptr := 0; + offset := 0; + + if nm = '' then exit; + DomainNameToLabels(nm, tsl); + if tsl.Count = 0 then exit; + + for dmn in tsl do + begin + SetLength(Result.ulabels, (Length(Result.ulabels) + Length(dmn)+1)); + Result.ulabels[offset] := Length(dmn); + Inc(offset); + Move(dmn[1], Result.ulabels[offset], Length(dmn)); + Inc(offset, Length(dmn)); + end; + + SetLength(Result.ulabels, Length(Result.ulabels) + 1); + Result.ulabels[offset] := 0; +end; + +function TNetDbTest.WriteDNSDomainByteStreamToBuffer(var buf: TBuffer; + var offset: Cardinal; dbs: TDNSDomainByteStream): Word; +var + p: TDNSDomainPointer; + so: Word; +begin + Result := 0; + // no label, no pointer, no write for you. + if (Length(dbs.ulabels) = 0) and (dbs.cptr = 0) then exit; + if (offset + CalcRdLength(dbs)) > Length(buf) then exit; + + so := offset; + // labels can be empty, in which case we're writing just a pointer. + if Length(dbs.ulabels) > 0 then + begin + Move(dbs.ulabels[0], buf[offset], Length(dbs.ulabels)); + Inc(offset, Length(dbs.ulabels)); + end; + if dbs.cptr > 0 then + begin + p := GetDnsDomainPointer(dbs.cptr); + Move(p.ba, buf[offset], Length(p.ba)); + Inc(offset, Min(Length(p.ba), (Length(buf) - offset))); + end; + Result := offset - so; +end; + +{ +Write a domain name as RDATA. This means an RDLength (Word) and the +domain labels. +} +function TNetDbTest.WriteDomainAsRdata(var buf: TBuffer; var offset: Cardinal; + dbs: TDNSDomainByteStream): TRDataWriteRes; +var + s,l: Word; +begin + l := CalcRdLength(dbs); + Result.etw := l + 2; + s := offset; + WriteNumToBuffer(buf, offset,l); + WriteDNSDomainByteStreamToBuffer(buf, offset, dbs); + Result.bw := offset - s; +end; + + +procedure TNetDbTest.BuildFakeResponseA(nm: ShortString; out + fr: TFakeDNSResponse); +begin + // metadata + SetLength(fr.strtable, 0); + + // start by building a fake header. + fr.hdr.ID[0] := 12; + fr.hdr.ID[1] := 34; + fr.hdr.flags1 := QF_QR or QF_RD; + fr.hdr.flags2 := 0; + fr.hdr.qdcount := 1; + fr.hdr.ancount := 2; + fr.hdr.nscount := 0; + fr.hdr.arcount := 0; + + // Next is the query part + fr.qry.nm := nm; + fr.qry.qclass := 1; + fr.qry.qtype := DNSQRY_A; + + // now the answer RRs + SetLength(fr.answers,2); + BuildFakeRR_A(fr.answers[0], nm, 300, '127.0.0.1'); + BuildFakeRR_A(fr.answers[1], nm, 215, '127.0.5.1'); +end; + +procedure TNetDbTest.BuildFakeResponseAAAA(nm: ShortString; out + fr: TFakeDNSResponse); +begin + // metadata + SetLength(fr.strtable, 0); + + // start by building a fake header. + fr.hdr.ID[0] := 12; + fr.hdr.ID[1] := 34; + fr.hdr.flags1 := QF_QR or QF_RD; + fr.hdr.flags2 := 0; + fr.hdr.qdcount := 1; + fr.hdr.ancount := 2; + fr.hdr.nscount := 0; + fr.hdr.arcount := 0; + + // Next is the query part + fr.qry.nm := nm; + fr.qry.qclass := 1; + fr.qry.qtype := DNSQRY_AAAA; + + // now the answer RRs + SetLength(fr.answers,2); + BuildFakeRR_AAAA(fr.answers[0], nm, 300, 'fe80::3b92:3429:ff16:a3e4'); + BuildFakeRR_AAAA(fr.answers[1], nm, 215, 'fe80::92e6:baff:fe44:ffbb'); +end; + +procedure TNetDbTest.BuildFakeResponseMX(nm: ShortString; out + fr: TFakeDNSResponse); +begin + // metadata + SetLength(fr.strtable, 0); + + // start by building a fake header. + fr.hdr.ID[0] := 12; + fr.hdr.ID[1] := 34; + fr.hdr.flags1 := QF_QR or QF_RD; + fr.hdr.flags2 := 0; + fr.hdr.qdcount := 1; + fr.hdr.ancount := 1; + fr.hdr.nscount := 0; + fr.hdr.arcount := 2; + + // Next is the query part + fr.qry.nm := nm; + fr.qry.qclass := 1; + fr.qry.qtype := DNSQRY_MX; + + // now the answer RRs + SetLength(fr.answers,1); + BuildFakeRR_MX(fr.answers[0], nm, 0, 10, 'mailer.'+FAKEFQDN); + // now an additional rr with the A record for the above. + SetLength(fr.additional, 2); + BuildFakeRR_A(fr.additional[0], 'mailer.'+FAKEFQDN, 0, + '172.16.27.238'); + BuildFakeRR_AAAA(fr.additional[1], 'mailer.'+FAKEFQDN, 0, + 'fe80::3b92:3429:ff16:a3e4'); +end; + +procedure TNetDbTest.BuildFakeResponseSOA(nm: ShortString; out + fr: TFakeDNSResponse); +begin + // metadata + SetLength(fr.strtable, 0); + + // start by building a fake header. + fr.hdr.ID[0] := 12; + fr.hdr.ID[1] := 34; + fr.hdr.flags1 := QF_QR or QF_RD; + fr.hdr.flags2 := 0; + fr.hdr.qdcount := 1; + fr.hdr.ancount := 1; + fr.hdr.nscount := 0; + fr.hdr.arcount := 0; + + // Next is the query part + fr.qry.nm := nm; + fr.qry.qclass := 1; + fr.qry.qtype := DNSQRY_SOA; + // now the answer RRs + SetLength(fr.answers,1); + BuildFakeRR_SOA(fr.answers[0],FAKEFQDN,33, + 'mn.'+FAKEFQDN,'rn.'+FAKEFQDN,76543210, + 123,456,789,60); +end; + +procedure TNetDbTest.BuildFakeResponseCNAME(nm: ShortString; out + fr: TFakeDNSResponse); +begin + // metadata + SetLength(fr.strtable, 0); + + // start by building a fake header. + fr.hdr.ID[0] := 12; + fr.hdr.ID[1] := 34; + fr.hdr.flags1 := QF_QR or QF_RD; + fr.hdr.flags2 := 0; + fr.hdr.qdcount := 1; + fr.hdr.ancount := 1; + fr.hdr.nscount := 0; + fr.hdr.arcount := 0; + + // Next is the query part + fr.qry.nm := nm; + fr.qry.qclass := 1; + fr.qry.qtype := DNSQRY_CNAME; + + // now the answer RRs + SetLength(fr.answers,1); + BuildFakeRR_CNAME(fr.answers[0], nm, 300, 'fakecname.'+FAKEFQDN); +end; + +procedure TNetDbTest.BuildFakeResponseNS(nm: ShortString; out + fr: TFakeDNSResponse); +begin + // metadata + SetLength(fr.strtable, 0); + + // start by building a fake header. + fr.hdr.ID[0] := 12; + fr.hdr.ID[1] := 34; + fr.hdr.flags1 := QF_QR or QF_RD; + fr.hdr.flags2 := 0; + fr.hdr.qdcount := 1; + fr.hdr.ancount := 1; + fr.hdr.nscount := 0; + fr.hdr.arcount := 0; + + // Next is the query part + fr.qry.nm := nm; + fr.qry.qclass := 1; + fr.qry.qtype := DNSQRY_NS; + + // now the answer RRs + SetLength(fr.answers,1); + BuildFakeRR_NS(fr.answers[0], nm, 300, 'fakens.'+FAKEFQDN); +end; + +procedure TNetDbTest.BuildFakeResponsePTR(nm: ShortString; out + fr: TFakeDNSResponse); +begin + // metadata + SetLength(fr.strtable, 0); + + // start by building a fake header. + fr.hdr.ID[0] := 12; + fr.hdr.ID[1] := 34; + fr.hdr.flags1 := QF_QR or QF_RD; + fr.hdr.flags2 := 0; + fr.hdr.qdcount := 1; + fr.hdr.ancount := 1; + fr.hdr.nscount := 0; + fr.hdr.arcount := 0; + + // Next is the query part + fr.qry.nm := nm; + fr.qry.qclass := 1; + fr.qry.qtype := DNSQRY_PTR; + + // now the answer RRs + SetLength(fr.answers,1); + BuildFakeRR_PTR(fr.answers[0], nm, 300, 'fakeptrans.'+FAKEFQDN); +end; + +procedure TNetDbTest.BuildFakeResponseTXT(nm: ShortString; out + fr: TFakeDNSResponse); +var + txtarr: TTextArray; +begin + // metadata + SetLength(fr.strtable, 0); + + // start by building a fake header. + fr.hdr.ID[0] := 12; + fr.hdr.ID[1] := 34; + fr.hdr.flags1 := QF_QR or QF_RD; + fr.hdr.flags2 := 0; + fr.hdr.qdcount := 1; + fr.hdr.ancount := 1; + fr.hdr.nscount := 0; + fr.hdr.arcount := 0; + + // Next is the query part + fr.qry.nm := nm; + fr.qry.qclass := 1; + fr.qry.qtype := DNSQRY_TXT; + + txtarr[1] := 'v=spf1 mx a:lists.'+FAKEFQDN; + txtarr[2] := 'Always look on the bright side of life!'; + // now the answer RRs + SetLength(fr.answers,1); + BuildFakeRR_TXT(fr.answers[0], nm, 300, 2, txtarr); +end; + +procedure TNetDbTest.BuildFakeResponseSRV(nm: ShortString; out + fr: TFakeDNSResponse); +begin + // metadata + SetLength(fr.strtable, 0); + + // start by building a fake header. + fr.hdr.ID[0] := 12; + fr.hdr.ID[1] := 34; + fr.hdr.flags1 := QF_QR or QF_RD; + fr.hdr.flags2 := 0; + fr.hdr.qdcount := 1; + fr.hdr.ancount := 1; + fr.hdr.nscount := 0; + fr.hdr.arcount := 0; + + // Next is the query part + fr.qry.nm := nm; + fr.qry.qclass := 1; + fr.qry.qtype := DNSQRY_SRV; + // now the answer RRs + SetLength(fr.answers,1); + BuildFakeRR_SRV(fr.answers[0],FAKEFQDN,3300,22,44,2201,'_this._that._other'); +end; + +{ +Test that BuildPayload puts the right values into the payload buffer. +} +procedure TNetDbTest.TestBuildPayloadSimple; +var + Q: TQueryData; + R, I,J,el: Integer; + S: String; +begin + R := BuildPayLoad(Q, FAKEFQDN, DNSQRY_A, 1); + // this is the expected length. Essentially, for each label, len(label)+1, + // then 4 bytes for the qclass and qtype, and 1 more for a 0 byte. + // rather than hardwire the length we calculate it so that no matter + // what the fake domain the test passes. + el := (Length(FAKEDOMAIN)+1)+(Length(FAKETLD)+1)+5; + AssertEquals('Payload byte count wrong:', el, R); + I := 0; + J := 0; + S := stringfromlabel(Q.Payload,I); + AssertEquals('Wrong domain name returned:',FAKEFQDN, S); + Move(Q.Payload[I],J,SizeOf(Word)); + AssertEquals('Wrong query type', DNSQRY_A, NToHs(J)); + Inc(I,2); + Move(Q.Payload[I],J,SizeOf(Word)); + AssertEquals('Wrong class', 1, NToHs(J)); +end; + +{ +Test building a payload with an empty str. +} +procedure TNetDbTest.TestBuildPayloadSimpleEmpty; +var + Q: TQueryData; + R: Integer; +begin + R := BuildPayLoad(Q, '', DNSQRY_A, 1); + AssertEquals('Payload byte count wrong:',-1, R); +end; + +{ +Test BuildQuery with a label that ends in a dot. This should be allowed. +A dot at the end is an empty label but we must not count its 0 byte twice. +} +procedure TNetDbTest.TestBuildPayloadSimpleEndDot; +var + Q: TQueryData; + R,el: Integer; +begin + // this is the expected length. Essentially, for each label, len(label)+1, + // then 4 bytes for the qclass and qtype, and 1 more for a 0 byte. + // rather than hardwire the length we calculate it so that no matter + // what the fake domain the test passes. + el := (Length(FAKEDOMAIN)+1)+(Length(FAKETLD)+1)+5; + R := BuildPayLoad(Q, FAKEFQDN+'.', DNSQRY_A, 1); + AssertEquals('Payload byte count wrong:',el, R); +end; + +{ +Test BuildPayload with a label that starts with a dot. This should be +rejected outright. +} +procedure TNetDbTest.TestBuildPayloadSimpleStartDot; +var + Q: TQueryData; + R: Integer; +begin + R := BuildPayLoad(Q, '.'+FAKEFQDN, DNSQRY_A, 1); + AssertEquals('Payload byte count wrong:',-1, R); +end; + +{ +Test BuildPayload with multiple dots (empty labels) in the middle of the domain +name. This should be rejected outright. +} +procedure TNetDbTest.TestBuildPayloadSimpleMultipleDot; +var + Q: TQueryData; + R: Integer; +begin + R := BuildPayLoad(Q, FAKEDOMAIN+'.....'+FAKETLD, DNSQRY_A, 1); + AssertEquals('Payload byte count wrong:',-1, R); +end; + +procedure TNetDbTest.TestDnsQueryUDP_A; +var + fakeresp: TFakeDNSResponse; + qd: TQueryData; + anslen, ansstart: Word; + RRArr: TRRNameDataArray; + ip: THostAddr; +begin + BuildFakeResponseA(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to querydata', + BuildQueryData(fakeresp, qd, anslen)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of A records.', 2, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + AssertEquals('Wrong number of resource records.', 2, Length(RRArr)); + AssertEquals('RR 0 is not an A RR.',DNSQRY_A, RRarr[0].RRMeta.Atype); + AssertEquals('RR 1 is not an A RR.', DNSQRY_A, RRarr[1].RRMeta.Atype); + AssertEquals('Wrong A record name for RR 0', FAKEFQDN, + RRArr[0].RRName); + AssertEquals('Wrong A record name for RR 1', FAKEFQDN, + RRArr[1].RRName); + AssertTrue('Did not get RR A data.', DNSRRGetA(RRArr[0], qd.Payload, ip)); + AssertEquals('Wrong ip for A.', '127.0.0.1', HostAddrToStr(ip)); + AssertTrue('Did not get RR A data.', DNSRRGetA(RRArr[1], qd.Payload, ip)); + AssertEquals('Wrong ip for A.', '127.0.5.1', HostAddrToStr(ip)); +end; + +procedure TNetDbTest.TestDnsQueryTCP_A; +var + fakeresp: TFakeDNSResponse; + qd: TQueryDataLengthTCP; + anslen, ansstart: Word; + RRArr: TRRNameDataArray; + ip: THostAddr; +begin + BuildFakeResponseA(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to querydata', + BuildQueryData(fakeresp, qd, anslen)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of A records.', 2, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + AssertEquals('Wrong number of resource records.', 2, Length(RRArr)); + AssertEquals('RR 0 is not an A RR.',DNSQRY_A, RRarr[0].RRMeta.Atype); + AssertEquals('RR 1 is not an A RR.', DNSQRY_A, RRarr[1].RRMeta.Atype); + AssertEquals('Wrong A record name for RR 0', FAKEFQDN, + RRArr[0].RRName); + AssertEquals('Wrong A record name for RR 1', FAKEFQDN, + RRArr[1].RRName); + AssertTrue('Did not get RR A data.', DNSRRGetA(RRArr[0], qd.Payload, ip)); + AssertEquals('Wrong ip for A.', '127.0.0.1', HostAddrToStr(ip)); + AssertTrue('Did not get RR A data.', DNSRRGetA(RRArr[1], qd.Payload, ip)); + AssertEquals('Wrong ip for A.', '127.0.5.1', HostAddrToStr(ip)); +end; + +procedure TNetDbTest.TestDnsQueryCompressUDP_A; +var + fakeresp: TFakeDNSResponse; + qd: TQueryData; + anslen, ansstart: Word; + RRArr: TRRNameDataArray; + ip: THostAddr; +begin + BuildFakeResponseA(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to compressed querydata', + BuildQueryData(fakeresp, qd, anslen, True)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of A records.', 2, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + AssertEquals('Wrong number of resource records.', 2, Length(RRArr)); + AssertEquals('RR 0 is not an A RR.',DNSQRY_A, RRarr[0].RRMeta.Atype); + AssertEquals('RR 1 is not an A RR.', DNSQRY_A, RRarr[1].RRMeta.Atype); + AssertEquals('Wrong A record name for RR 0', FAKEFQDN, + RRArr[0].RRName); + AssertEquals('Wrong A record name for RR 1', FAKEFQDN, + RRArr[1].RRName); + AssertTrue('Did not get RR A data.', DNSRRGetA(RRArr[0], qd.Payload, ip)); + AssertEquals('Wrong ip for A.', '127.0.0.1', HostAddrToStr(ip)); + AssertTrue('Did not get RR A data.', DNSRRGetA(RRArr[1], qd.Payload, ip)); + AssertEquals('Wrong ip for A.', '127.0.5.1', HostAddrToStr(ip)); +end; + +procedure TNetDbTest.TestDnsQueryCompressTCP_A; +var + fakeresp: TFakeDNSResponse; + qd: TQueryDataLengthTCP; + anslen, ansstart: Word; + RRArr: TRRNameDataArray; + ip: THostAddr; +begin + BuildFakeResponseA(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to compressed querydata', + BuildQueryData(fakeresp, qd, anslen, True)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of A records.', 2, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + AssertEquals('Wrong number of resource records.', 2, Length(RRArr)); + AssertEquals('RR 0 is not an A RR.',DNSQRY_A, RRarr[0].RRMeta.Atype); + AssertEquals('RR 1 is not an A RR.', DNSQRY_A, RRarr[1].RRMeta.Atype); + AssertEquals('Wrong A record name for RR 0', FAKEFQDN, + RRArr[0].RRName); + AssertEquals('Wrong A record name for RR 1', FAKEFQDN, + RRArr[1].RRName); + AssertTrue('Did not get RR A data.', DNSRRGetA(RRArr[0], qd.Payload, ip)); + AssertEquals('Wrong ip for A.', '127.0.0.1', HostAddrToStr(ip)); + AssertTrue('Did not get RR A data.', DNSRRGetA(RRArr[1], qd.Payload, ip)); + AssertEquals('Wrong ip for A.', '127.0.5.1', HostAddrToStr(ip)); +end; + +procedure TNetDbTest.TestDnsQueryUDP_AAAA; +var + fakeresp: TFakeDNSResponse; + qd: TQueryData; + anslen, ansstart: Word; + RRArr: TRRNameDataArray; + ip: THostAddr6; +begin + BuildFakeResponseAAAA(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to querydata', + BuildQueryData(fakeresp, qd, anslen)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of AAAA records.', 2, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + AssertEquals('Wrong number of resource records.', 2, Length(RRArr)); + AssertEquals('RR 0 is not an AAAA RR.',DNSQRY_AAAA, RRarr[0].RRMeta.Atype); + AssertEquals('RR 1 is not an AAAA RR.', DNSQRY_AAAA, RRarr[1].RRMeta.Atype); + AssertEquals('Wrong AAAA record name for RR 0', FAKEFQDN, + RRArr[0].RRName); + AssertEquals('Wrong AAAA record name for RR 1', FAKEFQDN, + RRArr[1].RRName); + AssertTrue('Did not get RR AAAA data.', DNSRRGetAAAA(RRArr[0], qd.Payload, ip)); + AssertEquals('Wrong ip for AAAA.', 'FE80::3B92:3429:FF16:A3E4', HostAddrToStr6(ip)); + AssertTrue('Did not get RR AAAA data.', DNSRRGetAAAA(RRArr[1], qd.Payload, ip)); + AssertEquals('Wrong ip for AAAA.', 'FE80::92E6:BAFF:FE44:FFBB', HostAddrToStr6(ip)); +end; + +procedure TNetDbTest.TestDnsQueryTCP_AAAA; +var + fakeresp: TFakeDNSResponse; + qd: TQueryDataLengthTCP; + anslen, ansstart: Word; + RRArr: TRRNameDataArray; + ip: THostAddr6; +begin + BuildFakeResponseAAAA(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to querydata', + BuildQueryData(fakeresp, qd, anslen)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of AAAA records.', 2, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + AssertEquals('Wrong number of resource records.', 2, Length(RRArr)); + AssertEquals('RR 0 is not an AAAA RR.',DNSQRY_AAAA, RRarr[0].RRMeta.Atype); + AssertEquals('RR 1 is not an AAAA RR.', DNSQRY_AAAA, RRarr[1].RRMeta.Atype); + AssertEquals('Wrong AAAA record name for RR 0', FAKEFQDN, + RRArr[0].RRName); + AssertEquals('Wrong AAAA record name for RR 1', FAKEFQDN, + RRArr[1].RRName); + AssertTrue('Did not get RR AAAA data.', DNSRRGetAAAA(RRArr[0], + qd.Payload, ip)); + AssertEquals('Wrong ip for AAAA.', 'FE80::3B92:3429:FF16:A3E4', + HostAddrToStr6(ip)); + AssertTrue('Did not get RR AAAA data.', DNSRRGetAAAA(RRArr[1], + qd.Payload, ip)); + AssertEquals('Wrong ip for AAAA.', 'FE80::92E6:BAFF:FE44:FFBB', + HostAddrToStr6(ip)); +end; + +procedure TNetDbTest.TestDnsQueryCompressUDP_AAAA; +var + fakeresp: TFakeDNSResponse; + qd: TQueryData; + anslen, ansstart: Word; + RRArr: TRRNameDataArray; + ip: THostAddr6; +begin + BuildFakeResponseAAAA(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to compressed querydata', + BuildQueryData(fakeresp, qd, anslen, True)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of AAAA records.', 2, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + AssertEquals('Wrong number of resource records.', 2, Length(RRArr)); + AssertEquals('RR 0 is not an AAAA RR.',DNSQRY_AAAA, RRarr[0].RRMeta.Atype); + AssertEquals('RR 1 is not an AAAA RR.', DNSQRY_AAAA, RRarr[1].RRMeta.Atype); + AssertEquals('Wrong AAAA record name for RR 0', FAKEFQDN, + RRArr[0].RRName); + AssertEquals('Wrong AAAA record name for RR 1', FAKEFQDN, + RRArr[1].RRName); + AssertTrue('Did not get RR AAAA data.', DNSRRGetAAAA(RRArr[0], + qd.Payload, ip)); + AssertEquals('Wrong ip for AAAA.', 'FE80::3B92:3429:FF16:A3E4', + HostAddrToStr6(ip)); + AssertTrue('Did not get RR AAAA data.', DNSRRGetAAAA(RRArr[1], + qd.Payload, ip)); + AssertEquals('Wrong ip for AAAA.', 'FE80::92E6:BAFF:FE44:FFBB', + HostAddrToStr6(ip)); +end; + +procedure TNetDbTest.TestDnsQueryCompressTCP_AAAA; +var + fakeresp: TFakeDNSResponse; + qd: TQueryDataLengthTCP; + anslen, ansstart: Word; + RRArr: TRRNameDataArray; + ip: THostAddr6; +begin + BuildFakeResponseAAAA(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to compressed querydata', + BuildQueryData(fakeresp, qd, anslen, True)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of AAAA records.', 2, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + AssertEquals('Wrong number of resource records.', 2, Length(RRArr)); + AssertEquals('RR 0 is not an AAAA RR.',DNSQRY_AAAA, RRarr[0].RRMeta.Atype); + AssertEquals('RR 1 is not an AAAA RR.', DNSQRY_AAAA, RRarr[1].RRMeta.Atype); + AssertEquals('Wrong AAAA record name for RR 0', FAKEFQDN, + RRArr[0].RRName); + AssertEquals('Wrong AAAA record name for RR 1', FAKEFQDN, + RRArr[1].RRName); + AssertTrue('Did not get RR AAAA data.', DNSRRGetAAAA(RRArr[0], + qd.Payload, ip)); + AssertEquals('Wrong ip for AAAA.', 'FE80::3B92:3429:FF16:A3E4', + HostAddrToStr6(ip)); + AssertTrue('Did not get RR AAAA data.', DNSRRGetAAAA(RRArr[1], + qd.Payload, ip)); + AssertEquals('Wrong ip for AAAA.', 'FE80::92E6:BAFF:FE44:FFBB', + HostAddrToStr6(ip)); +end; + +procedure TNetDbTest.TestDnsQueryUDP_MX; +var + fakeresp: TFakeDNSResponse; + qd: TQueryData; + anslen, ansstart: Word; + RRArr: TRRNameDataArray; + mxrec: TDNSRR_MX; + ip: THostAddr; + ip6: THostAddr6; +begin + BuildFakeResponseMX(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to querydata', + BuildQueryData(fakeresp, qd, anslen)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of MX records.', 1, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + AssertEquals('Wrong number of resource records.', 1, Length(RRArr)); + AssertEquals('RR 0 is not an MX RR.',DNSQRY_MX, RRarr[0].RRMeta.Atype); + + AssertEquals('Wrong record name for RR 0', FAKEFQDN, + RRArr[0].RRName); + + AssertTrue('Did not get RR MX data.', DNSRRGetMX(RRArr[0], qd.Payload, mxrec)); + AssertEquals('Wrong MX hostname', 'mailer.'+FAKEFQDN, + mxrec.exchange); + AssertEquals('Wrong MX preference', 10, mxrec.preference); + + AssertEquals('Should be 2 additional RR records.',2,NToHs(qd.h.arcount)); + RRArr := GetRRrecords(qd.Payload, ansstart, NToHs(qd.h.arcount)); + AssertEquals('Wrong number of resource records.', 2, Length(RRArr)); + AssertEquals('RR 0 is not an A RR.',DNSQRY_A, RRarr[0].RRMeta.Atype); + AssertEquals('RR 1 is not an AAAA RR.', DNSQRY_AAAA, RRarr[1].RRMeta.Atype); + AssertTrue('Did not get RR A data.', DNSRRGetA(RRArr[0], qd.Payload, ip)); + AssertTrue('Did not get RR AAAA data.', DNSRRGetAAAA(RRArr[1], qd.Payload, ip6)); + + AssertEquals('Wrong ip for A.', '172.16.27.238', HostAddrToStr(ip)); + AssertEquals('Wrong ip for AAAA.', 'FE80::3B92:3429:FF16:A3E4', + HostAddrToStr6(ip6)); +end; + +procedure TNetDbTest.TestDnsQueryTCP_MX; +var + fakeresp: TFakeDNSResponse; + qd: TQueryDataLengthTCP; + anslen, ansstart: Word; + RRArr: TRRNameDataArray; + mxrec: TDNSRR_MX; + ip: THostAddr; + ip6: THostAddr6; +begin + BuildFakeResponseMX(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to querydata', + BuildQueryData(fakeresp, qd, anslen)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of MX records.', 1, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + AssertEquals('Wrong number of resource records.', 1, Length(RRArr)); + AssertEquals('RR 0 is not an MX RR.',DNSQRY_MX, RRarr[0].RRMeta.Atype); + + AssertEquals('Wrong record name for RR 0', FAKEFQDN, + RRArr[0].RRName); + + AssertTrue('Did not get RR MX data.', DNSRRGetMX(RRArr[0], qd.Payload, mxrec)); + AssertEquals('Wrong MX hostname', 'mailer.'+FAKEFQDN, + mxrec.exchange); + AssertEquals('Wrong MX preference', 10, mxrec.preference); + + AssertEquals('Should be 2 additional RR records.',2,NToHs(qd.h.arcount)); + RRArr := GetRRrecords(qd.Payload, ansstart, NToHs(qd.h.arcount)); + AssertEquals('Wrong number of resource records.', 2, Length(RRArr)); + AssertEquals('RR 0 is not an A RR.',DNSQRY_A, RRarr[0].RRMeta.Atype); + AssertEquals('RR 1 is not an AAAA RR.', DNSQRY_AAAA, RRarr[1].RRMeta.Atype); + AssertTrue('Did not get RR A data.', DNSRRGetA(RRArr[0], qd.Payload, ip)); + AssertTrue('Did not get RR AAAA data.', DNSRRGetAAAA(RRArr[1], qd.Payload, ip6)); + + AssertEquals('Wrong ip for A.', '172.16.27.238', HostAddrToStr(ip)); + AssertEquals('Wrong ip for AAAA.', 'FE80::3B92:3429:FF16:A3E4', + HostAddrToStr6(ip6)); +end; + +procedure TNetDbTest.TestDnsQueryCompressUDP_MX; +var + fakeresp: TFakeDNSResponse; + qd: TQueryData; + anslen, ansstart: Word; + RRArr: TRRNameDataArray; + mxrec: TDNSRR_MX; + ip: THostAddr; + ip6: THostAddr6; +begin + BuildFakeResponseMX(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to compressed querydata', + BuildQueryData(fakeresp, qd, anslen, True)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of MX records.', 1, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + AssertEquals('Wrong number of resource records.', 1, Length(RRArr)); + AssertEquals('RR 0 is not an MX RR.',DNSQRY_MX, RRarr[0].RRMeta.Atype); + + AssertEquals('Wrong record name for RR 0', FAKEFQDN, + RRArr[0].RRName); + + AssertTrue('Did not get RR MX data.', DNSRRGetMX(RRArr[0], qd.Payload, mxrec)); + AssertEquals('Wrong MX hostname', 'mailer.'+FAKEFQDN, + mxrec.exchange); + AssertEquals('Wrong MX preference', 10, mxrec.preference); + + AssertEquals('Should be 2 additional RR records.',2,NToHs(qd.h.arcount)); + RRArr := GetRRrecords(qd.Payload, ansstart, NToHs(qd.h.arcount)); + AssertEquals('Wrong number of resource records.', 2, Length(RRArr)); + AssertEquals('RR 0 is not an A RR.',DNSQRY_A, RRarr[0].RRMeta.Atype); + AssertEquals('RR 1 is not an AAAA RR.', DNSQRY_AAAA, RRarr[1].RRMeta.Atype); + AssertTrue('Did not get RR A data.', DNSRRGetA(RRArr[0], qd.Payload, ip)); + AssertTrue('Did not get RR AAAA data.', DNSRRGetAAAA(RRArr[1], qd.Payload, + ip6)); + + AssertEquals('Wrong ip for A.', '172.16.27.238', HostAddrToStr(ip)); + AssertEquals('Wrong ip for AAAA.', 'FE80::3B92:3429:FF16:A3E4', + HostAddrToStr6(ip6)); +end; + +procedure TNetDbTest.TestDnsQueryCompressTCP_MX; +var + fakeresp: TFakeDNSResponse; + qd: TQueryDataLengthTCP; + anslen, ansstart: Word; + RRArr: TRRNameDataArray; + mxrec: TDNSRR_MX; + ip: THostAddr; + ip6: THostAddr6; +begin + BuildFakeResponseMX(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to compressed querydata', + BuildQueryData(fakeresp, qd, anslen, True)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of MX records.', 1, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + AssertEquals('Wrong number of resource records.', 1, Length(RRArr)); + AssertEquals('RR 0 is not an MX RR.',DNSQRY_MX, RRarr[0].RRMeta.Atype); + + AssertEquals('Wrong record name for RR 0', FAKEFQDN, + RRArr[0].RRName); + + AssertTrue('Did not get RR MX data.', DNSRRGetMX(RRArr[0], qd.Payload, mxrec)); + AssertEquals('Wrong MX hostname', 'mailer.'+FAKEFQDN, + mxrec.exchange); + AssertEquals('Wrong MX preference', 10, mxrec.preference); + + AssertEquals('Should be 2 additional RR records.',2,NToHs(qd.h.arcount)); + RRArr := GetRRrecords(qd.Payload, ansstart, NToHs(qd.h.arcount)); + AssertEquals('Wrong number of resource records.', 2, Length(RRArr)); + AssertEquals('RR 0 is not an A RR.',DNSQRY_A, RRarr[0].RRMeta.Atype); + AssertEquals('RR 1 is not an AAAA RR.', DNSQRY_AAAA, RRarr[1].RRMeta.Atype); + AssertTrue('Did not get RR A data.', DNSRRGetA(RRArr[0], qd.Payload, ip)); + AssertTrue('Did not get RR AAAA data.', DNSRRGetAAAA(RRArr[1], qd.Payload, + ip6)); + + AssertEquals('Wrong ip for A.', '172.16.27.238', HostAddrToStr(ip)); + AssertEquals('Wrong ip for AAAA.', 'FE80::3B92:3429:FF16:A3E4', + HostAddrToStr6(ip6)); +end; + +procedure TNetDbTest.TestDnsQueryUDP_SOA; +var + fakeresp: TFakeDNSResponse; + qd: TQueryData; + anslen, ansstart: Word; + RRArr: TRRNameDataArray; + soarec: TDNSRR_SOA; +begin + BuildFakeResponseSOA(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to querydata', + BuildQueryData(fakeresp, qd, anslen)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of SOA records.', 1, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + AssertEquals('Wrong number of resource records.', 1, Length(RRArr)); + AssertEquals('RR 0 is not an SOA RR.',DNSQRY_SOA, RRarr[0].RRMeta.Atype); + + AssertEquals('Wrong record name for RR 0', FAKEFQDN, + RRArr[0].RRName); + + AssertTrue('Did not get RR SOA data.', DNSRRGetSOA(RRArr[0], qd.Payload, + soarec)); + AssertEquals('Wrong mname hostname', 'mn.'+FAKEFQDN, + soarec.mname); + AssertEquals('Wrong rname hostname', 'rn.'+FAKEFQDN, + soarec.rname); + AssertEquals('Wrong SOA serial', 76543210, soarec.serial); + AssertEquals('Wrong SOA refresh', 123, soarec.refresh); + AssertEquals('Wrong SOA retry', 456, soarec.retry); + AssertEquals('Wrong SOA expire', 789, soarec.expire); + AssertEquals('Wrong SOA min', 60, soarec.min); +end; + +procedure TNetDbTest.TestDnsQueryTCP_SOA; +var + fakeresp: TFakeDNSResponse; + qd: TQueryDataLengthTCP; + anslen, ansstart: Word; + RRArr: TRRNameDataArray; + soarec: TDNSRR_SOA; +begin + BuildFakeResponseSOA(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to querydata', + BuildQueryData(fakeresp, qd, anslen)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of SOA records.', 1, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + AssertEquals('Wrong number of resource records.', 1, Length(RRArr)); + AssertEquals('RR 0 is not an SOA RR.',DNSQRY_SOA, RRarr[0].RRMeta.Atype); + + AssertEquals('Wrong record name for RR 0', FAKEFQDN, + RRArr[0].RRName); + + AssertTrue('Did not get RR SOA data.', DNSRRGetSOA(RRArr[0], qd.Payload, + soarec)); + AssertEquals('Wrong mname hostname', 'mn.'+FAKEFQDN, + soarec.mname); + AssertEquals('Wrong rname hostname', 'rn.'+FAKEFQDN, + soarec.rname); + AssertEquals('Wrong SOA serial', 76543210, soarec.serial); + AssertEquals('Wrong SOA refresh', 123, soarec.refresh); + AssertEquals('Wrong SOA retry', 456, soarec.retry); + AssertEquals('Wrong SOA expire', 789, soarec.expire); + AssertEquals('Wrong SOA min', 60, soarec.min); +end; + +procedure TNetDbTest.TestDnsQueryCompressUDP_SOA; +var + fakeresp: TFakeDNSResponse; + qd: TQueryData; + anslen, ansstart: Word; + RRArr: TRRNameDataArray; + soarec: TDNSRR_SOA; +begin + BuildFakeResponseSOA(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to querydata', + BuildQueryData(fakeresp, qd, anslen, True)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of SOA records.', 1, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + AssertEquals('Wrong number of resource records.', 1, Length(RRArr)); + AssertEquals('RR 0 is not an SOA RR.',DNSQRY_SOA, RRarr[0].RRMeta.Atype); + + AssertEquals('Wrong record name for RR 0', FAKEFQDN, + RRArr[0].RRName); + + AssertTrue('Did not get RR SOA data.', DNSRRGetSOA(RRArr[0], qd.Payload, + soarec)); + AssertEquals('Wrong mname hostname', 'mn.'+FAKEFQDN, + soarec.mname); + AssertEquals('Wrong rname hostname', 'rn.'+FAKEFQDN, + soarec.rname); + AssertEquals('Wrong SOA serial', 76543210, soarec.serial); + AssertEquals('Wrong SOA refresh', 123, soarec.refresh); + AssertEquals('Wrong SOA retry', 456, soarec.retry); + AssertEquals('Wrong SOA expire', 789, soarec.expire); + AssertEquals('Wrong SOA min', 60, soarec.min); +end; + +procedure TNetDbTest.TestDnsQueryCompressTCP_SOA; +var + fakeresp: TFakeDNSResponse; + qd: TQueryDataLengthTCP; + anslen, ansstart: Word; + RRArr: TRRNameDataArray; + soarec: TDNSRR_SOA; +begin + BuildFakeResponseSOA(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to compressed querydata', + BuildQueryData(fakeresp, qd, anslen, True)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of SOA records.', 1, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + AssertEquals('Wrong number of resource records.', 1, Length(RRArr)); + AssertEquals('RR 0 is not an SOA RR.',DNSQRY_SOA, RRarr[0].RRMeta.Atype); + + AssertEquals('Wrong record name for RR 0', FAKEFQDN, + RRArr[0].RRName); + + AssertTrue('Did not get RR SOA data.', DNSRRGetSOA(RRArr[0], qd.Payload, + soarec)); + AssertEquals('Wrong mname hostname', 'mn.'+FAKEFQDN, + soarec.mname); + AssertEquals('Wrong rname hostname', 'rn.'+FAKEFQDN, + soarec.rname); + AssertEquals('Wrong SOA serial', 76543210, soarec.serial); + AssertEquals('Wrong SOA refresh', 123, soarec.refresh); + AssertEquals('Wrong SOA retry', 456, soarec.retry); + AssertEquals('Wrong SOA expire', 789, soarec.expire); + AssertEquals('Wrong SOA min', 60, soarec.min); +end; + +procedure TNetDbTest.TestDnsQueryUDP_CNAME; +var + fakeresp: TFakeDNSResponse; + qd: TQueryData; + anslen, ansstart: Word; + RRArr: TRRNameDataArray; + s: TDNSDomainName; +begin + BuildFakeResponseCNAME(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to querydata', + BuildQueryData(fakeresp, qd, anslen)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of CNAME records.', 1, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + AssertEquals('Wrong number of resource records.', 1, Length(RRArr)); + AssertEquals('RR 0 is not an CNAME RR.',DNSQRY_CNAME, RRarr[0].RRMeta.Atype); + AssertEquals('Wrong CNAME record name for RR 0', FAKEFQDN, + RRArr[0].RRName); + AssertTrue('Did not get RR CNAME data.', DNSRRGetCNAME(RRArr[0], qd.Payload, s)); + AssertEquals('Wrong CNAME.', 'fakecname.'+FAKEFQDN, s); +end; + +procedure TNetDbTest.TestDnsQueryTCP_CNAME; +var + fakeresp: TFakeDNSResponse; + qd: TQueryDataLengthTCP; + anslen, ansstart: Word; + RRArr: TRRNameDataArray; + s: TDNSDomainName; +begin + BuildFakeResponseCNAME(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to querydata', + BuildQueryData(fakeresp, qd, anslen)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of CNAME records.', 1, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + AssertEquals('Wrong number of resource records.', 1, Length(RRArr)); + AssertEquals('RR 0 is not an CNAME RR.',DNSQRY_CNAME, RRarr[0].RRMeta.Atype); + AssertEquals('Wrong CNAME record name for RR 0', FAKEFQDN, + RRArr[0].RRName); + AssertTrue('Did not get RR CNAME data.', DNSRRGetCNAME(RRArr[0], qd.Payload, s)); + AssertEquals('Wrong CNAME.', 'fakecname.'+FAKEFQDN, s); +end; + +procedure TNetDbTest.TestDnsQueryCompressUDP_CNAME; +var + fakeresp: TFakeDNSResponse; + qd: TQueryDataLengthTCP; + anslen, ansstart: Word; + RRArr: TRRNameDataArray; + s: TDNSDomainName; +begin + BuildFakeResponseCNAME(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to compressed querydata', + BuildQueryData(fakeresp, qd, anslen, True)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of CNAME records.', 1, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + AssertEquals('Wrong number of resource records.', 1, Length(RRArr)); + AssertEquals('RR 0 is not an CNAME RR.',DNSQRY_CNAME, RRarr[0].RRMeta.Atype); + AssertEquals('Wrong CNAME record name for RR 0', FAKEFQDN, + RRArr[0].RRName); + AssertTrue('Did not get RR CNAME data.', DNSRRGetCNAME(RRArr[0], qd.Payload, s)); + AssertEquals('Wrong CNAME.', 'fakecname.'+FAKEFQDN, s); +end; + +procedure TNetDbTest.TestDnsQueryCompressTCP_CNAME; +var + fakeresp: TFakeDNSResponse; + qd: TQueryDataLengthTCP; + anslen, ansstart: Word; + RRArr: TRRNameDataArray; + s: TDNSDomainName; +begin + BuildFakeResponseCNAME(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to compressed querydata', + BuildQueryData(fakeresp, qd, anslen, True)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of CNAME records.', 1, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + AssertEquals('Wrong number of resource records.', 1, Length(RRArr)); + AssertEquals('RR 0 is not an CNAME RR.',DNSQRY_CNAME, RRarr[0].RRMeta.Atype); + AssertEquals('Wrong CNAME record name for RR 0', FAKEFQDN, + RRArr[0].RRName); + AssertTrue('Did not get RR CNAME data.', DNSRRGetCNAME(RRArr[0], qd.Payload, + s)); + AssertEquals('Wrong CNAME.', 'fakecname.'+FAKEFQDN, s); +end; + +procedure TNetDbTest.TestDnsQueryUDP_NS; +var + fakeresp: TFakeDNSResponse; + qd: TQueryData; + anslen, ansstart: Word; + RRArr: TRRNameDataArray; + s: TDNSDomainName; +begin + BuildFakeResponseNS(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to querydata', + BuildQueryData(fakeresp, qd, anslen)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of NS records.', 1, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + AssertEquals('Wrong number of resource records.', 1, Length(RRArr)); + AssertEquals('RR 0 is not an NS RR.',DNSQRY_NS, RRarr[0].RRMeta.Atype); + AssertEquals('Wrong NS record name for RR 0', FAKEFQDN, + RRArr[0].RRName); + AssertTrue('Did not get RR NS data.', DNSRRGetNS(RRArr[0], qd.Payload, s)); + AssertEquals('Wrong NS.', 'fakens.'+FAKEFQDN, s); +end; + +procedure TNetDbTest.TestDnsQueryTCP_NS; +var + fakeresp: TFakeDNSResponse; + qd: TQueryDataLengthTCP; + anslen, ansstart: Word; + RRArr: TRRNameDataArray; + s: TDNSDomainName; +begin + BuildFakeResponseNS(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to querydata', + BuildQueryData(fakeresp, qd, anslen)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of NS records.', 1, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + AssertEquals('Wrong number of resource records.', 1, Length(RRArr)); + AssertEquals('RR 0 is not an NS RR.',DNSQRY_NS, RRarr[0].RRMeta.Atype); + AssertEquals('Wrong NS record name for RR 0', FAKEFQDN, + RRArr[0].RRName); + AssertTrue('Did not get RR NS data.', DNSRRGetNS(RRArr[0], qd.Payload, s)); + AssertEquals('Wrong NS.', 'fakens.'+FAKEFQDN, s); +end; + +procedure TNetDbTest.TestDnsQueryCompressUDP_NS; +var + fakeresp: TFakeDNSResponse; + qd: TQueryData; + anslen, ansstart: Word; + RRArr: TRRNameDataArray; + s: TDNSDomainName; +begin + BuildFakeResponseNS(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to compressed querydata', + BuildQueryData(fakeresp, qd, anslen, True)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of NS records.', 1, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + AssertEquals('Wrong number of resource records.', 1, Length(RRArr)); + AssertEquals('RR 0 is not an NS RR.',DNSQRY_NS, RRarr[0].RRMeta.Atype); + AssertEquals('Wrong NS record name for RR 0', FAKEFQDN, + RRArr[0].RRName); + AssertTrue('Did not get RR NS data.', DNSRRGetNS(RRArr[0], qd.Payload, s)); + AssertEquals('Wrong NS.', 'fakens.'+FAKEFQDN, s); +end; + +procedure TNetDbTest.TestDnsQueryCompressTCP_NS; +var + fakeresp: TFakeDNSResponse; + qd: TQueryDataLengthTCP; + anslen, ansstart: Word; + RRArr: TRRNameDataArray; + s: TDNSDomainName; +begin + BuildFakeResponseNS(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to compressed querydata', + BuildQueryData(fakeresp, qd, anslen, True)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of NS records.', 1, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + AssertEquals('Wrong number of resource records.', 1, Length(RRArr)); + AssertEquals('RR 0 is not an NS RR.',DNSQRY_NS, RRarr[0].RRMeta.Atype); + AssertEquals('Wrong NS record name for RR 0', FAKEFQDN, + RRArr[0].RRName); + AssertTrue('Did not get RR NS data.', DNSRRGetNS(RRArr[0], qd.Payload, s)); + AssertEquals('Wrong NS.', 'fakens.'+FAKEFQDN, s); +end; + +procedure TNetDbTest.TestDnsQueryUDP_PTR; +var + fakeresp: TFakeDNSResponse; + qd: TQueryData; + anslen, ansstart: Word; + RRArr: TRRNameDataArray; + s: TDNSDomainName; +begin + // the str passed in to this function doesn't really matter, but using + // a proper in-addr.arpa domain helps keep it clear what we're testing. + BuildFakeResponsePTR('0.5.0.127.in-addr.arpa', fakeresp); + AssertTrue('Unable to convert fake dns response to querydata', + BuildQueryData(fakeresp, qd, anslen)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of PTR records.', 1, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + AssertEquals('Wrong number of resource records.', 1, Length(RRArr)); + AssertEquals('RR 0 is not an PTR RR.',DNSQRY_PTR, RRarr[0].RRMeta.Atype); + AssertEquals('Wrong PTR record name for RR 0', '0.5.0.127.in-addr.arpa', + RRArr[0].RRName); + AssertTrue('Did not get RR PTR data.', DNSRRGetPTR(RRArr[0], qd.Payload, s)); + AssertEquals('Wrong PTR.', 'fakeptrans.'+FAKEFQDN, s); +end; + +procedure TNetDbTest.TestDnsQueryTCP_PTR; +var + fakeresp: TFakeDNSResponse; + qd: TQueryDataLengthTCP; + anslen, ansstart: Word; + RRArr: TRRNameDataArray; + s: TDNSDomainName; +begin + // the str passed in to this function doesn't really matter, but using + // a proper in-addr.arpa domain helps keep it clear what we're testing. + BuildFakeResponsePTR('0.5.0.127.in-addr.arpa', fakeresp); + AssertTrue('Unable to convert fake dns response to querydata', + BuildQueryData(fakeresp, qd, anslen)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of PTR records.', 1, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + AssertEquals('Wrong number of resource records.', 1, Length(RRArr)); + AssertEquals('RR 0 is not an PTR RR.',DNSQRY_PTR, RRarr[0].RRMeta.Atype); + AssertEquals('Wrong PTR record name for RR 0', '0.5.0.127.in-addr.arpa', + RRArr[0].RRName); + AssertTrue('Did not get RR PTR data.', DNSRRGetPTR(RRArr[0], qd.Payload, s)); + AssertEquals('Wrong PTR.', 'fakeptrans.'+FAKEFQDN, s); +end; + +procedure TNetDbTest.TestDnsQueryCompressUDP_PTR; +var + fakeresp: TFakeDNSResponse; + qd: TQueryData; + anslen, ansstart: Word; + RRArr: TRRNameDataArray; + s: TDNSDomainName; +begin + // the str passed in to this function doesn't really matter, but using + // a proper in-addr.arpa domain helps keep it clear what we're testing. + BuildFakeResponsePTR('0.5.0.127.in-addr.arpa', fakeresp); + AssertTrue('Unable to convert fake dns response to compressed querydata', + BuildQueryData(fakeresp, qd, anslen, True)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of PTR records.', 1, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + AssertEquals('Wrong number of resource records.', 1, Length(RRArr)); + AssertEquals('RR 0 is not an PTR RR.',DNSQRY_PTR, RRarr[0].RRMeta.Atype); + AssertEquals('Wrong PTR record name for RR 0', '0.5.0.127.in-addr.arpa', + RRArr[0].RRName); + AssertTrue('Did not get RR PTR data.', DNSRRGetPTR(RRArr[0], qd.Payload, s)); + AssertEquals('Wrong PTR.', 'fakeptrans.'+FAKEFQDN, s); +end; + +procedure TNetDbTest.TestDnsQueryCompressTCP_PTR; +var + fakeresp: TFakeDNSResponse; + qd: TQueryDataLengthTCP; + anslen, ansstart: Word; + RRArr: TRRNameDataArray; + s: TDNSDomainName; +begin + // the str passed in to this function doesn't really matter, but using + // a proper in-addr.arpa domain helps keep it clear what we're testing. + BuildFakeResponsePTR('0.5.0.127.in-addr.arpa', fakeresp); + AssertTrue('Unable to convert fake dns response to compressed querydata', + BuildQueryData(fakeresp, qd, anslen, True)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of PTR records.', 1, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + AssertEquals('Wrong number of resource records.', 1, Length(RRArr)); + AssertEquals('RR 0 is not an PTR RR.',DNSQRY_PTR, RRarr[0].RRMeta.Atype); + AssertEquals('Wrong PTR record name for RR 0', '0.5.0.127.in-addr.arpa', + RRArr[0].RRName); + AssertTrue('Did not get RR PTR data.', DNSRRGetPTR(RRArr[0], qd.Payload, s)); + AssertEquals('Wrong PTR.', 'fakeptrans.'+FAKEFQDN, s); +end; + +procedure TNetDbTest.TestDnsQueryUDP_TXT; +var + fakeresp: TFakeDNSResponse; + qd: TQueryData; + anslen, ansstart: Word; + RRArr: TRRNameDataArray; + s: AnsiString; +begin + s := ''; + BuildFakeResponseTXT(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to querydata', + BuildQueryData(fakeresp, qd, anslen)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of TXT records.', 1, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + AssertEquals('Wrong number of resource records.', 1, Length(RRArr)); + AssertEquals('RR 0 is not a TXT RR.',DNSQRY_TXT, RRarr[0].RRMeta.Atype); + AssertEquals('Wrong TXT record name for RR 0', FAKEFQDN, + RRArr[0].RRName); + AssertTrue('Did not get RR TXT data.', DNSRRGetText(RRArr[0], qd.Payload, s)); + AssertEquals( + 'v=spf1 mx a:lists.'+FAKEFQDN+'Always look on the bright side of life!', + s); +end; + +procedure TNetDbTest.TestDnsQueryTCP_TXT; +var + fakeresp: TFakeDNSResponse; + qd: TQueryDataLengthTCP; + anslen, ansstart: Word; + RRArr: TRRNameDataArray; + s: AnsiString; +begin + s := ''; + BuildFakeResponseTXT(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to querydata', + BuildQueryData(fakeresp, qd, anslen)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of TXT records.', 1, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + AssertEquals('Wrong number of resource records.', 1, Length(RRArr)); + AssertEquals('RR 0 is not a TXT RR.',DNSQRY_TXT, RRarr[0].RRMeta.Atype); + AssertEquals('Wrong TXT record name for RR 0', FAKEFQDN, + RRArr[0].RRName); + AssertTrue('Did not get RR TXT data.', DNSRRGetText(RRArr[0], qd.Payload, s)); + AssertEquals( + 'v=spf1 mx a:lists.'+FAKEFQDN+'Always look on the bright side of life!', + s); +end; + +procedure TNetDbTest.TestDnsQueryCompressUDP_TXT; +var + fakeresp: TFakeDNSResponse; + qd: TQueryData; + anslen, ansstart: Word; + RRArr: TRRNameDataArray; + s: AnsiString; +begin + s := ''; + BuildFakeResponseTXT(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to compressed querydata', + BuildQueryData(fakeresp, qd, anslen, True)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of TXT records.', 1, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + AssertEquals('Wrong number of resource records.', 1, Length(RRArr)); + AssertEquals('RR 0 is not a TXT RR.',DNSQRY_TXT, RRarr[0].RRMeta.Atype); + AssertEquals('Wrong TXT record name for RR 0', FAKEFQDN, + RRArr[0].RRName); + AssertTrue('Did not get RR TXT data.', DNSRRGetText(RRArr[0], qd.Payload, s)); + AssertEquals( + 'v=spf1 mx a:lists.'+FAKEFQDN+'Always look on the bright side of life!', + s); +end; + +procedure TNetDbTest.TestDnsQueryCompressTCP_TXT; +var + fakeresp: TFakeDNSResponse; + qd: TQueryDataLengthTCP; + anslen, ansstart: Word; + RRArr: TRRNameDataArray; + s: AnsiString; +begin + s := ''; + BuildFakeResponseTXT(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to compressed querydata', + BuildQueryData(fakeresp, qd, anslen, True)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of TXT records.', 1, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + AssertEquals('Wrong number of resource records.', 1, Length(RRArr)); + AssertEquals('RR 0 is not a TXT RR.',DNSQRY_TXT, RRarr[0].RRMeta.Atype); + AssertEquals('Wrong TXT record name for RR 0', FAKEFQDN, + RRArr[0].RRName); + AssertTrue('Did not get RR TXT data.', DNSRRGetText(RRArr[0], qd.Payload, s)); + AssertEquals( + 'v=spf1 mx a:lists.'+FAKEFQDN+'Always look on the bright side of life!', + s); +end; + +procedure TNetDbTest.TestDnsQueryUDP_SRV; +var + fakeresp: TFakeDNSResponse; + qd: TQueryData; + anslen, ansstart: Word; + RRArr: TRRNameDataArray; + srvrec: TDNSRR_SRV; +begin + BuildFakeResponseSRV(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to querydata', + BuildQueryData(fakeresp, qd, anslen)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of SRV records.', 1, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + AssertEquals('Wrong number of resource records.', 1, Length(RRArr)); + AssertEquals('RR 0 is not an SRV RR.',DNSQRY_SRV, RRarr[0].RRMeta.Atype); + + AssertEquals('Wrong record name for RR 0', FAKEFQDN, + RRArr[0].RRName); + + AssertTrue('Did not get RR SRV data.', DNSRRGetSRV(RRArr[0], qd.Payload, + srvrec)); + AssertEquals('Wrong SRV priority', 22, srvrec.priority); + AssertEquals('Wrong SRV weight', 44, srvrec.weight); + AssertEquals('Wrong SRV port', 2201, srvrec.port); + + AssertEquals('Wrong SRV hostname', '_this._that._other', srvrec.target); +end; + +procedure TNetDbTest.TestDnsQueryTCP_SRV; +var + fakeresp: TFakeDNSResponse; + qd: TQueryDataLengthTCP; + anslen, ansstart: Word; + RRArr: TRRNameDataArray; + srvrec: TDNSRR_SRV; +begin + BuildFakeResponseSRV(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to querydata', + BuildQueryData(fakeresp, qd, anslen)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of SRV records.', 1, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + AssertEquals('Wrong number of resource records.', 1, Length(RRArr)); + AssertEquals('RR 0 is not an SRV RR.',DNSQRY_SRV, RRarr[0].RRMeta.Atype); + + AssertEquals('Wrong record name for RR 0', FAKEFQDN, + RRArr[0].RRName); + + AssertTrue('Did not get RR SOA data.', DNSRRGetSRV(RRArr[0], qd.Payload, + srvrec)); + AssertEquals('Wrong SRV priority', 22, srvrec.priority); + AssertEquals('Wrong SRV weight', 44, srvrec.weight); + AssertEquals('Wrong SRV port', 2201, srvrec.port); + + AssertEquals('Wrong SRV hostname', '_this._that._other', srvrec.target); +end; + +procedure TNetDbTest.TestDnsQueryCompressUDP_SRV; +var + fakeresp: TFakeDNSResponse; + qd: TQueryData; + anslen, ansstart: Word; + RRArr: TRRNameDataArray; + srvrec: TDNSRR_SRV; +begin + BuildFakeResponseSRV(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to compressed querydata', + BuildQueryData(fakeresp, qd, anslen, True)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of SRV records.', 1, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + AssertEquals('Wrong number of resource records.', 1, Length(RRArr)); + AssertEquals('RR 0 is not an SRV RR.',DNSQRY_SRV, RRarr[0].RRMeta.Atype); + + AssertEquals('Wrong record name for RR 0', FAKEFQDN, + RRArr[0].RRName); + + AssertTrue('Did not get RR SRV data.', DNSRRGetSRV(RRArr[0], qd.Payload, + srvrec)); + AssertEquals('Wrong SRV priority', 22, srvrec.priority); + AssertEquals('Wrong SRV weight', 44, srvrec.weight); + AssertEquals('Wrong SRV port', 2201, srvrec.port); + + AssertEquals('Wrong SRV hostname', '_this._that._other', srvrec.target); +end; + +procedure TNetDbTest.TestDnsQueryCompressTCP_SRV; +var + fakeresp: TFakeDNSResponse; + qd: TQueryDataLengthTCP; + anslen, ansstart: Word; + RRArr: TRRNameDataArray; + srvrec: TDNSRR_SRV; +begin + BuildFakeResponseSRV(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to compressed querydata', + BuildQueryData(fakeresp, qd, anslen, True)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of SRV records.', 1, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + AssertEquals('Wrong number of resource records.', 1, Length(RRArr)); + AssertEquals('RR 0 is not an SRV RR.',DNSQRY_SRV, RRarr[0].RRMeta.Atype); + + AssertEquals('Wrong record name for RR 0', FAKEFQDN, + RRArr[0].RRName); + + AssertTrue('Did not get RR SOA data.', DNSRRGetSRV(RRArr[0], qd.Payload, + srvrec)); + AssertEquals('Wrong SRV priority', 22, srvrec.priority); + AssertEquals('Wrong SRV weight', 44, srvrec.weight); + AssertEquals('Wrong SRV port', 2201, srvrec.port); + + AssertEquals('Wrong SRV hostname', '_this._that._other', srvrec.target); +end; + +{ +This test is of debatable value, as it only detects truncation if the buffer +contents are zeroed which gives an invalid RR type. +} +procedure TNetDbTest.TestDnsQueryTruncateRR_UDP_A; +var + fakeresp: TFakeDNSResponse; + qd: TQueryData; + anslen, ansstart: Word; + RRArr: TRRNameDataArray; +begin + BuildFakeResponseA(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to querydata', + BuildTruncatedQueryData(fakeresp, qd, anslen,40)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + // the header says there are 2 A records, but it's a trap! + AssertEquals('Wrong number of A records.', 2, qd.h.ancount); + // truncation of buffer means this call returns 0 RRs. + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + AssertEquals('Wrong number of RRs', 0, Length(RRArr)); +end; + +procedure TNetDbTest.TestDnsRRBufferEdgeA; +var + fakeresp: TFakeDNSResponse; + qd: TQueryData; + anslen, ansstart: Word; + RRArr: TRRNameDataArray; + ip: THostAddr; +begin + BuildFakeResponseA(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to querydata', + BuildQueryData(fakeresp, qd, anslen)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of A records.', 2, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + + // Change start position for RR[0] to end of buffer - 4 + RRArr[0].RDataSt := Length(qd.Payload) - RRArr[0].RRMeta.RDLength; + qd.Payload[Length(qd.Payload)-1] := $AA; // sentinel marker we can look for + + AssertTrue('Did not get RR A data.', DNSRRGetA(RRArr[0], qd.Payload, ip)); + AssertEquals('Wrong ip for A.', '0.0.0.170', HostAddrToStr(ip)); +end; + +procedure TNetDbTest.TestDnsRRBufferPastEdgeA; +var + fakeresp: TFakeDNSResponse; + qd: TQueryData; + anslen, ansstart: Word; + RRArr: TRRNameDataArray; + ip: THostAddr; +begin + BuildFakeResponseA(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to querydata', + BuildQueryData(fakeresp, qd, anslen)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of A records.', 2, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + + // Change start position for RR[0] to end of buffer - 3 + RRArr[0].RDataSt := Length(qd.Payload) - (RRArr[0].RRMeta.RDLength - 3); + AssertFalse('Got RR A data.', DNSRRGetA(RRArr[0], qd.Payload, ip)); +end; + +{ +Test that we read the AAAA right at the buffer edge, with the last byte +being a special value we can test for. +} +procedure TNetDbTest.TestDnsRRBufferEdgeAAAA; +var + fakeresp: TFakeDNSResponse; + qd: TQueryData; + anslen, ansstart: Word; + RRArr: TRRNameDataArray; + ip: THostAddr6; +begin + BuildFakeResponseAAAA(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to querydata', + BuildQueryData(fakeresp, qd, anslen)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of AAAA records.', 2, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + // Change start position for RR[0] + RRArr[0].RDataSt := Length(qd.Payload) - SizeOf(THostAddr6); + qd.Payload[Length(qd.Payload)-1] := $AA; + AssertTrue('Got RR AAAA data.', DNSRRGetAAAA(RRArr[0], qd.Payload, ip)); + AssertEquals($AA, ip.u6_addr8[15]); +end; + +{ +Attempt to read an AAAA that goes past the end of the buffer. +} +procedure TNetDbTest.TestDNsRRBufferPastEdgeAAAA; +var + fakeresp: TFakeDNSResponse; + qd: TQueryData; + anslen, ansstart: Word; + RRArr: TRRNameDataArray; + ip: THostAddr6; +begin + BuildFakeResponseAAAA(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to querydata', + BuildQueryData(fakeresp, qd, anslen)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of AAAA records.', 2, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + // Change start position for RR[0]. attempting to read 16 bytes + // from this position will pass the end of the buffer. + RRArr[0].RDataSt := Length(qd.Payload) - (SizeOf(THostAddr6)-1); + qd.Payload[Length(qd.Payload)-1] := $AA; + AssertFalse('Got RR AAAA data.', DNSRRGetAAAA(RRArr[0], qd.Payload, ip)); +end; + +{ +Test reading an MX RR that terminates on the last byte of the buffer. +} +procedure TNetDbTest.TestDnsRRBufferEdgeMX; +var + fakeresp: TFakeDNSResponse; + qd: TQueryData; + anslen, ansstart, oldstart: Word; + RRArr: TRRNameDataArray; + fmx: TDNSRR_MX; +begin + BuildFakeResponseMX(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to querydata', + BuildQueryData(fakeresp, qd, anslen)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of MX records.', 1, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + + // move the MX RR bytes to the end of the payload buffer. + oldstart := RRArr[0].RDataSt; + RRArr[0].RDataSt := Length(qd.Payload) - RRArr[0].RRMeta.RDLength; + CopyBytesTo(qd.Payload, oldstart, RRArr[0].RDataSt, RRArr[0].RRMeta.RDLength); + + AssertTrue('Got RR MX data.', DNSRRGetMX(RRArr[0], qd.Payload, fmx)); + AssertEquals('Wrong MX hostname', 'mailer.'+FAKEFQDN, + fmx.exchange); + AssertEquals('Wrong MX preference', 10, fmx.preference); +end; + +procedure TNetDbTest.TestDnsRRBufferPastEdgeMX; +var + fakeresp: TFakeDNSResponse; + qd: TQueryData; + anslen, ansstart, oldstart: Word; + RRArr: TRRNameDataArray; + fmx: TDNSRR_MX; +begin + BuildFakeResponseMX(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to querydata', + BuildQueryData(fakeresp, qd, anslen)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of MX records.', 1, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + + // move the MX RR bytes to the end of the payload buffer. We omit the last + // 2 bytes of the MX to attempt to trick the code into reading past the buffer + // edge. + oldstart := RRArr[0].RDataSt; + RRArr[0].RDataSt := Length(qd.Payload) - (RRArr[0].RRMeta.RDLength - 2); + CopyBytesTo(qd.Payload, oldstart, RRArr[0].RDataSt, + (RRArr[0].RRMeta.RDLength-2)); + + AssertTrue('Got RR MX data.', DNSRRGetMX(RRArr[0], qd.Payload, fmx)); + // stringfromlabel should drop the last label, so the result should be just + // missing the tld. + AssertEquals('Wrong MX hostname', 'mailer.'+FAKEDOMAIN, + fmx.exchange); + AssertEquals('Wrong MX preference', 10, fmx.preference); +end; + +procedure TNetDbTest.TestDnsRRBufferEdgeSOA; +var + fakeresp: TFakeDNSResponse; + qd: TQueryData; + anslen, ansstart, oldstart: Word; + RRArr: TRRNameDataArray; + soarec: TDNSRR_SOA; +begin + BuildFakeResponseSOA(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to querydata', + BuildQueryData(fakeresp, qd, anslen)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of SOA records.', 1, qd.h.ancount); + + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + AssertEquals('Wrong number of resource records.', 1, Length(RRArr)); + AssertEquals('RR 0 is not an SOA RR.',DNSQRY_SOA, RRarr[0].RRMeta.Atype); + + // move the SOA RR bytes to the end of the payload buffer. + oldstart := RRArr[0].RDataSt; + RRArr[0].RDataSt := Length(qd.Payload) - RRArr[0].RRMeta.RDLength; + CopyBytesTo(qd.Payload, oldstart, RRArr[0].RDataSt, RRArr[0].RRMeta.RDLength); + + AssertTrue('Did not get RR SOA data.', DNSRRGetSOA(RRArr[0], qd.Payload, + soarec)); + AssertEquals('Wrong mname hostname', 'mn.'+FAKEFQDN, + soarec.mname); + AssertEquals('Wrong rname hostname', 'rn.'+FAKEFQDN, + soarec.rname); + AssertEquals('Wrong SOA serial', 76543210, soarec.serial); + AssertEquals('Wrong SOA refresh', 123, soarec.refresh); + AssertEquals('Wrong SOA retry', 456, soarec.retry); + AssertEquals('Wrong SOA expire', 789, soarec.expire); + AssertEquals('Wrong SOA min', 60, soarec.min); +end; + +procedure TNetDbTest.TestDnsRRBufferPastEdgeSOA; +var + fakeresp: TFakeDNSResponse; + qd: TQueryData; + anslen, ansstart, oldstart: Word; + RRArr: TRRNameDataArray; + soarec: TDNSRR_SOA; +begin + BuildFakeResponseSOA(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to querydata', + BuildQueryData(fakeresp, qd, anslen)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of SOA records.', 1, qd.h.ancount); + + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + AssertEquals('Wrong number of resource records.', 1, Length(RRArr)); + AssertEquals('RR 0 is not an SOA RR.',DNSQRY_SOA, RRarr[0].RRMeta.Atype); + + // move the SOA RR bytes to the end of the payload buffer. + oldstart := RRArr[0].RDataSt; + RRArr[0].RDataSt := Length(qd.Payload) - (RRArr[0].RRMeta.RDLength-1); + CopyBytesTo(qd.Payload, oldstart, RRArr[0].RDataSt, + (RRArr[0].RRMeta.RDLength-1)); + + AssertFalse('Got RR SOA data.', DNSRRGetSOA(RRArr[0], qd.Payload, + soarec)); +end; + +procedure TNetDbTest.TestDnsRRBufferEdgeSRV; +var + fakeresp: TFakeDNSResponse; + qd: TQueryData; + anslen, ansstart, oldstart: Word; + RRArr: TRRNameDataArray; + srvrec: TDNSRR_SRV; +begin + BuildFakeResponseSRV(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to querydata', + BuildQueryData(fakeresp, qd, anslen)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of SRV records.', 1, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + AssertEquals('Wrong number of resource records.', 1, Length(RRArr)); + AssertEquals('RR 0 is not an SRV RR.',DNSQRY_SRV, RRarr[0].RRMeta.Atype); + + // move the SRV RR bytes to the end of the payload buffer. + oldstart := RRArr[0].RDataSt; + RRArr[0].RDataSt := Length(qd.Payload) - RRArr[0].RRMeta.RDLength; + CopyBytesTo(qd.Payload, oldstart, RRArr[0].RDataSt, RRArr[0].RRMeta.RDLength); + + AssertTrue('Did not get RR SRV data.', DNSRRGetSRV(RRArr[0], qd.Payload, + srvrec)); + AssertEquals('Wrong SRV priority', 22, srvrec.priority); + AssertEquals('Wrong SRV weight', 44, srvrec.weight); + AssertEquals('Wrong SRV port', 2201, srvrec.port); + + AssertEquals('Wrong SRV hostname', '_this._that._other', srvrec.target); +end; + +procedure TNetDbTest.TestDnsRRBufferPastEdgeSRV; +var + fakeresp: TFakeDNSResponse; + qd: TQueryData; + anslen, ansstart, oldstart: Word; + RRArr: TRRNameDataArray; + srvrec: TDNSRR_SRV; +begin + BuildFakeResponseSRV(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to querydata', + BuildQueryData(fakeresp, qd, anslen)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of SRV records.', 1, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + AssertEquals('Wrong number of resource records.', 1, Length(RRArr)); + AssertEquals('RR 0 is not an SRV RR.',DNSQRY_SRV, RRarr[0].RRMeta.Atype); + + // move the SRV RR bytes to the end of the payload buffer. ensure that + // we're one byte short to try and trick the code into reading past the + // end of the buffer. + oldstart := RRArr[0].RDataSt; + RRArr[0].RDataSt := Length(qd.Payload) - (RRArr[0].RRMeta.RDLength - 1); + CopyBytesTo(qd.Payload, oldstart, RRArr[0].RDataSt, + (RRArr[0].RRMeta.RDLength - 1)); + + AssertFalse('Got RR SRV data.', DNSRRGetSRV(RRArr[0], qd.Payload, + srvrec)); +end; + +procedure TNetDbTest.TestDnsRRBufferEdgeCNAME; +var + fakeresp: TFakeDNSResponse; + qd: TQueryData; + anslen, ansstart, oldstart: Word; + RRArr: TRRNameDataArray; + s: TDNSDomainName; +begin + BuildFakeResponseCNAME(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to querydata', + BuildQueryData(fakeresp, qd, anslen)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of CNAME records.', 1, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + AssertEquals('Wrong number of resource records.', 1, Length(RRArr)); + AssertEquals('RR 0 is not an CNAME RR.',DNSQRY_CNAME, RRarr[0].RRMeta.Atype); + + // move the cname to the end of the buffer. + oldstart := RRArr[0].RDataSt; + RRArr[0].RDataSt := Length(qd.Payload) - RRArr[0].RRMeta.RDLength; + CopyBytesTo(qd.Payload, oldstart, RRArr[0].RDataSt, RRArr[0].RRMeta.RDLength); + + AssertTrue('Did not get RR CNAME data.', DNSRRGetCNAME(RRArr[0], qd.Payload, s)); + AssertEquals('Wrong CNAME.', 'fakecname.'+FAKEFQDN, s); +end; + +{ +Test retrieving a cname when the actual string is longer than rdlength says it +is. The bytes in the payload buffer try to point past the end of the buffer. +} +procedure TNetDbTest.TestDnsRRBufferPastEdgeCNAME; +var + fakeresp: TFakeDNSResponse; + qd: TQueryData; + anslen, ansstart, oldstart: Word; + RRArr: TRRNameDataArray; + s: TDNSDomainName; +begin + BuildFakeResponseCNAME(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to querydata', + BuildQueryData(fakeresp, qd, anslen)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of CNAME records.', 1, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + AssertEquals('Wrong number of resource records.', 1, Length(RRArr)); + AssertEquals('RR 0 is not an CNAME RR.',DNSQRY_CNAME, RRarr[0].RRMeta.Atype); + + // move the cname to the end of the buffer. we drop two bytes off the end of + // the cname, because there's a 0 byte at the end of a label if not a ptr. + // now, the last label's size is greater than the number of bytes left in + // the buffer. + oldstart := RRArr[0].RDataSt; + RRArr[0].RDataSt := Length(qd.Payload) - (RRArr[0].RRMeta.RDLength-2); + CopyBytesTo(qd.Payload, oldstart, RRArr[0].RDataSt, + (RRArr[0].RRMeta.RDLength-2)); + + // lie about the rdlength too! + Dec(RRArr[0].RRMeta.RDLength,2); + AssertTrue('Did not get RR CNAME data.', DNSRRGetCNAME(RRArr[0], qd.Payload, s)); + // last label will get removed, leaving just the domain part. + AssertEquals('Wrong CNAME.', 'fakecname.'+FAKEDOMAIN, s); +end; + +{ +Test retrieving an NS RR when it's at the end of the payload buffer. +} +procedure TNetDbTest.TestDnsRRBufferEdgeNS; +var + fakeresp: TFakeDNSResponse; + qd: TQueryData; + anslen, ansstart, oldstart: Word; + RRArr: TRRNameDataArray; + s: TDNSDomainName; +begin + BuildFakeResponseNS(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to querydata', + BuildQueryData(fakeresp, qd, anslen)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of NS records.', 1, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + AssertEquals('Wrong number of resource records.', 1, Length(RRArr)); + AssertEquals('RR 0 is not an NS RR.',DNSQRY_NS, RRarr[0].RRMeta.Atype); + AssertEquals('Wrong NS record name for RR 0', FAKEFQDN, + RRArr[0].RRName); + + // move the ns to the end of the buffer. + oldstart := RRArr[0].RDataSt; + RRArr[0].RDataSt := Length(qd.Payload) - RRArr[0].RRMeta.RDLength; + CopyBytesTo(qd.Payload, oldstart, RRArr[0].RDataSt, RRArr[0].RRMeta.RDLength); + + AssertTrue('Did not get RR NS data.', DNSRRGetNS(RRArr[0], qd.Payload, s)); + AssertEquals('Wrong NS.', 'fakens.'+FAKEFQDN, s); +end; + +procedure TNetDbTest.TestDnsRRBufferPastEdgeNS; +var + fakeresp: TFakeDNSResponse; + qd: TQueryData; + anslen, ansstart, oldstart: Word; + RRArr: TRRNameDataArray; + s: TDNSDomainName; +begin + BuildFakeResponseNS(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to querydata', + BuildQueryData(fakeresp, qd, anslen)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of NS records.', 1, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + AssertEquals('Wrong number of resource records.', 1, Length(RRArr)); + AssertEquals('RR 0 is not an NS RR.',DNSQRY_NS, RRarr[0].RRMeta.Atype); + + // move the ns to the end of the buffer. we drop two bytes off the end of + // the ns, because there's a 0 byte at the end of a label if not a ptr. + // now, the last label's size is greater than the number of bytes left in + // the buffer. + oldstart := RRArr[0].RDataSt; + RRArr[0].RDataSt := Length(qd.Payload) - (RRArr[0].RRMeta.RDLength-2); + CopyBytesTo(qd.Payload, oldstart, RRArr[0].RDataSt, + (RRArr[0].RRMeta.RDLength-2)); + + // lie about the rdlength too! + Dec(RRArr[0].RRMeta.RDLength,2); + AssertTrue('Did not get RR NS data.', DNSRRGetNS(RRArr[0], qd.Payload, s)); + // last label will get removed, leaving just the domain part. + AssertEquals('Wrong NS.', 'fakens.'+FAKEDOMAIN, s); +end; + +procedure TNetDbTest.TestDnsRRBufferEdgePTR; +var + fakeresp: TFakeDNSResponse; + qd: TQueryData; + anslen, ansstart, oldstart: Word; + RRArr: TRRNameDataArray; + s: TDNSDomainName; +begin + // the str passed in to this function doesn't really matter, but using + // a proper in-addr.arpa domain helps keep it clear what we're testing. + BuildFakeResponsePTR('0.5.0.127.in-addr.arpa', fakeresp); + AssertTrue('Unable to convert fake dns response to querydata', + BuildQueryData(fakeresp, qd, anslen)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of PTR records.', 1, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + AssertEquals('Wrong number of resource records.', 1, Length(RRArr)); + AssertEquals('RR 0 is not an PTR RR.',DNSQRY_PTR, RRarr[0].RRMeta.Atype); + AssertEquals('Wrong PTR record name for RR 0', '0.5.0.127.in-addr.arpa', + RRArr[0].RRName); + + // move the ptr to the end of the buffer. + oldstart := RRArr[0].RDataSt; + RRArr[0].RDataSt := Length(qd.Payload) - RRArr[0].RRMeta.RDLength; + CopyBytesTo(qd.Payload, oldstart, RRArr[0].RDataSt, RRArr[0].RRMeta.RDLength); + + AssertTrue('Did not get RR PTR data.', DNSRRGetPTR(RRArr[0], qd.Payload, s)); + AssertEquals('Wrong PTR.', 'fakeptrans.'+FAKEFQDN, s); +end; + +procedure TNetDbTest.TestDnsRRBufferPastEdgePTR; +var + fakeresp: TFakeDNSResponse; + qd: TQueryData; + anslen, ansstart, oldstart: Word; + RRArr: TRRNameDataArray; + s: TDNSDomainName; +begin + // the str passed in to this function doesn't really matter, but using + // a proper in-addr.arpa domain helps keep it clear what we're testing. + BuildFakeResponsePTR('0.5.0.127.in-addr.arpa', fakeresp); + AssertTrue('Unable to convert fake dns response to querydata', + BuildQueryData(fakeresp, qd, anslen)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of PTR records.', 1, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + AssertEquals('Wrong number of resource records.', 1, Length(RRArr)); + AssertEquals('RR 0 is not an PTR RR.',DNSQRY_PTR, RRarr[0].RRMeta.Atype); + AssertEquals('Wrong PTR record name for RR 0', '0.5.0.127.in-addr.arpa', + RRArr[0].RRName); + + // move the ns to the end of the buffer. we drop two bytes off the end of + // the ns, because there's a 0 byte at the end of a label if not a ptr. + // now, the last label's size is greater than the number of bytes left in + // the buffer. + oldstart := RRArr[0].RDataSt; + RRArr[0].RDataSt := Length(qd.Payload) - (RRArr[0].RRMeta.RDLength-2); + CopyBytesTo(qd.Payload, oldstart, RRArr[0].RDataSt, + (RRArr[0].RRMeta.RDLength-2)); + + // lie about the rdlength too! + Dec(RRArr[0].RRMeta.RDLength,2); + AssertTrue('Did not get RR PTR data.', DNSRRGetPTR(RRArr[0], qd.Payload, s)); + // last label will get removed, leaving just the domain part. + AssertEquals('Wrong PTR.', 'fakeptrans.'+FAKEDOMAIN, s); +end; + +{ +Test reading a text record right at the edge of the payload buffer. +} +procedure TNetDbTest.TestDnsRRBufferEdgeTXT; +var + fakeresp: TFakeDNSResponse; + qd: TQueryData; + anslen, ansstart,oldstart: Word; + RRArr: TRRNameDataArray; + s: AnsiString; +begin + s := ''; + BuildFakeResponseTXT(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to querydata', + BuildQueryData(fakeresp, qd, anslen)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of TXT records.', 1, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + AssertEquals('Wrong number of resource records.', 1, Length(RRArr)); + AssertEquals('RR 0 is not a TXT RR.',DNSQRY_TXT, RRarr[0].RRMeta.Atype); + AssertEquals('Wrong TXT record name for RR 0', FAKEFQDN, + RRArr[0].RRName); + + // Move the text record to the end of the buffer + oldstart := RRArr[0].RDataSt; + RRArr[0].RDataSt := Length(qd.Payload) - RRArr[0].RRMeta.RDLength; + CopyBytesTo(qd.Payload, oldstart, RRArr[0].RDataSt, RRArr[0].RRMeta.RDLength); + AssertTrue('Did not get RR TXT data.', DNSRRGetText(RRArr[0], qd.Payload, s)); + AssertEquals( + 'v=spf1 mx a:lists.'+FAKEFQDN+'Always look on the bright side of life!', + s); +end; + +{ +Try reading a TXT record that points past the end of the payload buffer. +} +procedure TNetDbTest.TestDnsRRBufferPastEdgeTXT; +var + fakeresp: TFakeDNSResponse; + qd: TQueryData; + anslen, ansstart,oldstart: Word; + RRArr: TRRNameDataArray; + s: AnsiString; +begin + s := ''; + BuildFakeResponseTXT(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to querydata', + BuildQueryData(fakeresp, qd, anslen)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of TXT records.', 1, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + AssertEquals('Wrong number of resource records.', 1, Length(RRArr)); + AssertEquals('RR 0 is not a TXT RR.',DNSQRY_TXT, RRarr[0].RRMeta.Atype); + AssertEquals('Wrong TXT record name for RR 0', FAKEFQDN, + RRArr[0].RRName); + + // Move the text record to the end of the buffer, cutting off the last + // 2 bytes. this means the length byte for the second string will point + // past the end of the buffer. + oldstart := RRArr[0].RDataSt; + RRArr[0].RDataSt := Length(qd.Payload) - (RRArr[0].RRMeta.RDLength - 2); + CopyBytesTo(qd.Payload, oldstart, RRArr[0].RDataSt, + (RRArr[0].RRMeta.RDLength - 2)); + AssertFalse('Did not get RR TXT data.', + DNSRRGetText(RRArr[0], qd.Payload, s)); +end; + +procedure TNetDbTest.TestDnsRRBufferEdgeTCPA; +var + fakeresp: TFakeDNSResponse; + qd: TQueryDataLengthTCP; + anslen, ansstart: Word; + RRArr: TRRNameDataArray; + ip: THostAddr; +begin + BuildFakeResponseA(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to querydata', + BuildQueryData(fakeresp, qd, anslen)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of A records.', 2, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + + // Change start position for RR[0] to end of buffer - 4 + RRArr[0].RDataSt := Length(qd.Payload) - RRArr[0].RRMeta.RDLength; + qd.Payload[Length(qd.Payload)-1] := $AA; // sentinel marker we can look for + AssertTrue('Did not get RR A data.', DNSRRGetA(RRArr[0], qd.Payload, ip)); + AssertEquals('Wrong ip for A.', '0.0.0.170', HostAddrToStr(ip)); +end; + +procedure TNetDbTest.TestDnsRRBufferPastEdgeTCPA; +var + fakeresp: TFakeDNSResponse; + qd: TQueryDataLengthTCP; + anslen, ansstart: Word; + RRArr: TRRNameDataArray; + ip: THostAddr; +begin + BuildFakeResponseA(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to querydata', + BuildQueryData(fakeresp, qd, anslen)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of A records.', 2, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + + // Change start position for RR[0] to end of buffer - 3 + RRArr[0].RDataSt := Length(qd.Payload) - (RRArr[0].RRMeta.RDLength - 2); + AssertFalse('Got RR A data.', DNSRRGetA(RRArr[0], qd.Payload, ip)); +end; + +procedure TNetDbTest.TestDnsRRBufferEdgeTCPAAAA; +var + fakeresp: TFakeDNSResponse; + qd: TQueryData; + anslen, ansstart: Word; + RRArr: TRRNameDataArray; + ip: THostAddr6; +begin + BuildFakeResponseAAAA(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to querydata', + BuildQueryData(fakeresp, qd, anslen)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of AAAA records.', 2, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + // Change start position for RR[0] + RRArr[0].RDataSt := Length(qd.Payload) - SizeOf(THostAddr6); + qd.Payload[Length(qd.Payload)-1] := $AA; + AssertTrue('Got RR AAAA data.', DNSRRGetAAAA(RRArr[0], qd.Payload, ip)); + AssertEquals($AA, ip.u6_addr8[15]); +end; + +procedure TNetDbTest.TestDNsRRBufferPastEdgeTCPAAAA; +var + fakeresp: TFakeDNSResponse; + qd: TQueryDataLengthTCP; + anslen, ansstart: Word; + RRArr: TRRNameDataArray; + ip: THostAddr6; +begin + BuildFakeResponseAAAA(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to querydata', + BuildQueryData(fakeresp, qd, anslen)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of AAAA records.', 2, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + // Change start position for RR[0]. attempting to read 16 bytes + // from this position will pass the end of the buffer. + RRArr[0].RDataSt := Length(qd.Payload) - (SizeOf(THostAddr6)-1); + AssertFalse('Got RR AAAA data.', DNSRRGetAAAA(RRArr[0], qd.Payload, ip)); +end; + +procedure TNetDbTest.TestDnsRRBufferEdgeTCPMX; +var + fakeresp: TFakeDNSResponse; + qd: TQueryDataLengthTCP; + anslen, ansstart, oldstart: Word; + RRArr: TRRNameDataArray; + fmx: TDNSRR_MX; +begin + BuildFakeResponseMX(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to querydata', + BuildQueryData(fakeresp, qd, anslen)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of MX records.', 1, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + + // move the MX RR bytes to the end of the payload buffer. + oldstart := RRArr[0].RDataSt; + RRArr[0].RDataSt := Length(qd.Payload) - RRArr[0].RRMeta.RDLength; + CopyBytesTo(qd.Payload, oldstart, RRArr[0].RDataSt, RRArr[0].RRMeta.RDLength); + + AssertTrue('Got RR MX data.', DNSRRGetMX(RRArr[0], qd.Payload, fmx)); + AssertEquals('Wrong MX hostname', 'mailer.'+FAKEFQDN, + fmx.exchange); + AssertEquals('Wrong MX preference', 10, fmx.preference); +end; + +procedure TNetDbTest.TestDnsRRBufferPastEdgeTCPMX; +var + fakeresp: TFakeDNSResponse; + qd: TQueryDataLengthTCP; + anslen, ansstart, oldstart: Word; + RRArr: TRRNameDataArray; + fmx: TDNSRR_MX; +begin + BuildFakeResponseMX(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to querydata', + BuildQueryData(fakeresp, qd, anslen)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of MX records.', 1, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + + // move the MX RR bytes to the end of the payload buffer. We omit the last + // 2 bytes of the MX to attempt to trick the code into reading past the buffer + // edge. + oldstart := RRArr[0].RDataSt; + RRArr[0].RDataSt := Length(qd.Payload) - (RRArr[0].RRMeta.RDLength - 2); + CopyBytesTo(qd.Payload, oldstart, RRArr[0].RDataSt, + (RRArr[0].RRMeta.RDLength-2)); + + AssertTrue('Got RR MX data.', DNSRRGetMX(RRArr[0], qd.Payload, fmx)); + // stringfromlabel should drop the last label, so the result should be just + // missing the tld. + AssertEquals('Wrong MX hostname', 'mailer.'+FAKEDOMAIN, + fmx.exchange); + AssertEquals('Wrong MX preference', 10, fmx.preference); +end; + +procedure TNetDbTest.TestDnsRRBufferEdgeTCPSOA; +var + fakeresp: TFakeDNSResponse; + qd: TQueryDataLengthTCP; + anslen, ansstart, oldstart: Word; + RRArr: TRRNameDataArray; + soarec: TDNSRR_SOA; +begin + BuildFakeResponseSOA(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to querydata', + BuildQueryData(fakeresp, qd, anslen)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of SOA records.', 1, qd.h.ancount); + + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + AssertEquals('Wrong number of resource records.', 1, Length(RRArr)); + AssertEquals('RR 0 is not an SOA RR.',DNSQRY_SOA, RRarr[0].RRMeta.Atype); + + // move the SOA RR bytes to the end of the payload buffer. + oldstart := RRArr[0].RDataSt; + RRArr[0].RDataSt := Length(qd.Payload) - RRArr[0].RRMeta.RDLength; + CopyBytesTo(qd.Payload, oldstart, RRArr[0].RDataSt, RRArr[0].RRMeta.RDLength); + + AssertTrue('Did not get RR SOA data.', DNSRRGetSOA(RRArr[0], qd.Payload, + soarec)); + AssertEquals('Wrong mname hostname', 'mn.'+FAKEFQDN, + soarec.mname); + AssertEquals('Wrong rname hostname', 'rn.'+FAKEFQDN, + soarec.rname); + AssertEquals('Wrong SOA serial', 76543210, soarec.serial); + AssertEquals('Wrong SOA refresh', 123, soarec.refresh); + AssertEquals('Wrong SOA retry', 456, soarec.retry); + AssertEquals('Wrong SOA expire', 789, soarec.expire); + AssertEquals('Wrong SOA min', 60, soarec.min); +end; + +procedure TNetDbTest.TestDnsRRBufferPastEdgeTCPSOA; +var + fakeresp: TFakeDNSResponse; + qd: TQueryDataLengthTCP; + anslen, ansstart, oldstart: Word; + RRArr: TRRNameDataArray; + soarec: TDNSRR_SOA; +begin + BuildFakeResponseSOA(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to querydata', + BuildQueryData(fakeresp, qd, anslen)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of SOA records.', 1, qd.h.ancount); + + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + AssertEquals('Wrong number of resource records.', 1, Length(RRArr)); + AssertEquals('RR 0 is not an SOA RR.',DNSQRY_SOA, RRarr[0].RRMeta.Atype); + + // move the SOA RR bytes to the end of the payload buffer. + oldstart := RRArr[0].RDataSt; + RRArr[0].RDataSt := Length(qd.Payload) - (RRArr[0].RRMeta.RDLength-1); + CopyBytesTo(qd.Payload, oldstart, RRArr[0].RDataSt, + (RRArr[0].RRMeta.RDLength-1)); + + AssertFalse('Got RR SOA data.', DNSRRGetSOA(RRArr[0], qd.Payload, + soarec)); +end; + +procedure TNetDbTest.TestDnsRRBufferEdgeTCPSRV; +var + fakeresp: TFakeDNSResponse; + qd: TQueryDataLengthTCP; + anslen, ansstart, oldstart: Word; + RRArr: TRRNameDataArray; + srvrec: TDNSRR_SRV; +begin + BuildFakeResponseSRV(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to querydata', + BuildQueryData(fakeresp, qd, anslen)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of SRV records.', 1, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + AssertEquals('Wrong number of resource records.', 1, Length(RRArr)); + AssertEquals('RR 0 is not an SRV RR.',DNSQRY_SRV, RRarr[0].RRMeta.Atype); + + // move the SRV RR bytes to the end of the payload buffer. + oldstart := RRArr[0].RDataSt; + RRArr[0].RDataSt := Length(qd.Payload) - RRArr[0].RRMeta.RDLength; + CopyBytesTo(qd.Payload, oldstart, RRArr[0].RDataSt, RRArr[0].RRMeta.RDLength); + + AssertTrue('Did not get RR SRV data.', DNSRRGetSRV(RRArr[0], qd.Payload, + srvrec)); + AssertEquals('Wrong SRV priority', 22, srvrec.priority); + AssertEquals('Wrong SRV weight', 44, srvrec.weight); + AssertEquals('Wrong SRV port', 2201, srvrec.port); + + AssertEquals('Wrong SRV hostname', '_this._that._other', srvrec.target); +end; + +procedure TNetDbTest.TestDnsRRBufferPastEdgeTCPSRV; +var + fakeresp: TFakeDNSResponse; + qd: TQueryDataLengthTCP; + anslen, ansstart, oldstart: Word; + RRArr: TRRNameDataArray; + srvrec: TDNSRR_SRV; +begin + BuildFakeResponseSRV(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to querydata', + BuildQueryData(fakeresp, qd, anslen)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of SRV records.', 1, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + AssertEquals('Wrong number of resource records.', 1, Length(RRArr)); + AssertEquals('RR 0 is not an SRV RR.',DNSQRY_SRV, RRarr[0].RRMeta.Atype); + + // move the SRV RR bytes to the end of the payload buffer. ensure that + // we're one byte short to try and trick the code into reading past the + // end of the buffer. + oldstart := RRArr[0].RDataSt; + RRArr[0].RDataSt := Length(qd.Payload) - (RRArr[0].RRMeta.RDLength - 1); + CopyBytesTo(qd.Payload, oldstart, RRArr[0].RDataSt, + (RRArr[0].RRMeta.RDLength - 1)); + + AssertFalse('Got RR SRV data.', DNSRRGetSRV(RRArr[0], qd.Payload, + srvrec)); +end; + +procedure TNetDbTest.TestDnsRRBufferEdgeTCPCNAME; +var + fakeresp: TFakeDNSResponse; + qd: TQueryDataLengthTCP; + anslen, ansstart, oldstart: Word; + RRArr: TRRNameDataArray; + s: TDNSDomainName; +begin + BuildFakeResponseCNAME(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to querydata', + BuildQueryData(fakeresp, qd, anslen)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of CNAME records.', 1, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + AssertEquals('Wrong number of resource records.', 1, Length(RRArr)); + AssertEquals('RR 0 is not an CNAME RR.',DNSQRY_CNAME, RRarr[0].RRMeta.Atype); + + // move the cname to the end of the buffer. + oldstart := RRArr[0].RDataSt; + RRArr[0].RDataSt := Length(qd.Payload) - RRArr[0].RRMeta.RDLength; + CopyBytesTo(qd.Payload, oldstart, RRArr[0].RDataSt, RRArr[0].RRMeta.RDLength); + + AssertTrue('Did not get RR CNAME data.', DNSRRGetCNAME(RRArr[0], qd.Payload, s)); + AssertEquals('Wrong CNAME.', 'fakecname.'+FAKEFQDN, s); +end; + +procedure TNetDbTest.TestDnsRRBufferPastEdgeTCPCNAME; +var + fakeresp: TFakeDNSResponse; + qd: TQueryDataLengthTCP; + anslen, ansstart, oldstart: Word; + RRArr: TRRNameDataArray; + s: TDNSDomainName; +begin + BuildFakeResponseCNAME(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to querydata', + BuildQueryData(fakeresp, qd, anslen)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of CNAME records.', 1, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + AssertEquals('Wrong number of resource records.', 1, Length(RRArr)); + AssertEquals('RR 0 is not an CNAME RR.',DNSQRY_CNAME, RRarr[0].RRMeta.Atype); + + // move the cname to the end of the buffer. we drop two bytes off the end of + // the cname, because there's a 0 byte at the end of a label if not a ptr. + // now, the last label's size is greater than the number of bytes left in + // the buffer. + oldstart := RRArr[0].RDataSt; + RRArr[0].RDataSt := Length(qd.Payload) - (RRArr[0].RRMeta.RDLength-2); + CopyBytesTo(qd.Payload, oldstart, RRArr[0].RDataSt, + (RRArr[0].RRMeta.RDLength-2)); + + // lie about the rdlength too! + Dec(RRArr[0].RRMeta.RDLength,2); + AssertTrue('Did not get RR CNAME data.', DNSRRGetCNAME(RRArr[0], qd.Payload, s)); + // last label will get removed, leaving just the domain part. + AssertEquals('Wrong CNAME.', 'fakecname.'+FAKEDOMAIN, s); +end; + +procedure TNetDbTest.TestDnsRRBufferEdgeTCPNS; +var + fakeresp: TFakeDNSResponse; + qd: TQueryDataLengthTCP; + anslen, ansstart, oldstart: Word; + RRArr: TRRNameDataArray; + s: TDNSDomainName; +begin + BuildFakeResponseNS(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to querydata', + BuildQueryData(fakeresp, qd, anslen)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of NS records.', 1, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + AssertEquals('Wrong number of resource records.', 1, Length(RRArr)); + AssertEquals('RR 0 is not an NS RR.',DNSQRY_NS, RRarr[0].RRMeta.Atype); + AssertEquals('Wrong NS record name for RR 0', FAKEFQDN, + RRArr[0].RRName); + + // move the ns to the end of the buffer. + oldstart := RRArr[0].RDataSt; + RRArr[0].RDataSt := Length(qd.Payload) - RRArr[0].RRMeta.RDLength; + CopyBytesTo(qd.Payload, oldstart, RRArr[0].RDataSt, RRArr[0].RRMeta.RDLength); + + AssertTrue('Did not get RR NS data.', DNSRRGetNS(RRArr[0], qd.Payload, s)); + AssertEquals('Wrong NS.', 'fakens.'+FAKEFQDN, s); +end; + +procedure TNetDbTest.TestDnsRRBufferPastEdgeTCPNS; +var + fakeresp: TFakeDNSResponse; + qd: TQueryDataLengthTCP; + anslen, ansstart, oldstart: Word; + RRArr: TRRNameDataArray; + s: TDNSDomainName; +begin + BuildFakeResponseNS(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to querydata', + BuildQueryData(fakeresp, qd, anslen)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of NS records.', 1, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + AssertEquals('Wrong number of resource records.', 1, Length(RRArr)); + AssertEquals('RR 0 is not an NS RR.',DNSQRY_NS, RRarr[0].RRMeta.Atype); + + // move the ns to the end of the buffer. we drop two bytes off the end of + // the ns, because there's a 0 byte at the end of a label if not a ptr. + // now, the last label's size is greater than the number of bytes left in + // the buffer. + oldstart := RRArr[0].RDataSt; + RRArr[0].RDataSt := Length(qd.Payload) - (RRArr[0].RRMeta.RDLength-2); + CopyBytesTo(qd.Payload, oldstart, RRArr[0].RDataSt, + (RRArr[0].RRMeta.RDLength-2)); + + // lie about the rdlength too! + Dec(RRArr[0].RRMeta.RDLength,2); + AssertTrue('Did not get RR NS data.', DNSRRGetNS(RRArr[0], qd.Payload, s)); + // last label will get removed, leaving just the domain part. + AssertEquals('Wrong NS.', 'fakens.'+FAKEDOMAIN, s); +end; + +procedure TNetDbTest.TestDnsRRBufferEdgeTCPPTR; +var + fakeresp: TFakeDNSResponse; + qd: TQueryDataLengthTCP; + anslen, ansstart, oldstart: Word; + RRArr: TRRNameDataArray; + s: TDNSDomainName; +begin + // the str passed in to this function doesn't really matter, but using + // a proper in-addr.arpa domain helps keep it clear what we're testing. + BuildFakeResponsePTR('0.5.0.127.in-addr.arpa', fakeresp); + AssertTrue('Unable to convert fake dns response to querydata', + BuildQueryData(fakeresp, qd, anslen)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of PTR records.', 1, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + AssertEquals('Wrong number of resource records.', 1, Length(RRArr)); + AssertEquals('RR 0 is not an PTR RR.',DNSQRY_PTR, RRarr[0].RRMeta.Atype); + AssertEquals('Wrong PTR record name for RR 0', '0.5.0.127.in-addr.arpa', + RRArr[0].RRName); + + // move the ptr to the end of the buffer. + oldstart := RRArr[0].RDataSt; + RRArr[0].RDataSt := Length(qd.Payload) - RRArr[0].RRMeta.RDLength; + CopyBytesTo(qd.Payload, oldstart, RRArr[0].RDataSt, RRArr[0].RRMeta.RDLength); + + AssertTrue('Did not get RR PTR data.', DNSRRGetPTR(RRArr[0], qd.Payload, s)); + AssertEquals('Wrong PTR.', 'fakeptrans.'+FAKEFQDN, s); +end; + +procedure TNetDbTest.TestDnsRRBufferPastEdgeTCPPTR; +var + fakeresp: TFakeDNSResponse; + qd: TQueryDataLengthTCP; + anslen, ansstart, oldstart: Word; + RRArr: TRRNameDataArray; + s: TDNSDomainName; +begin + // the str passed in to this function doesn't really matter, but using + // a proper in-addr.arpa domain helps keep it clear what we're testing. + BuildFakeResponsePTR('0.5.0.127.in-addr.arpa', fakeresp); + AssertTrue('Unable to convert fake dns response to querydata', + BuildQueryData(fakeresp, qd, anslen)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of PTR records.', 1, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + AssertEquals('Wrong number of resource records.', 1, Length(RRArr)); + AssertEquals('RR 0 is not an PTR RR.',DNSQRY_PTR, RRarr[0].RRMeta.Atype); + AssertEquals('Wrong PTR record name for RR 0', '0.5.0.127.in-addr.arpa', + RRArr[0].RRName); + + // move the ns to the end of the buffer. we drop two bytes off the end of + // the ns, because there's a 0 byte at the end of a label if not a ptr. + // now, the last label's size is greater than the number of bytes left in + // the buffer. + oldstart := RRArr[0].RDataSt; + RRArr[0].RDataSt := Length(qd.Payload) - (RRArr[0].RRMeta.RDLength-2); + CopyBytesTo(qd.Payload, oldstart, RRArr[0].RDataSt, + (RRArr[0].RRMeta.RDLength-2)); + + // lie about the rdlength too! + Dec(RRArr[0].RRMeta.RDLength,2); + AssertTrue('Did not get RR PTR data.', DNSRRGetPTR(RRArr[0], qd.Payload, s)); + // last label will get removed, leaving just the domain part. + AssertEquals('Wrong PTR.', 'fakeptrans.'+FAKEDOMAIN, s); +end; + +procedure TNetDbTest.TestDnsRRBufferEdgeTCPTXT; +var + fakeresp: TFakeDNSResponse; + qd: TQueryDataLengthTCP; + anslen, ansstart,oldstart: Word; + RRArr: TRRNameDataArray; + s: AnsiString; +begin + s := ''; + BuildFakeResponseTXT(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to querydata', + BuildQueryData(fakeresp, qd, anslen)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of TXT records.', 1, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + AssertEquals('Wrong number of resource records.', 1, Length(RRArr)); + AssertEquals('RR 0 is not a TXT RR.',DNSQRY_TXT, RRarr[0].RRMeta.Atype); + AssertEquals('Wrong TXT record name for RR 0', FAKEFQDN, + RRArr[0].RRName); + + // Move the text record to the end of the buffer + oldstart := RRArr[0].RDataSt; + RRArr[0].RDataSt := Length(qd.Payload) - RRArr[0].RRMeta.RDLength; + CopyBytesTo(qd.Payload, oldstart, RRArr[0].RDataSt, RRArr[0].RRMeta.RDLength); + AssertTrue('Did not get RR TXT data.', DNSRRGetText(RRArr[0], qd.Payload, s)); + AssertEquals( + 'v=spf1 mx a:lists.'+FAKEFQDN+'Always look on the bright side of life!', + s); +end; + +procedure TNetDbTest.TestDnsRRBufferPastEdgeTCPTXT; +var + fakeresp: TFakeDNSResponse; + qd: TQueryDataLengthTCP; + anslen, ansstart,oldstart: Word; + RRArr: TRRNameDataArray; + s: AnsiString; +begin + s := ''; + BuildFakeResponseTXT(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to querydata', + BuildQueryData(fakeresp, qd, anslen)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of TXT records.', 1, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + AssertEquals('Wrong number of resource records.', 1, Length(RRArr)); + AssertEquals('RR 0 is not a TXT RR.',DNSQRY_TXT, RRarr[0].RRMeta.Atype); + AssertEquals('Wrong TXT record name for RR 0', FAKEFQDN, + RRArr[0].RRName); + + // Move the text record to the end of the buffer, cutting off the last + // 2 bytes. this means the length byte for the second string will point + // past the end of the buffer. + oldstart := RRArr[0].RDataSt; + RRArr[0].RDataSt := Length(qd.Payload) - (RRArr[0].RRMeta.RDLength - 2); + CopyBytesTo(qd.Payload, oldstart, RRArr[0].RDataSt, + (RRArr[0].RRMeta.RDLength - 2)); + AssertFalse('Did not get RR TXT data.', + DNSRRGetText(RRArr[0], qd.Payload, s)); +end; + +{ +Test that NextNameRR correctly reads an RR on the edge of the buffer. +} +procedure TNetDbTest.TestNextNameRREdgeA; +var + fakeresp: TFakeDNSResponse; + qd: TQueryData; + anslen, ansstart: Word; + rrn: TRRNameData; + ip: THostAddr; + t: Cardinal; +begin + BuildFakeResponseA(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to querydata', + BuildQueryData(fakeresp, qd, anslen)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + + // get an RR from its normal position. need this to calculate the length. + AssertTrue('NextNameRR should succeed.', + NextNameRR(qd.Payload, ansstart, rrn)); + + // calculate the size in bytes of the rr so we can copy it to the end + // of the payload buffer + t := (rrn.RDataSt + rrn.RRMeta.RDLength) - ansstart; + CopyBytesTo(qd.Payload,ansstart,Length(qd.Payload)-t, t); + AssertTrue('NextNameRR should succeed.', + NextNameRR(qd.Payload, Length(qd.Payload)-t, rrn)); + AssertEquals(DNSQRY_A, rrn.RRMeta.Atype); + AssertEquals(300, rrn.RRMeta.TTL); + AssertTrue(DNSRRGetA(rrn, qd.Payload, ip)); + AssertEquals('Wrong ip for A.', '127.0.0.1', HostAddrToStr(ip)); +end; + +{ +Try to trick NextNameRR into reading past the end of the payload buffer. +} +procedure TNetDbTest.TestNextNameRRPastEdgeA; +var + fakeresp: TFakeDNSResponse; + qd: TQueryData; + anslen, ansstart: Word; + rrn: TRRNameData; + t: Cardinal; +begin + BuildFakeResponseA(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to querydata', + BuildQueryData(fakeresp, qd, anslen)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + + // get an RR from its normal position. need this to calculate the length. + AssertTrue('NextNameRR should succeed.', + NextNameRR(qd.Payload, ansstart, rrn)); + + // calculate the size in bytes of the rr so we can copy it to the end + // of the payload buffer + t := (rrn.RDataSt + rrn.RRMeta.RDLength) - ansstart; + // copy the bytes, but leave off the last one. leave the rdlength unchanged. + CopyBytesTo(qd.Payload,ansstart,Length(qd.Payload)-(t-1), t-1); + AssertFalse('NextNameRR should fail.', + NextNameRR(qd.Payload, Length(qd.Payload)-(t-1), rrn)); +end; + +procedure TNetDbTest.TestNextNameRREdgeTCPA; +var + fakeresp: TFakeDNSResponse; + qd: TQueryDataLengthTCP; + anslen, ansstart: Word; + rrn: TRRNameData; + ip: THostAddr; + t: Cardinal; +begin + BuildFakeResponseA(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to querydata', + BuildQueryData(fakeresp, qd, anslen)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + + // get an RR from its normal position. need this to calculate the length. + AssertTrue('NextNameRR should succeed.', + NextNameRR(qd.Payload, ansstart, rrn)); + + // calculate the size in bytes of the rr so we can copy it to the end + // of the payload buffer + t := (rrn.RDataSt + rrn.RRMeta.RDLength) - ansstart; + CopyBytesTo(qd.Payload,ansstart,Length(qd.Payload)-t, t); + AssertTrue('NextNameRR should succeed.', + NextNameRR(qd.Payload, Length(qd.Payload)-t, rrn)); + AssertEquals(DNSQRY_A, rrn.RRMeta.Atype); + AssertEquals(300, rrn.RRMeta.TTL); + AssertTrue(DNSRRGetA(rrn, qd.Payload, ip)); + AssertEquals('Wrong ip for A.', '127.0.0.1', HostAddrToStr(ip)); +end; + +procedure TNetDbTest.TestNextNameRRPastEdgeTCPA; +var + fakeresp: TFakeDNSResponse; + qd: TQueryDataLengthTCP; + anslen, ansstart: Word; + rrn: TRRNameData; + t: Cardinal; +begin + BuildFakeResponseA(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to querydata', + BuildQueryData(fakeresp, qd, anslen)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + + // get an RR from its normal position. need this to calculate the length. + AssertTrue('NextNameRR should succeed.', + NextNameRR(qd.Payload, ansstart, rrn)); + + // calculate the size in bytes of the rr so we can copy it to the end + // of the payload buffer + t := (rrn.RDataSt + rrn.RRMeta.RDLength) - ansstart; + // copy the bytes, but leave off the last one. leave the rdlength unchanged. + CopyBytesTo(qd.Payload,ansstart,Length(qd.Payload)-(t-1), t-1); + AssertFalse('NextNameRR should fail.', + NextNameRR(qd.Payload, Length(qd.Payload)-(t-1), rrn)); +end; + +{ +Call GetRRrecords with a start position past the end of the buffer. +} + +procedure TNetDbTest.TestGetRRrecordsInvalidStart; +var + fakeresp: TFakeDNSResponse; + qd: TQueryData; + anslen, ansstart: Word; + RRArr: TRRNameDataArray; +begin + BuildFakeResponseA(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to querydata', + BuildQueryData(fakeresp, qd, anslen)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := High(Word); + anslen := High(Word); + AssertEquals('Wrong number of A records.', 2, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, anslen); + AssertEquals(0, Length(RRArr)); +end; + +procedure TNetDbTest.TestGetRRrecordsInvalidStartTCP; +var + fakeresp: TFakeDNSResponse; + qd: TQueryDataLengthTCP; + anslen, ansstart: Word; + RRArr: TRRNameDataArray; +begin + BuildFakeResponseA(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to querydata', + BuildQueryData(fakeresp, qd, anslen)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := High(Word); + anslen := High(Word); + AssertEquals('Wrong number of A records.', 2, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, anslen); + AssertEquals(0, Length(RRArr)); +end; + +procedure TNetDbTest.TestGetFixLenStrSimple; +const + s = 'another fine mess'; +var + buf: TBuffer; + pl: TPayload; + tr: TTextArray; + offset: Cardinal; + res: ShortString; +begin + tr[1] := s; + tr[2] := ''; + tr[3] := ''; + tr[4] := ''; + tr[5] := ''; + SetLength(buf, 1024); + offset := 0; + WriteTextRecAsRData(buf, offset, tr); + SetLength(buf, offset); + BufferToPayload(buf, pl); + // rdlength is word, so len byte for str is at offset 2 and str starts + // at offset 3. + GetFixlenStr(pl, 3, pl[2], res); + AssertEquals(s, res); +end; + +procedure TNetDbTest.TestGetFixLenStrSimpleTCP; +const + s = 'another fine mess'; +var + buf: TBuffer; + pl: TPayLoadTCP; + tr: TTextArray; + offset: Cardinal; + res: ShortString; +begin + tr[1] := s; + tr[2] := ''; + tr[3] := ''; + tr[4] := ''; + tr[5] := ''; + SetLength(buf, 1024); + offset := 0; + WriteTextRecAsRData(buf, offset, tr); + SetLength(buf, offset); + BufferToPayload(buf, pl); + // rdlength is word, so len byte for str is at offset 2 and str starts + // at offset 3. + GetFixlenStr(pl, 3, pl[2], res); + AssertEquals(s, res); +end; + +procedure TNetDbTest.TestGetFixLenStrSimpleAtEdge; +const + s = 'another fine mess'; +var + buf: TBuffer; + pl: TPayload; + tr: TTextArray; + offset,n: Cardinal; + res: ShortString; +begin + tr[1] := s; + tr[2] := ''; + tr[3] := ''; + tr[4] := ''; + tr[5] := ''; + SetLength(buf, Length(pl)); + offset := Length(pl) - (Length(s)+3); + n := offset+2; + WriteTextRecAsRData(buf, offset, tr); + SetLength(buf, offset); + BufferToPayload(buf, pl); + GetFixlenStr(pl, n+1, pl[n], res); + AssertEquals(s, res); +end; + +procedure TNetDbTest.TestGetFixLenStrSimpleTCPAtEdge; +const + s = 'another fine mess'; +var + buf: TBuffer; + pl: TPayLoadTCP; + tr: TTextArray; + offset,n: Cardinal; + res: ShortString; +begin + tr[1] := s; + tr[2] := ''; + tr[3] := ''; + tr[4] := ''; + tr[5] := ''; + SetLength(buf, Length(pl)); + offset := Length(pl) - (Length(s)+3); + n := offset+2; + WriteTextRecAsRData(buf, offset, tr); + SetLength(buf, offset); + BufferToPayload(buf, pl); + GetFixlenStr(pl, n+1, pl[n], res); + AssertEquals(s, res); +end; + +{ +Test GetFixLenStr where len would take string past edge of buffer. +} +procedure TNetDbTest.TestGetFixLenStrSimplePastEdge; +var + pl: TPayLoadTCP; + res: ShortString; +begin + pl[Length(pl) - 2] := 30; + pl[Length(pl) - 1] := Ord('a'); + GetFixlenStr(pl, Length(pl)-1, pl[Length(pl)-2], res); + AssertEquals('', res); +end; + +procedure TNetDbTest.TestGetFixLenStrSimpleTCPPastEdge; +var + pl: TPayLoadTCP; + res: ShortString; +begin + pl[Length(pl) - 2] := 30; + pl[Length(pl) - 1] := Ord('a'); + GetFixlenStr(pl, Length(pl)-1, pl[Length(pl)-2], res); + AssertEquals('', res); +end; + +{ + read a label at the end of the buffer where the last byte is a count + greater than 0. this is to try and trick stringfromlabel into reading past + the end of the buffer. +} +procedure TNetDbTest.TestStringFromLabelCountAsLastByte; +var + fakeresp: TFakeDNSResponse; + qd: TQueryData; + anslen, ansstart, oldstart: Word; + RRArr: TRRNameDataArray; + s: TDNSDomainName; + startpos: Longint; +begin + // we can use any of CNAME, NS or PTR because these RRs are just a single + // domain name or series of labels. + BuildFakeResponseNS(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to querydata', + BuildQueryData(fakeresp, qd, anslen)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of NS records.', 1, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + AssertEquals('Wrong number of resource records.', 1, Length(RRArr)); + AssertEquals('RR 0 is not an NS RR.',DNSQRY_NS, RRarr[0].RRMeta.Atype); + + // move the ns to the end of the buffer. + oldstart := RRArr[0].RDataSt; + RRArr[0].RDataSt := Length(qd.Payload) - RRArr[0].RRMeta.RDLength; + CopyBytesTo(qd.Payload, oldstart, RRArr[0].RDataSt, RRArr[0].RRMeta.RDLength); + + // Set the last byte in the buffer to a high count + qd.Payload[Length(qd.Payload)-1] := 63; // must be less than 64 + + // need this var because stringfromlabel expects a longint that's a var type. + startpos := RRarr[0].RDataSt; + s := stringfromlabel(qd.Payload, startpos); + AssertEquals('fakens.'+FAKEFQDN, s); + AssertEquals(Length(qd.Payload), startpos); +end; + +procedure TNetDbTest.TestStringFromLabelCountAsLastByteTCP; +var + fakeresp: TFakeDNSResponse; + qd: TQueryDataLengthTCP; + anslen, ansstart, oldstart: Word; + RRArr: TRRNameDataArray; + s: TDNSDomainName; + startpos: Longint; +begin + // we can use any of CNAME, NS or PTR because these RRs are just a single + // domain name or series of labels. + BuildFakeResponseNS(FAKEFQDN, fakeresp); + AssertTrue('Unable to convert fake dns response to querydata', + BuildQueryData(fakeresp, qd, anslen)); + AssertTrue('CheckAnswer should return true.', CheckAnswer(qd.h,qd.h)); + ansstart := SkipAnsQueries(qd, anslen); + AssertEquals('Wrong number of NS records.', 1, qd.h.ancount); + RRArr := GetRRrecords(qd.Payload, ansstart, qd.h.ancount); + AssertEquals('Wrong number of resource records.', 1, Length(RRArr)); + AssertEquals('RR 0 is not an NS RR.',DNSQRY_NS, RRarr[0].RRMeta.Atype); + + // move the ns to the end of the buffer. + oldstart := RRArr[0].RDataSt; + RRArr[0].RDataSt := Length(qd.Payload) - RRArr[0].RRMeta.RDLength; + CopyBytesTo(qd.Payload, oldstart, RRArr[0].RDataSt, RRArr[0].RRMeta.RDLength); + + // Set the last byte in the buffer to a high count + qd.Payload[Length(qd.Payload)-1] := 63; // must be less than 64 + + // need this var because stringfromlabel expects a longint that's a var type. + startpos := RRarr[0].RDataSt; + s := stringfromlabel(qd.Payload, startpos); + AssertEquals('fakens.'+FAKEFQDN, s); + AssertEquals(Length(qd.Payload), startpos); +end; + +procedure TNetDbTest.TestStringFromLabelCompress; +var + buf: TBuffer; + stt: TDomainCompressionTable; + offset: Cardinal; + offset2: Longint; + pl: TPayload; + s: String; + dmbs: TDNSDomainByteStream; +begin + SetLength(buf, 1024); + SetLength(stt,0); + offset := 0; + // initial str is uncompressed because compress table empty + dmbs := DomainNameToByteStream(FAKEFQDN, stt); + WriteDNSDomainByteStreamToBuffer(buf, offset, dmbs); + offset2 := offset; + // write same domain, this time we get compression. + dmbs := DomainNameToByteStream(FAKEFQDN, stt); + WriteDNSDomainByteStreamToBuffer(buf, offset, dmbs); + BufferToPayload(buf,pl); + s := stringfromlabel(pl, offset2); + AssertEquals(FAKEFQDN,s); +end; + +procedure TNetDbTest.TestStringFromLabelCompressTCP; +var + buf: TBuffer; + stt: TDomainCompressionTable; + offset: Cardinal; + offset2: Longint; + pl: TPayLoadTCP; + s: String; + dmbs: TDNSDomainByteStream; +begin + SetLength(buf, 1024); + SetLength(stt,0); + offset := 0; + // initial str is uncompressed because compress table empty + dmbs := DomainNameToByteStream(FAKEFQDN, stt); + WriteDNSDomainByteStreamToBuffer(buf, offset, dmbs); + offset2 := offset; + // write same domain, this time we get compression. + dmbs := DomainNameToByteStream(FAKEFQDN, stt); + WriteDNSDomainByteStreamToBuffer(buf, offset, dmbs); + BufferToPayload(buf,pl); + s := stringfromlabel(pl, offset2); + AssertEquals(FAKEFQDN,s); +end; + +procedure TNetDbTest.TestStringFromLabelCompressWithUncompressedLabel; +var + buf: TBuffer; + dmbs: TDNSDomainByteStream; + offset: Cardinal; + so: Longint; + stt: TDomainCompressionTable; + len: Word; + pl: TPayload; + s: String; +begin + SetLength(buf, 1024); + SetLength(stt,0); + // compress table empty so no compression here. + dmbs := DomainNameToByteStream(FAKEFQDN, stt); + offset := 0; + WriteDNSDomainByteStreamToBuffer(buf, offset, dmbs); + + so := offset; + // should get compression on FAKEFQDN but label "foo" is written as full label. + dmbs := DomainNameToByteStream('foo.' + FAKEFQDN, stt); + len := CalcRdLength(dmbs); + // len is 4 for 'foo' (including its length byte) and 2 for the pointer. + AssertEquals(6, len); + WriteDNSDomainByteStreamToBuffer(buf, offset, dmbs); + BufferToPayload(buf,pl); + s := stringfromlabel(pl, so); + AssertEquals('foo.'+FAKEFQDN,s); +end; + +procedure TNetDbTest.TestStringFromLabelCompressWithUncompressedLabelTCP; +var + buf: TBuffer; + dmbs: TDNSDomainByteStream; + offset: Cardinal; + so: Longint; + stt: TDomainCompressionTable; + len: Word; + pl: TPayLoadTCP; + s: String; +begin + SetLength(buf, 1024); + SetLength(stt,0); + // compress table empty so no compression here. + dmbs := DomainNameToByteStream(FAKEFQDN, stt); + offset := 0; + WriteDNSDomainByteStreamToBuffer(buf, offset, dmbs); + + so := offset; + // should get compression on FAKEFQDN but label "foo" is written as full label. + dmbs := DomainNameToByteStream('foo.' + FAKEFQDN, stt); + len := CalcRdLength(dmbs); + // len is 4 for 'foo' (including its length byte) and 2 for the pointer. + AssertEquals(6, len); + WriteDNSDomainByteStreamToBuffer(buf, offset, dmbs); + BufferToPayload(buf,pl); + s := stringfromlabel(pl, so); + AssertEquals('foo.'+FAKEFQDN,s); +end; + +{ +Test stringfromlabel with a compressed label at the end of the buffer. +} +procedure TNetDbTest.TestStringFromLabelCompressEndBuffer; +var + buf: TBuffer; + stt: TDomainCompressionTable; + offset: Cardinal; + offset2: Longint; + pl: TPayload; + s: String; + dmbs: TDNSDomainByteStream; +begin + SetLength(buf, 1024); + SetLength(stt,0); + offset := 0; + + // initial str is uncompressed because compress table empty + dmbs := DomainNameToByteStream(FAKEFQDN, stt); + WriteDNSDomainByteStreamToBuffer(buf, offset, dmbs); + offset2 := offset; + // write same domain, this time we get compression. + dmbs := DomainNameToByteStream(FAKEFQDN, stt); + + // write the pointer at the end of the payload buffer + offset := Length(pl) - 2; + WriteDNSDomainByteStreamToBuffer(buf, offset, dmbs); + BufferToPayload(buf,pl); + + // read back the label. + offset2 := Length(pl) - 2; + s := stringfromlabel(pl, offset2); + AssertEquals(FAKEFQDN,s); +end; + +procedure TNetDbTest.TestStringFromLabelCompressEndBufferTCP; +var + buf: TBuffer; + stt: TDomainCompressionTable; + offset: Cardinal; + offset2: Longint; + pl: TPayLoadTCP; + s: String; + dmbs: TDNSDomainByteStream; +begin + SetLength(buf, Length(pl)); + SetLength(stt,0); + offset := 0; + + // initial str is uncompressed because compress table empty + dmbs := DomainNameToByteStream(FAKEFQDN, stt); + WriteDNSDomainByteStreamToBuffer(buf, offset, dmbs); + offset2 := offset; + // write same domain, this time we get compression. + dmbs := DomainNameToByteStream(FAKEFQDN, stt); + + // write the pointer at the end of the payload buffer + offset := Length(pl) - 2; + WriteDNSDomainByteStreamToBuffer(buf, offset, dmbs); + BufferToPayload(buf,pl); + + // read back the label. + offset2 := Length(pl) - 2; + s := stringfromlabel(pl, offset2); + AssertEquals(FAKEFQDN,s); +end; + +procedure TNetDbTest.TestStringFromLabelCompressSplit; +var + pl: TPayload; + s: String; + offset: Longint; +begin + // fill the buffer with 'A' so that we'll know if stringfromlabel read any + // of it. + FillByte(pl, Length(pl), 65); + offset := Length(pl) - 1; + pl[offset] := 192; + s := stringfromlabel(pl, offset); + AssertEquals('', s); +end; + +procedure TNetDbTest.TestStringFromLabelCompressSplitTCP; +var + pl: TPayLoadTCP; + s: String; + offset: Longint; +begin + // fill the buffer with 'A' so that we'll know if stringfromlabel read any + // of it. + FillByte(pl, Length(pl), 65); + offset := Length(pl) - 1; + pl[offset] := 192; + s := stringfromlabel(pl, offset); + AssertEquals('', s); +end; + +procedure TNetDbTest.TestStringFromLabelCompressPtrFwd; +var + pl: TPayload; + s: String; + offset: Longint; + ptr: TDNSDomainPointer; +begin + FillByte(pl, Length(pl), 0); + Move('foo', pl[21], 3); + pl[20] := 3; + + ptr := GetDnsDomainPointer(32); // offset 20 + 12 for the header + offset := 0; + pl[offset] := ptr.b1; + pl[offset+1] := ptr.b2; + s := stringfromlabel(pl, offset); + AssertEquals('', s); +end; + +procedure TNetDbTest.TestStringFromLabelCompressPtrFwdTCP; +var + pl: TPayLoadTCP; + s: String; + offset: Longint; + ptr: TDNSDomainPointer; +begin + FillByte(pl, Length(pl), 0); + Move('foo', pl[21], 3); + pl[20] := 3; + + ptr := GetDnsDomainPointer(32); // offset 20 + 12 for the header + offset := 0; + pl[offset] := ptr.b1; + pl[offset+1] := ptr.b2; + s := stringfromlabel(pl, offset); + AssertEquals('', s); +end; + +procedure TNetDbTest.TestStringFromLabelCompressAllPtrStart; +var + pl: TPayload; + s: String; + offset: Longint; +begin + FillByte(pl, Length(pl), 192); + offset := 0; + s := stringfromlabel(pl, offset); + AssertEquals('', s); +end; + +procedure TNetDbTest.TestStringFromLabelCompressAllPtrStartTCP; +var + pl: TPayLoadTCP; + s: String; + offset: Longint; +begin + FillByte(pl, Length(pl), 192); + offset := 0; + s := stringfromlabel(pl, offset); + AssertEquals('', s); +end; + +{ +Test what happens when pointer is 0. +} +procedure TNetDbTest.TestStringFromLabelCompressedZero; +var + pl: TPayLoad; + s: String; + offset: Longint; + ptr: TDNSDomainPointer; +begin + FillByte(pl, Length(pl), 0); + pl[0] := 1; + pl[1] := Ord('a'); + ptr := GetDnsDomainPointer(0); + offset := 5; + pl[offset] := ptr.b1; + pl[offset+1] := ptr.b2; + + s := stringfromlabel(pl, offset); + AssertEquals('', s); +end; + +{ +Test what happens when pointer is 0. +} +procedure TNetDbTest.TestStringFromLabelCompressedZeroTCP; +var + pl: TPayLoadTCP; + s: String; + offset: Longint; + ptr: TDNSDomainPointer; +begin + FillByte(pl, Length(pl), 0); + pl[0] := 1; + pl[1] := Ord('a'); + ptr := GetDnsDomainPointer(0); + offset := 5; + pl[offset] := ptr.b1; + pl[offset+1] := ptr.b2; + + s := stringfromlabel(pl, offset); + AssertEquals('', s); +end; + +procedure TNetDbTest.TestStringFromLabelInfiniteLoop; +var + buf: TBuffer; + stt: TDomainCompressionTable; + offset: Cardinal; + offset2: Longint; + pl: TPayload; + s: String; + dmbs: TDNSDomainByteStream; + ptr: TDNSDomainPointer; +begin + SetLength(buf, 1024); + SetLength(stt,0); + offset := 0; + // initial str is uncompressed because compress table empty + dmbs := DomainNameToByteStream(FAKEFQDN, stt); + WriteDNSDomainByteStreamToBuffer(buf, offset, dmbs); + ptr := GetDnsDomainPointer(12); + + // offset now points to 0 byte at end of label. We're overwriting that + // 0 so that stringfromlabel will be tricked into a loop. + Dec(offset); + Move(ptr.ba, buf[offset], 2); + + BufferToPayload(buf,pl); + offset2 := 0; + s := stringfromlabel(pl, offset2); + // if stringfromlabel returns at all then the test passed. +end; + +procedure TNetDbTest.TestStringFromLabelInfiniteLoopTCP; +var + buf: TBuffer; + stt: TDomainCompressionTable; + offset: Cardinal; + offset2: Longint; + pl: TPayLoadTCP; + s: String; + dmbs: TDNSDomainByteStream; + ptr: TDNSDomainPointer; +begin + SetLength(buf, 1024); + SetLength(stt,0); + offset := 0; + // initial str is uncompressed because compress table empty + dmbs := DomainNameToByteStream(FAKEFQDN, stt); + WriteDNSDomainByteStreamToBuffer(buf, offset, dmbs); + ptr := GetDnsDomainPointer(12); + + // offset now points to 0 byte at end of label. We're overwriting that + // 0 so that stringfromlabel will be tricked into a loop. + Dec(offset); + Move(ptr.ba, buf[offset], 2); + + BufferToPayload(buf,pl); + offset2 := 0; + s := stringfromlabel(pl, offset2); + // if stringfromlabel returns at all then the test passed. +end; + +procedure TNetDbTest.TestCompressShortDomain; +const + shortdomain = 'a.b'; +var + buf: TBuffer; + stt: TDomainCompressionTable; + offset: Cardinal; + offset2: Longint; + pl: TPayload; + s: String; + dmbs: TDNSDomainByteStream; +begin + SetLength(buf, 1024); + SetLength(stt,0); + offset := 0; + // initial str is uncompressed because compress table empty + dmbs := DomainNameToByteStream(shortdomain, stt); + WriteDNSDomainByteStreamToBuffer(buf, offset, dmbs); + offset2 := offset; + // second str is compressed + dmbs := DomainNameToByteStream(shortdomain, stt); + WriteDNSDomainByteStreamToBuffer(buf, offset, dmbs); + + BufferToPayload(buf,pl); + s := stringfromlabel(pl, offset2); + AssertEquals(shortdomain, s); +end; + +procedure TNetDbTest.TestCompressShortDomainTCP; +const + shortdomain = 'a.b'; +var + buf: TBuffer; + stt: TDomainCompressionTable; + offset: Cardinal; + offset2: Longint; + pl: TPayLoadTCP; + s: String; + dmbs: TDNSDomainByteStream; +begin + SetLength(buf, 1024); + SetLength(stt,0); + offset := 0; + // initial str is uncompressed because compress table empty + dmbs := DomainNameToByteStream(shortdomain, stt); + WriteDNSDomainByteStreamToBuffer(buf, offset, dmbs); + offset2 := offset; + // second str is compressed + dmbs := DomainNameToByteStream(shortdomain, stt); + WriteDNSDomainByteStreamToBuffer(buf, offset, dmbs); + + BufferToPayload(buf,pl); + s := stringfromlabel(pl, offset2); + AssertEquals(shortdomain, s); +end; + +procedure TNetDbTest.SetUp; +begin + tsl := TStringList.Create; +end; + +procedure TNetDbTest.TearDown; +begin + tsl.Free; +end; + +procedure TNetDbTest.CopyBytesTo(var buf: TPayLoad; startidx, destidx, + count: Word); +begin + // no tests for overlapping source and dest. + if ((startidx+count) > Length(buf)) or ((destidx+count) > Length(buf)) then + exit; + Move(buf[startidx], buf[destidx], count); +end; + +procedure TNetDbTest.CopyBytesTo(var buf: TPayLoadTCP; startidx, destidx, + count: Word); +begin + // no tests for overlapping source and dest. + if ((startidx+count) > Length(buf)) or ((destidx+count) > Length(buf)) then + exit; + Move(buf[startidx], buf[destidx], count); +end; + +function TNetDbTest.WriteNumToBuffer(var buf: TBuffer; var offset: Cardinal; + val: Word): Word; +begin + Result := 0; + if (offset + SizeOf(val)) > Length(buf) then exit; + Move(HToNs(val), buf[offset], SizeOf(val)); + Inc(offset, SizeOf(val)); + Result := SizeOf(val); +end; + +function TNetDbTest.WriteNumToBuffer(var buf: TBuffer; var offset: Cardinal; + val: Cardinal): Word; +begin + Result := 0; + if (offset + SizeOf(val)) > Length(buf) then exit; + Move(HToNl(val), buf[offset], SizeOf(val)); + Inc(offset, SizeOf(val)); + Result := SizeOf(val); +end; + +{ +Write a number to the buffer without converting it to network byte order. +} +function TNetDbTest.WriteNumToBufferN(var buf: TBuffer; var offset: Cardinal; + val: Word): Word; +begin + Result := 0; + if (offset + SizeOf(val)) > Length(buf) then exit; + Move(val, buf[offset], SizeOf(val)); + Inc(offset, SizeOf(val)); + Result := SizeOf(val); +end; + +{ +Write a number to the buffer without converting it to network byte order. +} +function TNetDbTest.WriteNumToBufferN(var buf: TBuffer; var offset: Cardinal; + val: Cardinal): Word; +begin + Result := 0; + if (offset + SizeOf(val)) > Length(buf) then exit; + Move(val, buf[offset], SizeOf(val)); + Inc(offset, SizeOf(val)); + Result := SizeOf(val); +end; + +{ +Write an RR to the byte buffer. No compression of domain names will occur. +} +function TNetDbTest.WriteRRToBuffer(var buf: TBuffer; var offset: Cardinal; + rr: TFakeRR): Word; +var + s,etw: Word; + dmbs: TDNSDomainByteStream; + res: TRDataWriteRes; +begin + etw := 0; + s := offset; + // write the RR Name + dmbs := DomainNameToByteStream(rr.RRName); + etw := CalcRdLength(dmbs); + if WriteDNSDomainByteStreamToBuffer(buf, offset, dmbs) < etw + then + Fail('Cannot write RR name to buffer at offset '+ inttostr(offset)); + + if (offset + SizeOf(rr.Atype) + SizeOf(rr.AClass) + SizeOf(rr.TTL)) > + Length(buf) + then + Fail('Not enough space to add RR type,class,ttl at offset '+ inttostr(offset)); + + // Write the RR type, class and TTL. + WriteNumToBuffer(buf, offset,rr.Atype); + WriteNumToBuffer(buf, offset, rr.AClass); + WriteNumToBuffer(buf, offset, rr.TTL); + + // now the RR data, which is type specific. Each type-specific method + // also writes the RDLength word, so we have to account for 2 additional + // bytes. + case rr.Atype of + DNSQRY_A: + res := WriteAasRData(buf, offset, rr.ip); + DNSQRY_AAAA: + res := WriteAAAAasRData(buf, offset, rr.ip6); + DNSQRY_SOA: + res := WriteSOAasRData(buf, offset, rr.fsoa); + DNSQRY_MX: + res := WriteMXAsRData(buf, offset, rr.fmx); + DNSQRY_NS: + begin + dmbs := DomainNameToByteStream(rr.nsh); + res := WriteDomainAsRdata(buf,offset,dmbs); + end; + DNSQRY_PTR: + begin + dmbs := DomainNameToByteStream(rr.nsh); + res := WriteDomainAsRdata(buf,offset,dmbs); + end; + DNSQRY_CNAME: + begin + dmbs := DomainNameToByteStream(rr.cn); + res := WriteDomainAsRdata(buf,offset,dmbs); + end; + DNSQRY_TXT: + res := WriteTextRecAsRData(buf, offset, rr.txtarr); + DNSQRY_SRV: + res := WriteSRVasRData(buf, offset, rr.fsrv); + else + Fail('Called to handle RR type '+inttostr(rr.Atype)+ + ' but no code to handle it.'); + end; + + if res.bw < res.etw then + Fail('Unable to write RR of type ' +inttostr(RR.Atype) + + ', name "' + rr.RRName + '" to buffer at offset '+inttostr(offset)+ + '. Wrote '+inttostr(res.bw)+' bytes, expected to write '+ + inttostr(res.etw)+' bytes.'); + + Result := offset - s; +end; + +{ +Write an RR to the output buffer, with compression of domain names turned on. +} +function TNetDbTest.WriteRRToBuffer(var buf: TBuffer; var offset: Cardinal; + rr: TFakeRR; var ctbl: TDomainCompressionTable): Word; +var + s, etw: Word; + dmbs: TDNSDomainByteStream; + res: TRDataWriteRes; +begin + etw := 0; + s := offset; + // write the RR Name + dmbs := DomainNameToByteStream(rr.RRName, ctbl); + etw := CalcRdLength(dmbs); + if WriteDNSDomainByteStreamToBuffer(buf, offset, dmbs) < etw + then + Fail('Cannot write RR name to buffer at offset '+ inttostr(offset)); + + if (offset + SizeOf(rr.Atype) + SizeOf(rr.AClass) + SizeOf(rr.TTL)) > + Length(buf) + then + Fail('Not enough space to add RR type,class,ttl at offset '+ inttostr(offset)); + + // Write the RR type, class and TTL. + WriteNumToBuffer(buf, offset,rr.Atype); + WriteNumToBuffer(buf, offset, rr.AClass); + WriteNumToBuffer(buf, offset, rr.TTL); + + // now the RR data, which is type specific. Each type-specific method + // also writes the RDLength word, so we have to account for 2 additional + // bytes. + case rr.Atype of + DNSQRY_A: + begin + res := WriteAasRData(buf, offset, rr.ip); + end; + DNSQRY_AAAA: + begin + res := WriteAAAAasRData(buf, offset, rr.ip6); + end; + DNSQRY_SOA: + begin + res := WriteSOAasRData(buf, offset, rr.fsoa); + end; + DNSQRY_MX: + begin + res := WriteMXAsRData(buf, offset, rr.fmx, ctbl); + end; + DNSQRY_NS: + begin + dmbs := DomainNameToByteStream(rr.nsh, ctbl); + res := WriteDomainAsRdata(buf,offset,dmbs); + end; + DNSQRY_PTR: + begin + dmbs := DomainNameToByteStream(rr.nsh, ctbl); + res := WriteDomainAsRdata(buf,offset,dmbs); + end; + DNSQRY_CNAME: + begin + dmbs := DomainNameToByteStream(rr.cn, ctbl); + res := WriteDomainAsRdata(buf,offset,dmbs); + end; + DNSQRY_TXT: + begin + res := WriteTextRecAsRData(buf, offset, rr.txtarr); + end; + DNSQRY_SRV: + begin + res := WriteSRVasRData(buf, offset, rr.fsrv); + end; + else + Fail('Called to handle RR type '+inttostr(rr.Atype)+ + ' but no code to handle it.'); + end; + + if res.bw < res.etw then + Fail('Unable to write RR of type ' +inttostr(RR.Atype) + + ', name "' + rr.RRName + '" to buffer at offset '+inttostr(offset)+ + '. Wrote '+inttostr(res.bw)+' bytes, expected to write '+ + inttostr(res.etw)+' bytes.'); + + Result := offset - s; +end; + +{ +Turn a fake DNS response into a payload buffer. This is a byte buffer minus the +DNS header. That is, the buffer begins with the question part of the response, +after which comes the RRs of the answers, authority, and additional sections. +} +function TNetDbTest.FakeDNSResponseToByteBuffer(fdr: TFakeDNSResponse; out + buf: TBuffer; compress: Boolean): Cardinal; +var + offset: Cardinal; + rr: TFakeRR; + dbs: TDNSDomainByteStream; +begin + // plenty of room for our test responses. could precalculate this, but there's + // no benefit. The return value of this function is the length of the + // DNS reply, which we get for free since we have to track our offset into + // the buffer as we write it. + SetLength(buf, 2048); + offset := 0; + + if compress then + dbs := DomainNameToByteStream(fdr.qry.nm,fdr.strtable) + else + dbs := DomainNameToByteStream(fdr.qry.nm); + + // The question section consists of the dns query name, the qtype and + // qclass. + if WriteDNSDomainByteStreamToBuffer(buf, offset, dbs) < CalcRdLength(dbs) + then + Fail('Cannot write name to buffer at offset '+ inttostr(offset)); + + WriteNumToBuffer(buf, offset, fdr.qry.qtype); + WriteNumToBuffer(buf, offset, fdr.qry.qclass); + + // Now the answer sections. + for rr in fdr.answers do + if compress then + WriteRRToBuffer(buf, offset, rr, fdr.strtable) + else + WriteRRToBuffer(buf, offset, rr); + for rr in fdr.authority do + if compress then + WriteRRToBuffer(buf, offset, rr, fdr.strtable) + else + WriteRRToBuffer(buf, offset, rr); + for rr in fdr.additional do + if compress then + WriteRRToBuffer(buf, offset, rr, fdr.strtable) + else + WriteRRToBuffer(buf, offset, rr); + + SetLength(buf, offset); + Result := offset; +end; + +{ +Generate a TPayload buffer, a fixed-length array of byte, from the TBuffer +type, which is a variable-length array of byte. +} +function TNetDbTest.BufferToPayload(const buf: TBuffer; + out pl: TPayload): Boolean; +begin + Result := False; + FillChar(pl,Length(pl),0); + Move(buf[0], pl[0], Min(Length(pl),Length(buf))); + Result := True; +end; + +function TNetDbTest.BufferToPayload(const buf: TBuffer; + out pl: TPayLoadTCP): Boolean; +begin + Result := False; + FillChar(pl,Length(pl),0); + Move(buf[0], pl[0], Min(Length(pl),Length(buf))); + Result := True; +end; + +function TNetDbTest.BuildQueryData(fdr: TFakeDNSResponse; out qd: TQueryData; + out qlen: Word; Compress: Boolean = False): Boolean; +var + buf: TBuffer; +begin + qlen := FakeDNSResponseToByteBuffer(fdr, buf, Compress); + qd.h.ancount := HToNs(fdr.hdr.ancount); + qd.h.arcount := HToNs(fdr.hdr.arcount); + qd.h.nscount := HToNs(fdr.hdr.nscount); + qd.h.qdcount := HToNs(fdr.hdr.qdcount); + qd.h.flags1 := fdr.hdr.flags1; + qd.h.flags2 := fdr.hdr.flags2; + qd.h.id[0] := fdr.hdr.id[0]; + qd.h.id[1] := fdr.hdr.id[1]; + Result := BufferToPayload(buf, qd.Payload); +end; + +function TNetDbTest.BuildQueryData(fdr: TFakeDNSResponse; out + qd: TQueryDataLengthTCP; out qlen: Word; Compress: Boolean = False): Boolean; +var + buf: TBuffer; +begin + qlen := FakeDNSResponseToByteBuffer(fdr, buf, Compress); + qd.h.ancount := HToNs(fdr.hdr.ancount); + qd.h.arcount := HToNs(fdr.hdr.arcount); + qd.h.nscount := HToNs(fdr.hdr.nscount); + qd.h.qdcount := HToNs(fdr.hdr.qdcount); + qd.h.flags1 := fdr.hdr.flags1; + qd.h.flags2 := fdr.hdr.flags2; + qd.h.id[0] := fdr.hdr.id[0]; + qd.h.id[1] := fdr.hdr.id[1]; + Result := BufferToPayload(buf, qd.Payload); +end; + +{ +Create a deliberately invalid DNS response to test our API's ability to cope +with invalid data without causing memory corruption. + +After building a valid DNS response as normal, we truncate it at the given +offset.} +function TNetDbTest.BuildTruncatedQueryData(fdr: TFakeDNSResponse; out + qd: TQueryData; out qlen: Word; truncoffset: Word): Boolean; +var + buf: TBuffer; +begin + qlen := FakeDNSResponseToByteBuffer(fdr, buf); + qd.h.ancount := HToNs(fdr.hdr.ancount); + qd.h.arcount := HToNs(fdr.hdr.arcount); + qd.h.nscount := HToNs(fdr.hdr.nscount); + qd.h.qdcount := HToNs(fdr.hdr.qdcount); + qd.h.flags1 := fdr.hdr.flags1; + qd.h.flags2 := fdr.hdr.flags2; + qd.h.id[0] := fdr.hdr.id[0]; + qd.h.id[1] := fdr.hdr.id[1]; + SetLength(buf, truncoffset); + Result := BufferToPayload(buf, qd.Payload); +end; + +initialization + + RegisterTest(TNetDbTest); +end. + diff --git a/packages/fcl-net/tests/tresolvertests.pp b/packages/fcl-net/tests/tresolvertests.pp new file mode 100644 index 0000000000..9892dc446b --- /dev/null +++ b/packages/fcl-net/tests/tresolvertests.pp @@ -0,0 +1,28 @@ +program tresolvertests; + +{$mode objfpc}{$H+} + +uses + Classes, consoletestrunner, netdbtest; + +type + + { TMyTestRunner } + + TMyTestRunner = class(TTestRunner) + protected + // override the protected methods of TTestRunner to customize its behavior + end; + +var + Application: TMyTestRunner; + +begin + DefaultFormat:=fPlain; + DefaultRunAllTests:=True; + Application := TMyTestRunner.Create(nil); + Application.Initialize; + Application.Title:='resolvertests'; + Application.Run; + Application.Free; +end. diff --git a/rtl/i386/cpu.pp b/rtl/i386/cpu.pp index 7454440dba..0ba4844035 100644 --- a/rtl/i386/cpu.pp +++ b/rtl/i386/cpu.pp @@ -70,7 +70,7 @@ unit cpu; function InterlockedCompareExchange128(var Target: Int128Rec; NewValue: Int128Rec; Comperand: Int128Rec): Int128Rec; begin {$if FPC_FULLVERSION >= 30101} -{$ifndef FPC_PIC} +{$ifndef FPC_PIC} if _RTMSupport then begin asm @@ -92,11 +92,10 @@ unit cpu; { 8a: 0f 01 d5 xend } .byte 0x0f, 0x01, 0xd5 {$endif} - xend end; end else -{$endif FPC_PIC} +{$endif FPC_PIC} {$endif FPC_FULLVERSION >= 30101} RunError(217); end; diff --git a/rtl/unix/sysutils.pp b/rtl/unix/sysutils.pp index 68520a7e99..ee4b500ef1 100644 --- a/rtl/unix/sysutils.pp +++ b/rtl/unix/sysutils.pp @@ -55,6 +55,10 @@ uses {$DEFINE HAVECLOCKGETTIME} {$ENDIF} +{$if defined(LINUX)} +{$DEFINE HAS_STATX} +{$endif} + { Include platform independent interface part } {$i sysutilh.inc} @@ -547,12 +551,26 @@ begin end; end; + Function FileAge (Const FileName : RawByteString): Int64; Var Info : Stat; SystemFileName: RawByteString; +{$ifdef HAS_STATX} + Infox : Statx; +{$endif HAS_STATX} begin SystemFileName:=ToSingleByteFileSystemEncodedFileName(FileName); + +{$ifdef HAS_STATX} + { first try statx } + if (Fpstatx(0,pchar(SystemFileName),0,STATX_MTIME or STATX_MODE,Infox)>=0) and not(fpS_ISDIR(Infox.stx_mode)) then + begin + Result:=Infox.stx_mtime.tv_sec; + exit; + end; +{$endif HAS_STATX} + If (fpstat(pchar(SystemFileName),Info)<0) or fpS_ISDIR(info.st_mode) then exit(-1) else diff --git a/tests/Makefile b/tests/Makefile index 4f15b9bc56..5ba9988b9c 100644 --- a/tests/Makefile +++ b/tests/Makefile @@ -2429,7 +2429,7 @@ LOGEXT=.testlog .tbslog .tbflog .webtbslog .webtbflog TESTUNITDIRS=system dos crt objects strings sysutils math sharemem strutils matrix lineinfo ucomplex fpwidestring cpu fmtbcd windows classes character dateutil fpcunit softfpu variants sortbase sortalgs linux unixutil types nullable TESTDIRECTDIRS= TESTSUBDIRS=cg cg/variants cg/cdecl cpu16 cpu16/i8086 library opt $(addprefix units/,$(TESTUNITDIRS)) -TESTPACKAGESDIRS=win-base webtbs hash fcl-registry fcl-process zlib fcl-db fcl-xml cocoaint bzip2 +TESTPACKAGESDIRS=win-base webtbs hash fcl-registry fcl-process zlib fcl-db fcl-xml cocoaint bzip2 fcl-net TESTPACKAGESUBDIRS=$(addprefix packages/,$(TESTPACKAGESDIRS)) TESTPACKAGESDIRECTDIRS=rtl-objpas rtl-generics hash regexpr fcl-registry TESTPACKAGESDIRECTSUBDIRS=$(addprefix ../packages/,$(addsuffix /tests,$(TESTPACKAGESDIRECTDIRS))) diff --git a/tests/Makefile.fpc b/tests/Makefile.fpc index 253860a059..15e765d5c4 100644 --- a/tests/Makefile.fpc +++ b/tests/Makefile.fpc @@ -162,7 +162,7 @@ LOGEXT=.testlog .tbslog .tbflog .webtbslog .webtbflog TESTUNITDIRS=system dos crt objects strings sysutils math sharemem strutils matrix lineinfo ucomplex fpwidestring cpu fmtbcd windows classes character dateutil fpcunit softfpu variants sortbase sortalgs linux unixutil types nullable TESTDIRECTDIRS= TESTSUBDIRS=cg cg/variants cg/cdecl cpu16 cpu16/i8086 library opt $(addprefix units/,$(TESTUNITDIRS)) -TESTPACKAGESDIRS=win-base webtbs hash fcl-registry fcl-process zlib fcl-db fcl-xml cocoaint bzip2 +TESTPACKAGESDIRS=win-base webtbs hash fcl-registry fcl-process zlib fcl-db fcl-xml cocoaint bzip2 fcl-net TESTPACKAGESUBDIRS=$(addprefix packages/,$(TESTPACKAGESDIRS)) TESTPACKAGESDIRECTDIRS=rtl-objpas rtl-generics hash regexpr fcl-registry TESTPACKAGESDIRECTSUBDIRS=$(addprefix ../packages/,$(addsuffix /tests,$(TESTPACKAGESDIRECTDIRS))) diff --git a/tests/test/units/sysutils/tfileage.pp b/tests/test/units/sysutils/tfileage.pp new file mode 100644 index 0000000000..050f75a5d1 --- /dev/null +++ b/tests/test/units/sysutils/tfileage.pp @@ -0,0 +1,10 @@ +uses + sysutils; +begin + if 3600*24*(now()-FileDateToDateTime(FileAge(paramstr(0))))>7200 then + begin + writeln('FileAge returns: ',FileDateToDateTime(FileAge(paramstr(0)))); + writeln('Compilation time and run time differ too much, SysUtils.FileAge buggy?'); + halt(1); + end; +end. |