X-Git-Url: http://www.lcore.org/git/lcore.git/blobdiff_plain/eaa75975b23ce60360526c08628f2b0651c95167..560d0547386a23a8fb79d1919d60dfdd04b49f62:/dnscore.pas

diff --git a/dnscore.pas b/dnscore.pas
index fa9eee2..ac985e6 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,25 +32,42 @@
   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.
+
+
+  hosts file support:
+
+  code is here to do hosts file lookups. this is not done automatically by
+  dnscore, the caller (this is dnssync and dnsasync) has to call the hosts file
+  functions if it wants hosts file lookups.
+
+  the current implementation will automatically periodically reload the file into
+  a fast lookup cache if the file changed.
+
+  both forward and reverse lookups are supported.
+
+  a single IP having multiple hostnames, so "192.0.2.1 foo bar" is supported.
+
+  local hostnames under the locally configured domain (so domain "example.org",
+  a "192.0.2.1 foo" entry causing "foo.example.org" to resolve) is not supported.
 }
 unit dnscore;
 
@@ -62,7 +79,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 +123,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 +179,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 +189,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);
 
@@ -218,12 +238,467 @@ var
 
 function getquerytype(s:ansistring):integer;
 
+//optionally do any time consuming initing in advance, in case one wants the first dns lookup to be as fast as possible
+procedure dnscore_preinit(alsoreverse:boolean);
+
+var
+  hostsfile_inited:boolean;
+  hostsfile_reverseinited:boolean;
+  hostsfile_filename:ansistring;  //the app can change this, to use a custom hosts file
+  hostsfile_entries:tstringlist;
+  hostsfile_lastfileage:longint;  //fileage is longint on freepascal, integer on delphi
+  hostsfile_lastcheckts:integer;
+  hostsfile_reverseentries:tstringlist;
+
+  //parameter settings
+  hostsfile_disabled:boolean;  //the app can set this to disable all hosts file lookup functionality, including localhost
+  hostsfile_onlylocalhost:boolean;  //the app can set this to disable the hosts file but keep localhost
+  hostsfile_alsocustomserver:boolean;  //the app can set this to use hosts file functionality even when a custom nameserver is set
+  hostsfile_manualreload:boolean;           //don't check if the hosts file changed and auto reload it, the app can call hostsfile_reload to reload
+
+procedure hostsfile_init;
+procedure hostsfile_initreverse;
+procedure hostsfile_reload;
+procedure hostsfile_reloadifneeded;
+procedure hostsfile_add(const name:ansistring;const ip:tbinip);
+function hostsfile_forwardlookuplist(const name:ansistring):tbiniplist;
+function hostsfile_reverselookup(ip:tbinip):ansistring;
+function gethostsfilename:ansistring;
+
 implementation
 
 uses
+  {$ifdef mswindows}windows,{$endif}
+  {$ifdef unix}unix,{$endif}  
   lcorelocalips,
+  readtxt2,
+  ltimevalstuff,
   sysutils;
 
+type
+  pbiniplist=^tbiniplist;
+  thostsfile_entry=record
+    l:tbiniplist;
+  end;
+  phostsfile_entry=^thostsfile_entry;
+
+  thostsfile_reverseentry=record
+    name:ansistring;
+  end;
+  phostsfile_reverseentry=^thostsfile_reverseentry;
+
+
+function hostsfile_findbyname(const name:ansistring):integer;
+begin
+  if not hostsfile_entries.Find(name,result) then begin
+    if (copy(name,length(name),1) = '.') then begin
+      //if the name has a trailing dot, try to find without it
+      if not hostsfile_entries.Find(copy(name,1,length(name)-1),result) then result := -1;
+    end else begin
+      //if the name has no trailing dot, try to find with it
+      if not hostsfile_entries.Find(name + '.',result) then result := -1;
+    end;
+  end;
+end;
+
+
+function hostsfile_forwardlookuplist(const name:ansistring):tbiniplist;
+var
+  index:integer;
+  l:tbiniplist;
+begin
+  hostsfile_init;
+  index := hostsfile_findbyname(name);
+
+  result := biniplist_new;
+
+  if (index >= 0) then begin
+    l := phostsfile_entry(hostsfile_entries.objects[index]).l;
+
+    {$ifdef ipv6}
+    if (useaf <> useaf_v6) and (useaf <> useaf_preferv6) then
+    {$endif}
+    begin
+      addipsoffamily(result,l,af_inet);
+    end;
+    {$ifdef ipv6}
+    if (useaf <> useaf_v4) then begin
+      addipsoffamily(result,l,af_inet6);
+      if (useaf = useaf_preferv6) then begin
+        addipsoffamily(result,l,af_inet);
+      end;
+    end;
+    {$endif}
+  end;
+end;
+
+procedure hostsfile_clearreverse;
+var
+  index:integer;
+begin
+  for index := hostsfile_reverseentries.count-1 downto 0 do begin
+    phostsfile_reverseentry(hostsfile_reverseentries.objects[index]).name := '';
+    dispose(phostsfile_reverseentry(hostsfile_reverseentries.objects[index]));
+  end;
+  hostsfile_reverseentries.clear;
+end;
+
+
+procedure hostsfile_initreverse;
+var
+  index,index2:integer;
+  l:tbiniplist;
+  a,countbefore:integer;
+  ip:tbinip;
+  s:ansistring;
+  he:phostsfile_reverseentry;
+begin
+  hostsfile_init;
+  if hostsfile_reverseinited then exit;
+  hostsfile_reverseinited := true;
+
+  hostsfile_clearreverse;
+
+  //build fast search table for reverse lookups
+  for index := hostsfile_entries.count-1 downto 0 do begin
+    l := phostsfile_entry(hostsfile_entries.objects[index]).l;
+    for a := biniplist_getcount(l)-1 downto 0 do begin
+      ip := biniplist_get(l,a);
+      s := ipbintostr(ip);
+
+      countbefore := hostsfile_reverseentries.count;
+      index2 := hostsfile_reverseentries.Add(s);
+      if (hostsfile_reverseentries.count > countbefore) then begin
+        new(he);
+        hostsfile_reverseentries.objects[index2] := tobject(he);
+        he.name := hostsfile_entries[index];
+      end;
+
+    end;
+  end;
+end;
+
+function hostsfile_reverselookup(ip:tbinip):ansistring;
+var
+  index:integer;
+  s:ansistring;
+begin
+  hostsfile_initreverse;
+  result := '';
+  s := ipbintostr(ip);
+
+  if hostsfile_reverseentries.find(s,index) then begin
+    result := phostsfile_reverseentry(hostsfile_reverseentries.objects[index]).name;
+  end;
+end;
+
+procedure hostsfile_clear;
+var
+  index:integer;
+begin
+  for index := hostsfile_entries.count-1 downto 0 do begin
+    biniplist_free(phostsfile_entry(hostsfile_entries.objects[index]).l);
+    dispose(phostsfile_entry(hostsfile_entries.objects[index]));
+  end;
+  hostsfile_entries.clear;
+
+  hostsfile_clearreverse;
+
+  hostsfile_lastfileage := 0;
+  hostsfile_lastcheckts := 0;
+end;
+
+procedure hostsfile_add(const name:ansistring;const ip:tbinip);
+var
+
+  a,index,countbefore:integer;
+
+  ip2:tbinip;
+  he:phostsfile_entry;
+  l:tbiniplist;
+begin
+
+  countbefore := hostsfile_entries.count;
+  //add, with dupignore, will add it if it's not in the list. if it is in the list, it returns the index
+  //to know if it was added, see if the count went up. this saves on duplicate searches in the list, for speed
+  index := hostsfile_entries.add(name);
+
+  if (hostsfile_entries.count > countbefore) then begin
+   // writeln('name newly added ',name,' ',ipbintostr(ip),' ',index);
+
+    new(he);
+    hostsfile_entries.objects[index] := tobject(he);
+    he.l := biniplist_new;
+    //he.name := name;
+  end else begin
+   // writeln('name found ',name,' ',ipbintostr(ip),' ',index);
+    //search for IP match
+
+    he := phostsfile_entry(hostsfile_entries.objects[index]);
+    l := he.l;
+    for a := biniplist_getcount(l)-1 downto 0 do begin
+      ip2 := biniplist_get(l,a);
+      if comparebinip(ip,ip2) then begin
+      //  writeln('duplicate ip ',name,' ',ipbintostr(ip));
+        exit; //duplicate
+      end;
+    end;
+  end;
+  //add it
+  biniplist_add(he.l,ip);
+end;
+
+
+function getts:integer;
+{$ifdef mswindows}
+begin
+  result := GetTickCount;
+{$else}
+var
+  temp:ttimeval;
+begin
+  gettimemonotonic(temp);
+  result := ((temp.tv_usec div 1000) + (temp.tv_sec * 1000));
+{$endif}
+end;
+
+
+function gethostsfilename:ansistring;
+var
+{$ifdef mswindows}
+  windir:array [0..255] of ansichar;
+
+  GetSystemWindowsDirectoryA:function(buffer:pansichar;size:integer):integer; stdcall;
+  dllhandle:thandle;
+  OsVersion                  : TOSVersionInfo;
+{$endif}
+  filenamesuffix:ansistring;
+begin
+    {$ifdef mswindows}
+
+    ZeroMemory(@OsVersion, SizeOf(OsVersion));
+    OsVersion.dwOSVersionInfoSize := SizeOf(TOSVERSIONINFO);
+
+    if ((GetVersionEx(OsVersion)) and (OsVersion.dwPlatformId = VER_PLATFORM_WIN32_NT)) then begin
+      filenamesuffix := '\system32\drivers\etc\hosts';
+    end else begin
+      filenamesuffix := '\hosts';
+    end;
+
+    //first try "user" windows directory. on a multiuser this may not be c:\windows
+    GetWindowsDirectoryA(windir,255);
+    result := windir;
+    if (copy(result,length(result),1) = '\') then result := copy(result,1,length(result)-1);
+    result := result + filenamesuffix;
+
+    if not fileexists(result) then begin
+      //then try "system" windows directory which is typically c:\windows on a multiuser system
+      dllhandle := loadlibrary('kernel32.dll');
+      if (dllhandle <> 0) then begin
+        GetSystemWindowsDirectoryA := getprocaddress(dllhandle,'GetSystemWindowsDirectoryA');
+        if assigned(GetSystemWindowsDirectoryA) then begin
+          GetSystemWindowsDirectoryA(windir,255);
+          freelibrary(dllhandle);
+          result := windir;
+          if (copy(result,length(result),1) = '\') then result := copy(result,1,length(result)-1);
+          result := result + filenamesuffix;
+        end;
+      end;
+    end;
+
+    {$else}
+    result := '/etc/hosts';
+    {$endif}
+end;
+
+procedure hostsfile_reload;
+label lineend;
+var
+  t:treadtxt;
+
+  validchar:array[0..255] of boolean;
+  ipv4char:array[0..255] of boolean;
+  s:ansistring;
+  ch:ansichar;
+  a,len,field,startindex,labellen:integer;
+  lastwasspace,onlyipv4chars:boolean;
+  ipstring,hostname:ansistring;
+  biniptemp:tbinip;
+begin
+  hostsfile_clear;
+
+  if hostsfile_disabled then exit;
+  hostsfile_reverseinited := false;
+
+  //add builtin entries
+  hostsfile_add('localhost',ipstrtobinf('127.0.0.1'));
+  {$ifdef ipv6}
+  hostsfile_add('localhost',ipstrtobinf('::1'));
+  {$endif}
+
+  if hostsfile_onlylocalhost then exit;
+
+  if (hostsfile_filename = '') then hostsfile_filename := gethostsfilename;
+
+  //DNS names can only contain lower and uppercase, digits, dash, and dot
+  fillchar(validchar,sizeof(validchar),0);
+  validchar[ord('.')] := true;
+  validchar[ord('-')] := true;
+  fillchar(validchar[48],10,1);
+  fillchar(validchar[65],26,1);
+  fillchar(validchar[97],26,1);
+
+  //chars that can be in an ipv4 address: digits and dot
+  fillchar(ipv4char,sizeof(ipv4char),0);
+  ipv4char[ord('.')] := true;
+  fillchar(ipv4char[48],10,1);
+
+  hostsfile_lastfileage := fileage(hostsfile_filename);
+  hostsfile_lastcheckts := getts;
+  //writeln('------ reloading ',hostsfile_lastfileage);
+  try
+    t := treadtxt.createf(hostsfile_filename);
+  except
+    exit;
+  end;
+  if not assigned(t) then exit;
+
+  while not t.eof do begin
+    s := t.readline;
+
+    len := length(s);
+    if (len > 512) then goto lineend; //sanity check
+    field := -1;
+    lastwasspace := true;
+
+    onlyipv4chars := true;
+
+    //one extra loop iteration at the end with a "pretend space" for easy parsing
+    inc(len);
+    ipstring := '';
+    hostname := '';
+    a := 0;
+    while (a <= len) do begin
+      inc(a);
+      if (a >= len) then ch := ' ' else ch := s[a];
+
+      if (ch = '#') then begin
+        //pretend the start of a comment is a space and the end of the line
+        ch := ' ';
+        len := a;
+      end;
+
+      if (ch = #9) or (ch = ' ') then begin
+        if not (lastwasspace) then begin
+          if (field = 0) then begin
+            ipstring := copy(s,startindex,a - startindex);
+          end else if (field >= 1) then begin
+            //maximum length of hostname
+            if (a - startindex) > 253 then goto lineend;
+
+            //remove a trailing dot
+            //if (labellen = 0) then dec(a);
+
+            //hostname must not be an empty string
+            if (a - startindex) < 1 then goto lineend;
+
+            hostname := copy(s,startindex,a - startindex);
+
+            //reject a hosts entry with a name that is a valid ipv4 address.
+            //we don't need to check for ipv6 addresses because they have a colon and so aren't valid hostsnames
+            //the windows resolver does allow it, but i think it has potential security issues
+            if onlyipv4chars then if ipstrtobin(hostname,biniptemp) then goto lineend;
+
+            if ipstrtobin(ipstring,biniptemp) then begin
+              //writeln('!!!hosts file adding ip=',ipstring,'@host=',hostname,'@');
+
+              hostsfile_add(hostname,biniptemp);
+            end;
+
+            //break scan loop
+            //a := len;
+          end;
+
+        end;
+
+        lastwasspace := true;
+      end else begin
+        if lastwasspace then begin
+          inc(field);
+          startindex := a;
+          lastwasspace := false;
+          labellen := 0;
+        end;
+        //enforce valid characters in hostname
+        if (field = 1) then begin
+          if not validchar[ord(ch)] then goto lineend;
+          onlyipv4chars := onlyipv4chars and ipv4char[ord(ch)];
+          if (ch = '.') then begin
+            if (labellen = 0) then goto lineend;
+            labellen := 0;
+          end else begin
+            inc(labellen);
+            if (labellen > 63) then goto lineend;
+          end;
+        end;
+      end;
+    end;
+lineend:
+  end;
+  t.destroy;
+
+end;
+
+
+procedure hostsfile_reloadifneeded;
+var
+  ts:integer;
+begin
+  if (hostsfile_disabled or hostsfile_onlylocalhost or hostsfile_manualreload) then exit;
+  if hostsfile_filename = '' then exit;
+
+  ts := getts;
+  //writeln('reloadifneeded ts=',ts,' oldts=',hostsfile_lastcheckts);
+  if not ((ts > hostsfile_lastcheckts + 10000) or (ts < hostsfile_lastcheckts)) then exit;
+
+  hostsfile_lastcheckts := ts;
+
+  //writeln('reloadifneeded new=',fileage(hostsfile_filename),' old=',hostsfile_lastfileage);
+  if fileage(hostsfile_filename) = hostsfile_lastfileage then exit;
+  hostsfile_reload;
+end;
+
+procedure hostsfile_init;
+begin
+  //writeln('init ',hostsfile_inited);
+  if hostsfile_inited then begin
+    hostsfile_reloadifneeded;
+    exit;
+  end;
+  hostsfile_inited := true;
+  hostsfile_entries := tstringlist.create;
+  hostsfile_entries.casesensitive := false;
+  hostsfile_entries.sorted := true;
+  hostsfile_entries.duplicates := dupignore;
+
+  hostsfile_reverseentries := tstringlist.create;
+  hostsfile_reverseentries.casesensitive := true;
+  hostsfile_reverseentries.sorted := true;
+  hostsfile_reverseentries.duplicates := dupignore;
+
+  hostsfile_reload;
+end;
+
+procedure dnscore_preinit(alsoreverse:boolean);
+begin
+  {$ifdef ipv6}
+  initpreferredmode;
+  {$endif}
+  hostsfile_init;
+  populatednsserverlist;
+  randomdword;
+  if alsoreverse then hostsfile_initreverse;
+end;
 
 
 function getquerytype(s:ansistring):integer;
@@ -502,7 +977,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;
 
@@ -591,7 +1069,6 @@ recursed:
     goto failure;
   end;
 
-  {do /ets/hosts lookup here}
   state.sendpacketlen := buildrequest(state.queryname,state.sendpacket,state.requesttype);
   if state.sendpacketlen = 0 then begin
     failurereason := 'building request packet failed';
@@ -633,7 +1110,7 @@ function getcurrentsystemnameserverbin(var id:integer):tbinip;
 var
   counter : integer;
 begin
-  {override the name server choice here, instead of overriding it whereever it's called
+  {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);
@@ -644,7 +1121,7 @@ begin
   end;
 
   if not assigned(dnsserverlag) then populatednsserverlist;
-  if dnsserverlag.count=0 then raise exception.create('no dns servers availible');
+  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
@@ -678,31 +1155,16 @@ end;
 {$ifdef ipv6}
 
 procedure initpreferredmode;
-var
-  l:tbiniplist;
-  a:integer;
-  ip:tbinip;
-  ipmask_global,ipmask_6to4,ipmask_teredo:tbinip;
-
 begin
   if preferredmodeinited then exit;
   if useaf <> useaf_default then exit;
-  l := getv6localips;
-  if biniplist_getcount(l) = 0 then exit;
-  useaf := useaf_preferv4;
-  ipstrtobin('2000::',ipmask_global);
-  ipstrtobin('2001::',ipmask_teredo);
-  ipstrtobin('2002::',ipmask_6to4);
-  {if there is any v6 IP which is globally routable and not 6to4 and not teredo, prefer v6}
-  for a := biniplist_getcount(l)-1 downto 0 do begin
-    ip := biniplist_get(l,a);
-    if not comparebinipmask(ip,ipmask_global,3) then continue;
-    if comparebinipmask(ip,ipmask_teredo,32) then continue;
-    if comparebinipmask(ip,ipmask_6to4,16) then continue;
-    useaf := useaf_preferv6;
-    preferredmodeinited := true;
-    exit;
-  end;
+
+  if (have_ipv6_connectivity) then
+    useaf := useaf_preferv6
+  else
+    useaf := useaf_preferv4;
+
+  preferredmodeinited := true;
 end;
 
 {$endif}