Merged with delphi 2010 branch

[lcore.git] / dnscore.pas

diff --git a/dnscore.pas b/dnscore.pas
old mode 100755 (executable)
new mode 100644 (file)
index 600581d..d0dbbf0
--- 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


@@ -60,7 +60,7 @@ unit dnscore;
 \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
 {hint to users of this unit that they should use windows dns instead.\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


@@ -82,6 +82,11 @@ can be set by apps as desired
 }\r
 var useaf:integer = useaf_default;\r
 \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
   maxnamefieldlen=63;\r
 const\r
   maxnamelength=127;\r
   maxnamefieldlen=63;\r


@@ -93,12 +98,14 @@ 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
+  querytype_txt=16;\r
+  querytype_spf=99;\r
+  maxrecursion=50;\r

   maxrrofakind=20;\r
 \r
   retryafter=300000; //microseconds must be less than one second;\r
   maxrrofakind=20;\r
 \r
   retryafter=300000; //microseconds must be less than one second;\r


@@ -118,16 +125,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


@@ -158,28 +165,25 @@ type
 //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 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
 //set up state for a foward lookup. A family value of AF_INET6 will give only\r
 //ipv6 results. Any other value will give only ipv4 results\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 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
 \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
 procedure populatednsserverlist;\r
 procedure cleardnsservercache;\r
 \r


@@ -191,7 +195,7 @@ var
 //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
 //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

 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


@@ -199,17 +203,19 @@ procedure reportlag(id:integer;lag:integer); //lag should be in microseconds and
 { $endif}\r
 \r
 \r
 { $endif}\r
 \r
 \r

-{$ifdef linux}{$ifdef ipv6}\r
+{$ifdef ipv6}\r

 function getv6localips:tbiniplist;\r
 procedure initpreferredmode;\r
 \r
 var\r
   preferredmodeinited:boolean;\r
 \r
 function getv6localips:tbiniplist;\r
 procedure initpreferredmode;\r
 \r
 var\r
   preferredmodeinited:boolean;\r
 \r

-{$endif}{$endif}\r
+{$endif}\r

 \r
 var\r
 \r
 var\r

-  failurereason:string;\r
+  failurereason:ansistring;\r
+\r
+function getquerytype(s:ansistring):integer;\r

 \r
 implementation\r
 \r
 \r
 implementation\r
 \r


@@ -220,16 +226,35 @@ uses
 \r
   sysutils;\r
 \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


@@ -264,9 +289,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


@@ -298,10 +323,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


@@ -342,7 +367,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


@@ -360,6 +385,14 @@ end;
 \r
 {==============================================================================}\r
 \r
 \r
 {==============================================================================}\r
 \r

+function getrawfromrr(const rrp:trrpointer;len:integer):ansistring;\r
+begin\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
 function getipfromrr(const rrp:trrpointer;len:integer):tbinip;\r
 begin\r
   fillchar(result,sizeof(result),0);\r


@@ -391,6 +424,16 @@ begin
     querytype_a{$ifdef ipv6},querytype_aaaa{$endif}: begin\r
       state.resultbin := getipfromrr(rrp,len);\r
     end;\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


@@ -398,7 +441,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


@@ -409,7 +452,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


@@ -425,6 +468,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


@@ -576,18 +626,18 @@ end;
   type\r
     tip_addr_string=packed record\r
       Next :pointer;\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
+      IpAddress : array[0..15] of ansichar;\r
+      ipmask    : array[0..15] of ansichar;\r

       context   : dword;\r
     end;\r
     pip_addr_string=^tip_addr_string;\r
     tFIXED_INFO=packed record\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
+       HostName         : array[0..MAX_HOSTNAME_LEN-1] of ansichar;\r
+       DomainName       : array[0..MAX_DOMAIN_NAME_LEN-1] of ansichar;\r

        currentdnsserver : pip_addr_string;\r
        dnsserverlist    : tip_addr_string;\r
        nodetype         : longint;\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
+       ScopeId          : array[0..MAX_SCOPE_ID_LEN + 4] of ansichar;\r

        enablerouting    : longbool;\r
        enableproxy      : longbool;\r
        enabledns        : longbool;\r
        enablerouting    : longbool;\r
        enableproxy      : longbool;\r
        enabledns        : longbool;\r


@@ -606,7 +656,7 @@ var
     currentdnsserver : pip_addr_string;\r
   {$else}\r
     t:textfile;\r
     currentdnsserver : pip_addr_string;\r
   {$else}\r
     t:textfile;\r

-    s:string;\r
+    s:ansistring;\r

     a:integer;\r
   {$endif}\r
 begin\r
     a:integer;\r
   {$endif}\r
 begin\r


@@ -667,7 +717,7 @@ begin
   end;\r
 end;\r
 \r
   end;\r
 end;\r
 \r

-function getcurrentsystemnameserver(var id:integer):string;\r
+function getcurrentsystemnameserver(var id:integer):ansistring;\r

 var\r
   counter : integer;\r
 \r
 var\r
   counter : integer;\r
 \r


@@ -701,11 +751,13 @@ end;
 \r
 \r
 \r
 \r
 \r
 \r

-{$ifdef linux}{$ifdef ipv6}\r
+{$ifdef ipv6}\r
+\r
+{$ifdef linux}\r

 function getv6localips:tbiniplist;\r
 var\r
   t:textfile;\r
 function getv6localips:tbiniplist;\r
 var\r
   t:textfile;\r

-  s,s2:string;\r
+  s,s2:ansistring;\r

   ip:tbinip;\r
   a:integer;\r
 begin\r
   ip:tbinip;\r
   a:integer;\r
 begin\r


@@ -728,6 +780,13 @@ begin
   closefile(t);\r
 end;\r
 \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
 var\r
   l:tbiniplist;\r
 procedure initpreferredmode;\r
 var\r
   l:tbiniplist;\r


@@ -738,8 +797,9 @@ var
 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

-  useaf := useaf_preferv4;\r

   l := getv6localips;\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
   ipstrtobin('2000::',ipmask_global);\r
   ipstrtobin('2001::',ipmask_teredo);\r
   ipstrtobin('2002::',ipmask_6to4);\r


@@ -755,7 +815,7 @@ begin
   end;\r
 end;\r
 \r
   end;\r
 end;\r
 \r

-{$endif}{$endif}\r
+{$endif}\r

 \r
 \r
 {  quick and dirty description of dns packet structure to aid writing and\r
 \r
 \r
 {  quick and dirty description of dns packet structure to aid writing and\r