X-Git-Url: http://www.lcore.org/git/lcore.git/blobdiff_plain/31d4361fb52761b6486f55af10268a51ee536a6f..dc073bfadb411ab43bc39e2a39f48811706dfc0e:/dnscore.pas
diff --git a/dnscore.pas b/dnscore.pas
index 18e40c9..e38f35f 100644
--- a/dnscore.pas
+++ b/dnscore.pas
@@ -6,12 +6,12 @@
{
code wanting to use this dns system should act as follows (note: app
- developers will probablly want to use dnsasync or dnssync or write a similar
- wrapper unit of thier own).
+ developers will probably want to use dnsasync or dnssync or write a similar
+ wrapper unit of their own).
for normal lookups call setstate_forward or setstate_reverse to set up the
state, for more obscure lookups use setstate_request_init and fill in other
- relavent state manually.
+ relevant state manually.
call state_process which will do processing on the information in the state
and return an action
@@ -20,7 +20,7 @@
action_sendpacket means that dnscore wants the code that calls it to send
the packet in sendpacket/sendpacketlen and then start (or go back to) listening
for
- action_done means the request has completed (either suceeded or failed)
+ action_done means the request has completed (either succeeded or failed)
callers should resend the last packet they tried to send if they have not
been asked to send a new packet for more than some timeout value they choose.
@@ -32,23 +32,23 @@
following ways.
on failure state.resultstr will be an empty string and state.resultbin will
- be zeroed out (easilly detected by the fact that it will have a family of 0)
+ be zeroed out (easily detected by the fact that it will have a family of 0)
on success for a A or AAAA lookup state.resultstr will be an empty string
- and state.resultbin will contain the result (note: AAAA lookups require IPV6
+ and state.resultbin will contain the result (note: AAAA lookups require IPv6
enabled).
- if an A lookup fails and the code is built with ipv6 enabled then the code
+ if an A lookup fails and the code is built with IPv6 enabled then the code
will return any AAAA records with the same name. The reverse does not apply
- so if an application preffers IPV6 but wants IPV4 results as well it must
- check them seperately.
+ so if an application prefers IPv6 but wants IPv4 results as well it must
+ check them separately.
on success for any other type of lookup state.resultstr will be an empty
note the state contains ansistrings, setstate_init with a null name parameter
- can be used to clean theese up if required.
+ can be used to clean these up if required.
- callers may use setstate_failure to mark the state as failed themseleves
+ callers may use setstate_failure to mark the state as failed themselves
before passing it on to other code, for example this may be done in the event
of a timeout.
}
@@ -62,7 +62,7 @@ interface
uses binipstuff,classes,pgtypes,lcorernd;
-var usewindns : boolean = {$ifdef win32}true{$else}false{$endif};
+var usewindns : boolean = {$ifdef mswindows}true{$else}false{$endif};
{hint to users of this unit that they should use windows dns instead.
May be disabled by applications if desired. (e.g. if setting a custom
dnsserverlist).
@@ -106,7 +106,10 @@ const
querytype_txt=16;
querytype_spf=99;
maxrecursion=50;
- maxrrofakind=20;
+ maxrrofakind=32;
+ {the maximum number of RR of a kind of purely an extra sanity check and could be omitted.
+ before, i set it to 20, but valid replies can have more. dnscore only does udp requests,
+ and ordinary DNS, so up to 512 bytes. the maximum number of A records that fits seems to be 29}
retryafter=300000; //microseconds must be less than one second;
timeoutlag=1000000000; // penalty value to be treated as lag in the event of a timeout (microseconds)
@@ -159,7 +162,7 @@ type
end;
//commenting out functions from interface that do not have documented semantics
-//and probablly should not be called from outside this unit, reenable them
+//and probably should not be called from outside this unit, reenable them
//if you must but please document them at the same time --plugwash
//function buildrequest(const name:string;var packet:tdnspacket;requesttype:word):integer;
@@ -169,7 +172,7 @@ function makereversename(const binip:tbinip):ansistring;
procedure setstate_request_init(const name:ansistring;var state:tdnsstate);
-//set up state for a foward lookup. A family value of AF_INET6 will give only
+//set up state for a forward lookup. A family value of AF_INET6 will give only
//ipv6 results. Any other value will give only ipv4 results
procedure setstate_forward(const name:ansistring;var state:tdnsstate;family:integer);
@@ -188,7 +191,8 @@ procedure populatednsserverlist;
procedure cleardnsservercache;
var
- dnsserverlist : tstringlist;
+ dnsserverlist : tbiniplist;
+ dnsserverlag:tlist;
// currentdnsserverno : integer;
@@ -196,6 +200,7 @@ var
//id to the id of that nameserver. id should later be used to report how laggy
//the servers response was and if it was timed out.
function getcurrentsystemnameserver(var id:integer) :ansistring;
+function getcurrentsystemnameserverbin(var id:integer) :tbinip;
procedure reportlag(id:integer;lag:integer); //lag should be in microseconds and should be -1 to report a timeout
//var
@@ -219,9 +224,6 @@ function getquerytype(s:ansistring):integer;
implementation
uses
- {$ifdef win32}
- windows,
- {$endif}
lcorelocalips,
sysutils;
@@ -503,7 +505,10 @@ begin
state.numrr2 := 0;
for a := 0 to 3 do begin
state.numrr1[a] := htons(state.recvpacket.rrcount[a]);
- if state.numrr1[a] > maxrrofakind then goto failure;
+ if state.numrr1[a] > maxrrofakind then begin
+ failurereason := 'exceeded maximum RR of a kind';
+ goto failure;
+ end;
inc(state.numrr2,state.numrr1[a]);
end;
@@ -592,7 +597,7 @@ recursed:
goto failure;
end;
- {do /ets/hosts lookup here}
+ {do /etc/hosts lookup here}
state.sendpacketlen := buildrequest(state.queryname,state.sendpacket,state.requesttype);
if state.sendpacketlen = 0 then begin
failurereason := 'building request packet failed';
@@ -605,132 +610,59 @@ recursed:
failure:
setstate_failure(state);
end;
-{$ifdef win32}
- const
- MAX_HOSTNAME_LEN = 132;
- MAX_DOMAIN_NAME_LEN = 132;
- MAX_SCOPE_ID_LEN = 260 ;
- MAX_ADAPTER_NAME_LENGTH = 260;
- MAX_ADAPTER_ADDRESS_LENGTH = 8;
- MAX_ADAPTER_DESCRIPTION_LENGTH = 132;
- ERROR_BUFFER_OVERFLOW = 111;
- MIB_IF_TYPE_ETHERNET = 6;
- MIB_IF_TYPE_TOKENRING = 9;
- MIB_IF_TYPE_FDDI = 15;
- MIB_IF_TYPE_PPP = 23;
- MIB_IF_TYPE_LOOPBACK = 24;
- MIB_IF_TYPE_SLIP = 28;
-
-
- type
- tip_addr_string=packed record
- Next :pointer;
- IpAddress : array[0..15] of ansichar;
- ipmask : array[0..15] of ansichar;
- context : dword;
- end;
- pip_addr_string=^tip_addr_string;
- tFIXED_INFO=packed record
- HostName : array[0..MAX_HOSTNAME_LEN-1] of ansichar;
- DomainName : array[0..MAX_DOMAIN_NAME_LEN-1] of ansichar;
- currentdnsserver : pip_addr_string;
- dnsserverlist : tip_addr_string;
- nodetype : longint;
- ScopeId : array[0..MAX_SCOPE_ID_LEN + 4] of ansichar;
- enablerouting : longbool;
- enableproxy : longbool;
- enabledns : longbool;
- end;
- pFIXED_INFO=^tFIXED_INFO;
- var
- iphlpapi : thandle;
- getnetworkparams : function(pFixedInfo : PFIXED_INFO;OutBufLen : plongint) : longint;stdcall;
-{$endif}
+
procedure populatednsserverlist;
var
- {$ifdef win32}
- fixed_info : pfixed_info;
- fixed_info_len : longint;
- currentdnsserver : pip_addr_string;
- {$else}
- t:textfile;
- s:ansistring;
- a:integer;
- {$endif}
+ a:integer;
begin
- //result := '';
- if assigned(dnsserverlist) then begin
- dnsserverlist.clear;
+ if assigned(dnsserverlag) then begin
+ dnsserverlag.clear;
end else begin
- dnsserverlist := tstringlist.Create;
+ dnsserverlag := tlist.Create;
end;
- {$ifdef win32}
- if iphlpapi=0 then iphlpapi := loadlibrary('iphlpapi.dll');
- if not assigned(getnetworkparams) then @getnetworkparams := getprocaddress(iphlpapi,'GetNetworkParams');
- if not assigned(getnetworkparams) then exit;
- fixed_info_len := 0;
- if GetNetworkParams(nil,@fixed_info_len)<>ERROR_BUFFER_OVERFLOW then exit;
- //fixed_info_len :=sizeof(tfixed_info);
- getmem(fixed_info,fixed_info_len);
- if GetNetworkParams(fixed_info,@fixed_info_len)<>0 then begin
- freemem(fixed_info);
- exit;
- end;
- currentdnsserver := @(fixed_info.dnsserverlist);
- while assigned(currentdnsserver) do begin
- dnsserverlist.Add(currentdnsserver.IpAddress);
- currentdnsserver := currentdnsserver.next;
- end;
- freemem(fixed_info);
- {$else}
- filemode := 0;
- assignfile(t,'/etc/resolv.conf');
- {$i-}reset(t);{$i+}
- if ioresult <> 0 then exit;
-
- while not eof(t) do begin
- readln(t,s);
- if not (copy(s,1,10) = 'nameserver') then continue;
- s := copy(s,11,500);
- while s <> '' do begin
- if (s[1] = #32) or (s[1] = #9) then s := copy(s,2,500) else break;
- end;
- a := pos(' ',s);
- if a <> 0 then s := copy(s,1,a-1);
- a := pos(#9,s);
- if a <> 0 then s := copy(s,1,a-1);
- //result := s;
- //if result <> '' then break;
- dnsserverlist.Add(s);
- end;
- close(t);
- {$endif}
+
+ dnsserverlist := getsystemdnsservers;
+ for a := biniplist_getcount(dnsserverlist)-1 downto 0 do dnsserverlag.Add(nil);
end;
procedure cleardnsservercache;
begin
- if assigned(dnsserverlist) then begin
- dnsserverlist.destroy;
- dnsserverlist := nil;
+ if assigned(dnsserverlag) then begin
+ dnsserverlag.destroy;
+ dnsserverlag := nil;
+ dnsserverlist := '';
end;
end;
-function getcurrentsystemnameserver(var id:integer):ansistring;
+function getcurrentsystemnameserverbin(var id:integer):tbinip;
var
counter : integer;
-
begin
- if not assigned(dnsserverlist) then populatednsserverlist;
- if dnsserverlist.count=0 then raise exception.create('no dns servers availible');
- id := 0;
- if dnsserverlist.count >1 then begin
+ {override the name server choice here, instead of overriding it wherever it's called
+ setting ID to -1 causes it to be ignored in reportlag}
+ if (overridednsserver <> '') then begin
+ result := ipstrtobinf(overridednsserver);
+ if result.family <> 0 then begin
+ id := -1;
+ exit;
+ end;
+ end;
- for counter := 1 to dnsserverlist.count-1 do begin
- if taddrint(dnsserverlist.objects[counter]) < taddrint(dnsserverlist.objects[id]) then id := counter;
+ if not assigned(dnsserverlag) then populatednsserverlist;
+ if dnsserverlag.count=0 then raise exception.create('no dns servers available');
+ id := 0;
+ if dnsserverlag.count >1 then begin
+ for counter := dnsserverlag.count-1 downto 1 do begin
+ if taddrint(dnsserverlag[counter]) < taddrint(dnsserverlag[id]) then id := counter;
end;
end;
- result := dnsserverlist[id]
+ result := biniplist_get(dnsserverlist,id);
+end;
+
+function getcurrentsystemnameserver(var id:integer):ansistring;
+begin
+ result := ipbintostr(getcurrentsystemnameserverbin(id));
end;
procedure reportlag(id:integer;lag:integer); //lag should be in microseconds and should be -1 to report a timeout
@@ -738,12 +670,12 @@ var
counter : integer;
temp : integer;
begin
- if (id < 0) or (id >= dnsserverlist.count) then exit;
+ if (id < 0) or (id >= dnsserverlag.count) then exit;
if lag = -1 then lag := timeoutlag;
- for counter := 0 to dnsserverlist.count-1 do begin
- temp := taddrint(dnsserverlist.objects[counter]) *15;
+ for counter := 0 to dnsserverlag.count-1 do begin
+ temp := taddrint(dnsserverlag[counter]) *15;
if counter=id then temp := temp + lag;
- dnsserverlist.objects[counter] := tobject(temp div 16);
+ dnsserverlag[counter] := tobject(temp div 16);
end;
end;