the big lot of changes by beware

[lcore.git] / dnscore.pas

diff --git a/dnscore.pas b/dnscore.pas
index bb4fab49b6d000491fa1e6534607dc3f1b4d589c..ef4c2f1fd660ee4eac3c8076d5938233aefa3d72 100755 (executable)
--- a/dnscore.pas
+++ b/dnscore.pas
@@ -54,25 +54,33 @@
 }\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
 uses binipstuff,classes,pgtypes;\r
 \r
 var usewindns : boolean = {$ifdef win32}true{$else}false{$endif};\r
 \r
 interface\r
 \r
 uses binipstuff,classes,pgtypes;\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
 const\r
   maxnamelength=127;\r
 \r
 const\r
   maxnamelength=127;\r


@@ -115,6 +123,7 @@ type
     parsepacket:boolean;\r
     resultstr:string;\r
     resultbin:tbinip;\r
     parsepacket:boolean;\r
     resultstr:string;\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


@@ -147,7 +156,9 @@ 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
+//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

 \r
 procedure setstate_request_init(const name:string;var state:tdnsstate);\r
 \r
 \r
 procedure setstate_request_init(const name:string;var state:tdnsstate);\r
 \r


@@ -337,25 +348,37 @@ 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 getipfromrr(const rrp:trrpointer;len:integer):tbinip;\r

 begin\r
 begin\r

-  state.resultaction := action_done;\r
-  state.resultstr := '';\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

   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


@@ -456,6 +479,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


@@ -587,6 +623,7 @@ begin
   {$ifdef win32}\r
     if iphlpapi=0 then iphlpapi := loadlibrary('iphlpapi.dll');\r
     if not assigned(getnetworkparams) then @getnetworkparams := getprocaddress(iphlpapi,'GetNetworkParams');\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
     fixed_info_len := 0;\r
     if GetNetworkParams(nil,@fixed_info_len)<>ERROR_BUFFER_OVERFLOW then exit;\r
     //fixed_info_len :=sizeof(tfixed_info);\r


@@ -635,7 +672,7 @@ begin
 end;\r
 \r
 function getcurrentsystemnameserver(var id:integer):string;\r
 end;\r
 \r
 function getcurrentsystemnameserver(var id:integer):string;\r

-var \r
+var\r

   counter : integer;\r
 \r
 begin\r
   counter : integer;\r
 \r
 begin\r