X-Git-Url: http://www.lcore.org/git/lcore.git/blobdiff_plain/d53fe26eaac895d1e7a0ba2b2b8965cf77932de8..2c3a30778bb5a281c10736470058b5a63575a516:/dnsasync.pas?ds=sidebyside

diff --git a/dnsasync.pas b/dnsasync.pas
old mode 100755
new mode 100644
index 7a10bbf..f9fa50e
--- a/dnsasync.pas
+++ b/dnsasync.pas
@@ -7,15 +7,19 @@
 //not seem to have any form of retry code.
 
 unit dnsasync;
-
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
 interface
 
 uses
-  {$ifdef win32}
+  {$ifdef winasyncdns}
     dnswin,
   {$endif}
   lsocket,lcore,
-  classes,binipstuff,dnscore,btime;
+  classes,binipstuff,dnscore,btime,lcorernd;
+
+{$include lcoreconfig.inc}
 
 const
   numsock=1{$ifdef ipv6}+1{$endif};
@@ -33,9 +37,11 @@ type
 
     states: array[0..numsock-1] of tdnsstate;
 
+    destinations: array[0..numsock-1] of tbinip;
+
     dnsserverids : array[0..numsock-1] of integer;
     startts:double;
-    {$ifdef win32}
+    {$ifdef winasyncdns}
       dwas : tdnswinasync;
     {$endif}
 
@@ -45,7 +51,7 @@ type
     procedure asyncprocess(socketno:integer);
     procedure receivehandler(sender:tobject;error:word);
     function sendquery(socketno:integer;const packet:tdnspacket;len:integer):boolean;
-    {$ifdef win32}
+    {$ifdef winasyncdns}
       procedure winrequestdone(sender:tobject;error:word);
     {$endif}
 
@@ -53,25 +59,21 @@ type
     onrequestdone:tsocketevent;
 
     //addr and port allow the application to specify a dns server specifically
-    //for this dnsasync object. This is not a reccomended mode of operation
+    //for this dnsasync object. This is not a recommended mode of operation
     //because it limits the app to one dns server but is kept for compatibility
     //and special uses.
-    addr,port:string;
+    addr,port:ansistring;
 
     overrideaf : integer;
 
-    //A family value of AF_INET6 will give only
-    //ipv6 results. Any other value will give ipv4 results in preference and ipv6
-    //results if ipv4 results are not available;
-    forwardfamily:integer;
-
     procedure cancel;//cancel an outstanding dns request
-    function dnsresult:string; //get result of dnslookup as a string
+    function dnsresult:ansistring; //get result of dnslookup as a string
     procedure dnsresultbin(var binip:tbinip); //get result of dnslookup as a tbinip
     property dnsresultlist : tbiniplist read fresultlist;
-    procedure forwardlookup(const name:string); //start forward lookup,
-                                                //preffering ipv4
+    procedure forwardlookup(const name:ansistring); //start forward lookup,
+                                                //preferring ipv4
     procedure reverselookup(const binip:tbinip); //start reverse lookup
+    procedure customlookup(const name:ansistring;querytype:integer); //start custom type lookup
 
     constructor create(aowner:tcomponent); override;
     destructor destroy; override;
@@ -100,29 +102,54 @@ var
   socketno : integer;
 begin
   for socketno := 0 to numsock -1 do begin
-    if dnsserverids[socketno] >= 0 then begin
-      reportlag(dnsserverids[socketno],-1);
-      dnsserverids[socketno] := -1;
+    if assigned(sockets[socketno]) then begin
+      if dnsserverids[socketno] >= 0 then begin
+        reportlag(dnsserverids[socketno],-1);
+        dnsserverids[socketno] := -1;
+      end;
+      sockets[socketno].release;
+      setstate_request_init('',states[socketno]);
     end;
-    sockets[socketno].release;
-    setstate_request_init('',states[socketno]);
   end;
+
+  {$ifdef winasyncdns}
+  if assigned(dwas) then begin
+    dwas.release;
+    dwas := nil;
+  end;
+  {$endif}
+
   inherited destroy;
 end;
 
 procedure tdnsasync.receivehandler(sender:tobject;error:word);
 var
   socketno : integer;
+  Src    : TInetSockAddrV;
+  SrcLen : Integer;
+  fromip:tbinip;
+  fromport:ansistring;
 begin
   socketno := tlsocket(sender).tag;
   //writeln('got a reply on socket number ',socketno);
   fillchar(states[socketno].recvpacket,sizeof(states[socketno].recvpacket),0);
-  states[socketno].recvpacketlen := twsocket(sender).Receive(@(states[socketno].recvpacket), SizeOf(states[socketno].recvpacket));
+
+  SrcLen := SizeOf(Src);
+  states[socketno].recvpacketlen := twsocket(sender).ReceiveFrom(@(states[socketno].recvpacket), SizeOf(states[socketno].recvpacket), Src, SrcLen);
+
+  fromip := inaddrvtobinip(Src);
+  fromport := inttostr(htons(src.InAddr.port));
+
+  if ((not comparebinip(fromip,destinations[socketno])) or (fromport <> port)) then begin
+   // writeln('dnsasync received from wrong IP:port ',ipbintostr(fromip),'#',fromport,', expected ',ipbintostr(destinations[socketno]),'#',port);
+    exit;
+  end;
+
   states[socketno].parsepacket := true;
   if states[socketno].resultaction <> action_done then begin
     //we ignore packets that come after we are done
     if dnsserverids[socketno] >= 0 then begin
-      reportlag(dnsserverids[socketno],trunc((unixtimefloat-startts)*1000));
+      reportlag(dnsserverids[socketno],trunc((unixtimefloat-startts)*1000000));
       dnsserverids[socketno] := -1;
     end;
   {  writeln('received reply');}
@@ -136,8 +163,9 @@ end;
 
 function tdnsasync.sendquery(socketno:integer;const packet:tdnspacket;len:integer):boolean;
 var
-  destination : string;
+  destination : tbinip;
   inaddr : tinetsockaddrv;
+  trytolisten:integer;
 begin
 {  writeln('sendquery ',decodename(state.packet,state.packetlen,12,0,a),' ',state.requesttype);}
   //writeln('trying to send query on socket number ',socketno);
@@ -148,21 +176,36 @@ begin
     if port = '' then port := '53';
     sockets[socketno].Proto := 'udp';
     sockets[socketno].ondataavailable := receivehandler;
-    try
-      sockets[socketno].listen;
-    except
-      result := false;
-      exit;
+
+    {we are going to bind on a random local port for the DNS request, against the kaminsky attack
+    there is a small chance that we're trying to bind on an already used port, so retry a few times}
+    for trytolisten := 3 downto 0 do begin
+      try
+        sockets[socketno].port := inttostr(1024 + randominteger(65536 - 1024));
+        sockets[socketno].listen;
+      except
+        {writeln('failed to listen ',sockets[socketno].localport,' ',trytolisten);}
+        if (trytolisten = 0) then begin
+          result := false;
+          exit;
+        end;
+      end;
     end;
 
   end;
   if addr <> '' then begin
     dnsserverids[socketno] := -1;
-    destination := addr
+    destination := ipstrtobinf(addr);
   end else begin
-    destination := getcurrentsystemnameserver(dnsserverids[socketno]);
+    destination := getcurrentsystemnameserverbin(dnsserverids[socketno]);
   end;
-  makeinaddrv(ipstrtobinf(destination),port,inaddr);
+  destinations[socketno] := destination;
+
+  {$ifdef ipv6}{$ifdef mswindows}
+  if destinations[socketno].family = AF_INET6 then if (requestaf = useaf_default) then requestaf := useaf_preferv6;
+  {$endif}{$endif}
+
+  makeinaddrv(destinations[socketno],port,inaddr);
   sockets[socketno].sendto(inaddr,sizeof(inaddr), @packet,len);
   result := true;
 
@@ -212,7 +255,6 @@ var
   bip : tbinip;
   i : integer;
 begin
-
   ipstrtobin(name,bip);
 
   if bip.family <> 0 then begin
@@ -224,21 +266,22 @@ begin
   end;
 
   if overrideaf = useaf_default then begin
-    {$ifdef linux}{$ifdef ipv6}initpreferredmode;{$endif}{$endif}
+    {$ifdef ipv6}
+      {$ifdef mswindows}if not (usewindns and (addr = '')) then{$endif}
+      initpreferredmode;
+    {$endif}
     requestaf := useaf;
   end else begin
     requestaf := overrideaf;
   end;
 
-  {$ifdef win32}
-    if usewindns or (addr = '') then begin
+  {$ifdef winasyncdns}
+    if usewindns and (addr = '') then begin
       dwas := tdnswinasync.create;
       dwas.onrequestdone := winrequestdone;
-      if forwardfamily = AF_INET6 then begin
-        dwas.forwardlookup(name,true);
-      end else begin
-        dwas.forwardlookup(name,false);
-      end;
+
+      dwas.forwardlookup(name);
+
       exit;
     end;
   {$endif}
@@ -256,17 +299,16 @@ begin
       inc(numsockused);
     end;
   {$endif}
+
   for i := 0 to numsockused-1 do begin
     asyncprocess(i);
   end;
-
 end;
 
 procedure tdnsasync.reverselookup;
-
 begin
-  {$ifdef win32}
-    if usewindns or (addr = '') then begin
+  {$ifdef winasyncdns}
+    if usewindns and (addr = '') then begin
       dwas := tdnswinasync.create;
       dwas.onrequestdone := winrequestdone;
       dwas.reverselookup(binip);
@@ -279,6 +321,13 @@ begin
   asyncprocess(0);
 end;
 
+procedure tdnsasync.customlookup;
+begin
+  setstate_custom(name,querytype,states[0]);
+  numsockused := 1;
+  asyncprocess(0);
+end;
+
 function tdnsasync.dnsresult;
 begin
   if states[0].resultstr <> '' then result := states[0].resultstr else begin
@@ -295,7 +344,7 @@ procedure tdnsasync.cancel;
 var
   socketno : integer;
 begin
-  {$ifdef win32}
+  {$ifdef winasyncdns}
     if assigned(dwas) then begin
       dwas.release;
       dwas := nil;
@@ -318,11 +367,11 @@ begin
   onrequestdone(self,0);
 end;
 
-{$ifdef win32}
+{$ifdef winasyncdns}
   procedure tdnsasync.winrequestdone(sender:tobject;error:word);
  
   begin
-    if dwas.reverse then begin 
+    if dwas.reverse then begin
       states[0].resultstr := dwas.name;
     end else begin