X-Git-Url: http://www.lcore.org/git/lcore.git/blobdiff_plain/4782a5c5afee47721cc617daa40dd29828342c2b..a1858883733a454b6ffb73aa263ef5badc2a1d07:/dnsasync.pas

diff --git a/dnsasync.pas b/dnsasync.pas
index 0a32459..8c3ce3a 100755
--- a/dnsasync.pas
+++ b/dnsasync.pas
@@ -15,10 +15,15 @@ uses
     dnswin,
   {$endif}
   lsocket,lcore,
-  classes,binipstuff,dnscore,btime;
+  classes,binipstuff,dnscore,btime,lcorernd;
 
+{$include lcoreconfig.inc}
+
+const
+  numsock=1{$ifdef ipv6}+1{$endif};
 
 type
+
   //after completion or cancelation a dnswinasync may be reused
   tdnsasync=class(tcomponent)
 
@@ -26,26 +31,28 @@ type
     //made a load of stuff private that does not appear to be part of the main
     //public interface. If you make any of it public again please consider the
     //consequences when using windows dns. --plugwash.
-    sock:twsocket;
+    sockets: array[0..numsock-1] of tlsocket;
 
-    sockopen:boolean;
+    states: array[0..numsock-1] of tdnsstate;
 
+    destinations: array[0..numsock-1] of tbinip;
 
-    state:tdnsstate;
-
-    dnsserverid:integer;
+    dnsserverids : array[0..numsock-1] of integer;
     startts:double;
     {$ifdef win32}
       dwas : tdnswinasync;
     {$endif}
 
-
-    procedure asyncprocess;
+    numsockused : integer;
+    fresultlist : tbiniplist;
+    requestaf : integer;
+    procedure asyncprocess(socketno:integer);
     procedure receivehandler(sender:tobject;error:word);
-    function sendquery(const packet:tdnspacket;len:integer):boolean;
+    function sendquery(socketno:integer;const packet:tdnspacket;len:integer):boolean;
     {$ifdef win32}
       procedure winrequestdone(sender:tobject;error:word);
     {$endif}
+
   public
     onrequestdone:tsocketevent;
 
@@ -55,17 +62,16 @@ type
     //and special uses.
     addr,port:string;
 
-    //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;
+    overrideaf : integer;
 
     procedure cancel;//cancel an outstanding dns request
     function dnsresult:string; //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 reverselookup(const binip:tbinip); //start reverse lookup
+    procedure customlookup(const name:string;querytype:integer); //start custom type lookup
 
     constructor create(aowner:tcomponent); override;
     destructor destroy; override;
@@ -79,109 +85,221 @@ uses sysutils;
 constructor tdnsasync.create;
 begin
   inherited create(aowner);
-  dnsserverid := -1;
-  sock := twsocket.create(self);
+  dnsserverids[0] := -1;
+  sockets[0] := twsocket.create(self);
+  sockets[0].tag := 0;
+  {$ifdef ipv6}
+    dnsserverids[1] := -1;
+    sockets[1] := twsocket.Create(self);
+    sockets[1].tag := 1;
+  {$endif}
 end;
 
 destructor tdnsasync.destroy;
+var
+  socketno : integer;
 begin
-  if dnsserverid >= 0 then begin
-    reportlag(dnsserverid,-1);
-    dnsserverid := -1;
+  for socketno := 0 to numsock -1 do begin
+    if dnsserverids[socketno] >= 0 then begin
+      reportlag(dnsserverids[socketno],-1);
+      dnsserverids[socketno] := -1;
+    end;
+    sockets[socketno].release;
+    setstate_request_init('',states[socketno]);
   end;
-  sock.release;
-  setstate_request_init('',state);
   inherited destroy;
 end;
 
-procedure tdnsasync.receivehandler;
+procedure tdnsasync.receivehandler(sender:tobject;error:word);
+var
+  socketno : integer;
+  Src    : TInetSockAddrV;
+  SrcLen : Integer;
+  fromip:tbinip;
+  fromport:string;
 begin
-  if dnsserverid >= 0 then begin
-    reportlag(dnsserverid,trunc((unixtimefloat-startts)*1000));
-    dnsserverid := -1;
+  socketno := tlsocket(sender).tag;
+  //writeln('got a reply on socket number ',socketno);
+  fillchar(states[socketno].recvpacket,sizeof(states[socketno].recvpacket),0);
+
+  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)*1000000));
+      dnsserverids[socketno] := -1;
+    end;
+  {  writeln('received reply');}
+
+    asyncprocess(socketno);
+    //writeln('processed it');
+  end else begin
+    //writeln('ignored it because request is done');
   end;
-{  writeln('received reply');}
-  fillchar(state.recvpacket,sizeof(state.recvpacket),0);
-  state.recvpacketlen := twsocket(sender).Receive(@state.recvpacket, SizeOf(state.recvpacket));
-  state.parsepacket := true;
-  asyncprocess;
 end;
 
-function tdnsasync.sendquery;
+function tdnsasync.sendquery(socketno:integer;const packet:tdnspacket;len:integer):boolean;
+var
+  destination : string;
+  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);
   result := false;
   if len = 0 then exit; {no packet}
-  if not sockopen then begin
-    if addr <> '' then sock.addr := addr else sock.addr := getcurrentsystemnameserver(dnsserverid);//getunixnameservercached;
+  if sockets[socketno].state <> wsconnected then begin
     startts := unixtimefloat;
     if port = '' then port := '53';
-    sock.port := port;
-    sock.Proto := 'udp';
-    sock.ondataavailable := receivehandler;
-    try
-      sock.connect;
-    except
-      on e:exception do begin
-        //writeln('exception '+e.message);
-        exit;
+    sockets[socketno].Proto := 'udp';
+    sockets[socketno].ondataavailable := receivehandler;
+
+    {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;
-    sockopen := true;
+
   end;
-  sock.send(@packet,len);
+  if addr <> '' then begin
+    dnsserverids[socketno] := -1;
+    destination := addr
+  end else begin
+    destination := getcurrentsystemnameserver(dnsserverids[socketno]);
+  end;
+  destinations[socketno] := ipstrtobinf(destination);
+
+  {$ifdef ipv6}{$ifdef win32}
+  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;
+
+
 end;
 
-procedure tdnsasync.asyncprocess;
+procedure tdnsasync.asyncprocess(socketno:integer);
 begin
-  state_process(state);
-  case state.resultaction of
+  state_process(states[socketno]);
+  case states[socketno].resultaction of
     action_ignore: begin {do nothing} end;
     action_done: begin
-      onrequestdone(self,0);
+      {$ifdef ipv6}
+      if (numsockused = 1) or (states[socketno xor 1].resultaction=action_done) then
+      //if using two sockets we need to wait until both sockets are in the done
+      //state before firing the event
+      {$endif}
+      begin
+        fresultlist := biniplist_new;
+        if (numsockused = 1) then begin
+          //writeln('processing for one state');
+          biniplist_addlist(fresultlist,states[0].resultlist);
+        {$ifdef ipv6}
+        end else if (requestaf = useaf_preferv6) then begin
+          //writeln('processing for two states, ipv6 preference');
+          //writeln('merging lists '+biniplist_tostr(states[1].resultlist)+' and '+biniplist_tostr(states[0].resultlist));
+          biniplist_addlist(fresultlist,states[1].resultlist);
+          biniplist_addlist(fresultlist,states[0].resultlist);
+        end else begin
+          //writeln('processing for two states, ipv4 preference');
+          biniplist_addlist(fresultlist,states[0].resultlist);
+          biniplist_addlist(fresultlist,states[1].resultlist);
+        {$endif}
+        end;
+        //writeln(biniplist_tostr(fresultlist));
+        onrequestdone(self,0);
+      end;
     end;
     action_sendquery:begin
-      sendquery(state.sendpacket,state.sendpacketlen);
+      sendquery(socketno,states[socketno].sendpacket,states[socketno].sendpacketlen);
     end;
   end;
 end;
 
 procedure tdnsasync.forwardlookup;
+var
+  bip : tbinip;
+  i : integer;
 begin
+  ipstrtobin(name,bip);
 
-  ipstrtobin(name,state.resultbin);
+  if bip.family <> 0 then begin
+    // it was an IP address
+    fresultlist := biniplist_new;
+    biniplist_add(fresultlist,bip);
+    onrequestdone(self,0);
+    exit;
+  end;
+
+  if (overridednsserver <> '') and (addr = '') then addr := overridednsserver;
+
+  if overrideaf = useaf_default then begin
+    {$ifdef ipv6}
+      {$ifdef win32}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
+    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}
 
-
-  if state.resultbin.family <> 0 then begin
-    onrequestdone(self,0);
-    exit;
+  numsockused := 0;
+  fresultlist := biniplist_new;
+  if (requestaf <> useaf_v6) then begin
+    setstate_forward(name,states[numsockused],af_inet);
+    inc(numsockused);
   end;
 
-
-  setstate_forward(name,state,forwardfamily);
-  asyncprocess;
+  {$ifdef ipv6}
+    if (requestaf <> useaf_v4) then begin
+      setstate_forward(name,states[numsockused],af_inet6);
+      inc(numsockused);
+    end;
+  {$endif}
+  for i := 0 to numsockused-1 do begin
+    asyncprocess(i);
+  end;
 
 end;
 
 procedure tdnsasync.reverselookup;
-
 begin
+  if (overridednsserver <> '') and (addr = '') then addr := overridednsserver;
   {$ifdef win32}
-    if usewindns or (addr = '') then begin
+    if usewindns and (addr = '') then begin
       dwas := tdnswinasync.create;
       dwas.onrequestdone := winrequestdone;
       dwas.reverselookup(binip);
@@ -189,42 +307,55 @@ begin
     end;
   {$endif}
 
-  setstate_reverse(binip,state);
-  asyncprocess;
+  setstate_reverse(binip,states[0]);
+  numsockused := 1;
+  asyncprocess(0);
+end;
+
+procedure tdnsasync.customlookup;
+begin
+  if (overridednsserver <> '') and (addr = '') then addr := overridednsserver;
+  setstate_custom(name,querytype,states[0]);
+  numsockused := 1;
+  asyncprocess(0);
 end;
 
 function tdnsasync.dnsresult;
 begin
-  if state.resultstr <> '' then result := state.resultstr else begin
-    result := ipbintostr(state.resultbin);
+  if states[0].resultstr <> '' then result := states[0].resultstr else begin
+    result := ipbintostr(biniplist_get(fresultlist,0));
   end;
 end;
 
 procedure tdnsasync.dnsresultbin(var binip:tbinip);
 begin
-  move(state.resultbin,binip,sizeof(binip));
+  binip := biniplist_get(fresultlist,0);
 end;
 
 procedure tdnsasync.cancel;
+var
+  socketno : integer;
 begin
   {$ifdef win32}
     if assigned(dwas) then begin
       dwas.release;
       dwas := nil;
-    end else 
+    end else
   {$endif}
   begin
+    for socketno := 0 to numsock-1 do begin
+      reportlag(dnsserverids[socketno],-1);
+      dnsserverids[socketno] := -1;
 
-    if dnsserverid >= 0 then begin
-      reportlag(dnsserverid,-1);
-      dnsserverid := -1;
-    end;
-    if sockopen then begin
-      sock.close;
-      sockopen := false;
+      sockets[socketno].close;
     end;
+
+  end;
+  for socketno := 0 to numsock-1 do begin
+    setstate_failure(states[socketno]);
+
   end;
-  setstate_failure(state);
+  fresultlist := biniplist_new;
   onrequestdone(self,0);
 end;
 
@@ -232,13 +363,29 @@ end;
   procedure tdnsasync.winrequestdone(sender:tobject;error:word);
  
   begin
-    if dwas.reverse then begin 
-      state.resultstr := dwas.name;
+    if dwas.reverse then begin
+      states[0].resultstr := dwas.name;
     end else begin 
-      state.resultbin := dwas.ip;
-      if (forwardfamily = AF_INET6) and (state.resultbin.family = AF_INET) then begin
-        fillchar(state.resultbin,sizeof(tbinip),0);
+
+      {$ifdef ipv6}
+      if (requestaf = useaf_preferv4) then begin
+        {prefer mode: sort the IP's}
+        fresultlist := biniplist_new;
+        addipsoffamily(fresultlist,dwas.iplist,af_inet);
+        addipsoffamily(fresultlist,dwas.iplist,af_inet6);
+
+      end else if (requestaf = useaf_preferv6) then begin
+        {prefer mode: sort the IP's}
+        fresultlist := biniplist_new;
+        addipsoffamily(fresultlist,dwas.iplist,af_inet6);
+        addipsoffamily(fresultlist,dwas.iplist,af_inet);
+        
+      end else
+      {$endif}
+      begin
+        fresultlist := dwas.iplist;
       end;
+
     end;
     dwas.release;
     onrequestdone(self,error);