FreeBSD support

[lcore.git] / dnsasync.pas

diff --git a/dnsasync.pas b/dnsasync.pas
old mode 100755 (executable)
new mode 100644 (file)
index 7a10bbf..d387059
--- a/dnsasync.pas
+++ b/dnsasync.pas
@@ -7,15 +7,19 @@
 //not seem to have any form of retry code.\r
 \r
 unit dnsasync;\r
 //not seem to have any form of retry code.\r
 \r
 unit dnsasync;\r

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

 interface\r
 \r
 interface\r
 \r

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

 uses\r
 uses\r

-  {$ifdef win32}\r
+  {$ifdef winasyncdns}\r

     dnswin,\r
   {$endif}\r
   lsocket,lcore,\r
     dnswin,\r
   {$endif}\r
   lsocket,lcore,\r

-  classes,binipstuff,dnscore,btime;\r
+  classes,binipstuff,dnscore,btime,lcorernd;\r

 \r
 const\r
   numsock=1{$ifdef ipv6}+1{$endif};\r
 \r
 const\r
   numsock=1{$ifdef ipv6}+1{$endif};\r


@@ -33,9 +37,11 @@ type
 \r
     states: array[0..numsock-1] of tdnsstate;\r
 \r
 \r
     states: array[0..numsock-1] of tdnsstate;\r
 \r

+    destinations: array[0..numsock-1] of tbinip;\r
+\r

     dnsserverids : array[0..numsock-1] of integer;\r
     startts:double;\r
     dnsserverids : array[0..numsock-1] of integer;\r
     startts:double;\r

-    {$ifdef win32}\r
+    {$ifdef winasyncdns}\r

       dwas : tdnswinasync;\r
     {$endif}\r
 \r
       dwas : tdnswinasync;\r
     {$endif}\r
 \r


@@ -45,7 +51,7 @@ type
     procedure asyncprocess(socketno:integer);\r
     procedure receivehandler(sender:tobject;error:word);\r
     function sendquery(socketno:integer;const packet:tdnspacket;len:integer):boolean;\r
     procedure asyncprocess(socketno:integer);\r
     procedure receivehandler(sender:tobject;error:word);\r
     function sendquery(socketno:integer;const packet:tdnspacket;len:integer):boolean;\r

-    {$ifdef win32}\r
+    {$ifdef winasyncdns}\r

       procedure winrequestdone(sender:tobject;error:word);\r
     {$endif}\r
 \r
       procedure winrequestdone(sender:tobject;error:word);\r
     {$endif}\r
 \r


@@ -53,35 +59,42 @@ type
     onrequestdone:tsocketevent;\r
 \r
     //addr and port allow the application to specify a dns server specifically\r
     onrequestdone:tsocketevent;\r
 \r
     //addr and port allow the application to specify a dns server specifically\r

-    //for this dnsasync object. This is not a reccomended mode of operation\r
+    //for this dnsasync object. This is not a recommended mode of operation\r

     //because it limits the app to one dns server but is kept for compatibility\r
     //and special uses.\r
     //because it limits the app to one dns server but is kept for compatibility\r
     //and special uses.\r

-    addr,port:string;\r
+    addr,port:ansistring;\r

 \r
     overrideaf : integer;\r
 \r
 \r
     overrideaf : integer;\r
 \r

-    //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
-    forwardfamily:integer;\r
-\r

     procedure cancel;//cancel an outstanding dns request\r
     procedure cancel;//cancel an outstanding dns request\r

-    function dnsresult:string; //get result of dnslookup as a string\r
+    function dnsresult:ansistring; //get result of dnslookup as a string\r

     procedure dnsresultbin(var binip:tbinip); //get result of dnslookup as a tbinip\r
     property dnsresultlist : tbiniplist read fresultlist;\r
     procedure dnsresultbin(var binip:tbinip); //get result of dnslookup as a tbinip\r
     property dnsresultlist : tbiniplist read fresultlist;\r

-    procedure forwardlookup(const name:string); //start forward lookup,\r
-                                                //preffering ipv4\r
+    procedure forwardlookup(const name:ansistring); //start forward lookup,\r
+                                                //preferring ipv4\r

     procedure reverselookup(const binip:tbinip); //start reverse lookup\r
     procedure reverselookup(const binip:tbinip); //start reverse lookup\r

+    procedure customlookup(const name:ansistring;querytype:integer); //start custom type lookup\r

 \r
     constructor create(aowner:tcomponent); override;\r
     destructor destroy; override;\r
 \r
   end;\r
 \r
 \r
     constructor create(aowner:tcomponent); override;\r
     destructor destroy; override;\r
 \r
   end;\r
 \r

+//function that the app can use to know whether the builtin or system resolver is being used\r
+function willusebuiltindns_async:boolean;\r
+\r

 implementation\r
 \r
 uses sysutils;\r
 \r
 implementation\r
 \r
 uses sysutils;\r
 \r

+\r
+function willusebuiltindns_async:boolean;\r
+begin\r
+  result := true;\r
+  {$ifdef winasyncdns}if usewindns and (overridednsserver = '') and not (hostsfile_disabled or hostsfile_onlylocalhost) then result := false;{$endif}\r
+end;\r
+\r
+\r

 constructor tdnsasync.create;\r
 begin\r
   inherited create(aowner);\r
 constructor tdnsasync.create;\r
 begin\r
   inherited create(aowner);\r


@@ -100,29 +113,54 @@ var
   socketno : integer;\r
 begin\r
   for socketno := 0 to numsock -1 do begin\r
   socketno : integer;\r
 begin\r
   for socketno := 0 to numsock -1 do begin\r

-    if dnsserverids[socketno] >= 0 then begin\r
-      reportlag(dnsserverids[socketno],-1);\r
-      dnsserverids[socketno] := -1;\r
+    if assigned(sockets[socketno]) then begin\r
+      if dnsserverids[socketno] >= 0 then begin\r
+        reportlag(dnsserverids[socketno],-1);\r
+        dnsserverids[socketno] := -1;\r
+      end;\r
+      sockets[socketno].release;\r
+      setstate_request_init('',states[socketno]);\r

     end;\r
     end;\r

-    sockets[socketno].release;\r
-    setstate_request_init('',states[socketno]);\r

   end;\r
   end;\r

+\r
+  {$ifdef winasyncdns}\r
+  if assigned(dwas) then begin\r
+    dwas.release;\r
+    dwas := nil;\r
+  end;\r
+  {$endif}\r
+\r

   inherited destroy;\r
 end;\r
 \r
 procedure tdnsasync.receivehandler(sender:tobject;error:word);\r
 var\r
   socketno : integer;\r
   inherited destroy;\r
 end;\r
 \r
 procedure tdnsasync.receivehandler(sender:tobject;error:word);\r
 var\r
   socketno : integer;\r

+  Src    : TInetSockAddrV;\r
+  SrcLen : Integer;\r
+  fromip:tbinip;\r
+  fromport:ansistring;\r

 begin\r
   socketno := tlsocket(sender).tag;\r
   //writeln('got a reply on socket number ',socketno);\r
   fillchar(states[socketno].recvpacket,sizeof(states[socketno].recvpacket),0);\r
 begin\r
   socketno := tlsocket(sender).tag;\r
   //writeln('got a reply on socket number ',socketno);\r
   fillchar(states[socketno].recvpacket,sizeof(states[socketno].recvpacket),0);\r

-  states[socketno].recvpacketlen := twsocket(sender).Receive(@(states[socketno].recvpacket), SizeOf(states[socketno].recvpacket));\r
+\r
+  SrcLen := SizeOf(Src);\r
+  states[socketno].recvpacketlen := twsocket(sender).ReceiveFrom(@(states[socketno].recvpacket), SizeOf(states[socketno].recvpacket), Src, SrcLen);\r
+\r
+  fromip := inaddrvtobinip(Src);\r
+  fromport := inttostr(htons(src.InAddr.port));\r
+\r
+  if ((not comparebinip(fromip,destinations[socketno])) or (fromport <> port)) then begin\r
+   // writeln('dnsasync received from wrong IP:port ',ipbintostr(fromip),'#',fromport,', expected ',ipbintostr(destinations[socketno]),'#',port);\r
+    exit;\r
+  end;\r
+\r

   states[socketno].parsepacket := true;\r
   if states[socketno].resultaction <> action_done then begin\r
     //we ignore packets that come after we are done\r
     if dnsserverids[socketno] >= 0 then begin\r
   states[socketno].parsepacket := true;\r
   if states[socketno].resultaction <> action_done then begin\r
     //we ignore packets that come after we are done\r
     if dnsserverids[socketno] >= 0 then begin\r

-      reportlag(dnsserverids[socketno],trunc((unixtimefloat-startts)*1000));\r
+      reportlag(dnsserverids[socketno],trunc((wintimefloat-startts)*1000000));\r

       dnsserverids[socketno] := -1;\r
     end;\r
   {  writeln('received reply');}\r
       dnsserverids[socketno] := -1;\r
     end;\r
   {  writeln('received reply');}\r


@@ -136,33 +174,49 @@ end;
 \r
 function tdnsasync.sendquery(socketno:integer;const packet:tdnspacket;len:integer):boolean;\r
 var\r
 \r
 function tdnsasync.sendquery(socketno:integer;const packet:tdnspacket;len:integer):boolean;\r
 var\r

-  destination : string;\r
+  destination : tbinip;\r

   inaddr : tinetsockaddrv;\r
   inaddr : tinetsockaddrv;\r

+  trytolisten:integer;\r

 begin\r
 {  writeln('sendquery ',decodename(state.packet,state.packetlen,12,0,a),' ',state.requesttype);}\r
   //writeln('trying to send query on socket number ',socketno);\r
   result := false;\r
   if len = 0 then exit; {no packet}\r
   if sockets[socketno].state <> wsconnected then begin\r
 begin\r
 {  writeln('sendquery ',decodename(state.packet,state.packetlen,12,0,a),' ',state.requesttype);}\r
   //writeln('trying to send query on socket number ',socketno);\r
   result := false;\r
   if len = 0 then exit; {no packet}\r
   if sockets[socketno].state <> wsconnected then begin\r

-    startts := unixtimefloat;\r
+    startts := wintimefloat;\r

     if port = '' then port := '53';\r
     sockets[socketno].Proto := 'udp';\r
     sockets[socketno].ondataavailable := receivehandler;\r
     if port = '' then port := '53';\r
     sockets[socketno].Proto := 'udp';\r
     sockets[socketno].ondataavailable := receivehandler;\r

-    try\r
-      sockets[socketno].listen;\r
-    except\r
-      result := false;\r
-      exit;\r
+\r
+    {we are going to bind on a random local port for the DNS request, against the kaminsky attack\r
+    there is a small chance that we're trying to bind on an already used port, so retry a few times}\r
+    for trytolisten := 3 downto 0 do begin\r
+      try\r
+        sockets[socketno].port := inttostr(1024 + randominteger(65536 - 1024));\r
+        sockets[socketno].listen;\r
+      except\r
+        {writeln('failed to listen ',sockets[socketno].localport,' ',trytolisten);}\r
+        if (trytolisten = 0) then begin\r
+          result := false;\r
+          exit;\r
+        end;\r
+      end;\r

     end;\r
 \r
   end;\r
   if addr <> '' then begin\r
     dnsserverids[socketno] := -1;\r
     end;\r
 \r
   end;\r
   if addr <> '' then begin\r
     dnsserverids[socketno] := -1;\r

-    destination := addr\r
+    destination := ipstrtobinf(addr);\r

   end else begin\r
   end else begin\r

-    destination := getcurrentsystemnameserver(dnsserverids[socketno]);\r
+    destination := getcurrentsystemnameserverbin(dnsserverids[socketno]);\r

   end;\r
   end;\r

-  makeinaddrv(ipstrtobinf(destination),port,inaddr);\r
+  destinations[socketno] := destination;\r
+\r
+  {$ifdef ipv6}{$ifdef mswindows}\r
+  if destinations[socketno].family = AF_INET6 then if (requestaf = useaf_default) then requestaf := useaf_preferv6;\r
+  {$endif}{$endif}\r
+\r
+  makeinaddrv(destinations[socketno],port,inaddr);\r

   sockets[socketno].sendto(inaddr,sizeof(inaddr), @packet,len);\r
   result := true;\r
 \r
   sockets[socketno].sendto(inaddr,sizeof(inaddr), @packet,len);\r
   result := true;\r
 \r


@@ -211,8 +265,8 @@ procedure tdnsasync.forwardlookup;
 var\r
   bip : tbinip;\r
   i : integer;\r
 var\r
   bip : tbinip;\r
   i : integer;\r

+  willusewindns:boolean;\r

 begin\r
 begin\r

-\r

   ipstrtobin(name,bip);\r
 \r
   if bip.family <> 0 then begin\r
   ipstrtobin(name,bip);\r
 \r
   if bip.family <> 0 then begin\r


@@ -223,26 +277,40 @@ begin
     exit;\r
   end;\r
 \r
     exit;\r
   end;\r
 \r

+  willusewindns := false;\r
+  {$ifdef winasyncdns}\r
+  if usewindns and (addr = '') and (overridednsserver = '') and not (hostsfile_disabled or hostsfile_onlylocalhost) then willusewindns := true;\r
+  {$endif}\r
+\r

   if overrideaf = useaf_default then begin\r
   if overrideaf = useaf_default then begin\r

-    {$ifdef linux}{$ifdef ipv6}initpreferredmode;{$endif}{$endif}\r
+    {$ifdef ipv6}\r
+      if not willusewindns then initpreferredmode;\r
+    {$endif}\r

     requestaf := useaf;\r
   end else begin\r
     requestaf := overrideaf;\r
   end;\r
 \r
     requestaf := useaf;\r
   end else begin\r
     requestaf := overrideaf;\r
   end;\r
 \r

-  {$ifdef win32}\r
-    if usewindns or (addr = '') then begin\r
+  {$ifdef winasyncdns}\r
+    if willusewindns then begin\r

       dwas := tdnswinasync.create;\r
       dwas.onrequestdone := winrequestdone;\r
       dwas := tdnswinasync.create;\r
       dwas.onrequestdone := winrequestdone;\r

-      if forwardfamily = AF_INET6 then begin\r
-        dwas.forwardlookup(name,true);\r
-      end else begin\r
-        dwas.forwardlookup(name,false);\r
-      end;\r
+\r
+      dwas.forwardlookup(name);\r
+\r

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

+  if (((overridednsserver = '') and (addr = '')) or hostsfile_alsocustomserver) and (not hostsfile_disabled) then begin\r
+    //try a hosts file lookup\r
+    fresultlist := hostsfile_forwardlookuplist(name);\r
+    if (biniplist_getcount(fresultlist) > 0) then begin\r
+      onrequestdone(self,0);\r
+      exit;\r
+    end;\r
+  end;\r
+\r

   numsockused := 0;\r
   fresultlist := biniplist_new;\r
   if (requestaf <> useaf_v6) then begin\r
   numsockused := 0;\r
   fresultlist := biniplist_new;\r
   if (requestaf <> useaf_v6) then begin\r


@@ -256,17 +324,16 @@ begin
       inc(numsockused);\r
     end;\r
   {$endif}\r
       inc(numsockused);\r
     end;\r
   {$endif}\r

+\r

   for i := 0 to numsockused-1 do begin\r
     asyncprocess(i);\r
   end;\r
   for i := 0 to numsockused-1 do begin\r
     asyncprocess(i);\r
   end;\r

-\r

 end;\r
 \r
 procedure tdnsasync.reverselookup;\r
 end;\r
 \r
 procedure tdnsasync.reverselookup;\r

-\r

 begin\r
 begin\r

-  {$ifdef win32}\r
-    if usewindns or (addr = '') then begin\r
+  {$ifdef winasyncdns}\r
+    if usewindns and (addr = '') and (overridednsserver = '') and not (hostsfile_disabled or hostsfile_onlylocalhost) then begin\r

       dwas := tdnswinasync.create;\r
       dwas.onrequestdone := winrequestdone;\r
       dwas.reverselookup(binip);\r
       dwas := tdnswinasync.create;\r
       dwas.onrequestdone := winrequestdone;\r
       dwas.reverselookup(binip);\r


@@ -274,11 +341,27 @@ begin
     end;\r
   {$endif}\r
 \r
     end;\r
   {$endif}\r
 \r

+  if (((overridednsserver = '') and (addr = '')) or hostsfile_alsocustomserver) and (not hostsfile_disabled) then begin\r
+    //try a hosts file lookup\r
+    states[0].resultstr := hostsfile_reverselookup(binip);\r
+    if (states[0].resultstr <> '') then begin\r
+      onrequestdone(self,0);\r
+      exit;\r
+    end;\r
+  end;\r
+\r

   setstate_reverse(binip,states[0]);\r
   numsockused := 1;\r
   asyncprocess(0);\r
 end;\r
 \r
   setstate_reverse(binip,states[0]);\r
   numsockused := 1;\r
   asyncprocess(0);\r
 end;\r
 \r

+procedure tdnsasync.customlookup;\r
+begin\r
+  setstate_custom(name,querytype,states[0]);\r
+  numsockused := 1;\r
+  asyncprocess(0);\r
+end;\r
+\r

 function tdnsasync.dnsresult;\r
 begin\r
   if states[0].resultstr <> '' then result := states[0].resultstr else begin\r
 function tdnsasync.dnsresult;\r
 begin\r
   if states[0].resultstr <> '' then result := states[0].resultstr else begin\r


@@ -295,7 +378,7 @@ procedure tdnsasync.cancel;
 var\r
   socketno : integer;\r
 begin\r
 var\r
   socketno : integer;\r
 begin\r

-  {$ifdef win32}\r
+  {$ifdef winasyncdns}\r

     if assigned(dwas) then begin\r
       dwas.release;\r
       dwas := nil;\r
     if assigned(dwas) then begin\r
       dwas.release;\r
       dwas := nil;\r


@@ -318,11 +401,11 @@ begin
   onrequestdone(self,0);\r
 end;\r
 \r
   onrequestdone(self,0);\r
 end;\r
 \r

-{$ifdef win32}\r
+{$ifdef winasyncdns}\r

   procedure tdnsasync.winrequestdone(sender:tobject;error:word);\r
  \r
   begin\r
   procedure tdnsasync.winrequestdone(sender:tobject;error:word);\r
  \r
   begin\r

-    if dwas.reverse then begin \r
+    if dwas.reverse then begin\r

       states[0].resultstr := dwas.name;\r
     end else begin \r
 \r
       states[0].resultstr := dwas.name;\r
     end else begin \r
 \r