hosts file support in the built in dns resolver
[lcore.git] / dnscore.pas
old mode 100755 (executable)
new mode 100644 (file)
index 4cb52e2..ac985e6
@@ -6,12 +6,12 @@
 {\r
 \r
   code wanting to use this dns system should act as follows (note: app\r
 {\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
 \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
 \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_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
 \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
   when a packet is received the application should put the packet in\r
   recvbuf/recvbuflen , set state.parsepacket and call state_process again\r
 \r
   when a packet is received the application should put the packet in\r
   recvbuf/recvbuflen , set state.parsepacket and call state_process again\r
 \r
-  once the app gets action_done it can determine sucess or failure in the\r
+  once the app gets action_done it can determine success or failure in the\r
   following ways.\r
 \r
   on failure state.resultstr will be an empty string and state.resultbin will\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
 \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
   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
   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
 \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
 \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
   before passing it on to other code, for example this may be done in the event\r
   of a timeout.\r
+\r
+\r
+  hosts file support:\r
+\r
+  code is here to do hosts file lookups. this is not done automatically by\r
+  dnscore, the caller (this is dnssync and dnsasync) has to call the hosts file\r
+  functions if it wants hosts file lookups.\r
+\r
+  the current implementation will automatically periodically reload the file into\r
+  a fast lookup cache if the file changed.\r
+\r
+  both forward and reverse lookups are supported.\r
+\r
+  a single IP having multiple hostnames, so "192.0.2.1 foo bar" is supported.\r
+\r
+  local hostnames under the locally configured domain (so domain "example.org",\r
+  a "192.0.2.1 foo" entry causing "foo.example.org" to resolve) is not supported.\r
 }\r
 unit dnscore;\r
 \r
 }\r
 unit dnscore;\r
 \r
@@ -62,7 +79,7 @@ interface
 \r
 uses binipstuff,classes,pgtypes,lcorernd;\r
 \r
 \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
 {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
@@ -85,7 +102,7 @@ var useaf:integer = useaf_default;
 {\r
 (temporarily) use a different nameserver, regardless of the dnsserverlist\r
 }\r
 {\r
 (temporarily) use a different nameserver, regardless of the dnsserverlist\r
 }\r
-var overridednsserver:string;\r
+var overridednsserver:ansistring;\r
 \r
 const\r
   maxnamelength=127;\r
 \r
 const\r
   maxnamelength=127;\r
@@ -106,7 +123,10 @@ const
   querytype_txt=16;\r
   querytype_spf=99;\r
   maxrecursion=50;\r
   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
 \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
@@ -125,16 +145,16 @@ type
   tdnsstate=record\r
     id:word;\r
     recursioncount:integer;\r
   tdnsstate=record\r
     id:word;\r
     recursioncount:integer;\r
-    queryname:string;\r
+    queryname:ansistring;\r
     requesttype:word;\r
     parsepacket:boolean;\r
     requesttype:word;\r
     parsepacket:boolean;\r
-    resultstr:string;\r
+    resultstr:ansistring;\r
     resultbin:tbinip;\r
     resultlist:tbiniplist;\r
     resultaction:integer;\r
     numrr1:array[0..3] of integer;\r
     numrr2:integer;\r
     resultbin:tbinip;\r
     resultlist:tbiniplist;\r
     resultaction:integer;\r
     numrr1:array[0..3] of integer;\r
     numrr2:integer;\r
-    rrdata:string;\r
+    rrdata:ansistring;\r
     sendpacketlen:integer;\r
     sendpacket:tdnspacket;\r
     recvpacketlen:integer;\r
     sendpacketlen:integer;\r
     sendpacket:tdnspacket;\r
     recvpacketlen:integer;\r
@@ -159,26 +179,26 @@ type
   end;\r
 \r
 //commenting out functions from interface that do not have documented semantics\r
   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
 \r
 //returns the DNS name used to reverse look up an IP, such as 4.3.2.1.in-addr.arpa for 1.2.3.4\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
 \r
 //returns the DNS name used to reverse look up an IP, such as 4.3.2.1.in-addr.arpa for 1.2.3.4\r
-function makereversename(const binip:tbinip):string;\r
+function makereversename(const binip:tbinip):ansistring;\r
 \r
 \r
-procedure setstate_request_init(const name:string;var state:tdnsstate);\r
+procedure setstate_request_init(const name:ansistring;var state:tdnsstate);\r
 \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
 //ipv6 results. Any other value will give only ipv4 results\r
-procedure setstate_forward(const name:string;var state:tdnsstate;family:integer);\r
+procedure setstate_forward(const name:ansistring;var state:tdnsstate;family:integer);\r
 \r
 procedure setstate_reverse(const binip:tbinip;var state:tdnsstate);\r
 procedure setstate_failure(var state:tdnsstate);\r
 //procedure setstate_return(const rrp:trrpointer;len:integer;var state:tdnsstate);\r
 \r
 //for custom raw lookups such as TXT, as desired by the user\r
 \r
 procedure setstate_reverse(const binip:tbinip;var state:tdnsstate);\r
 procedure setstate_failure(var state:tdnsstate);\r
 //procedure setstate_return(const rrp:trrpointer;len:integer;var state:tdnsstate);\r
 \r
 //for custom raw lookups such as TXT, as desired by the user\r
-procedure setstate_custom(const name:string; requesttype:integer; var state:tdnsstate);\r
+procedure setstate_custom(const name:ansistring; requesttype:integer; var state:tdnsstate);\r
 \r
 procedure state_process(var state:tdnsstate);\r
 \r
 \r
 procedure state_process(var state:tdnsstate);\r
 \r
@@ -188,14 +208,16 @@ procedure populatednsserverlist;
 procedure cleardnsservercache;\r
 \r
 var\r
 procedure cleardnsservercache;\r
 \r
 var\r
-  dnsserverlist : tstringlist;\r
+  dnsserverlist : tbiniplist;\r
+  dnsserverlag:tlist;\r
 //  currentdnsserverno : integer;\r
 \r
 \r
 //getcurrentsystemnameserver returns the nameserver the app should use and sets\r
 //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
 //  currentdnsserverno : integer;\r
 \r
 \r
 //getcurrentsystemnameserver returns the nameserver the app should use and sets\r
 //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) :string;\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
 procedure reportlag(id:integer;lag:integer); //lag should be in microseconds and should be -1 to report a timeout\r
 \r
 //var\r
@@ -204,7 +226,6 @@ procedure reportlag(id:integer;lag:integer); //lag should be in microseconds and
 \r
 \r
 {$ifdef ipv6}\r
 \r
 \r
 {$ifdef ipv6}\r
-function getv6localips:tbiniplist;\r
 procedure initpreferredmode;\r
 \r
 var\r
 procedure initpreferredmode;\r
 \r
 var\r
@@ -213,22 +234,474 @@ var
 {$endif}\r
 \r
 var\r
 {$endif}\r
 \r
 var\r
-  failurereason:string;\r
+  failurereason:ansistring;\r
 \r
 \r
-function getquerytype(s:string):integer;\r
+function getquerytype(s:ansistring):integer;\r
+\r
+//optionally do any time consuming initing in advance, in case one wants the first dns lookup to be as fast as possible\r
+procedure dnscore_preinit(alsoreverse:boolean);\r
+\r
+var\r
+  hostsfile_inited:boolean;\r
+  hostsfile_reverseinited:boolean;\r
+  hostsfile_filename:ansistring;  //the app can change this, to use a custom hosts file\r
+  hostsfile_entries:tstringlist;\r
+  hostsfile_lastfileage:longint;  //fileage is longint on freepascal, integer on delphi\r
+  hostsfile_lastcheckts:integer;\r
+  hostsfile_reverseentries:tstringlist;\r
+\r
+  //parameter settings\r
+  hostsfile_disabled:boolean;  //the app can set this to disable all hosts file lookup functionality, including localhost\r
+  hostsfile_onlylocalhost:boolean;  //the app can set this to disable the hosts file but keep localhost\r
+  hostsfile_alsocustomserver:boolean;  //the app can set this to use hosts file functionality even when a custom nameserver is set\r
+  hostsfile_manualreload:boolean;           //don't check if the hosts file changed and auto reload it, the app can call hostsfile_reload to reload\r
+\r
+procedure hostsfile_init;\r
+procedure hostsfile_initreverse;\r
+procedure hostsfile_reload;\r
+procedure hostsfile_reloadifneeded;\r
+procedure hostsfile_add(const name:ansistring;const ip:tbinip);\r
+function hostsfile_forwardlookuplist(const name:ansistring):tbiniplist;\r
+function hostsfile_reverselookup(ip:tbinip):ansistring;\r
+function gethostsfilename:ansistring;\r
 \r
 implementation\r
 \r
 uses\r
 \r
 implementation\r
 \r
 uses\r
-  {$ifdef win32}\r
-    windows,\r
+  {$ifdef mswindows}windows,{$endif}\r
+  {$ifdef unix}unix,{$endif}  \r
+  lcorelocalips,\r
+  readtxt2,\r
+  ltimevalstuff,\r
+  sysutils;\r
+\r
+type\r
+  pbiniplist=^tbiniplist;\r
+  thostsfile_entry=record\r
+    l:tbiniplist;\r
+  end;\r
+  phostsfile_entry=^thostsfile_entry;\r
+\r
+  thostsfile_reverseentry=record\r
+    name:ansistring;\r
+  end;\r
+  phostsfile_reverseentry=^thostsfile_reverseentry;\r
+\r
+\r
+function hostsfile_findbyname(const name:ansistring):integer;\r
+begin\r
+  if not hostsfile_entries.Find(name,result) then begin\r
+    if (copy(name,length(name),1) = '.') then begin\r
+      //if the name has a trailing dot, try to find without it\r
+      if not hostsfile_entries.Find(copy(name,1,length(name)-1),result) then result := -1;\r
+    end else begin\r
+      //if the name has no trailing dot, try to find with it\r
+      if not hostsfile_entries.Find(name + '.',result) then result := -1;\r
+    end;\r
+  end;\r
+end;\r
+\r
+\r
+function hostsfile_forwardlookuplist(const name:ansistring):tbiniplist;\r
+var\r
+  index:integer;\r
+  l:tbiniplist;\r
+begin\r
+  hostsfile_init;\r
+  index := hostsfile_findbyname(name);\r
+\r
+  result := biniplist_new;\r
+\r
+  if (index >= 0) then begin\r
+    l := phostsfile_entry(hostsfile_entries.objects[index]).l;\r
+\r
+    {$ifdef ipv6}\r
+    if (useaf <> useaf_v6) and (useaf <> useaf_preferv6) then\r
+    {$endif}\r
+    begin\r
+      addipsoffamily(result,l,af_inet);\r
+    end;\r
+    {$ifdef ipv6}\r
+    if (useaf <> useaf_v4) then begin\r
+      addipsoffamily(result,l,af_inet6);\r
+      if (useaf = useaf_preferv6) then begin\r
+        addipsoffamily(result,l,af_inet);\r
+      end;\r
+    end;\r
+    {$endif}\r
+  end;\r
+end;\r
+\r
+procedure hostsfile_clearreverse;\r
+var\r
+  index:integer;\r
+begin\r
+  for index := hostsfile_reverseentries.count-1 downto 0 do begin\r
+    phostsfile_reverseentry(hostsfile_reverseentries.objects[index]).name := '';\r
+    dispose(phostsfile_reverseentry(hostsfile_reverseentries.objects[index]));\r
+  end;\r
+  hostsfile_reverseentries.clear;\r
+end;\r
+\r
+\r
+procedure hostsfile_initreverse;\r
+var\r
+  index,index2:integer;\r
+  l:tbiniplist;\r
+  a,countbefore:integer;\r
+  ip:tbinip;\r
+  s:ansistring;\r
+  he:phostsfile_reverseentry;\r
+begin\r
+  hostsfile_init;\r
+  if hostsfile_reverseinited then exit;\r
+  hostsfile_reverseinited := true;\r
+\r
+  hostsfile_clearreverse;\r
+\r
+  //build fast search table for reverse lookups\r
+  for index := hostsfile_entries.count-1 downto 0 do begin\r
+    l := phostsfile_entry(hostsfile_entries.objects[index]).l;\r
+    for a := biniplist_getcount(l)-1 downto 0 do begin\r
+      ip := biniplist_get(l,a);\r
+      s := ipbintostr(ip);\r
+\r
+      countbefore := hostsfile_reverseentries.count;\r
+      index2 := hostsfile_reverseentries.Add(s);\r
+      if (hostsfile_reverseentries.count > countbefore) then begin\r
+        new(he);\r
+        hostsfile_reverseentries.objects[index2] := tobject(he);\r
+        he.name := hostsfile_entries[index];\r
+      end;\r
+\r
+    end;\r
+  end;\r
+end;\r
+\r
+function hostsfile_reverselookup(ip:tbinip):ansistring;\r
+var\r
+  index:integer;\r
+  s:ansistring;\r
+begin\r
+  hostsfile_initreverse;\r
+  result := '';\r
+  s := ipbintostr(ip);\r
+\r
+  if hostsfile_reverseentries.find(s,index) then begin\r
+    result := phostsfile_reverseentry(hostsfile_reverseentries.objects[index]).name;\r
+  end;\r
+end;\r
+\r
+procedure hostsfile_clear;\r
+var\r
+  index:integer;\r
+begin\r
+  for index := hostsfile_entries.count-1 downto 0 do begin\r
+    biniplist_free(phostsfile_entry(hostsfile_entries.objects[index]).l);\r
+    dispose(phostsfile_entry(hostsfile_entries.objects[index]));\r
+  end;\r
+  hostsfile_entries.clear;\r
+\r
+  hostsfile_clearreverse;\r
+\r
+  hostsfile_lastfileage := 0;\r
+  hostsfile_lastcheckts := 0;\r
+end;\r
+\r
+procedure hostsfile_add(const name:ansistring;const ip:tbinip);\r
+var\r
+\r
+  a,index,countbefore:integer;\r
+\r
+  ip2:tbinip;\r
+  he:phostsfile_entry;\r
+  l:tbiniplist;\r
+begin\r
+\r
+  countbefore := hostsfile_entries.count;\r
+  //add, with dupignore, will add it if it's not in the list. if it is in the list, it returns the index\r
+  //to know if it was added, see if the count went up. this saves on duplicate searches in the list, for speed\r
+  index := hostsfile_entries.add(name);\r
+\r
+  if (hostsfile_entries.count > countbefore) then begin\r
+   // writeln('name newly added ',name,' ',ipbintostr(ip),' ',index);\r
+\r
+    new(he);\r
+    hostsfile_entries.objects[index] := tobject(he);\r
+    he.l := biniplist_new;\r
+    //he.name := name;\r
+  end else begin\r
+   // writeln('name found ',name,' ',ipbintostr(ip),' ',index);\r
+    //search for IP match\r
+\r
+    he := phostsfile_entry(hostsfile_entries.objects[index]);\r
+    l := he.l;\r
+    for a := biniplist_getcount(l)-1 downto 0 do begin\r
+      ip2 := biniplist_get(l,a);\r
+      if comparebinip(ip,ip2) then begin\r
+      //  writeln('duplicate ip ',name,' ',ipbintostr(ip));\r
+        exit; //duplicate\r
+      end;\r
+    end;\r
+  end;\r
+  //add it\r
+  biniplist_add(he.l,ip);\r
+end;\r
+\r
+\r
+function getts:integer;\r
+{$ifdef mswindows}\r
+begin\r
+  result := GetTickCount;\r
+{$else}\r
+var\r
+  temp:ttimeval;\r
+begin\r
+  gettimemonotonic(temp);\r
+  result := ((temp.tv_usec div 1000) + (temp.tv_sec * 1000));\r
+{$endif}\r
+end;\r
+\r
+\r
+function gethostsfilename:ansistring;\r
+var\r
+{$ifdef mswindows}\r
+  windir:array [0..255] of ansichar;\r
+\r
+  GetSystemWindowsDirectoryA:function(buffer:pansichar;size:integer):integer; stdcall;\r
+  dllhandle:thandle;\r
+  OsVersion                  : TOSVersionInfo;\r
+{$endif}\r
+  filenamesuffix:ansistring;\r
+begin\r
+    {$ifdef mswindows}\r
+\r
+    ZeroMemory(@OsVersion, SizeOf(OsVersion));\r
+    OsVersion.dwOSVersionInfoSize := SizeOf(TOSVERSIONINFO);\r
+\r
+    if ((GetVersionEx(OsVersion)) and (OsVersion.dwPlatformId = VER_PLATFORM_WIN32_NT)) then begin\r
+      filenamesuffix := '\system32\drivers\etc\hosts';\r
+    end else begin\r
+      filenamesuffix := '\hosts';\r
+    end;\r
+\r
+    //first try "user" windows directory. on a multiuser this may not be c:\windows\r
+    GetWindowsDirectoryA(windir,255);\r
+    result := windir;\r
+    if (copy(result,length(result),1) = '\') then result := copy(result,1,length(result)-1);\r
+    result := result + filenamesuffix;\r
+\r
+    if not fileexists(result) then begin\r
+      //then try "system" windows directory which is typically c:\windows on a multiuser system\r
+      dllhandle := loadlibrary('kernel32.dll');\r
+      if (dllhandle <> 0) then begin\r
+        GetSystemWindowsDirectoryA := getprocaddress(dllhandle,'GetSystemWindowsDirectoryA');\r
+        if assigned(GetSystemWindowsDirectoryA) then begin\r
+          GetSystemWindowsDirectoryA(windir,255);\r
+          freelibrary(dllhandle);\r
+          result := windir;\r
+          if (copy(result,length(result),1) = '\') then result := copy(result,1,length(result)-1);\r
+          result := result + filenamesuffix;\r
+        end;\r
+      end;\r
+    end;\r
+\r
+    {$else}\r
+    result := '/etc/hosts';\r
+    {$endif}\r
+end;\r
+\r
+procedure hostsfile_reload;\r
+label lineend;\r
+var\r
+  t:treadtxt;\r
+\r
+  validchar:array[0..255] of boolean;\r
+  ipv4char:array[0..255] of boolean;\r
+  s:ansistring;\r
+  ch:ansichar;\r
+  a,len,field,startindex,labellen:integer;\r
+  lastwasspace,onlyipv4chars:boolean;\r
+  ipstring,hostname:ansistring;\r
+  biniptemp:tbinip;\r
+begin\r
+  hostsfile_clear;\r
+\r
+  if hostsfile_disabled then exit;\r
+  hostsfile_reverseinited := false;\r
+\r
+  //add builtin entries\r
+  hostsfile_add('localhost',ipstrtobinf('127.0.0.1'));\r
+  {$ifdef ipv6}\r
+  hostsfile_add('localhost',ipstrtobinf('::1'));\r
   {$endif}\r
 \r
   {$endif}\r
 \r
-  sysutils;\r
+  if hostsfile_onlylocalhost then exit;\r
+\r
+  if (hostsfile_filename = '') then hostsfile_filename := gethostsfilename;\r
+\r
+  //DNS names can only contain lower and uppercase, digits, dash, and dot\r
+  fillchar(validchar,sizeof(validchar),0);\r
+  validchar[ord('.')] := true;\r
+  validchar[ord('-')] := true;\r
+  fillchar(validchar[48],10,1);\r
+  fillchar(validchar[65],26,1);\r
+  fillchar(validchar[97],26,1);\r
+\r
+  //chars that can be in an ipv4 address: digits and dot\r
+  fillchar(ipv4char,sizeof(ipv4char),0);\r
+  ipv4char[ord('.')] := true;\r
+  fillchar(ipv4char[48],10,1);\r
+\r
+  hostsfile_lastfileage := fileage(hostsfile_filename);\r
+  hostsfile_lastcheckts := getts;\r
+  //writeln('------ reloading ',hostsfile_lastfileage);\r
+  try\r
+    t := treadtxt.createf(hostsfile_filename);\r
+  except\r
+    exit;\r
+  end;\r
+  if not assigned(t) then exit;\r
+\r
+  while not t.eof do begin\r
+    s := t.readline;\r
+\r
+    len := length(s);\r
+    if (len > 512) then goto lineend; //sanity check\r
+    field := -1;\r
+    lastwasspace := true;\r
+\r
+    onlyipv4chars := true;\r
+\r
+    //one extra loop iteration at the end with a "pretend space" for easy parsing\r
+    inc(len);\r
+    ipstring := '';\r
+    hostname := '';\r
+    a := 0;\r
+    while (a <= len) do begin\r
+      inc(a);\r
+      if (a >= len) then ch := ' ' else ch := s[a];\r
+\r
+      if (ch = '#') then begin\r
+        //pretend the start of a comment is a space and the end of the line\r
+        ch := ' ';\r
+        len := a;\r
+      end;\r
+\r
+      if (ch = #9) or (ch = ' ') then begin\r
+        if not (lastwasspace) then begin\r
+          if (field = 0) then begin\r
+            ipstring := copy(s,startindex,a - startindex);\r
+          end else if (field >= 1) then begin\r
+            //maximum length of hostname\r
+            if (a - startindex) > 253 then goto lineend;\r
+\r
+            //remove a trailing dot\r
+            //if (labellen = 0) then dec(a);\r
+\r
+            //hostname must not be an empty string\r
+            if (a - startindex) < 1 then goto lineend;\r
+\r
+            hostname := copy(s,startindex,a - startindex);\r
+\r
+            //reject a hosts entry with a name that is a valid ipv4 address.\r
+            //we don't need to check for ipv6 addresses because they have a colon and so aren't valid hostsnames\r
+            //the windows resolver does allow it, but i think it has potential security issues\r
+            if onlyipv4chars then if ipstrtobin(hostname,biniptemp) then goto lineend;\r
+\r
+            if ipstrtobin(ipstring,biniptemp) then begin\r
+              //writeln('!!!hosts file adding ip=',ipstring,'@host=',hostname,'@');\r
+\r
+              hostsfile_add(hostname,biniptemp);\r
+            end;\r
+\r
+            //break scan loop\r
+            //a := len;\r
+          end;\r
+\r
+        end;\r
 \r
 \r
+        lastwasspace := true;\r
+      end else begin\r
+        if lastwasspace then begin\r
+          inc(field);\r
+          startindex := a;\r
+          lastwasspace := false;\r
+          labellen := 0;\r
+        end;\r
+        //enforce valid characters in hostname\r
+        if (field = 1) then begin\r
+          if not validchar[ord(ch)] then goto lineend;\r
+          onlyipv4chars := onlyipv4chars and ipv4char[ord(ch)];\r
+          if (ch = '.') then begin\r
+            if (labellen = 0) then goto lineend;\r
+            labellen := 0;\r
+          end else begin\r
+            inc(labellen);\r
+            if (labellen > 63) then goto lineend;\r
+          end;\r
+        end;\r
+      end;\r
+    end;\r
+lineend:\r
+  end;\r
+  t.destroy;\r
+\r
+end;\r
+\r
+\r
+procedure hostsfile_reloadifneeded;\r
+var\r
+  ts:integer;\r
+begin\r
+  if (hostsfile_disabled or hostsfile_onlylocalhost or hostsfile_manualreload) then exit;\r
+  if hostsfile_filename = '' then exit;\r
+\r
+  ts := getts;\r
+  //writeln('reloadifneeded ts=',ts,' oldts=',hostsfile_lastcheckts);\r
+  if not ((ts > hostsfile_lastcheckts + 10000) or (ts < hostsfile_lastcheckts)) then exit;\r
+\r
+  hostsfile_lastcheckts := ts;\r
+\r
+  //writeln('reloadifneeded new=',fileage(hostsfile_filename),' old=',hostsfile_lastfileage);\r
+  if fileage(hostsfile_filename) = hostsfile_lastfileage then exit;\r
+  hostsfile_reload;\r
+end;\r
+\r
+procedure hostsfile_init;\r
+begin\r
+  //writeln('init ',hostsfile_inited);\r
+  if hostsfile_inited then begin\r
+    hostsfile_reloadifneeded;\r
+    exit;\r
+  end;\r
+  hostsfile_inited := true;\r
+  hostsfile_entries := tstringlist.create;\r
+  hostsfile_entries.casesensitive := false;\r
+  hostsfile_entries.sorted := true;\r
+  hostsfile_entries.duplicates := dupignore;\r
+\r
+  hostsfile_reverseentries := tstringlist.create;\r
+  hostsfile_reverseentries.casesensitive := true;\r
+  hostsfile_reverseentries.sorted := true;\r
+  hostsfile_reverseentries.duplicates := dupignore;\r
+\r
+  hostsfile_reload;\r
+end;\r
+\r
+procedure dnscore_preinit(alsoreverse:boolean);\r
+begin\r
+  {$ifdef ipv6}\r
+  initpreferredmode;\r
+  {$endif}\r
+  hostsfile_init;\r
+  populatednsserverlist;\r
+  randomdword;\r
+  if alsoreverse then hostsfile_initreverse;\r
+end;\r
 \r
 \r
 \r
 \r
-function getquerytype(s:string):integer;\r
+function getquerytype(s:ansistring):integer;\r
 begin\r
   s := uppercase(s);\r
   result := 0;\r
 begin\r
   s := uppercase(s);\r
   result := 0;\r
@@ -244,10 +717,10 @@ begin
   if (s = 'SPF') then result := querytype_spf;\r
 end;\r
 \r
   if (s = 'SPF') then result := querytype_spf;\r
 end;\r
 \r
-function buildrequest(const name:string;var packet:tdnspacket;requesttype:word):integer;\r
+function buildrequest(const name:ansistring;var packet:tdnspacket;requesttype:word):integer;\r
 var\r
   a,b:integer;\r
 var\r
   a,b:integer;\r
-  s:string;\r
+  s:ansistring;\r
   arr:array[0..sizeof(packet)-1] of byte absolute packet;\r
 begin\r
  { writeln('buildrequest: name: ',name);}\r
   arr:array[0..sizeof(packet)-1] of byte absolute packet;\r
 begin\r
  { writeln('buildrequest: name: ',name);}\r
@@ -289,9 +762,9 @@ begin
   arr[result-4] := requesttype shr 8;\r
 end;\r
 \r
   arr[result-4] := requesttype shr 8;\r
 end;\r
 \r
-function makereversename(const binip:tbinip):string;\r
+function makereversename(const binip:tbinip):ansistring;\r
 var\r
 var\r
-  name:string;\r
+  name:ansistring;\r
   a,b:integer;\r
 begin\r
   name := '';\r
   a,b:integer;\r
 begin\r
   name := '';\r
@@ -323,10 +796,10 @@ doesnt read beyond len.
 empty result + non null failurereason: failure\r
 empty result + null failurereason: internal use\r
 }\r
 empty result + non null failurereason: failure\r
 empty result + null failurereason: internal use\r
 }\r
-function decodename(const packet:tdnspacket;len,start,recursion:integer;var numread:integer):string;\r
+function decodename(const packet:tdnspacket;len,start,recursion:integer;var numread:integer):ansistring;\r
 var\r
   arr:array[0..sizeof(packet)-1] of byte absolute packet;\r
 var\r
   arr:array[0..sizeof(packet)-1] of byte absolute packet;\r
-  s:string;\r
+  s:ansistring;\r
   a,b:integer;\r
 begin\r
   numread := 0;\r
   a,b:integer;\r
 begin\r
   numread := 0;\r
@@ -367,7 +840,7 @@ begin
           failurereason := 'decoding name: got out of range2';\r
           exit;\r
         end;\r
           failurereason := 'decoding name: got out of range2';\r
           exit;\r
         end;\r
-        result := result + char(arr[a]);\r
+        result := result + ansichar(arr[a]);\r
       end;\r
       inc(numread,b+1);\r
 \r
       end;\r
       inc(numread,b+1);\r
 \r
@@ -385,7 +858,7 @@ end;
 \r
 {==============================================================================}\r
 \r
 \r
 {==============================================================================}\r
 \r
-function getrawfromrr(const rrp:trrpointer;len:integer):string;\r
+function getrawfromrr(const rrp:trrpointer;len:integer):ansistring;\r
 begin\r
   setlength(result,htons(trr(rrp.p^).datalen));\r
   uniquestring(result);\r
 begin\r
   setlength(result,htons(trr(rrp.p^).datalen));\r
   uniquestring(result);\r
@@ -441,7 +914,7 @@ begin
   end;\r
 end;\r
 \r
   end;\r
 end;\r
 \r
-procedure setstate_request_init(const name:string;var state:tdnsstate);\r
+procedure setstate_request_init(const name:ansistring;var state:tdnsstate);\r
 begin\r
   {destroy things properly}\r
   state.resultstr := '';\r
 begin\r
   {destroy things properly}\r
   state.resultstr := '';\r
@@ -452,7 +925,7 @@ begin
   state.parsepacket := false;\r
 end;\r
 \r
   state.parsepacket := false;\r
 end;\r
 \r
-procedure setstate_forward(const name:string;var state:tdnsstate;family:integer);\r
+procedure setstate_forward(const name:ansistring;var state:tdnsstate;family:integer);\r
 begin\r
   setstate_request_init(name,state);\r
   state.forwardfamily := family;\r
 begin\r
   setstate_request_init(name,state);\r
   state.forwardfamily := family;\r
@@ -468,7 +941,7 @@ begin
   state.requesttype := querytype_ptr;\r
 end;\r
 \r
   state.requesttype := querytype_ptr;\r
 end;\r
 \r
-procedure setstate_custom(const name:string; requesttype:integer; var state:tdnsstate);\r
+procedure setstate_custom(const name:ansistring; requesttype:integer; var state:tdnsstate);\r
 begin\r
   setstate_request_init(name,state);\r
   state.requesttype := requesttype;\r
 begin\r
   setstate_request_init(name,state);\r
   state.requesttype := requesttype;\r
@@ -504,7 +977,10 @@ begin
     state.numrr2 := 0;\r
     for a := 0 to 3 do begin\r
       state.numrr1[a] := htons(state.recvpacket.rrcount[a]);\r
     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
       inc(state.numrr2,state.numrr1[a]);\r
     end;\r
 \r
@@ -593,7 +1069,6 @@ recursed:
     goto failure;\r
   end;\r
 \r
     goto failure;\r
   end;\r
 \r
-  {do /ets/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
   state.sendpacketlen := buildrequest(state.queryname,state.sendpacket,state.requesttype);\r
   if state.sendpacketlen = 0 then begin\r
     failurereason := 'building request packet failed';\r
@@ -606,132 +1081,59 @@ recursed:
 failure:\r
   setstate_failure(state);\r
 end;\r
 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 char;\r
-      ipmask    : array[0..15] of char;\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 char;\r
-       DomainName       : array[0..MAX_DOMAIN_NAME_LEN-1] of char;\r
-       currentdnsserver : pip_addr_string;\r
-       dnsserverlist    : tip_addr_string;\r
-       nodetype         : longint;\r
-       ScopeId          : array[0..MAX_SCOPE_ID_LEN + 4] of char;\r
-       enablerouting    : longbool;\r
-       enableproxy      : longbool;\r
-       enabledns        : longbool;\r
-    end;\r
-    pFIXED_INFO=^tFIXED_INFO;\r
 \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
 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:string;\r
-    a:integer;\r
-  {$endif}\r
+  a:integer;\r
 begin\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
   end else begin\r
-    dnsserverlist := tstringlist.Create;\r
+    dnsserverlag := tlist.Create;\r
   end;\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
 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
   end;\r
 end;\r
 \r
-function getcurrentsystemnameserver(var id:integer):string;\r
+function getcurrentsystemnameserverbin(var id:integer):tbinip;\r
 var\r
   counter : integer;\r
 var\r
   counter : integer;\r
-\r
 begin\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
 \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
     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
 end;\r
 \r
 procedure reportlag(id:integer;lag:integer); //lag should be in microseconds and should be -1 to report a timeout\r
@@ -739,80 +1141,30 @@ var
   counter : integer;\r
   temp : integer;\r
 begin\r
   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
   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
     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
 \r
 \r
   end;\r
 \r
 end;\r
 \r
 \r
-\r
 {$ifdef ipv6}\r
 \r
 {$ifdef ipv6}\r
 \r
-{$ifdef linux}\r
-function getv6localips:tbiniplist;\r
-var\r
-  t:textfile;\r
-  s,s2:string;\r
-  ip:tbinip;\r
-  a:integer;\r
-begin\r
-  result := biniplist_new;\r
-\r
-  assignfile(t,'/proc/net/if_inet6');\r
-  {$i-}reset(t);{$i+}\r
-  if ioresult <> 0 then exit; {none found, return empty list}\r
-\r
-  while not eof(t) do begin\r
-    readln(t,s);\r
-    s2 := '';\r
-    for a := 0 to 7 do begin\r
-      if (s2 <> '') then s2 := s2 + ':';\r
-      s2 := s2 + copy(s,(a shl 2)+1,4);\r
-    end;\r
-    ipstrtobin(s2,ip);\r
-    if ip.family <> 0 then biniplist_add(result,ip);\r
-  end;\r
-  closefile(t);\r
-end;\r
-\r
-{$else}\r
-function getv6localips:tbiniplist;\r
-begin\r
-  result := biniplist_new;\r
-end;\r
-{$endif}\r
-\r
 procedure initpreferredmode;\r
 procedure initpreferredmode;\r
-var\r
-  l:tbiniplist;\r
-  a:integer;\r
-  ip:tbinip;\r
-  ipmask_global,ipmask_6to4,ipmask_teredo:tbinip;\r
-\r
 begin\r
   if preferredmodeinited then exit;\r
   if useaf <> useaf_default then exit;\r
 begin\r
   if preferredmodeinited then exit;\r
   if useaf <> useaf_default then exit;\r
-  l := getv6localips;\r
-  if biniplist_getcount(l) = 0 then exit;\r
-  useaf := useaf_preferv4;\r
-  ipstrtobin('2000::',ipmask_global);\r
-  ipstrtobin('2001::',ipmask_teredo);\r
-  ipstrtobin('2002::',ipmask_6to4);\r
-  {if there is any v6 IP which is globally routable and not 6to4 and not teredo, prefer v6}\r
-  for a := biniplist_getcount(l)-1 downto 0 do begin\r
-    ip := biniplist_get(l,a);\r
-    if not comparebinipmask(ip,ipmask_global,3) then continue;\r
-    if comparebinipmask(ip,ipmask_teredo,32) then continue;\r
-    if comparebinipmask(ip,ipmask_6to4,16) then continue;\r
-    useaf := useaf_preferv6;\r
-    preferredmodeinited := true;\r
-    exit;\r
-  end;\r
+\r
+  if (have_ipv6_connectivity) then\r
+    useaf := useaf_preferv6\r
+  else\r
+    useaf := useaf_preferv4;\r
+\r
+  preferredmodeinited := true;\r
 end;\r
 \r
 {$endif}\r
 end;\r
 \r
 {$endif}\r