X-Git-Url: http://www.lcore.org/git/lcore.git/blobdiff_plain/baf753e54d73673524de916757e66ef8c485bc0d..d53fe26eaac895d1e7a0ba2b2b8965cf77932de8:/dnscore.pas

diff --git a/dnscore.pas b/dnscore.pas
index ef4c2f1..600581d 100755
--- a/dnscore.pas
+++ b/dnscore.pas
@@ -163,8 +163,7 @@ function makereversename(const binip:tbinip):string;
 procedure setstate_request_init(const name:string;var state:tdnsstate);
 
 //set up state for a foward lookup. A family value of AF_INET6 will give only
-//ipv6 results. Any other value will give ipv4 results in preference and ipv6
-//results if ipv4 results are not available;
+//ipv6 results. Any other value will give only ipv4 results
 procedure setstate_forward(const name:string;var state:tdnsstate;family:integer);
 
 procedure setstate_reverse(const binip:tbinip;var state:tdnsstate);
@@ -188,14 +187,27 @@ var
   dnsserverlist : tstringlist;
 //  currentdnsserverno : integer;
 
+
+//getcurrentsystemnameserver returns the nameserver the app should use and sets
+//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) :string;
+procedure reportlag(id:integer;lag:integer); //lag should be in microseconds and should be -1 to report a timeout
 
 //var
 //  unixnameservercache:string;
 { $endif}
 
 
-procedure reportlag(id:integer;lag:integer); //lag should be in microseconds and should be -1 to report a timeout
+{$ifdef linux}{$ifdef ipv6}
+function getv6localips:tbiniplist;
+procedure initpreferredmode;
+
+var
+  preferredmodeinited:boolean;
+
+{$endif}{$endif}
+
 var
   failurereason:string;
 
@@ -516,23 +528,7 @@ begin
 
     {no cnames found, no items of correct type found}
     if state.forwardfamily <> 0 then goto failure;
-{$ifdef ipv6}
-    if (state.requesttype = querytype_a) then begin
-      {v6 only: in case of forward, look for AAAA in alternative section}
-      for a := state.numrr1[0]+state.numrr1[1]+state.numrr1[2] to (state.numrr2-1) do begin
-        rrptemp := @state.rrdata[1+a*sizeof(trrpointer)];
-        rrtemp := rrptemp.p;
-        b := rrptemp.len;
-        if rrtemp.requesttype = querytype_aaaa then begin
-          setstate_return(rrptemp^,b,state);
-          exit;
-        end;
-      end;
-      {no AAAA's found in alternative, do a recursive lookup for them}
-      state.requesttype := querytype_aaaa;
-      goto recursed;
-    end;
-{$endif}
+
     goto failure;
 recursed:
     {here it needs recursed lookup}
@@ -703,6 +699,65 @@ begin
 
 end;
 
+
+
+{$ifdef linux}{$ifdef ipv6}
+function getv6localips:tbiniplist;
+var
+  t:textfile;
+  s,s2:string;
+  ip:tbinip;
+  a:integer;
+begin
+  result := biniplist_new;
+
+  assignfile(t,'/proc/net/if_inet6');
+  {$i-}reset(t);{$i+}
+  if ioresult <> 0 then exit; {none found, return empty list}
+
+  while not eof(t) do begin
+    readln(t,s);
+    s2 := '';
+    for a := 0 to 7 do begin
+      if (s2 <> '') then s2 := s2 + ':';
+      s2 := s2 + copy(s,(a shl 2)+1,4);
+    end;
+    ipstrtobin(s2,ip);
+    if ip.family <> 0 then biniplist_add(result,ip);
+  end;
+  closefile(t);
+end;
+
+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;
+  useaf := useaf_preferv4;
+  l := getv6localips;
+  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;
+end;
+
+{$endif}{$endif}
+
+
 {  quick and dirty description of dns packet structure to aid writing and
    understanding of parser code, refer to appropriate RFCs for proper specs
 - all words are network order