the big lot of changes by beware

[lcore.git] / dnssync.pas

diff --git a/dnssync.pas b/dnssync.pas
index 379aa05c81be4abb3ffec4e6c7370708266a73f1..3632b295f3a65a39ebaa88e700a1f6c221faff4c 100755 (executable)
--- a/dnssync.pas
+++ b/dnssync.pas
@@ -7,6 +7,8 @@ unit dnssync;
   {$mode delphi}\r
 {$endif}\r
 \r
   {$mode delphi}\r
 {$endif}\r
 \r

+{$include lcoreconfig.inc}\r
+\r

 interface\r
   uses\r
     dnscore,\r
 interface\r
   uses\r
     dnscore,\r


@@ -26,54 +28,95 @@ interface
     sysutils;\r
 \r
 //convert a name to an IP\r
     sysutils;\r
 \r
 //convert a name to an IP\r

-//IPV4 is preffered if availible, if not IPV6 will be returned (if ipv6 support\r
-//compiled in)\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
 //zeroed out but may be used for further error information in future)\r
 //on error the binip will have a family of 0 (other fiels are also currently\r
 //zeroed out but may be used for further error information in future)\r

-//timeout is in seconds, it is ignored when using windows dns\r
+//timeout is in miliseconds, it is ignored when using windows dns\r

 function forwardlookup(name:string;timeout:integer):tbinip;\r
 \r
 function forwardlookup(name:string;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
+function forwardlookuplist(name:string;timeout:integer):tbiniplist;\r
+\r

 \r
 \r

-//convert an IP to a name, on error a null string will be returned, other \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
 \r
 //details as above\r
 function reverselookup(ip:tbinip;timeout:integer):string;\r
 \r

+{$ifdef linux}{$ifdef ipv6}\r
+function getv6localips:tbiniplist;\r
+procedure initpreferredmode;\r
+\r
+var\r
+  preferredmodeinited:boolean;\r
+\r
+{$endif}{$endif}\r
+\r
+const\r
+  tswrap=$4000;\r
+  tsmask=tswrap-1;\r
+\r
+  numsock=1{$ifdef ipv6}+1{$endif};\r
+  defaulttimeout=10000;\r
+  const mintimeout=16;\r

 \r
 var\r
   dnssyncserver:string;\r
 \r
 var\r
   dnssyncserver:string;\r

-  id : integer;\r
-  {$ifdef win32}\r
-    sendquerytime : integer;\r
-  {$else}\r
-    sendquerytime : ttimeval;\r
-  {$endif}\r
+  id:integer;\r
+\r
+  sendquerytime:array[0..numsock-1] of integer;\r

 implementation\r
 implementation\r

+\r

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

+\r
+{$ifndef win32}\r
+{$define syncdnscore}\r
+{$endif}\r
+\r

 {$i unixstuff.inc}\r
 {$i ltimevalstuff.inc}\r
 \r
 var\r
 {$i unixstuff.inc}\r
 {$i ltimevalstuff.inc}\r
 \r
 var\r

-  fd:integer;\r
-  state:tdnsstate;\r
+  numsockused:integer;\r
+  fd:array[0..numsock-1] of integer;\r
+  state:array[0..numsock-1] of tdnsstate;\r
+\r
+{$ifdef syncdnscore}\r
+\r

 {$ifdef win32}\r
   const\r
     winsocket = 'wsock32.dll';\r
 {$ifdef win32}\r
   const\r
     winsocket = 'wsock32.dll';\r

-  function sendto(s: TSocket; const Buf; len, flags: Integer; var addrto: TinetSockAddr; tolen: Integer): Integer; stdcall; external    winsocket name 'sendto';\r
-  function bind(s: TSocket; var addr: TinetSockAddr; namelen: Integer): Longbool; stdcall; external    winsocket name 'bind';\r
+  function sendto(s: TSocket; const Buf; len, flags: Integer; var addrto: TinetSockAddrV; tolen: Integer): Integer; stdcall; external    winsocket name 'sendto';\r
+  function bind(s: TSocket; var addr: TinetSockAddrV; namelen: Integer): Longbool; stdcall; external    winsocket name 'bind';\r

   type\r
     fdset=tfdset;\r
 {$endif}\r
 \r
   type\r
     fdset=tfdset;\r
 {$endif}\r
 \r

-function sendquery(const packet:tdnspacket;len:integer):boolean;\r
+\r
+function getts:integer;\r
+{$ifdef win32}\r
+begin\r
+  result := GetTickCount and tsmask;\r
+{$else}\r
+var\r
+  temp:ttimeval;\r
+begin\r
+  gettimeofday(temp);\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

 var\r
   a:integer;\r
   addr       : string;\r
   port       : string;\r
 var\r
   a:integer;\r
   addr       : string;\r
   port       : string;\r

-  inaddr     : TInetSockAddr;\r
-\r
+  inaddr     : TInetSockAddrV;\r

 begin\r
 {  writeln('sendquery ',decodename(state.packet,state.packetlen,12,0,a),' ',state.requesttype);}\r
   result := false;\r
 begin\r
 {  writeln('sendquery ',decodename(state.packet,state.packetlen,12,0,a),' ',state.requesttype);}\r
   result := false;\r


@@ -82,35 +125,42 @@ begin
   if dnssyncserver <> '' then addr := dnssyncserver else addr := getcurrentsystemnameserver(id);\r
   port := '53';\r
 \r
   if dnssyncserver <> '' then addr := dnssyncserver else addr := getcurrentsystemnameserver(id);\r
   port := '53';\r
 \r

-  inAddr.family:=AF_INET;\r
-  inAddr.port:=htons(strtointdef(port,0));\r
-  inAddr.addr:=htonl(longip(addr));\r
+  makeinaddrv(ipstrtobinf(addr),port,inaddr);\r

 \r
 \r

-  sendto(fd,packet,len,0,inaddr,sizeof(inaddr));\r
-  {$ifdef win32}\r
-    sendquerytime := GetTickCount and $3fff;\r
-  {$else}\r
-    gettimeofday(sendquerytime);\r
-  {$endif}\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
   result := true;\r
 end;\r
 \r
 procedure setupsocket;\r
 var\r

-  inAddrtemp : TInetSockAddr;\r
+  inAddrtemp : TInetSockAddrV;\r
+  a:integer;\r
+  biniptemp:tbinip;\r
+  addr:string;\r

 begin\r
 begin\r

-  if fd > 0 then exit;\r
+  //init both sockets smultaneously, always, so they get succesive fd's\r
+  if fd[0] > 0 then exit;\r

 \r
 \r

-  fd := Socket(AF_INET,SOCK_DGRAM,0);\r
-  inAddrtemp.family:=AF_INET;\r
-  inAddrtemp.port:=0;\r
-  inAddrtemp.addr:=0;{htonl(longip('0.0.0.0'));}\r
-  If {$ifndef win32}Not{$endif} Bind(fd,inAddrtemp,SizeOf(inAddrtemp)) Then begin\r
-    {$ifdef win32}\r
-      raise Exception.create('unable to bind '+inttostr(WSAGetLastError));\r
-    {$else}\r
-      raise Exception.create('unable to bind '+inttostr(socketError));\r
-    {$endif}\r
+  if dnssyncserver <> '' then addr := dnssyncserver else addr := getcurrentsystemnameserver(id);\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
+\r
+  inaddrtemp.inaddr.family := biniptemp.family;\r
+\r
+  for a := 0 to numsockused-1 do begin\r
+    fd[a] := Socket(biniptemp.family,SOCK_DGRAM,0);\r
+\r
+    If {$ifndef win32}Not{$endif} Bind(fd[a],inAddrtemp,inaddrsize(inaddrtemp)) Then begin\r
+      {$ifdef win32}\r
+        raise Exception.create('unable to bind '+inttostr(WSAGetLastError));\r
+      {$else}\r
+        raise Exception.create('unable to bind '+inttostr(socketError));\r
+      {$endif}\r
+    end;\r

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


@@ -118,119 +168,201 @@ procedure resolveloop(timeout:integer);
 var\r
   selectresult   : integer;\r
   fds            : fdset;\r
 var\r
   selectresult   : integer;\r
   fds            : fdset;\r

-  {$ifdef win32}\r
-    endtime      : longint;\r
-    starttime    : longint;\r
-    wrapmode     : boolean;\r
-    currenttime  : integer;\r
-  {$else}\r
-    endtime      : ttimeval;\r
-    currenttime    : ttimeval;\r

 \r
 \r

-  {$endif}\r
+  endtime      : longint;\r
+  starttime    : longint;\r
+  wrapmode     : boolean;\r
+  currenttime  : integer;\r
+\r

   lag            : ttimeval;\r
   currenttimeout : ttimeval;\r
   selecttimeout         : ttimeval;\r
   lag            : ttimeval;\r
   currenttimeout : ttimeval;\r
   selecttimeout         : ttimeval;\r

-\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
 begin\r
 \r
 begin\r

-  {$ifdef win32}\r
-    starttime := GetTickCount and $3fff;\r
-    endtime := starttime +(timeout*1000);\r
-    if (endtime and $4000)=0 then 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
       wrapmode := false;\r
     end else begin\r
       wrapmode := true;\r
     end;\r

-    endtime := endtime and $3fff;\r
-  {$else}\r
-    gettimeofday(endtime);\r
-    endtime.tv_sec := endtime.tv_sec + timeout;\r
-  {$endif}\r
+    endtime := endtime and tsmask;\r

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

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

   repeat\r
   repeat\r

-    state_process(state);\r
-    case state.resultaction of\r
-      action_ignore: begin\r
-{        writeln('ignore');}\r
-        {do nothing}\r
-      end;\r
-      action_done: begin\r
-{        writeln('done');}\r
-        exit;\r
-        //onrequestdone(self,0);\r
-      end;\r
-      action_sendquery:begin\r
+    for socknum := numsockused-1 downto 0 do if needprocessing[socknum] then begin\r
+      state_process(state[socknum]);\r
+      case state[socknum].resultaction of\r
+        action_ignore: begin\r
+          {do nothing}\r
+        end;\r
+        action_done: begin\r
+          finished[socknum] := true;\r
+          //exit if all resolvers are finished\r
+          b := 0;\r
+          for a := 0 to numsockused-1 do begin\r
+            if finished[a] then inc(b);\r
+          end;\r
+          if (b = numsockused) then begin\r
+            exit;\r
+          end;\r
+          //onrequestdone(self,0);\r
+        end;\r
+        action_sendquery:begin\r

 {        writeln('send query');}\r
 {        writeln('send query');}\r

-        sendquery(state.sendpacket,state.sendpacketlen);\r
+          sendquery(socknum,state[socknum].sendpacket,state[socknum].sendpacketlen);\r
+        end;\r

       end;\r
       end;\r

+      needprocessing[socknum] := false;\r

     end;\r
     end;\r

-    {$ifdef win32}\r
-      currenttime := GetTickCount and $3fff;\r
-      msectotimeval(selecttimeout, (endtime-currenttime)and$3fff);\r
-    {$else}\r
-      gettimeofday(currenttime);\r
-      selecttimeout := endtime;\r
-      tv_substract(selecttimeout,currenttime);\r
-    {$endif}\r
+\r
+    currenttime := getts;\r
+    msectotimeval(selecttimeout, (endtime-currenttime) and tsmask);\r
+\r

     fd_zero(fds);\r
     fd_zero(fds);\r

-    fd_set(fd,fds);\r
+    for socknum := numsockused-1 downto 0 do if not finished[socknum] then fd_set(fd[socknum],fds);\r

     if (selecttimeout.tv_sec > 0) or (selecttimeout.tv_usec > retryafter) then begin\r
       selecttimeout.tv_sec := 0;\r
       selecttimeout.tv_usec := retryafter;\r
     end;\r
     if (selecttimeout.tv_sec > 0) or (selecttimeout.tv_usec > retryafter) then begin\r
       selecttimeout.tv_sec := 0;\r
       selecttimeout.tv_usec := retryafter;\r
     end;\r

-    selectresult := select(fd+1,@fds,nil,nil,@selecttimeout);\r
+    //find the highest of the used fd's\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

     if selectresult > 0 then begin\r
     if selectresult > 0 then begin\r

-{      writeln('selectresult>0');}\r
-      //why the hell are we zeroing out the packet buffer before reading into it?! --plugwash\r
-      fillchar(state.recvpacket,sizeof(state.recvpacket),0);\r
-      {$ifdef win32}\r
-        msectotimeval(lag,(currenttime-sendquerytime)and$3fff);\r
-      {$else}\r
-        lag := currenttime;\r
-        tv_substract(lag,sendquerytime);\r
+      currenttime := getts;\r
+      for socknum := numsockused-1 downto 0 do if fd_isset(fd[socknum],fds) then begin\r
+  {      writeln('selectresult>0');}\r
+        //why the hell are we zeroing out the packet buffer before reading into it?! --plugwash\r

 \r
 \r

-      {$endif}\r
+        fillchar(state[socknum].recvpacket,sizeof(state[socknum].recvpacket),0);\r
+        msectotimeval(lag,(currenttime-sendquerytime[socknum]) and tsmask);\r

 \r
 \r

-      reportlag(id,(lag.tv_sec*1000000)+lag.tv_usec);\r
-      state.recvpacketlen := recv(fd,state.recvpacket, SizeOf(state.recvpacket),0);\r
-      state.parsepacket := true;\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
+      end;\r

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

-      {$ifdef win32}\r
-        currenttime := GetTickCount;\r
-      {$else}\r
-        gettimeofday(currenttime);\r
-      {$endif}\r
-      reportlag(id,-1);\r
-      if {$ifdef win32}(currenttime >= endtime)and ((not wrapmode) or (currenttime < starttime)) {$else}tv_compare(currenttime,endtime){$endif} {currenttime >= endtime } then begin\r
+\r
+      currenttime := getts;\r
+\r
+      if dnssyncserver = '' then reportlag(id,-1);\r
+      if (currenttime >= endtime) and ((not wrapmode) or (currenttime < starttime)) then begin\r

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

-        sendquery(state.sendpacket,state.sendpacketlen);\r
+        for socknum := numsockused-1 downto 0 do begin\r
+          sendquery(socknum,state[socknum].sendpacket,state[socknum].sendpacketlen);\r
+        end;\r

       end;\r
     end;\r
   until false;\r
 end;\r
       end;\r
     end;\r
   until false;\r
 end;\r

+{$endif}\r

 \r
 \r

-function forwardlookup(name:string;timeout:integer):tbinip;\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
+function forwardlookuplist(name:string;timeout:integer):tbiniplist;\r

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

+  a,b:integer;\r
+  biniptemp:tbinip;\r
+  l:tbiniplist;\r

 begin\r
 begin\r

-  ipstrtobin(name,result);\r
-  if result.family <> 0 then exit; //it was an IP address, no need for dns\r
-                                   //lookup\r
+  ipstrtobin(name,biniptemp);\r
+  if biniptemp.family <> 0 then begin\r
+    result := biniplist_new;\r
+    biniplist_add(result,biniptemp);\r
+    exit; //it was an IP address, no need for dns\r
+  end;\r
+\r

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

-    if usewindns then begin\r
-      result := winforwardlookup(name,false,dummy);\r
-      exit;\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
+    {$ifdef ipv6}\r
+    if (useaf = useaf_preferv4) then begin\r
+      {prefer mode: sort the IP's}\r
+      l := biniplist_new;\r
+      addipsoffamily(l,result,af_inet);\r
+      addipsoffamily(l,result,af_inet6);\r
+      result := l;\r
+    end;\r
+    if (useaf = useaf_preferv6) then begin\r
+      {prefer mode: sort the IP's}\r
+      l := biniplist_new;\r
+      addipsoffamily(l,result,af_inet6);\r
+      addipsoffamily(l,result,af_inet);\r
+      result := l;\r

     end;\r
     end;\r

+    {$endif}\r
+  end else\r

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

-  setstate_forward(name,state,0);\r
-  resolveloop(timeout);\r
-  result := state.resultbin;\r
+  begin\r
+  {$ifdef syncdnscore}\r
+    {$ifdef linux}{$ifdef ipv6}initpreferredmode;{$endif}{$endif}\r
+\r
+    numsockused := 0;\r
+\r
+    result := biniplist_new;\r
+    if (useaf <> useaf_v6) then begin\r
+      setstate_forward(name,state[numsockused],af_inet);\r
+      inc(numsockused);\r
+    end;\r
+    {$ifdef ipv6}\r
+    if (useaf <> useaf_v4) then begin\r
+      setstate_forward(name,state[numsockused],af_inet6);\r
+      inc(numsockused);\r
+    end;\r
+    {$endif}\r
+\r
+    resolveloop(timeout);\r
+\r
+    if (numsockused = 1) then begin\r
+      biniplist_addlist(result,state[0].resultlist);\r
+    {$ifdef ipv6}\r
+    end else if (useaf = useaf_preferv6) then begin\r
+      biniplist_addlist(result,state[1].resultlist);\r
+      biniplist_addlist(result,state[0].resultlist);\r
+    end else begin\r
+      biniplist_addlist(result,state[0].resultlist);\r
+      biniplist_addlist(result,state[1].resultlist);\r
+    {$endif}  \r
+    end;\r
+    {$endif}\r
+  end;\r
+end;\r
+\r
+function forwardlookup(name:string;timeout:integer):tbinip;\r
+var\r
+  listtemp:tbiniplist;\r
+begin\r
+  listtemp := forwardlookuplist(name,timeout);\r
+  result := biniplist_get(listtemp,0);\r

 end;\r
 \r
 function reverselookup(ip:tbinip;timeout:integer):string;\r
 end;\r
 \r
 function reverselookup(ip:tbinip;timeout:integer):string;\r


@@ -243,11 +375,70 @@ begin
       exit;\r
     end;\r
   {$endif}\r
       exit;\r
     end;\r
   {$endif}\r

-  setstate_reverse(ip,state);\r
+  {$ifdef syncdnscore}\r
+  setstate_reverse(ip,state[0]);\r
+  numsockused := 1;\r

   resolveloop(timeout);\r
   resolveloop(timeout);\r

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

 end;\r
 \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
   var\r
     wsadata : twsadata;\r
 {$ifdef win32}\r
   var\r
     wsadata : twsadata;\r