removed redundant, and no longer valid, email address

[lcore.git] / dnsasync.pas

diff --git a/dnsasync.pas b/dnsasync.pas
index 0a32459af0a5c04c419652fff26cc9d08b49a742..8c3ce3a01d4afca44a754a3f268ca826fb6452ed 100755 (executable)
--- a/dnsasync.pas
+++ b/dnsasync.pas
@@ -15,10 +15,15 @@ uses
     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
 \r

+{$include lcoreconfig.inc}\r
+\r
+const\r
+  numsock=1{$ifdef ipv6}+1{$endif};\r

 \r
 type\r
 \r
 type\r

+\r

   //after completion or cancelation a dnswinasync may be reused\r
   tdnsasync=class(tcomponent)\r
 \r
   //after completion or cancelation a dnswinasync may be reused\r
   tdnsasync=class(tcomponent)\r
 \r


@@ -26,26 +31,28 @@ type
     //made a load of stuff private that does not appear to be part of the main\r
     //public interface. If you make any of it public again please consider the\r
     //consequences when using windows dns. --plugwash.\r
     //made a load of stuff private that does not appear to be part of the main\r
     //public interface. If you make any of it public again please consider the\r
     //consequences when using windows dns. --plugwash.\r

-    sock:twsocket;\r
+    sockets: array[0..numsock-1] of tlsocket;\r

 \r
 \r

-    sockopen:boolean;\r
+    states: array[0..numsock-1] of tdnsstate;\r

 \r
 \r

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

 \r
 \r

-    state:tdnsstate;\r
-\r
-    dnsserverid:integer;\r
+    dnsserverids : array[0..numsock-1] of integer;\r

     startts:double;\r
     {$ifdef win32}\r
       dwas : tdnswinasync;\r
     {$endif}\r
 \r
     startts:double;\r
     {$ifdef win32}\r
       dwas : tdnswinasync;\r
     {$endif}\r
 \r

-\r
-    procedure asyncprocess;\r
+    numsockused : integer;\r
+    fresultlist : tbiniplist;\r
+    requestaf : integer;\r
+    procedure asyncprocess(socketno:integer);\r

     procedure receivehandler(sender:tobject;error:word);\r
     procedure receivehandler(sender:tobject;error:word);\r

-    function sendquery(const packet:tdnspacket;len:integer):boolean;\r
+    function sendquery(socketno:integer;const packet:tdnspacket;len:integer):boolean;\r

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

+\r

   public\r
     onrequestdone:tsocketevent;\r
 \r
   public\r
     onrequestdone:tsocketevent;\r
 \r


@@ -55,17 +62,16 @@ type
     //and special uses.\r
     addr,port:string;\r
 \r
     //and special uses.\r
     addr,port:string;\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
+    overrideaf : integer;\r

 \r
     procedure cancel;//cancel an outstanding dns request\r
     function dnsresult:string; //get result of dnslookup as a string\r
     procedure dnsresultbin(var binip:tbinip); //get result of dnslookup as a tbinip\r
 \r
     procedure cancel;//cancel an outstanding dns request\r
     function dnsresult:string; //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 forwardlookup(const name:string); //start forward lookup,\r
                                                 //preffering ipv4\r
     procedure reverselookup(const binip:tbinip); //start reverse lookup\r
     procedure forwardlookup(const name:string); //start forward lookup,\r
                                                 //preffering ipv4\r
     procedure reverselookup(const binip:tbinip); //start reverse lookup\r

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

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


@@ -79,109 +85,221 @@ uses sysutils;
 constructor tdnsasync.create;\r
 begin\r
   inherited create(aowner);\r
 constructor tdnsasync.create;\r
 begin\r
   inherited create(aowner);\r

-  dnsserverid := -1;\r
-  sock := twsocket.create(self);\r
+  dnsserverids[0] := -1;\r
+  sockets[0] := twsocket.create(self);\r
+  sockets[0].tag := 0;\r
+  {$ifdef ipv6}\r
+    dnsserverids[1] := -1;\r
+    sockets[1] := twsocket.Create(self);\r
+    sockets[1].tag := 1;\r
+  {$endif}\r

 end;\r
 \r
 destructor tdnsasync.destroy;\r
 end;\r
 \r
 destructor tdnsasync.destroy;\r

+var\r
+  socketno : integer;\r

 begin\r
 begin\r

-  if dnsserverid >= 0 then begin\r
-    reportlag(dnsserverid,-1);\r
-    dnsserverid := -1;\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
+    end;\r
+    sockets[socketno].release;\r
+    setstate_request_init('',states[socketno]);\r

   end;\r
   end;\r

-  sock.release;\r
-  setstate_request_init('',state);\r

   inherited destroy;\r
 end;\r
 \r
   inherited destroy;\r
 end;\r
 \r

-procedure tdnsasync.receivehandler;\r
+procedure tdnsasync.receivehandler(sender:tobject;error:word);\r
+var\r
+  socketno : integer;\r
+  Src    : TInetSockAddrV;\r
+  SrcLen : Integer;\r
+  fromip:tbinip;\r
+  fromport:string;\r

 begin\r
 begin\r

-  if dnsserverid >= 0 then begin\r
-    reportlag(dnsserverid,trunc((unixtimefloat-startts)*1000));\r
-    dnsserverid := -1;\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
+\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
+      reportlag(dnsserverids[socketno],trunc((unixtimefloat-startts)*1000000));\r
+      dnsserverids[socketno] := -1;\r
+    end;\r
+  {  writeln('received reply');}\r
+\r
+    asyncprocess(socketno);\r
+    //writeln('processed it');\r
+  end else begin\r
+    //writeln('ignored it because request is done');\r

   end;\r
   end;\r

-{  writeln('received reply');}\r
-  fillchar(state.recvpacket,sizeof(state.recvpacket),0);\r
-  state.recvpacketlen := twsocket(sender).Receive(@state.recvpacket, SizeOf(state.recvpacket));\r
-  state.parsepacket := true;\r
-  asyncprocess;\r

 end;\r
 \r
 end;\r
 \r

-function tdnsasync.sendquery;\r
+function tdnsasync.sendquery(socketno:integer;const packet:tdnspacket;len:integer):boolean;\r
+var\r
+  destination : string;\r
+  inaddr : tinetsockaddrv;\r
+  trytolisten:integer;\r

 begin\r
 {  writeln('sendquery ',decodename(state.packet,state.packetlen,12,0,a),' ',state.requesttype);}\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
   result := false;\r
   if len = 0 then exit; {no packet}\r

-  if not sockopen then begin\r
-    if addr <> '' then sock.addr := addr else sock.addr := getcurrentsystemnameserver(dnsserverid);//getunixnameservercached;\r
+  if sockets[socketno].state <> wsconnected then begin\r

     startts := unixtimefloat;\r
     if port = '' then port := '53';\r
     startts := unixtimefloat;\r
     if port = '' then port := '53';\r

-    sock.port := port;\r
-    sock.Proto := 'udp';\r
-    sock.ondataavailable := receivehandler;\r
-    try\r
-      sock.connect;\r
-    except\r
-      on e:exception do begin\r
-        //writeln('exception '+e.message);\r
-        exit;\r
+    sockets[socketno].Proto := 'udp';\r
+    sockets[socketno].ondataavailable := receivehandler;\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
       end;\r
     end;\r

-    sockopen := true;\r
+\r

   end;\r
   end;\r

-  sock.send(@packet,len);\r
+  if addr <> '' then begin\r
+    dnsserverids[socketno] := -1;\r
+    destination := addr\r
+  end else begin\r
+    destination := getcurrentsystemnameserver(dnsserverids[socketno]);\r
+  end;\r
+  destinations[socketno] := ipstrtobinf(destination);\r
+\r
+  {$ifdef ipv6}{$ifdef win32}\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
   result := true;\r

+\r
+\r

 end;\r
 \r
 end;\r
 \r

-procedure tdnsasync.asyncprocess;\r
+procedure tdnsasync.asyncprocess(socketno:integer);\r

 begin\r
 begin\r

-  state_process(state);\r
-  case state.resultaction of\r
+  state_process(states[socketno]);\r
+  case states[socketno].resultaction of\r

     action_ignore: begin {do nothing} end;\r
     action_done: begin\r
     action_ignore: begin {do nothing} end;\r
     action_done: begin\r

-      onrequestdone(self,0);\r
+      {$ifdef ipv6}\r
+      if (numsockused = 1) or (states[socketno xor 1].resultaction=action_done) then\r
+      //if using two sockets we need to wait until both sockets are in the done\r
+      //state before firing the event\r
+      {$endif}\r
+      begin\r
+        fresultlist := biniplist_new;\r
+        if (numsockused = 1) then begin\r
+          //writeln('processing for one state');\r
+          biniplist_addlist(fresultlist,states[0].resultlist);\r
+        {$ifdef ipv6}\r
+        end else if (requestaf = useaf_preferv6) then begin\r
+          //writeln('processing for two states, ipv6 preference');\r
+          //writeln('merging lists '+biniplist_tostr(states[1].resultlist)+' and '+biniplist_tostr(states[0].resultlist));\r
+          biniplist_addlist(fresultlist,states[1].resultlist);\r
+          biniplist_addlist(fresultlist,states[0].resultlist);\r
+        end else begin\r
+          //writeln('processing for two states, ipv4 preference');\r
+          biniplist_addlist(fresultlist,states[0].resultlist);\r
+          biniplist_addlist(fresultlist,states[1].resultlist);\r
+        {$endif}\r
+        end;\r
+        //writeln(biniplist_tostr(fresultlist));\r
+        onrequestdone(self,0);\r
+      end;\r

     end;\r
     action_sendquery:begin\r
     end;\r
     action_sendquery:begin\r

-      sendquery(state.sendpacket,state.sendpacketlen);\r
+      sendquery(socketno,states[socketno].sendpacket,states[socketno].sendpacketlen);\r

     end;\r
   end;\r
 end;\r
 \r
 procedure tdnsasync.forwardlookup;\r
     end;\r
   end;\r
 end;\r
 \r
 procedure tdnsasync.forwardlookup;\r

+var\r
+  bip : tbinip;\r
+  i : integer;\r

 begin\r
 begin\r

+  ipstrtobin(name,bip);\r

 \r
 \r

-  ipstrtobin(name,state.resultbin);\r
+  if bip.family <> 0 then begin\r
+    // it was an IP address\r
+    fresultlist := biniplist_new;\r
+    biniplist_add(fresultlist,bip);\r
+    onrequestdone(self,0);\r
+    exit;\r
+  end;\r
+\r
+  if (overridednsserver <> '') and (addr = '') then addr := overridednsserver;\r
+\r
+  if overrideaf = useaf_default then begin\r
+    {$ifdef ipv6}\r
+      {$ifdef win32}if not (usewindns and (addr = '')) then{$endif}\r
+      initpreferredmode;\r
+    {$endif}\r
+    requestaf := useaf;\r
+  end else begin\r
+    requestaf := overrideaf;\r
+  end;\r

 \r
   {$ifdef win32}\r
 \r
   {$ifdef win32}\r

-    if usewindns or (addr = '') then begin\r
+    if usewindns and (addr = '') 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

-\r
-  if state.resultbin.family <> 0 then begin\r
-    onrequestdone(self,0);\r
-    exit;\r
+  numsockused := 0;\r
+  fresultlist := biniplist_new;\r
+  if (requestaf <> useaf_v6) then begin\r
+    setstate_forward(name,states[numsockused],af_inet);\r
+    inc(numsockused);\r

   end;\r
 \r
   end;\r
 \r

-\r
-  setstate_forward(name,state,forwardfamily);\r
-  asyncprocess;\r
+  {$ifdef ipv6}\r
+    if (requestaf <> useaf_v4) then begin\r
+      setstate_forward(name,states[numsockused],af_inet6);\r
+      inc(numsockused);\r
+    end;\r
+  {$endif}\r
+  for i := 0 to numsockused-1 do begin\r
+    asyncprocess(i);\r
+  end;\r

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

-\r

 begin\r
 begin\r

+  if (overridednsserver <> '') and (addr = '') then addr := overridednsserver;\r

   {$ifdef win32}\r
   {$ifdef win32}\r

-    if usewindns or (addr = '') then begin\r
+    if usewindns and (addr = '') 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


@@ -189,42 +307,55 @@ begin
     end;\r
   {$endif}\r
 \r
     end;\r
   {$endif}\r
 \r

-  setstate_reverse(binip,state);\r
-  asyncprocess;\r
+  setstate_reverse(binip,states[0]);\r
+  numsockused := 1;\r
+  asyncprocess(0);\r
+end;\r
+\r
+procedure tdnsasync.customlookup;\r
+begin\r
+  if (overridednsserver <> '') and (addr = '') then addr := overridednsserver;\r
+  setstate_custom(name,querytype,states[0]);\r
+  numsockused := 1;\r
+  asyncprocess(0);\r

 end;\r
 \r
 function tdnsasync.dnsresult;\r
 begin\r
 end;\r
 \r
 function tdnsasync.dnsresult;\r
 begin\r

-  if state.resultstr <> '' then result := state.resultstr else begin\r
-    result := ipbintostr(state.resultbin);\r
+  if states[0].resultstr <> '' then result := states[0].resultstr else begin\r
+    result := ipbintostr(biniplist_get(fresultlist,0));\r

   end;\r
 end;\r
 \r
 procedure tdnsasync.dnsresultbin(var binip:tbinip);\r
 begin\r
   end;\r
 end;\r
 \r
 procedure tdnsasync.dnsresultbin(var binip:tbinip);\r
 begin\r

-  move(state.resultbin,binip,sizeof(binip));\r
+  binip := biniplist_get(fresultlist,0);\r

 end;\r
 \r
 procedure tdnsasync.cancel;\r
 end;\r
 \r
 procedure tdnsasync.cancel;\r

+var\r
+  socketno : integer;\r

 begin\r
   {$ifdef win32}\r
     if assigned(dwas) then begin\r
       dwas.release;\r
       dwas := nil;\r
 begin\r
   {$ifdef win32}\r
     if assigned(dwas) then begin\r
       dwas.release;\r
       dwas := nil;\r

-    end else \r
+    end else\r

   {$endif}\r
   begin\r
   {$endif}\r
   begin\r

+    for socketno := 0 to numsock-1 do begin\r
+      reportlag(dnsserverids[socketno],-1);\r
+      dnsserverids[socketno] := -1;\r

 \r
 \r

-    if dnsserverid >= 0 then begin\r
-      reportlag(dnsserverid,-1);\r
-      dnsserverid := -1;\r
-    end;\r
-    if sockopen then begin\r
-      sock.close;\r
-      sockopen := false;\r
+      sockets[socketno].close;\r

     end;\r
     end;\r

+\r
+  end;\r
+  for socketno := 0 to numsock-1 do begin\r
+    setstate_failure(states[socketno]);\r
+\r

   end;\r
   end;\r

-  setstate_failure(state);\r
+  fresultlist := biniplist_new;\r

   onrequestdone(self,0);\r
 end;\r
 \r
   onrequestdone(self,0);\r
 end;\r
 \r


@@ -232,13 +363,29 @@ end;
   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
-      state.resultstr := dwas.name;\r
+    if dwas.reverse then begin\r
+      states[0].resultstr := dwas.name;\r

     end else begin \r
     end else begin \r

-      state.resultbin := dwas.ip;\r
-      if (forwardfamily = AF_INET6) and (state.resultbin.family = AF_INET) then begin\r
-        fillchar(state.resultbin,sizeof(tbinip),0);\r
+\r
+      {$ifdef ipv6}\r
+      if (requestaf = useaf_preferv4) then begin\r
+        {prefer mode: sort the IP's}\r
+        fresultlist := biniplist_new;\r
+        addipsoffamily(fresultlist,dwas.iplist,af_inet);\r
+        addipsoffamily(fresultlist,dwas.iplist,af_inet6);\r
+\r
+      end else if (requestaf = useaf_preferv6) then begin\r
+        {prefer mode: sort the IP's}\r
+        fresultlist := biniplist_new;\r
+        addipsoffamily(fresultlist,dwas.iplist,af_inet6);\r
+        addipsoffamily(fresultlist,dwas.iplist,af_inet);\r
+        \r
+      end else\r
+      {$endif}\r
+      begin\r
+        fresultlist := dwas.iplist;\r

       end;\r
       end;\r

+\r

     end;\r
     dwas.release;\r
     onrequestdone(self,error);\r
     end;\r
     dwas.release;\r
     onrequestdone(self,error);\r