redone getlocalips fix more neatly

[lcore.git] / dnscore.pas

diff --git a/dnscore.pas b/dnscore.pas
old mode 100755 (executable)
new mode 100644 (file)
index bb4fab4..3a9596f
--- a/dnscore.pas
+++ b/dnscore.pas
@@ -28,7 +28,7 @@
   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


@@ -54,25 +54,38 @@
 }\r
 unit dnscore;\r
 \r
 }\r
 unit dnscore;\r
 \r

-\r
-\r

 {$ifdef fpc}{$mode delphi}{$endif}\r
 \r
 {$ifdef fpc}{$mode delphi}{$endif}\r
 \r

-\r
-\r
-\r
+{$include lcoreconfig.inc}\r

 \r
 interface\r
 \r
 \r
 interface\r
 \r

-uses binipstuff,classes,pgtypes;\r
+uses binipstuff,classes,pgtypes,lcorernd;\r

 \r
 var usewindns : boolean = {$ifdef win32}true{$else}false{$endif};\r
 \r
 var usewindns : boolean = {$ifdef win32}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

 \r
 \r

-//note: this unit will not be able to self populate it's dns server list on\r
-//older versions of windows.\r
+note: this unit will not be able to self populate it's dns server list on\r
+older versions of windows.}\r
+\r
+const\r
+  useaf_default=0;\r
+  useaf_preferv4=1;\r
+  useaf_preferv6=2;\r
+  useaf_v4=3;\r
+  useaf_v6=4;\r
+{\r
+hint to users of this unit to how to deal with connecting to hostnames regarding ipv4 or ipv6 usage\r
+can be set by apps as desired\r
+}\r
+var useaf:integer = useaf_default;\r
+\r
+{\r
+(temporarily) use a different nameserver, regardless of the dnsserverlist\r
+}\r
+var overridednsserver:ansistring;\r

 \r
 const\r
   maxnamelength=127;\r
 \r
 const\r
   maxnamelength=127;\r


@@ -85,13 +98,18 @@ const
   querytype_a=1;\r
   querytype_cname=5;\r
   querytype_aaaa=28;\r
   querytype_a=1;\r
   querytype_cname=5;\r
   querytype_aaaa=28;\r

+  querytype_a6=38;\r

   querytype_ptr=12;\r
   querytype_ns=2;\r
   querytype_soa=6;\r
   querytype_mx=15;\r
   querytype_ptr=12;\r
   querytype_ns=2;\r
   querytype_soa=6;\r
   querytype_mx=15;\r

-\r
-  maxrecursion=10;\r
-  maxrrofakind=20;\r
+  querytype_txt=16;\r
+  querytype_spf=99;\r
+  maxrecursion=50;\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


@@ -110,15 +128,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
     resultbin:tbinip;\r

+    resultlist:tbiniplist;\r

     resultaction:integer;\r
     numrr1:array[0..3] of integer;\r
     numrr2:integer;\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


@@ -147,66 +166,96 @@ type
 //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
 //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

-//function makereversename(const binip:tbinip):string;\r

 \r
 \r

-procedure setstate_request_init(const name:string;var state:tdnsstate);\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):ansistring;\r
+\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
 \r
 //set up state for a foward lookup. A family value of AF_INET6 will give only\r

-//ipv6 results. Any other value will give ipv4 results in preference and ipv6\r
-//results if ipv4 results are not available;\r
-procedure setstate_forward(const name:string;var state:tdnsstate;family:integer);\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
 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
 \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:ansistring; requesttype:integer; var state:tdnsstate);\r

 \r
 procedure state_process(var state:tdnsstate);\r
 \r
 //function decodename(const packet:tdnspacket;len,start,recursion:integer;var numread:integer):string;\r
 \r
 \r
 procedure state_process(var state:tdnsstate);\r
 \r
 //function decodename(const packet:tdnspacket;len,start,recursion:integer;var numread:integer):string;\r
 \r

-//presumablly this is exported to allow more secure random functions\r
-//to be substituted?\r
-var randomfunction:function:integer;\r
-\r
-\r

 procedure populatednsserverlist;\r
 procedure cleardnsservercache;\r
 \r
 var\r
 procedure populatednsserverlist;\r
 procedure cleardnsservercache;\r
 \r
 var\r

-  dnsserverlist : tstringlist;\r
+  dnsserverlist : tbiniplist;\r
+  dnsserverlag:tlist;\r

 //  currentdnsserverno : integer;\r
 \r
 //  currentdnsserverno : integer;\r
 \r

-function getcurrentsystemnameserver(var id:integer) :string;\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) :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
 //  unixnameservercache:string;\r
 { $endif}\r
 \r
 \r
 \r
 //var\r
 //  unixnameservercache:string;\r
 { $endif}\r
 \r
 \r

-procedure reportlag(id:integer;lag:integer); //lag should be in microseconds and should be -1 to report a timeout\r
+{$ifdef ipv6}\r
+procedure initpreferredmode;\r
+\r

 var\r
 var\r

-  failurereason:string;\r
+  preferredmodeinited:boolean;\r
+\r
+{$endif}\r
+\r
+var\r
+  failurereason:ansistring;\r
+\r
+function getquerytype(s:ansistring):integer;\r

 \r
 implementation\r
 \r
 uses\r
 \r
 implementation\r
 \r
 uses\r

-  {$ifdef win32}\r
-    windows,\r
-  {$endif}\r
-\r
+  lcorelocalips,\r

   sysutils;\r
 \r
   sysutils;\r
 \r

-function buildrequest(const name:string;var packet:tdnspacket;requesttype:word):integer;\r
+\r
+\r
+function getquerytype(s:ansistring):integer;\r
+begin\r
+  s := uppercase(s);\r
+  result := 0;\r
+  if (s = 'A') then result := querytype_a else\r
+  if (s = 'CNAME') then result := querytype_cname else\r
+  if (s = 'AAAA') then result := querytype_aaaa else\r
+  if (s = 'PTR') then result := querytype_ptr else\r
+  if (s = 'NS') then result := querytype_ns else\r
+  if (s = 'MX') then result := querytype_mx else\r
+  if (s = 'A6') then result := querytype_a6 else\r
+  if (s = 'TXT') then result := querytype_txt else\r
+  if (s = 'SOA') then result := querytype_soa else\r
+  if (s = 'SPF') then result := querytype_spf;\r
+end;\r
+\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
   result := 0;\r
   fillchar(packet,sizeof(packet),0);\r
   arr:array[0..sizeof(packet)-1] of byte absolute packet;\r
 begin\r
  { writeln('buildrequest: name: ',name);}\r
   result := 0;\r
   fillchar(packet,sizeof(packet),0);\r

-  if assigned(randomfunction) then packet.id := (randomfunction and $ffff) else packet.id := random(65536);\r
+  packet.id := randominteger($10000);\r
+\r

   packet.flags := htons($0100);\r
   packet.rrcount[0] := htons($0001);\r
 \r
   packet.flags := htons($0100);\r
   packet.rrcount[0] := htons($0001);\r
 \r


@@ -241,9 +290,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


@@ -275,10 +324,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


@@ -319,7 +368,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


@@ -337,25 +386,55 @@ end;
 \r
 {==============================================================================}\r
 \r
 \r
 {==============================================================================}\r
 \r

-procedure setstate_return(const rrp:trrpointer;len:integer;var state:tdnsstate);\r
-var\r
-  a:integer;\r
+function getrawfromrr(const rrp:trrpointer;len:integer):ansistring;\r

 begin\r
 begin\r

-  state.resultaction := action_done;\r
-  state.resultstr := '';\r
+  setlength(result,htons(trr(rrp.p^).datalen));\r
+  uniquestring(result);\r
+  move(trr(rrp.p^).data,result[1],length(result));\r
+end;\r
+\r
+\r
+function getipfromrr(const rrp:trrpointer;len:integer):tbinip;\r
+begin\r
+  fillchar(result,sizeof(result),0);\r

   case trr(rrp.p^).requesttype of\r
     querytype_a: begin\r
       if htons(trr(rrp.p^).datalen) <> 4 then exit;\r
   case trr(rrp.p^).requesttype of\r
     querytype_a: begin\r
       if htons(trr(rrp.p^).datalen) <> 4 then exit;\r

-      move(trr(rrp.p^).data,state.resultbin.ip,4);\r
-      state.resultbin.family :=AF_INET;\r
+      move(trr(rrp.p^).data,result.ip,4);\r
+      result.family :=AF_INET;\r

     end;\r
     {$ifdef ipv6}\r
     querytype_aaaa: begin\r
       if htons(trr(rrp.p^).datalen) <> 16 then exit;\r
     end;\r
     {$ifdef ipv6}\r
     querytype_aaaa: begin\r
       if htons(trr(rrp.p^).datalen) <> 16 then exit;\r

-      state.resultbin.family := AF_INET6;\r
-      move(trr(rrp.p^).data,state.resultbin.ip6,16);\r
+      result.family := AF_INET6;\r
+      move(trr(rrp.p^).data,result.ip6,16);\r

     end;\r
     {$endif}\r
     end;\r
     {$endif}\r

+  else\r
+    {}\r
+  end;\r
+end;\r
+\r
+procedure setstate_return(const rrp:trrpointer;len:integer;var state:tdnsstate);\r
+var\r
+  a:integer;\r
+begin\r
+  state.resultaction := action_done;\r
+  state.resultstr := '';\r
+  case trr(rrp.p^).requesttype of\r
+    querytype_a{$ifdef ipv6},querytype_aaaa{$endif}: begin\r
+      state.resultbin := getipfromrr(rrp,len);\r
+    end;\r
+    querytype_txt:begin\r
+      {TXT returns a raw string}\r
+      state.resultstr := copy(getrawfromrr(rrp,len),2,9999);\r
+      fillchar(state.resultbin,sizeof(state.resultbin),0);\r
+    end;\r
+    querytype_mx:begin\r
+      {MX is a name after a 16 bits word}\r
+      state.resultstr := decodename(state.recvpacket,state.recvpacketlen,taddrint(rrp.p)-taddrint(@state.recvpacket)+12,0,a);\r
+      fillchar(state.resultbin,sizeof(state.resultbin),0);\r
+    end;\r

   else\r
     {other reply types (PTR, MX) return a hostname}\r
     state.resultstr := decodename(state.recvpacket,state.recvpacketlen,taddrint(rrp.p)-taddrint(@state.recvpacket)+10,0,a);\r
   else\r
     {other reply types (PTR, MX) return a hostname}\r
     state.resultstr := decodename(state.recvpacket,state.recvpacketlen,taddrint(rrp.p)-taddrint(@state.recvpacket)+10,0,a);\r


@@ -363,7 +442,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


@@ -374,7 +453,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


@@ -390,6 +469,13 @@ begin
   state.requesttype := querytype_ptr;\r
 end;\r
 \r
   state.requesttype := querytype_ptr;\r
 end;\r
 \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
+end;\r
+\r
+\r

 procedure setstate_failure(var state:tdnsstate);\r
 begin\r
   state.resultstr := '';\r
 procedure setstate_failure(var state:tdnsstate);\r
 begin\r
   state.resultstr := '';\r


@@ -419,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
     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


@@ -456,6 +545,19 @@ begin
       goto failure;\r
     end;\r
 \r
       goto failure;\r
     end;\r
 \r

+    {if we requested A or AAAA build a list of all replies}\r
+    if (state.requesttype = querytype_a) or (state.requesttype = querytype_aaaa) then begin\r
+      state.resultlist := biniplist_new;\r
+      for a := state.numrr1[0] to (state.numrr1[0]+state.numrr1[1]-1) do begin\r
+        rrptemp := @state.rrdata[1+a*sizeof(trrpointer)];\r
+        rrtemp := rrptemp.p;\r
+        b := rrptemp.len;\r
+        if rrtemp.requesttype = state.requesttype then begin\r
+          biniplist_add(state.resultlist,getipfromrr(rrptemp^,b));\r
+        end;\r
+      end;\r
+    end;\r
+\r

     {- check for items of the requested type in answer section, if so return success first}\r
     for a := state.numrr1[0] to (state.numrr1[0]+state.numrr1[1]-1) do begin\r
       rrptemp := @state.rrdata[1+a*sizeof(trrpointer)];\r
     {- check for items of the requested type in answer section, if so return success first}\r
     for a := state.numrr1[0] to (state.numrr1[0]+state.numrr1[1]-1) do begin\r
       rrptemp := @state.rrdata[1+a*sizeof(trrpointer)];\r


@@ -480,23 +582,7 @@ begin
 \r
     {no cnames found, no items of correct type found}\r
     if state.forwardfamily <> 0 then goto failure;\r
 \r
     {no cnames found, no items of correct type found}\r
     if state.forwardfamily <> 0 then goto failure;\r

-{$ifdef ipv6}\r
-    if (state.requesttype = querytype_a) then begin\r
-      {v6 only: in case of forward, look for AAAA in alternative section}\r
-      for a := state.numrr1[0]+state.numrr1[1]+state.numrr1[2] to (state.numrr2-1) do begin\r
-        rrptemp := @state.rrdata[1+a*sizeof(trrpointer)];\r
-        rrtemp := rrptemp.p;\r
-        b := rrptemp.len;\r
-        if rrtemp.requesttype = querytype_aaaa then begin\r
-          setstate_return(rrptemp^,b,state);\r
-          exit;\r
-        end;\r
-      end;\r
-      {no AAAA's found in alternative, do a recursive lookup for them}\r
-      state.requesttype := querytype_aaaa;\r
-      goto recursed;\r
-    end;\r
-{$endif}\r
+\r

     goto failure;\r
 recursed:\r
     {here it needs recursed lookup}\r
     goto failure;\r
 recursed:\r
     {here it needs recursed lookup}\r


@@ -524,131 +610,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
-    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
-var \r
+function getcurrentsystemnameserverbin(var id:integer):tbinip;\r
+var\r

   counter : integer;\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 whereever 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 availible');\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


@@ -656,16 +670,50 @@ 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
   end;\r
 \r
 end;\r
 \r

+\r
+{$ifdef ipv6}\r
+\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
+  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
+end;\r
+\r
+{$endif}\r
+\r
+\r

 {  quick and dirty description of dns packet structure to aid writing and\r
    understanding of parser code, refer to appropriate RFCs for proper specs\r
 - all words are network order\r
 {  quick and dirty description of dns packet structure to aid writing and\r
    understanding of parser code, refer to appropriate RFCs for proper specs\r
 - all words are network order\r