* fixed NT services not working. app must now call lcoreinit() at some point before...

[lcore.git] / dnscore.pas

diff --git a/dnscore.pas b/dnscore.pas
index 600581dface0910f25ddabd48b44fdfbf31e6880..4cb52e2461231bab9f3a34a547e0ee9290f0f44d 100755 (executable)
--- a/dnscore.pas
+++ b/dnscore.pas
@@ -60,7 +60,7 @@ unit dnscore;
 \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
@@ -82,6 +82,11 @@ can be set by apps as desired
 }\r
 var useaf:integer = useaf_default;\r
 \r
+{\r
+(temporarily) use a different nameserver, regardless of the dnsserverlist\r
+}\r
+var overridednsserver:string;\r
+\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_a6=38;\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
@@ -170,16 +177,13 @@ procedure setstate_reverse(const binip:tbinip;var state:tdnsstate);
 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:string; 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
-//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
@@ -199,18 +203,20 @@ procedure reportlag(id:integer;lag:integer); //lag should be in microseconds and
 { $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
-{$endif}{$endif}\r
+{$endif}\r
 \r
 var\r
   failurereason:string;\r
 \r
+function getquerytype(s:string):integer;\r
+\r
 implementation\r
 \r
 uses\r
@@ -220,6 +226,24 @@ uses
 \r
   sysutils;\r
 \r
+\r
+\r
+function getquerytype(s:string):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:string;var packet:tdnspacket;requesttype:word):integer;\r
 var\r
   a,b:integer;\r
@@ -229,7 +253,8 @@ begin
  { 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
@@ -360,6 +385,14 @@ end;
 \r
 {==============================================================================}\r
 \r
+function getrawfromrr(const rrp:trrpointer;len:integer):string;\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
@@ -391,6 +424,16 @@ begin
     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
@@ -425,6 +468,13 @@ begin
   state.requesttype := querytype_ptr;\r
 end;\r
 \r
+procedure setstate_custom(const name:string; 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
@@ -701,7 +751,9 @@ end;
 \r
 \r
 \r
-{$ifdef linux}{$ifdef ipv6}\r
+{$ifdef ipv6}\r
+\r
+{$ifdef linux}\r
 function getv6localips:tbiniplist;\r
 var\r
   t:textfile;\r
@@ -728,6 +780,13 @@ begin
   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
@@ -738,8 +797,9 @@ var
 begin\r
   if preferredmodeinited then exit;\r
   if useaf <> useaf_default then exit;\r
-  useaf := useaf_preferv4;\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
@@ -755,7 +815,7 @@ begin
   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