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