replace internal uses of gettimeofday with monotonic time where appropriate. make...

[lcore.git] / dnssync.pas

diff --git a/dnssync.pas b/dnssync.pas
old mode 100755 (executable)
new mode 100644 (file)
index 3632b29..84caf9a
--- a/dnssync.pas
+++ b/dnssync.pas
@@ -13,7 +13,7 @@ interface
   uses\r
     dnscore,\r
     binipstuff,\r
   uses\r
     dnscore,\r
     binipstuff,\r

-    {$ifdef win32}\r
+    {$ifdef mswindows}\r

       winsock,\r
       windows,\r
     {$else}\r
       winsock,\r
       windows,\r
     {$else}\r


@@ -25,33 +25,28 @@ interface
       sockets,\r
       fd_utils,\r
     {$endif}\r
       sockets,\r
       fd_utils,\r
     {$endif}\r

-    sysutils;\r
+    lcorernd,\r
+    sysutils,\r
+    ltimevalstuff;\r

 \r
 //convert a name to an IP\r
 //will return v4 or v6 depending on what seems favorable, or manual preference setting\r
 \r
 //convert a name to an IP\r
 //will return v4 or v6 depending on what seems favorable, or manual preference setting\r

-//on error the binip will have a family of 0 (other fiels are also currently\r
+//on error the binip will have a family of 0 (other fields are also currently\r

 //zeroed out but may be used for further error information in future)\r
 //zeroed out but may be used for further error information in future)\r

-//timeout is in miliseconds, it is ignored when using windows dns\r
-function forwardlookup(name:string;timeout:integer):tbinip;\r
+//timeout is in milliseconds, it is ignored when using windows dns\r
+function forwardlookup(name:ansistring;timeout:integer):tbinip;\r

 \r
 //convert a name to a list of all IP's returned\r
 //this returns both v4 and v6 IP's, or possibly only v4 or v6, depending on settings\r
 //on error, returns an empty list\r
 \r
 //convert a name to a list of all IP's returned\r
 //this returns both v4 and v6 IP's, or possibly only v4 or v6, depending on settings\r
 //on error, returns an empty list\r

-function forwardlookuplist(name:string;timeout:integer):tbiniplist;\r
+function forwardlookuplist(name:ansistring;timeout:integer):tbiniplist;\r

 \r
 \r
 //convert an IP to a name, on error a null string will be returned, other\r
 //details as above\r
 \r
 \r
 //convert an IP to a name, on error a null string will be returned, other\r
 //details as above\r

-function reverselookup(ip:tbinip;timeout:integer):string;\r
+function reverselookup(ip:tbinip;timeout:integer):ansistring;\r

 \r
 \r

-{$ifdef linux}{$ifdef ipv6}\r
-function getv6localips:tbiniplist;\r
-procedure initpreferredmode;\r

 \r
 \r

-var\r
-  preferredmodeinited:boolean;\r
-\r
-{$endif}{$endif}\r

 \r
 const\r
   tswrap=$4000;\r
 \r
 const\r
   tswrap=$4000;\r


@@ -61,33 +56,27 @@ const
   defaulttimeout=10000;\r
   const mintimeout=16;\r
 \r
   defaulttimeout=10000;\r
   const mintimeout=16;\r
 \r

-var\r
-  dnssyncserver:string;\r
-  id:integer;\r
+  toport='53';\r

 \r
 \r

-  sendquerytime:array[0..numsock-1] of integer;\r

 implementation\r
 \r
 implementation\r
 \r

-{$ifdef win32}\r
+{$ifdef mswindows}\r

   uses dnswin;\r
 {$endif}\r
 \r
 \r
   uses dnswin;\r
 {$endif}\r
 \r
 \r

-{$ifndef win32}\r
+{$ifndef mswindows}\r

 {$define syncdnscore}\r
 {$endif}\r
 \r
 {$i unixstuff.inc}\r
 {$define syncdnscore}\r
 {$endif}\r
 \r
 {$i unixstuff.inc}\r

-{$i ltimevalstuff.inc}\r

 \r
 \r

-var\r
-  numsockused:integer;\r
-  fd:array[0..numsock-1] of integer;\r
-  state:array[0..numsock-1] of tdnsstate;\r
+type tdnsstatearr=array[0..numsock-1] of tdnsstate;\r

 \r
 {$ifdef syncdnscore}\r
 \r
 \r
 {$ifdef syncdnscore}\r
 \r

-{$ifdef win32}\r
+\r
+{$ifdef mswindows}\r

   const\r
     winsocket = 'wsock32.dll';\r
   function sendto(s: TSocket; const Buf; len, flags: Integer; var addrto: TinetSockAddrV; tolen: Integer): Integer; stdcall; external    winsocket name 'sendto';\r
   const\r
     winsocket = 'wsock32.dll';\r
   function sendto(s: TSocket; const Buf; len, flags: Integer; var addrto: TinetSockAddrV; tolen: Integer): Integer; stdcall; external    winsocket name 'sendto';\r


@@ -98,64 +87,78 @@ var
 \r
 \r
 function getts:integer;\r
 \r
 \r
 function getts:integer;\r

-{$ifdef win32}\r
+{$ifdef mswindows}\r

 begin\r
   result := GetTickCount and tsmask;\r
 {$else}\r
 var\r
   temp:ttimeval;\r
 begin\r
 begin\r
   result := GetTickCount and tsmask;\r
 {$else}\r
 var\r
   temp:ttimeval;\r
 begin\r

-  gettimeofday(temp);\r
+  gettimemonotonic(temp);\r

   result := ((temp.tv_usec div 1000) + (temp.tv_sec * 1000)) and tsmask;\r
 {$endif}\r
 end;\r
 \r
   result := ((temp.tv_usec div 1000) + (temp.tv_sec * 1000)) and tsmask;\r
 {$endif}\r
 end;\r
 \r

-\r
-function sendquery(socknum:integer;const packet:tdnspacket;len:integer):boolean;\r
+procedure resolveloop(timeout:integer;var state:tdnsstatearr;numsockused:integer);\r

 var\r
 var\r

-  a:integer;\r
-  addr       : string;\r
-  port       : string;\r
-  inaddr     : TInetSockAddrV;\r
-begin\r
-{  writeln('sendquery ',decodename(state.packet,state.packetlen,12,0,a),' ',state.requesttype);}\r
-  result := false;\r
-  if len = 0 then exit; {no packet}\r
+  selectresult   : integer;\r
+  fds            : fdset;\r
+\r
+  endtime      : longint;\r
+  starttime    : longint;\r
+  wrapmode     : boolean;\r
+  currenttime  : integer;\r
+\r
+  lag            : ttimeval;\r
+  selecttimeout         : ttimeval;\r
+  socknum:integer;\r
+  needprocessing:array[0..numsock-1] of boolean;\r
+  finished:array[0..numsock-1] of boolean;\r
+  a,b:integer;\r

 \r
 \r

-  if dnssyncserver <> '' then addr := dnssyncserver else addr := getcurrentsystemnameserver(id);\r
-  port := '53';\r
+  Src    : TInetSockAddrV;\r
+  Srcx   : {$ifdef mswindows}sockaddr_in{$else}TInetSockAddrV{$endif} absolute Src;\r
+  SrcLen : Integer;\r
+  fromip:tbinip;\r
+  fromport:ansistring;\r

 \r
 \r

-  makeinaddrv(ipstrtobinf(addr),port,inaddr);\r
+  fd:array[0..numsock-1] of integer;\r
+  toaddr:array[0..numsock-1] of tbinip;\r
+  id:integer;\r
+  sendquerytime:array[0..numsock-1] of integer;\r

 \r
 \r

-  sendto(fd[socknum],packet,len,0,inaddr,inaddrsize(inaddr));\r
-  sendquerytime[socknum] := getts;\r
-  result := true;\r
-end;\r

 \r
 procedure setupsocket;\r
 var\r
   inAddrtemp : TInetSockAddrV;\r
 \r
 procedure setupsocket;\r
 var\r
   inAddrtemp : TInetSockAddrV;\r

-  a:integer;\r

   biniptemp:tbinip;\r
   biniptemp:tbinip;\r

-  addr:string;\r
+  a,retrycount,porttemp:integer;\r
+  bindresult:boolean;\r

 begin\r
 begin\r

-  //init both sockets smultaneously, always, so they get succesive fd's\r
-  if fd[0] > 0 then exit;\r
-\r
-  if dnssyncserver <> '' then addr := dnssyncserver else addr := getcurrentsystemnameserver(id);\r
+  biniptemp := getcurrentsystemnameserverbin(id);\r

   //must get the DNS server here so we know to init v4 or v6\r
 \r
   //must get the DNS server here so we know to init v4 or v6\r
 \r

-  fillchar(inaddrtemp,sizeof(inaddrtemp),0);\r
-  ipstrtobin(addr,biniptemp);\r
-  if biniptemp.family = 0 then biniptemp.family := AF_INET;\r
+  if biniptemp.family = AF_INET6 then biniptemp := ipstrtobinf('::') else biniptemp := ipstrtobinf('0.0.0.0');\r

 \r
 \r

-  inaddrtemp.inaddr.family := biniptemp.family;\r

 \r
   for a := 0 to numsockused-1 do begin\r
 \r
   for a := 0 to numsockused-1 do begin\r

-    fd[a] := Socket(biniptemp.family,SOCK_DGRAM,0);\r
+    retrycount := 5;\r
+    repeat\r
+      if (retrycount <= 1) then begin\r
+        porttemp := 0; //for the last attempt let the OS decide\r
+      end else begin\r
+        porttemp := 1024 + randominteger(65536 - 1024);\r
+      end;\r

 \r
 \r

-    If {$ifndef win32}Not{$endif} Bind(fd[a],inAddrtemp,inaddrsize(inaddrtemp)) Then begin\r
-      {$ifdef win32}\r
+      makeinaddrv(biniptemp,inttostr( porttemp ),inaddrtemp);\r
+\r
+      fd[a] := Socket(biniptemp.family,SOCK_DGRAM,0);\r
+      bindresult := {$ifdef mswindows}Not{$endif} Bind(fd[a],inAddrtemp,inaddrsize(inaddrtemp));\r
+      dec(retrycount);\r
+    until (retrycount <= 0) or (bindresult);\r
+\r
+    If (not bindresult) Then begin\r
+      {$ifdef mswindows}\r

         raise Exception.create('unable to bind '+inttostr(WSAGetLastError));\r
       {$else}\r
         raise Exception.create('unable to bind '+inttostr(socketError));\r
         raise Exception.create('unable to bind '+inttostr(WSAGetLastError));\r
       {$else}\r
         raise Exception.create('unable to bind '+inttostr(socketError));\r


@@ -164,37 +167,53 @@ begin
   end;\r
 end;\r
 \r
   end;\r
 end;\r
 \r

-procedure resolveloop(timeout:integer);\r
+procedure cleanupsockets;\r

 var\r
 var\r

-  selectresult   : integer;\r
-  fds            : fdset;\r
+  a:integer;\r
+begin\r
+  for a := 0 to numsockused-1 do closesocket(fd[a]);\r
+end;\r

 \r
 \r

-  endtime      : longint;\r
-  starttime    : longint;\r
-  wrapmode     : boolean;\r
-  currenttime  : integer;\r
+function sendquery(socknum:integer;const packet:tdnspacket;len:integer):boolean;\r
+var\r
+  ip       : tbinip;\r
+  port       : ansistring;\r
+  inaddr     : TInetSockAddrV;\r
+begin\r
+{  writeln('sendquery ',decodename(state.packet,state.packetlen,12,0,a),' ',state.requesttype);}\r
+  result := false;\r
+  if len = 0 then exit; {no packet}\r

 \r
 \r

-  lag            : ttimeval;\r
-  currenttimeout : ttimeval;\r
-  selecttimeout         : ttimeval;\r
-  socknum:integer;\r
-  needprocessing:array[0..numsock-1] of boolean;\r
-  finished:array[0..numsock-1] of boolean;\r
-  a,b:integer;\r
+  ip := getcurrentsystemnameserverbin(id);\r
+\r
+  {$ifdef ipv6}{$ifdef mswindows}\r
+  if toaddr[socknum].family = AF_INET6 then if (useaf = 0) then useaf := useaf_preferv6;\r
+  {$endif}{$endif}\r
+\r
+  port := toport;\r
+  toaddr[socknum] := ip;\r
+  makeinaddrv(toaddr[socknum],port,inaddr);\r
+\r
+  sendto(fd[socknum],packet,len,0,inaddr,inaddrsize(inaddr));\r
+  sendquerytime[socknum] := getts;\r
+  result := true;\r
+end;\r

 \r
 begin\r
   if timeout < mintimeout then timeout := defaulttimeout;\r
 \r
 \r
 begin\r
   if timeout < mintimeout then timeout := defaulttimeout;\r
 \r

-    starttime := getts;\r
-    endtime := starttime + timeout;\r
-    if (endtime and tswrap)=0 then begin\r
-      wrapmode := false;\r
-    end else begin\r
-      wrapmode := true;\r
-    end;\r
-    endtime := endtime and tsmask;\r
+  starttime := getts;\r
+  endtime := starttime + timeout;\r
+  if (endtime and tswrap)=0 then begin\r
+    wrapmode := false;\r
+  end else begin\r
+    wrapmode := true;\r
+  end;\r
+  endtime := endtime and tsmask;\r

 \r
   setupsocket;\r
 \r
   setupsocket;\r

+\r
+\r

   for socknum := 0 to numsockused-1 do begin\r
     needprocessing[socknum] := true;\r
     finished[socknum] := false;\r
   for socknum := 0 to numsockused-1 do begin\r
     needprocessing[socknum] := true;\r
     finished[socknum] := false;\r


@@ -215,6 +234,7 @@ begin
             if finished[a] then inc(b);\r
           end;\r
           if (b = numsockused) then begin\r
             if finished[a] then inc(b);\r
           end;\r
           if (b = numsockused) then begin\r

+            cleanupsockets;\r

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


@@ -236,7 +256,7 @@ begin
       selecttimeout.tv_sec := 0;\r
       selecttimeout.tv_usec := retryafter;\r
     end;\r
       selecttimeout.tv_sec := 0;\r
       selecttimeout.tv_usec := retryafter;\r
     end;\r

-    //find the highest of the used fd's\r
+    //find the highest of the used fds\r

     b := 0;\r
     for socknum := numsockused-1 downto 0 do if fd[socknum] > b then b := fd[socknum];\r
     selectresult := select(b+1,@fds,nil,nil,@selecttimeout);\r
     b := 0;\r
     for socknum := numsockused-1 downto 0 do if fd[socknum] > b then b := fd[socknum];\r
     selectresult := select(b+1,@fds,nil,nil,@selecttimeout);\r


@@ -249,10 +269,22 @@ begin
         fillchar(state[socknum].recvpacket,sizeof(state[socknum].recvpacket),0);\r
         msectotimeval(lag,(currenttime-sendquerytime[socknum]) and tsmask);\r
 \r
         fillchar(state[socknum].recvpacket,sizeof(state[socknum].recvpacket),0);\r
         msectotimeval(lag,(currenttime-sendquerytime[socknum]) and tsmask);\r
 \r

-        if dnssyncserver = '' then reportlag(id,(lag.tv_sec*1000000)+lag.tv_usec);\r
-        state[socknum].recvpacketlen := recv(fd[socknum],state[socknum].recvpacket, SizeOf(state[socknum].recvpacket),0);\r
-        state[socknum].parsepacket := true;\r
-        needprocessing[socknum] := true;\r
+        reportlag(id,(lag.tv_sec*1000000)+lag.tv_usec);\r
+\r
+        SrcLen := SizeOf(Src);\r
+        state[socknum].recvpacketlen := recvfrom(fd[socknum],state[socknum].recvpacket, SizeOf(state[socknum].recvpacket),0,Srcx,SrcLen);\r
+\r
+        if (state[socknum].recvpacketlen > 0) then begin\r
+          fromip := inaddrvtobinip(Src);\r
+          fromport := inttostr(htons(src.InAddr.port));\r
+          if ((not comparebinip(toaddr[socknum],fromip)) or (fromport <> toport)) then begin\r
+//            writeln('dnssync received from wrong IP:port ',ipbintostr(fromip),'#',fromport);\r
+            state[socknum].recvpacketlen := 0;\r
+          end else begin\r
+            state[socknum].parsepacket := true;\r
+            needprocessing[socknum] := true;\r
+          end;\r
+        end;\r

       end;\r
     end;\r
     if selectresult < 0 then exit;\r
       end;\r
     end;\r
     if selectresult < 0 then exit;\r


@@ -260,8 +292,9 @@ begin
 \r
       currenttime := getts;\r
 \r
 \r
       currenttime := getts;\r
 \r

-      if dnssyncserver = '' then reportlag(id,-1);\r
+      reportlag(id,-1);\r

       if (currenttime >= endtime) and ((not wrapmode) or (currenttime < starttime)) then begin\r
       if (currenttime >= endtime) and ((not wrapmode) or (currenttime < starttime)) then begin\r

+        cleanupsockets;\r

         exit;\r
       end else begin\r
         //resend\r
         exit;\r
       end else begin\r
         //resend\r


@@ -274,24 +307,18 @@ begin
 end;\r
 {$endif}\r
 \r
 end;\r
 {$endif}\r
 \r

-procedure addipsoffamily(var l:tbiniplist;const l2:tbiniplist;family:integer);\r
-var\r
-  a:integer;\r
-  biniptemp:tbinip;\r
-begin\r
-  for a := biniplist_getcount(l2)-1 downto 0 do begin\r
-    biniptemp := biniplist_get(l2,a);\r
-    if (biniptemp.family = family) then biniplist_add(l,biniptemp);\r
-  end;\r
-end;\r

 \r
 \r
 \r
 \r

-function forwardlookuplist(name:string;timeout:integer):tbiniplist;\r
+function forwardlookuplist(name:ansistring;timeout:integer):tbiniplist;\r

 var\r
   dummy : integer;\r
 var\r
   dummy : integer;\r

-  a,b:integer;\r
+  a:integer;\r

   biniptemp:tbinip;\r
   l:tbiniplist;\r
   biniptemp:tbinip;\r
   l:tbiniplist;\r

+\r
+  numsockused:integer;\r
+  state:tdnsstatearr;\r
+\r

 begin\r
   ipstrtobin(name,biniptemp);\r
   if biniptemp.family <> 0 then begin\r
 begin\r
   ipstrtobin(name,biniptemp);\r
   if biniptemp.family <> 0 then begin\r


@@ -300,7 +327,7 @@ begin
     exit; //it was an IP address, no need for dns\r
   end;\r
 \r
     exit; //it was an IP address, no need for dns\r
   end;\r
 \r

-  {$ifdef win32}\r
+  {$ifdef mswindows}\r

   if usewindns then begin\r
     if (useaf = useaf_v4) then a := af_inet else if (useaf = useaf_v6) then a := af_inet6 else a := 0;\r
     result := winforwardlookuplist(name,a,dummy);\r
   if usewindns then begin\r
     if (useaf = useaf_v4) then a := af_inet else if (useaf = useaf_v6) then a := af_inet6 else a := 0;\r
     result := winforwardlookuplist(name,a,dummy);\r


@@ -324,7 +351,7 @@ begin
   {$endif}\r
   begin\r
   {$ifdef syncdnscore}\r
   {$endif}\r
   begin\r
   {$ifdef syncdnscore}\r

-    {$ifdef linux}{$ifdef ipv6}initpreferredmode;{$endif}{$endif}\r
+    {$ifdef ipv6}initpreferredmode;{$endif}\r

 \r
     numsockused := 0;\r
 \r
 \r
     numsockused := 0;\r
 \r


@@ -340,7 +367,7 @@ begin
     end;\r
     {$endif}\r
 \r
     end;\r
     {$endif}\r
 \r

-    resolveloop(timeout);\r
+    resolveloop(timeout,state,numsockused);\r

 \r
     if (numsockused = 1) then begin\r
       biniplist_addlist(result,state[0].resultlist);\r
 \r
     if (numsockused = 1) then begin\r
       biniplist_addlist(result,state[0].resultlist);\r


@@ -351,13 +378,13 @@ begin
     end else begin\r
       biniplist_addlist(result,state[0].resultlist);\r
       biniplist_addlist(result,state[1].resultlist);\r
     end else begin\r
       biniplist_addlist(result,state[0].resultlist);\r
       biniplist_addlist(result,state[1].resultlist);\r

-    {$endif}  \r
+    {$endif}\r

     end;\r
     {$endif}\r
   end;\r
 end;\r
 \r
     end;\r
     {$endif}\r
   end;\r
 end;\r
 \r

-function forwardlookup(name:string;timeout:integer):tbinip;\r
+function forwardlookup(name:ansistring;timeout:integer):tbinip;\r

 var\r
   listtemp:tbiniplist;\r
 begin\r
 var\r
   listtemp:tbiniplist;\r
 begin\r


@@ -365,11 +392,13 @@ begin
   result := biniplist_get(listtemp,0);\r
 end;\r
 \r
   result := biniplist_get(listtemp,0);\r
 end;\r
 \r

-function reverselookup(ip:tbinip;timeout:integer):string;\r
+function reverselookup(ip:tbinip;timeout:integer):ansistring;\r

 var\r
   dummy : integer;\r
 var\r
   dummy : integer;\r

+  numsockused:integer;\r
+  state:tdnsstatearr;\r

 begin\r
 begin\r

-  {$ifdef win32}\r
+  {$ifdef mswindows}\r

     if usewindns then begin\r
       result := winreverselookup(ip,dummy);\r
       exit;\r
     if usewindns then begin\r
       result := winreverselookup(ip,dummy);\r
       exit;\r


@@ -378,68 +407,12 @@ begin
   {$ifdef syncdnscore}\r
   setstate_reverse(ip,state[0]);\r
   numsockused := 1;\r
   {$ifdef syncdnscore}\r
   setstate_reverse(ip,state[0]);\r
   numsockused := 1;\r

-  resolveloop(timeout);\r
+  resolveloop(timeout,state,numsockused);\r

   result := state[0].resultstr;\r
   {$endif}\r
 end;\r
 \r
   result := state[0].resultstr;\r
   {$endif}\r
 end;\r
 \r

-{$ifdef linux}{$ifdef ipv6}{$ifdef syncdnscore}\r
-function getv6localips:tbiniplist;\r
-var\r
-  t:textfile;\r
-  s,s2:string;\r
-  ip:tbinip;\r
-  a:integer;\r
-begin\r
-  result := biniplist_new;\r
-\r
-  assignfile(t,'/proc/net/if_inet6');\r
-  {$i-}reset(t);{$i+}\r
-  if ioresult <> 0 then exit; {none found, return empty list}\r
-\r
-  while not eof(t) do begin\r
-    readln(t,s);\r
-    s2 := '';\r
-    for a := 0 to 7 do begin\r
-      if (s2 <> '') then s2 := s2 + ':';\r
-      s2 := s2 + copy(s,(a shl 2)+1,4);\r
-    end;\r
-    ipstrtobin(s2,ip);\r
-    if ip.family <> 0 then biniplist_add(result,ip);\r
-  end;\r
-  closefile(t);\r
-end;\r
-\r
-procedure initpreferredmode;\r
-var\r
-  l:tbiniplist;\r
-  a:integer;\r
-  ip:tbinip;\r
-  ipmask_global,ipmask_6to4,ipmask_teredo:tbinip;\r
-\r
-begin\r
-  if preferredmodeinited then exit;\r
-  if useaf <> useaf_default then exit;\r
-  useaf := useaf_preferv4;\r
-  l := getv6localips;\r
-  ipstrtobin('2000::',ipmask_global);\r
-  ipstrtobin('2001::',ipmask_teredo);\r
-  ipstrtobin('2002::',ipmask_6to4);\r
-  {if there is any v6 IP which is globally routable and not 6to4 and not teredo, prefer v6}\r
-  for a := biniplist_getcount(l)-1 downto 0 do begin\r
-    ip := biniplist_get(l,a);\r
-    if not comparebinipmask(ip,ipmask_global,3) then continue;\r
-    if comparebinipmask(ip,ipmask_teredo,32) then continue;\r
-    if comparebinipmask(ip,ipmask_6to4,16) then continue;\r
-    useaf := useaf_preferv6;\r
-    preferredmodeinited := true;\r
-    exit;\r
-  end;\r
-end;\r
-\r
-{$endif}{$endif}{$endif}\r
-\r
-{$ifdef win32}\r
+{$ifdef mswindows}\r

   var\r
     wsadata : twsadata;\r
 \r
   var\r
     wsadata : twsadata;\r
 \r