X-Git-Url: http://www.lcore.org/git/lcore.git/blobdiff_plain/27e903c56380abcb11b5a0b8d7ccab88a14b5cde..eca2c8e0a8aad79c7dc7738346d265f973428995:/dnssync.pas

diff --git a/dnssync.pas b/dnssync.pas
index c603b92..84caf9a 100644
--- a/dnssync.pas
+++ b/dnssync.pas
@@ -13,7 +13,7 @@ interface
   uses
     dnscore,
     binipstuff,
-    {$ifdef win32}
+    {$ifdef mswindows}
       winsock,
       windows,
     {$else}
@@ -31,9 +31,9 @@ interface
 
 //convert a name to an IP
 //will return v4 or v6 depending on what seems favorable, or manual preference setting
-//on error the binip will have a family of 0 (other fiels are also currently
+//on error the binip will have a family of 0 (other fields are also currently
 //zeroed out but may be used for further error information in future)
-//timeout is in miliseconds, it is ignored when using windows dns
+//timeout is in milliseconds, it is ignored when using windows dns
 function forwardlookup(name:ansistring;timeout:integer):tbinip;
 
 //convert a name to a list of all IP's returned
@@ -58,32 +58,25 @@ const
 
   toport='53';
 
-var
-  id:integer;
-
-  sendquerytime:array[0..numsock-1] of integer;
 implementation
 
-{$ifdef win32}
+{$ifdef mswindows}
   uses dnswin;
 {$endif}
 
 
-{$ifndef win32}
+{$ifndef mswindows}
 {$define syncdnscore}
 {$endif}
 
 {$i unixstuff.inc}
 
+type tdnsstatearr=array[0..numsock-1] of tdnsstate;
 
 {$ifdef syncdnscore}
-var
-  numsockused:integer;
-  fd:array[0..numsock-1] of integer;
-  state:array[0..numsock-1] of tdnsstate;
-  toaddr:array[0..numsock-1] of tbinip;
 
-{$ifdef win32}
+
+{$ifdef mswindows}
   const
     winsocket = 'wsock32.dll';
   function sendto(s: TSocket; const Buf; len, flags: Integer; var addrto: TinetSockAddrV; tolen: Integer): Integer; stdcall; external    winsocket name 'sendto';
@@ -94,69 +87,78 @@ var
 
 
 function getts:integer;
-{$ifdef win32}
+{$ifdef mswindows}
 begin
   result := GetTickCount and tsmask;
 {$else}
 var
   temp:ttimeval;
 begin
-  gettimeofday(temp);
+  gettimemonotonic(temp);
   result := ((temp.tv_usec div 1000) + (temp.tv_sec * 1000)) and tsmask;
 {$endif}
 end;
 
-
-function sendquery(socknum:integer;const packet:tdnspacket;len:integer):boolean;
+procedure resolveloop(timeout:integer;var state:tdnsstatearr;numsockused:integer);
 var
-  addr       : ansistring;
-  port       : ansistring;
-  inaddr     : TInetSockAddrV;
-begin
-{  writeln('sendquery ',decodename(state.packet,state.packetlen,12,0,a),' ',state.requesttype);}
-  result := false;
-  if len = 0 then exit; {no packet}
+  selectresult   : integer;
+  fds            : fdset;
 
-  if overridednsserver <> '' then addr := overridednsserver else addr := getcurrentsystemnameserver(id);
+  endtime      : longint;
+  starttime    : longint;
+  wrapmode     : boolean;
+  currenttime  : integer;
 
-  {$ifdef ipv6}{$ifdef win32}
-  if toaddr[socknum].family = AF_INET6 then if (useaf = 0) then useaf := useaf_preferv6;
-  {$endif}{$endif}
+  lag            : ttimeval;
+  selecttimeout	 : ttimeval;
+  socknum:integer;
+  needprocessing:array[0..numsock-1] of boolean;
+  finished:array[0..numsock-1] of boolean;
+  a,b:integer;
 
-  port := toport;
-  toaddr[socknum] := ipstrtobinf(addr);
-  makeinaddrv(toaddr[socknum],port,inaddr);
+  Src    : TInetSockAddrV;
+  Srcx   : {$ifdef mswindows}sockaddr_in{$else}TInetSockAddrV{$endif} absolute Src;
+  SrcLen : Integer;
+  fromip:tbinip;
+  fromport:ansistring;
+
+  fd:array[0..numsock-1] of integer;
+  toaddr:array[0..numsock-1] of tbinip;
+  id:integer;
+  sendquerytime:array[0..numsock-1] of integer;
 
-  sendto(fd[socknum],packet,len,0,inaddr,inaddrsize(inaddr));
-  sendquerytime[socknum] := getts;
-  result := true;
-end;
 
 procedure setupsocket;
 var
   inAddrtemp : TInetSockAddrV;
-  a:integer;
   biniptemp:tbinip;
-  addr:ansistring;
+  a,retrycount,porttemp:integer;
+  bindresult:boolean;
 begin
-  //init both sockets smultaneously, always, so they get succesive fd's
-  if fd[0] > 0 then exit;
-
-  if overridednsserver <> '' then addr := overridednsserver else addr := getcurrentsystemnameserver(id);
+  biniptemp := getcurrentsystemnameserverbin(id);
   //must get the DNS server here so we know to init v4 or v6
 
-  ipstrtobin(addr,biniptemp);
-
   if biniptemp.family = AF_INET6 then biniptemp := ipstrtobinf('::') else biniptemp := ipstrtobinf('0.0.0.0');
 
 
   for a := 0 to numsockused-1 do begin
-    makeinaddrv(biniptemp,inttostr( 1024 + randominteger(65536 - 1024) ),inaddrtemp);
+    retrycount := 5;
+    repeat
+      if (retrycount <= 1) then begin
+        porttemp := 0; //for the last attempt let the OS decide
+      end else begin
+        porttemp := 1024 + randominteger(65536 - 1024);
+      end;
 
-    fd[a] := Socket(biniptemp.family,SOCK_DGRAM,0);
+      makeinaddrv(biniptemp,inttostr( porttemp ),inaddrtemp);
 
-    If {$ifndef win32}Not{$endif} Bind(fd[a],inAddrtemp,inaddrsize(inaddrtemp)) Then begin
-      {$ifdef win32}
+      fd[a] := Socket(biniptemp.family,SOCK_DGRAM,0);
+      bindresult := {$ifdef mswindows}Not{$endif} Bind(fd[a],inAddrtemp,inaddrsize(inaddrtemp));
+      dec(retrycount);
+    until (retrycount <= 0) or (bindresult);
+
+    If (not bindresult) Then begin
+      {$ifdef mswindows}
         raise Exception.create('unable to bind '+inttostr(WSAGetLastError));
       {$else}
         raise Exception.create('unable to bind '+inttostr(socketError));
@@ -165,42 +167,53 @@ begin
   end;
 end;
 
-procedure resolveloop(timeout:integer);
+procedure cleanupsockets;
 var
-  selectresult   : integer;
-  fds            : fdset;
+  a:integer;
+begin
+  for a := 0 to numsockused-1 do closesocket(fd[a]);
+end;
 
-  endtime      : longint;
-  starttime    : longint;
-  wrapmode     : boolean;
-  currenttime  : integer;
+function sendquery(socknum:integer;const packet:tdnspacket;len:integer):boolean;
+var
+  ip       : tbinip;
+  port       : ansistring;
+  inaddr     : TInetSockAddrV;
+begin
+{  writeln('sendquery ',decodename(state.packet,state.packetlen,12,0,a),' ',state.requesttype);}
+  result := false;
+  if len = 0 then exit; {no packet}
 
-  lag            : ttimeval;
-  selecttimeout	 : ttimeval;
-  socknum:integer;
-  needprocessing:array[0..numsock-1] of boolean;
-  finished:array[0..numsock-1] of boolean;
-  a,b:integer;
+  ip := getcurrentsystemnameserverbin(id);
 
-  Src    : TInetSockAddrV;
-  Srcx   : {$ifdef win32}sockaddr_in{$else}TInetSockAddrV{$endif} absolute Src;
-  SrcLen : Integer;
-  fromip:tbinip;
-  fromport:ansistring;
+  {$ifdef ipv6}{$ifdef mswindows}
+  if toaddr[socknum].family = AF_INET6 then if (useaf = 0) then useaf := useaf_preferv6;
+  {$endif}{$endif}
+
+  port := toport;
+  toaddr[socknum] := ip;
+  makeinaddrv(toaddr[socknum],port,inaddr);
+
+  sendto(fd[socknum],packet,len,0,inaddr,inaddrsize(inaddr));
+  sendquerytime[socknum] := getts;
+  result := true;
+end;
 
 begin
   if timeout < mintimeout then timeout := defaulttimeout;
 
-    starttime := getts;
-    endtime := starttime + timeout;
-    if (endtime and tswrap)=0 then begin
-      wrapmode := false;
-    end else begin
-      wrapmode := true;
-    end;
-    endtime := endtime and tsmask;
+  starttime := getts;
+  endtime := starttime + timeout;
+  if (endtime and tswrap)=0 then begin
+    wrapmode := false;
+  end else begin
+    wrapmode := true;
+  end;
+  endtime := endtime and tsmask;
 
   setupsocket;
+
+
   for socknum := 0 to numsockused-1 do begin
     needprocessing[socknum] := true;
     finished[socknum] := false;
@@ -221,6 +234,7 @@ begin
             if finished[a] then inc(b);
           end;
           if (b = numsockused) then begin
+            cleanupsockets;
             exit;
           end;
           //onrequestdone(self,0);
@@ -242,7 +256,7 @@ begin
       selecttimeout.tv_sec := 0;
       selecttimeout.tv_usec := retryafter;
     end;
-    //find the highest of the used fd's
+    //find the highest of the used fds
     b := 0;
     for socknum := numsockused-1 downto 0 do if fd[socknum] > b then b := fd[socknum];
     selectresult := select(b+1,@fds,nil,nil,@selecttimeout);
@@ -255,7 +269,7 @@ begin
         fillchar(state[socknum].recvpacket,sizeof(state[socknum].recvpacket),0);
         msectotimeval(lag,(currenttime-sendquerytime[socknum]) and tsmask);
 
-        if overridednsserver = '' then reportlag(id,(lag.tv_sec*1000000)+lag.tv_usec);
+        reportlag(id,(lag.tv_sec*1000000)+lag.tv_usec);
 
         SrcLen := SizeOf(Src);
         state[socknum].recvpacketlen := recvfrom(fd[socknum],state[socknum].recvpacket, SizeOf(state[socknum].recvpacket),0,Srcx,SrcLen);
@@ -278,8 +292,9 @@ begin
 
       currenttime := getts;
 
-      if overridednsserver = '' then reportlag(id,-1);
+      reportlag(id,-1);
       if (currenttime >= endtime) and ((not wrapmode) or (currenttime < starttime)) then begin
+        cleanupsockets;
         exit;
       end else begin
         //resend
@@ -300,6 +315,10 @@ var
   a:integer;
   biniptemp:tbinip;
   l:tbiniplist;
+
+  numsockused:integer;
+  state:tdnsstatearr;
+
 begin
   ipstrtobin(name,biniptemp);
   if biniptemp.family <> 0 then begin
@@ -308,7 +327,7 @@ begin
     exit; //it was an IP address, no need for dns
   end;
 
-  {$ifdef win32}
+  {$ifdef mswindows}
   if usewindns then begin
     if (useaf = useaf_v4) then a := af_inet else if (useaf = useaf_v6) then a := af_inet6 else a := 0;
     result := winforwardlookuplist(name,a,dummy);
@@ -348,7 +367,7 @@ begin
     end;
     {$endif}
 
-    resolveloop(timeout);
+    resolveloop(timeout,state,numsockused);
 
     if (numsockused = 1) then begin
       biniplist_addlist(result,state[0].resultlist);
@@ -376,8 +395,10 @@ end;
 function reverselookup(ip:tbinip;timeout:integer):ansistring;
 var
   dummy : integer;
+  numsockused:integer;
+  state:tdnsstatearr;
 begin
-  {$ifdef win32}
+  {$ifdef mswindows}
     if usewindns then begin
       result := winreverselookup(ip,dummy);
       exit;
@@ -386,12 +407,12 @@ begin
   {$ifdef syncdnscore}
   setstate_reverse(ip,state[0]);
   numsockused := 1;
-  resolveloop(timeout);
+  resolveloop(timeout,state,numsockused);
   result := state[0].resultstr;
   {$endif}
 end;
 
-{$ifdef win32}
+{$ifdef mswindows}
   var
     wsadata : twsadata;