(* Return a socket suitable for DNS queries, or an error code as a negative
number. This is unprivileged, but is opened here so that the router (ping)
and DNS client code can be kept as similar as possible.
*)
function DnsClientSocket(): TSocket;
begin
result := dnsClientSocketHandle
end { DnsClientSocket } ;
(* Send a query to a randomly-selected DNS server, return the saved sequence
number or 0xffff on error. If not in error, the MSB of the sequence number is
set iff the address is local (RFC1918 etc.).
*)
function SendDnsQuery(): TDnsSequence;
(* See e.g. https://www2.cs.duke.edu/courses/fall16/compsci356/DNS/DNS-primer.pdf *)
const
standardQuery= $0000;
inverseQuery= $0800;
statusQuery= $1000;
query= #1 + '1' +
#1 + '0' +
#1 + '0' +
#3 + '127' +
#7 + 'in-addr' +
#4 + 'arpa' +
#0 +
#$00 + #$0c + (* Query type, network-endian *)
#$00 + #$01; (* Query class, network-endian *)
var
server: string;
a: in4_addr;
sockAddr: TSockAddr;
sz: integer;
msg: TDnsMsg;
function localAddress(a: longword): boolean;
begin
result := false;
if a and $ff000000 = (10 << 24) then
exit(true);
if a and $ffff0000 = (192 << 24) + (168 << 16) then
exit(true);
if a and $ff000000 = (172 << 24) then
if a and $00f00000 <> $00000000 then
exit(true);
if a and $ffff0000 = (169 << 24) + (254 << 16) then
exit(true)
end { localAddress } ;
begin
if DnsClientSocket <= 0 then
exit($ffff);
if not Assigned(nameservers) or (nameservers.Count = 0) then
needsReload := true;
if needsReload then
if not loadResolvConf() then begin
{$ifdef DEBUG }
WriteLn('DNS query abort -----');
{$endif DEBUG }
exit($ffff)
end else
needsReload := false;
server := nameservers[0];
nameservers.Delete(0);
(* If we've just deleted the last server from the nameservers list, reread the *)
(* /etc/resolv.conf file. If this returns more than one item then repeat this *)
(* until the first entry in the nameservers list is not the same as the one *)
(* that we're about to use, so that if it fails we're not trying the same *)
(* server twice in succession. This is a noteworthy but justifiable departure *)
(* from randomness. *)
if nameservers.Count = 0 then
repeat
if not loadResolvConf() then
break; (* List is left empty *)
if nameservers.Count = 1 then
break; (* No alternative to a repeat address *)
until nameservers[0] <> server;
{$ifdef DEBUG }
WriteLn('DNS query ', server, ' -----');
{$endif DEBUG }
a := in4_addr(StrToHostAddr(server));
if a = in4_null then
exit($ffff);
FillChar(sockAddr, SizeOf(sockAddr), 0);
sockAddr.sa_family:= AF_INET;
sockAddr.sin_port:= hToNS(53);
sockAddr.sin_addr.s_addr := htoNL(longword(a));
result := Random($7fff);
if localAddress(longword(a)) then
result += $8000; (* Maximum possible is $7ffe + $8000 *)
FillChar(msg, SizeOf(msg), 0);
with msg do begin
hdr.id := htons(result);
hdr.flags := htons(standardQuery);
hdr.cnts[2] := htons(1)
end;
Move(query[1], msg.body[0], Length(query));
sz := SizeOf(TDnsHdr) + Length(query);
// while sz mod 4 <> 0 do
// sz += 1;
if fpSendTo(DnsClientSocket, @msg, sz, 0, @sockAddr, SizeOf(sockAddr)) < 0 then
result := $ffff;
{$ifdef DEBUG }
WriteLn('DNS seq: ', result)
{$endif DEBUG }
end { SendDnsQuery } ;
(* Retrieve the result of a query returned by a DNS server. Return false if
there is no result or the sequence number doesn't match.
*)
function PollDnsResult(const seq: TDnsSequence): TDnsResponse;
var
sockAddr: TSockAddr;
saLength, sz: integer;
msg: TDnsMsg;
begin
result := DnsNoResponse;
if (DnsClientSocket <= 0) or (seq = $ffff) then
exit;
FillChar(sockAddr, SizeOf(sockAddr), 0);
saLength := SizeOf(sockAddr);
FillChar(msg, SizeOf(msg), $ff);
sz := fpRecvFrom(DnsClientSocket, @msg, SizeOf(msg), MSG_DONTWAIT, @sockAddr, @saLength);
if sz <= SizeOf(TDnsHdr) then
exit;
{$ifdef DEBUG }
Write('DNS rsp: ', seq);
WriteLn(' got: ', ntohs(msg.hdr.id));
{$endif DEBUG }
(* Any coherent response is adequate confirmation that we can get through to *)
(* at least one server. *)
if msg.hdr.id = htons(seq) then
result := DnsOkResponse
else
result := DnsBadResponse;
{$ifdef DEBUG }
if result = DnsOkResponse then
WriteLn('DNS OK')
else
WriteLn('DNS Fail')
{$endif DEBUG }
end { PollDnsResult } ;
// Elsewhere
var
dnsClientSocketHandle: TSocket= -32768;
Write(StdErr, 'Creating new Internet domain connectionless client socket... ');
dnsClientSocketHandle := fpSocket(PF_INET, SOCK_DGRAM, 0);
if dnsClientSocketHandle > 0 then
WriteLn(StdErr, 'OK')
else begin
WriteLn(StdErr, 'failed, might need CAP_DAC_OVERRIDE,CAP_NET_BIND_SERVICE,CAP_NET_RAW=p+e');
dnsClientSocketHandle := -Abs(ErrNo)
end;
dnsQuery := SendDnsQuery(); (* Response should turn it green *)
dnsQueryTime := Now();
case PollDnsResult(dnsQuery) of
DNSWrongResponse: ;
DnsOkResponse: begin
if (dnsQuery and $8000) = $8000 then
DispatchWatchdog(IniFilesLocation.GetHostName() + '/' + SpecialName + '.DNS:0,13')
else
DispatchWatchdog(IniFilesLocation.GetHostName() + '/' + SpecialName + '.DNS:0,22');
dnsQuery := $ffff
end
otherwise (* Timeout on no or bad response *)
if Now() - dnsQueryTime > 46 * OneSecond then
dnsQuery := $ffff
end