summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authornickysn <nickysn@3ad0048d-3df7-0310-abae-a5850022a9f2>2021-01-30 22:29:44 +0000
committernickysn <nickysn@3ad0048d-3df7-0310-abae-a5850022a9f2>2021-01-30 22:29:44 +0000
commit442f014d5c957381208bfb5ce46528f351505787 (patch)
tree0d4acf326b195376b170eaca6b4b112a5f96c163
parente49c331a7b16e22f168b5e21060d4a62e3cf340f (diff)
parent86797a513f7e0aa500c2cac8cf2721c694802faa (diff)
downloadfpc-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.pp64
-rw-r--r--packages/fcl-net/src/netdb.pp1117
-rw-r--r--packages/fcl-net/tests/netdbtest.pp4615
-rw-r--r--packages/fcl-net/tests/tresolvertests.pp28
-rw-r--r--rtl/i386/cpu.pp5
-rw-r--r--rtl/unix/sysutils.pp18
-rw-r--r--tests/Makefile2
-rw-r--r--tests/Makefile.fpc2
-rw-r--r--tests/test/units/sysutils/tfileage.pp10
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.