X-Git-Url: http://www.lcore.org/git/lcore.git/blobdiff_plain/6cb6b7ede2d178e03fa817bc28474c175f5a93b9..refs/heads/master:/dnssync.pas?ds=inline

diff --git a/dnssync.pas b/dnssync.pas
old mode 100755
new mode 100644
index 3632b29..66d9802
--- a/dnssync.pas
+++ b/dnssync.pas
@@ -13,7 +13,7 @@ interface
   uses
     dnscore,
     binipstuff,
-    {$ifdef win32}
+    {$ifdef mswindows}
       winsock,
       windows,
     {$else}
@@ -25,33 +25,28 @@ interface
       sockets,
       fd_utils,
     {$endif}
-    sysutils;
+    lcorernd,
+    sysutils,
+    ltimevalstuff;
 
 //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
-function forwardlookup(name:string;timeout:integer):tbinip;
+//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
 //this returns both v4 and v6 IP's, or possibly only v4 or v6, depending on settings
 //on error, returns an empty list
-function forwardlookuplist(name:string;timeout:integer):tbiniplist;
+function forwardlookuplist(name:ansistring;timeout:integer):tbiniplist;
 
 
 //convert an IP to a name, on error a null string will be returned, other
 //details as above
-function reverselookup(ip:tbinip;timeout:integer):string;
+function reverselookup(ip:tbinip;timeout:integer):ansistring;
 
-{$ifdef linux}{$ifdef ipv6}
-function getv6localips:tbiniplist;
-procedure initpreferredmode;
 
-var
-  preferredmodeinited:boolean;
-
-{$endif}{$endif}
 
 const
   tswrap=$4000;
@@ -61,33 +56,27 @@ const
   defaulttimeout=10000;
   const mintimeout=16;
 
-var
-  dnssyncserver:string;
-  id:integer;
+  toport='53';
 
-  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}
-{$i ltimevalstuff.inc}
 
-var
-  numsockused:integer;
-  fd:array[0..numsock-1] of integer;
-  state:array[0..numsock-1] of tdnsstate;
+type tdnsstatearr=array[0..numsock-1] of tdnsstate;
 
 {$ifdef syncdnscore}
 
-{$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';
@@ -98,64 +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
-  a:integer;
-  addr       : string;
-  port       : string;
-  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;
+
+  endtime      : longint;
+  starttime    : longint;
+  wrapmode     : boolean;
+  currenttime  : integer;
+
+  lag            : ttimeval;
+  selecttimeout	 : ttimeval;
+  socknum:integer;
+  needprocessing:array[0..numsock-1] of boolean;
+  finished:array[0..numsock-1] of boolean;
+  a,b:integer;
 
-  if dnssyncserver <> '' then addr := dnssyncserver else addr := getcurrentsystemnameserver(id);
-  port := '53';
+  Src    : TInetSockAddrV;
+  Srcx   : {$ifdef mswindows}sockaddr_in{$else}TInetSockAddrV{$endif} absolute Src;
+  SrcLen : Integer;
+  fromip:tbinip;
+  fromport:ansistring;
 
-  makeinaddrv(ipstrtobinf(addr),port,inaddr);
+  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:string;
+  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 dnssyncserver <> '' then addr := dnssyncserver else addr := getcurrentsystemnameserver(id);
+  biniptemp := getcurrentsystemnameserverbin(id);
   //must get the DNS server here so we know to init v4 or v6
 
-  fillchar(inaddrtemp,sizeof(inaddrtemp),0);
-  ipstrtobin(addr,biniptemp);
-  if biniptemp.family = 0 then biniptemp.family := AF_INET;
+  if biniptemp.family = AF_INET6 then biniptemp := ipstrtobinf('::') else biniptemp := ipstrtobinf('0.0.0.0');
 
-  inaddrtemp.inaddr.family := biniptemp.family;
 
   for a := 0 to numsockused-1 do begin
-    fd[a] := Socket(biniptemp.family,SOCK_DGRAM,0);
+    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;
 
-    If {$ifndef win32}Not{$endif} Bind(fd[a],inAddrtemp,inaddrsize(inaddrtemp)) Then begin
-      {$ifdef win32}
+      makeinaddrv(biniptemp,inttostr( porttemp ),inaddrtemp);
+
+      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));
@@ -164,37 +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;
-  currenttimeout : 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);
+
+  {$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;
@@ -215,6 +234,7 @@ begin
             if finished[a] then inc(b);
           end;
           if (b = numsockused) then begin
+            cleanupsockets;
             exit;
           end;
           //onrequestdone(self,0);
@@ -236,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);
@@ -249,10 +269,22 @@ begin
         fillchar(state[socknum].recvpacket,sizeof(state[socknum].recvpacket),0);
         msectotimeval(lag,(currenttime-sendquerytime[socknum]) and tsmask);
 
-        if dnssyncserver = '' then reportlag(id,(lag.tv_sec*1000000)+lag.tv_usec);
-        state[socknum].recvpacketlen := recv(fd[socknum],state[socknum].recvpacket, SizeOf(state[socknum].recvpacket),0);
-        state[socknum].parsepacket := true;
-        needprocessing[socknum] := true;
+        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);
+
+        if (state[socknum].recvpacketlen > 0) then begin
+          fromip := inaddrvtobinip(Src);
+          fromport := inttostr(htons(src.InAddr.port));
+          if ((not comparebinip(toaddr[socknum],fromip)) or (fromport <> toport)) then begin
+//            writeln('dnssync received from wrong IP:port ',ipbintostr(fromip),'#',fromport);
+            state[socknum].recvpacketlen := 0;
+          end else begin
+            state[socknum].parsepacket := true;
+            needprocessing[socknum] := true;
+          end;
+        end;
       end;
     end;
     if selectresult < 0 then exit;
@@ -260,8 +292,9 @@ begin
 
       currenttime := getts;
 
-      if dnssyncserver = '' then reportlag(id,-1);
+      reportlag(id,-1);
       if (currenttime >= endtime) and ((not wrapmode) or (currenttime < starttime)) then begin
+        cleanupsockets;
         exit;
       end else begin
         //resend
@@ -274,24 +307,18 @@ begin
 end;
 {$endif}
 
-procedure addipsoffamily(var l:tbiniplist;const l2:tbiniplist;family:integer);
-var
-  a:integer;
-  biniptemp:tbinip;
-begin
-  for a := biniplist_getcount(l2)-1 downto 0 do begin
-    biniptemp := biniplist_get(l2,a);
-    if (biniptemp.family = family) then biniplist_add(l,biniptemp);
-  end;
-end;
 
 
-function forwardlookuplist(name:string;timeout:integer):tbiniplist;
+function forwardlookuplist(name:ansistring;timeout:integer):tbiniplist;
 var
   dummy : integer;
-  a,b:integer;
+  a:integer;
   biniptemp:tbinip;
   l:tbiniplist;
+
+  numsockused:integer;
+  state:tdnsstatearr;
+
 begin
   ipstrtobin(name,biniptemp);
   if biniptemp.family <> 0 then begin
@@ -300,8 +327,8 @@ begin
     exit; //it was an IP address, no need for dns
   end;
 
-  {$ifdef win32}
-  if usewindns then begin
+  {$ifdef mswindows}
+  if usewindns and (overridednsserver = '') 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);
     {$ifdef ipv6}
@@ -324,7 +351,7 @@ begin
   {$endif}
   begin
   {$ifdef syncdnscore}
-    {$ifdef linux}{$ifdef ipv6}initpreferredmode;{$endif}{$endif}
+    {$ifdef ipv6}initpreferredmode;{$endif}
 
     numsockused := 0;
 
@@ -340,7 +367,7 @@ begin
     end;
     {$endif}
 
-    resolveloop(timeout);
+    resolveloop(timeout,state,numsockused);
 
     if (numsockused = 1) then begin
       biniplist_addlist(result,state[0].resultlist);
@@ -351,13 +378,13 @@ begin
     end else begin
       biniplist_addlist(result,state[0].resultlist);
       biniplist_addlist(result,state[1].resultlist);
-    {$endif}  
+    {$endif}
     end;
     {$endif}
   end;
 end;
 
-function forwardlookup(name:string;timeout:integer):tbinip;
+function forwardlookup(name:ansistring;timeout:integer):tbinip;
 var
   listtemp:tbiniplist;
 begin
@@ -365,12 +392,14 @@ begin
   result := biniplist_get(listtemp,0);
 end;
 
-function reverselookup(ip:tbinip;timeout:integer):string;
+function reverselookup(ip:tbinip;timeout:integer):ansistring;
 var
   dummy : integer;
+  numsockused:integer;
+  state:tdnsstatearr;
 begin
-  {$ifdef win32}
-    if usewindns then begin
+  {$ifdef mswindows}
+    if usewindns and (overridednsserver = '') then begin
       result := winreverselookup(ip,dummy);
       exit;
     end;
@@ -378,68 +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 linux}{$ifdef ipv6}{$ifdef syncdnscore}
-function getv6localips:tbiniplist;
-var
-  t:textfile;
-  s,s2:string;
-  ip:tbinip;
-  a:integer;
-begin
-  result := biniplist_new;
-
-  assignfile(t,'/proc/net/if_inet6');
-  {$i-}reset(t);{$i+}
-  if ioresult <> 0 then exit; {none found, return empty list}
-
-  while not eof(t) do begin
-    readln(t,s);
-    s2 := '';
-    for a := 0 to 7 do begin
-      if (s2 <> '') then s2 := s2 + ':';
-      s2 := s2 + copy(s,(a shl 2)+1,4);
-    end;
-    ipstrtobin(s2,ip);
-    if ip.family <> 0 then biniplist_add(result,ip);
-  end;
-  closefile(t);
-end;
-
-procedure initpreferredmode;
-var
-  l:tbiniplist;
-  a:integer;
-  ip:tbinip;
-  ipmask_global,ipmask_6to4,ipmask_teredo:tbinip;
-
-begin
-  if preferredmodeinited then exit;
-  if useaf <> useaf_default then exit;
-  useaf := useaf_preferv4;
-  l := getv6localips;
-  ipstrtobin('2000::',ipmask_global);
-  ipstrtobin('2001::',ipmask_teredo);
-  ipstrtobin('2002::',ipmask_6to4);
-  {if there is any v6 IP which is globally routable and not 6to4 and not teredo, prefer v6}
-  for a := biniplist_getcount(l)-1 downto 0 do begin
-    ip := biniplist_get(l,a);
-    if not comparebinipmask(ip,ipmask_global,3) then continue;
-    if comparebinipmask(ip,ipmask_teredo,32) then continue;
-    if comparebinipmask(ip,ipmask_6to4,16) then continue;
-    useaf := useaf_preferv6;
-    preferredmodeinited := true;
-    exit;
-  end;
-end;
-
-{$endif}{$endif}{$endif}
-
-{$ifdef win32}
+{$ifdef mswindows}
   var
     wsadata : twsadata;