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

diff --git a/dnsasync.pas b/dnsasync.pas
index 0a32459..7a10bbf 100755
--- a/dnsasync.pas
+++ b/dnsasync.pas
@@ -17,8 +17,11 @@ uses
   lsocket,lcore,
   classes,binipstuff,dnscore,btime;
 
+const
+  numsock=1{$ifdef ipv6}+1{$endif};
 
 type
+
   //after completion or cancelation a dnswinasync may be reused
   tdnsasync=class(tcomponent)
 
@@ -26,26 +29,26 @@ 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;
-
-    sockopen:boolean;
-
+    sockets: array[0..numsock-1] of tlsocket;
 
-    state:tdnsstate;
+    states: array[0..numsock-1] of 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,6 +58,8 @@ type
     //and special uses.
     addr,port:string;
 
+    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;
@@ -63,6 +68,7 @@ type
     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
@@ -79,78 +85,150 @@ 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;
 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);
+  states[socketno].recvpacketlen := twsocket(sender).Receive(@(states[socketno].recvpacket), SizeOf(states[socketno].recvpacket));
+  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));
+      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;
 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;
+    sockets[socketno].Proto := 'udp';
+    sockets[socketno].ondataavailable := receivehandler;
     try
-      sock.connect;
+      sockets[socketno].listen;
     except
-      on e:exception do begin
-        //writeln('exception '+e.message);
-        exit;
-      end;
+      result := false;
+      exit;
     end;
-    sockopen := true;
+
+  end;
+  if addr <> '' then begin
+    dnsserverids[socketno] := -1;
+    destination := addr
+  end else begin
+    destination := getcurrentsystemnameserver(dnsserverids[socketno]);
   end;
-  sock.send(@packet,len);
+  makeinaddrv(ipstrtobinf(destination),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,state.resultbin);
+  ipstrtobin(name,bip);
+
+  if bip.family <> 0 then begin
+    // it was an IP address
+    fresultlist := biniplist_new;
+    biniplist_add(fresultlist,bip);
+    onrequestdone(self,0);
+    exit;
+  end;
+
+  if overrideaf = useaf_default then begin
+    {$ifdef linux}{$ifdef ipv6}initpreferredmode;{$endif}{$endif}
+    requestaf := useaf;
+  end else begin
+    requestaf := overrideaf;
+  end;
 
   {$ifdef win32}
     if usewindns or (addr = '') then begin
@@ -165,15 +243,22 @@ begin
     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;
 
@@ -189,42 +274,47 @@ begin
     end;
   {$endif}
 
-  setstate_reverse(binip,state);
-  asyncprocess;
+  setstate_reverse(binip,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;
-  setstate_failure(state);
+  for socketno := 0 to numsock-1 do begin
+    setstate_failure(states[socketno]);
+
+  end;
+  fresultlist := biniplist_new;
   onrequestdone(self,0);
 end;
 
@@ -233,12 +323,28 @@ end;
  
   begin
     if dwas.reverse then begin 
-      state.resultstr := dwas.name;
+      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);