X-Git-Url: http://www.lcore.org/git/lcore.git/blobdiff_plain/d53fe26eaac895d1e7a0ba2b2b8965cf77932de8..46424de88e9de51a8151fd6ef813ff7827b1ad8c:/dnscore.pas?ds=sidebyside

diff --git a/dnscore.pas b/dnscore.pas
old mode 100755
new mode 100644
index 600581d..4cb52e2
--- a/dnscore.pas
+++ b/dnscore.pas
@@ -60,7 +60,7 @@ unit dnscore;
 
 interface
 
-uses binipstuff,classes,pgtypes;
+uses binipstuff,classes,pgtypes,lcorernd;
 
 var usewindns : boolean = {$ifdef win32}true{$else}false{$endif};
 {hint to users of this unit that they should use windows dns instead.
@@ -82,6 +82,11 @@ can be set by apps as desired
 }
 var useaf:integer = useaf_default;
 
+{
+(temporarily) use a different nameserver, regardless of the dnsserverlist
+}
+var overridednsserver:string;
+
 const
   maxnamelength=127;
   maxnamefieldlen=63;
@@ -93,12 +98,14 @@ const
   querytype_a=1;
   querytype_cname=5;
   querytype_aaaa=28;
+  querytype_a6=38;
   querytype_ptr=12;
   querytype_ns=2;
   querytype_soa=6;
   querytype_mx=15;
-
-  maxrecursion=10;
+  querytype_txt=16;
+  querytype_spf=99;
+  maxrecursion=50;
   maxrrofakind=20;
 
   retryafter=300000; //microseconds must be less than one second;
@@ -170,16 +177,13 @@ procedure setstate_reverse(const binip:tbinip;var state:tdnsstate);
 procedure setstate_failure(var state:tdnsstate);
 //procedure setstate_return(const rrp:trrpointer;len:integer;var state:tdnsstate);
 
+//for custom raw lookups such as TXT, as desired by the user
+procedure setstate_custom(const name:string; requesttype:integer; var state:tdnsstate);
 
 procedure state_process(var state:tdnsstate);
 
 //function decodename(const packet:tdnspacket;len,start,recursion:integer;var numread:integer):string;
 
-//presumablly this is exported to allow more secure random functions
-//to be substituted?
-var randomfunction:function:integer;
-
-
 procedure populatednsserverlist;
 procedure cleardnsservercache;
 
@@ -199,18 +203,20 @@ procedure reportlag(id:integer;lag:integer); //lag should be in microseconds and
 { $endif}
 
 
-{$ifdef linux}{$ifdef ipv6}
+{$ifdef ipv6}
 function getv6localips:tbiniplist;
 procedure initpreferredmode;
 
 var
   preferredmodeinited:boolean;
 
-{$endif}{$endif}
+{$endif}
 
 var
   failurereason:string;
 
+function getquerytype(s:string):integer;
+
 implementation
 
 uses
@@ -220,6 +226,24 @@ uses
 
   sysutils;
 
+
+
+function getquerytype(s:string):integer;
+begin
+  s := uppercase(s);
+  result := 0;
+  if (s = 'A') then result := querytype_a else
+  if (s = 'CNAME') then result := querytype_cname else
+  if (s = 'AAAA') then result := querytype_aaaa else
+  if (s = 'PTR') then result := querytype_ptr else
+  if (s = 'NS') then result := querytype_ns else
+  if (s = 'MX') then result := querytype_mx else
+  if (s = 'A6') then result := querytype_a6 else
+  if (s = 'TXT') then result := querytype_txt else
+  if (s = 'SOA') then result := querytype_soa else
+  if (s = 'SPF') then result := querytype_spf;
+end;
+
 function buildrequest(const name:string;var packet:tdnspacket;requesttype:word):integer;
 var
   a,b:integer;
@@ -229,7 +253,8 @@ begin
  { writeln('buildrequest: name: ',name);}
   result := 0;
   fillchar(packet,sizeof(packet),0);
-  if assigned(randomfunction) then packet.id := (randomfunction and $ffff) else packet.id := random(65536);
+  packet.id := randominteger($10000);
+
   packet.flags := htons($0100);
   packet.rrcount[0] := htons($0001);
 
@@ -360,6 +385,14 @@ end;
 
 {==============================================================================}
 
+function getrawfromrr(const rrp:trrpointer;len:integer):string;
+begin
+  setlength(result,htons(trr(rrp.p^).datalen));
+  uniquestring(result);
+  move(trr(rrp.p^).data,result[1],length(result));
+end;
+
+
 function getipfromrr(const rrp:trrpointer;len:integer):tbinip;
 begin
   fillchar(result,sizeof(result),0);
@@ -391,6 +424,16 @@ begin
     querytype_a{$ifdef ipv6},querytype_aaaa{$endif}: begin
       state.resultbin := getipfromrr(rrp,len);
     end;
+    querytype_txt:begin
+      {TXT returns a raw string}
+      state.resultstr := copy(getrawfromrr(rrp,len),2,9999);
+      fillchar(state.resultbin,sizeof(state.resultbin),0);
+    end;
+    querytype_mx:begin
+      {MX is a name after a 16 bits word}
+      state.resultstr := decodename(state.recvpacket,state.recvpacketlen,taddrint(rrp.p)-taddrint(@state.recvpacket)+12,0,a);
+      fillchar(state.resultbin,sizeof(state.resultbin),0);
+    end;
   else
     {other reply types (PTR, MX) return a hostname}
     state.resultstr := decodename(state.recvpacket,state.recvpacketlen,taddrint(rrp.p)-taddrint(@state.recvpacket)+10,0,a);
@@ -425,6 +468,13 @@ begin
   state.requesttype := querytype_ptr;
 end;
 
+procedure setstate_custom(const name:string; requesttype:integer; var state:tdnsstate);
+begin
+  setstate_request_init(name,state);
+  state.requesttype := requesttype;
+end;
+
+
 procedure setstate_failure(var state:tdnsstate);
 begin
   state.resultstr := '';
@@ -701,7 +751,9 @@ end;
 
 
 
-{$ifdef linux}{$ifdef ipv6}
+{$ifdef ipv6}
+
+{$ifdef linux}
 function getv6localips:tbiniplist;
 var
   t:textfile;
@@ -728,6 +780,13 @@ begin
   closefile(t);
 end;
 
+{$else}
+function getv6localips:tbiniplist;
+begin
+  result := biniplist_new;
+end;
+{$endif}
+
 procedure initpreferredmode;
 var
   l:tbiniplist;
@@ -738,8 +797,9 @@ var
 begin
   if preferredmodeinited then exit;
   if useaf <> useaf_default then exit;
-  useaf := useaf_preferv4;
   l := getv6localips;
+  if biniplist_getcount(l) = 0 then exit;
+  useaf := useaf_preferv4;
   ipstrtobin('2000::',ipmask_global);
   ipstrtobin('2001::',ipmask_teredo);
   ipstrtobin('2002::',ipmask_6to4);
@@ -755,7 +815,7 @@ begin
   end;
 end;
 
-{$endif}{$endif}
+{$endif}
 
 
 {  quick and dirty description of dns packet structure to aid writing and