X-Git-Url: http://www.lcore.org/git/lcore.git/blobdiff_plain/4782a5c5afee47721cc617daa40dd29828342c2b..eca2c8e0a8aad79c7dc7738346d265f973428995:/dnssync.pas?ds=sidebyside

diff --git a/dnssync.pas b/dnssync.pas
old mode 100755
new mode 100644
index 379aa05..84caf9a
--- a/dnssync.pas
+++ b/dnssync.pas
@@ -7,11 +7,13 @@ unit dnssync;
   {$mode delphi}
 {$endif}
 
+{$include lcoreconfig.inc}
+
 interface
   uses
     dnscore,
     binipstuff,
-    {$ifdef win32}
+    {$ifdef mswindows}
       winsock,
       windows,
     {$else}
@@ -23,232 +25,394 @@ interface
       sockets,
       fd_utils,
     {$endif}
-    sysutils;
+    lcorernd,
+    sysutils,
+    ltimevalstuff;
 
 //convert a name to an IP
-//IPV4 is preffered if availible, if not IPV6 will be returned (if ipv6 support
-//compiled in)
-//on error the binip will have a family of 0 (other fiels are also currently
+//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 fields are also currently
 //zeroed out but may be used for further error information in future)
-//timeout is in seconds, 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:ansistring;timeout:integer):tbiniplist;
 
 
-//convert an IP to a name, on error a null string will be returned, other 
+//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;
 
 
-var
-  dnssyncserver:string;
-  id : integer;
-  {$ifdef win32}
-    sendquerytime : integer;
-  {$else}
-    sendquerytime : ttimeval;
-  {$endif}
+
+const
+  tswrap=$4000;
+  tsmask=tswrap-1;
+
+  numsock=1{$ifdef ipv6}+1{$endif};
+  defaulttimeout=10000;
+  const mintimeout=16;
+
+  toport='53';
+
 implementation
-{$ifdef win32}
+
+{$ifdef mswindows}
   uses dnswin;
 {$endif}
 
+
+{$ifndef mswindows}
+{$define syncdnscore}
+{$endif}
+
 {$i unixstuff.inc}
-{$i ltimevalstuff.inc}
 
-var
-  fd:integer;
-  state:tdnsstate;
-{$ifdef win32}
+type tdnsstatearr=array[0..numsock-1] of tdnsstate;
+
+{$ifdef syncdnscore}
+
+
+{$ifdef mswindows}
   const
     winsocket = 'wsock32.dll';
-  function sendto(s: TSocket; const Buf; len, flags: Integer; var addrto: TinetSockAddr; tolen: Integer): Integer; stdcall; external    winsocket name 'sendto';
-  function bind(s: TSocket; var addr: TinetSockAddr; namelen: Integer): Longbool; stdcall; external    winsocket name 'bind';
+  function sendto(s: TSocket; const Buf; len, flags: Integer; var addrto: TinetSockAddrV; tolen: Integer): Integer; stdcall; external    winsocket name 'sendto';
+  function bind(s: TSocket; var addr: TinetSockAddrV; namelen: Integer): Longbool; stdcall; external    winsocket name 'bind';
   type
     fdset=tfdset;
 {$endif}
 
-function sendquery(const packet:tdnspacket;len:integer):boolean;
-var
-  a:integer;
-  addr       : string;
-  port       : string;
-  inaddr     : TInetSockAddr;
 
+function getts:integer;
+{$ifdef mswindows}
 begin
-{  writeln('sendquery ',decodename(state.packet,state.packetlen,12,0,a),' ',state.requesttype);}
-  result := false;
-  if len = 0 then exit; {no packet}
+  result := GetTickCount and tsmask;
+{$else}
+var
+  temp:ttimeval;
+begin
+  gettimemonotonic(temp);
+  result := ((temp.tv_usec div 1000) + (temp.tv_sec * 1000)) and tsmask;
+{$endif}
+end;
 
-  if dnssyncserver <> '' then addr := dnssyncserver else addr := getcurrentsystemnameserver(id);
-  port := '53';
+procedure resolveloop(timeout:integer;var state:tdnsstatearr;numsockused:integer);
+var
+  selectresult   : integer;
+  fds            : fdset;
 
-  inAddr.family:=AF_INET;
-  inAddr.port:=htons(strtointdef(port,0));
-  inAddr.addr:=htonl(longip(addr));
+  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;
+
+  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,packet,len,0,inaddr,sizeof(inaddr));
-  {$ifdef win32}
-    sendquerytime := GetTickCount and $3fff;
-  {$else}
-    gettimeofday(sendquerytime);
-  {$endif}
-  result := true;
-end;
 
 procedure setupsocket;
 var
-  inAddrtemp : TInetSockAddr;
+  inAddrtemp : TInetSockAddrV;
+  biniptemp:tbinip;
+  a,retrycount,porttemp:integer;
+  bindresult:boolean;
 begin
-  if fd > 0 then exit;
-
-  fd := Socket(AF_INET,SOCK_DGRAM,0);
-  inAddrtemp.family:=AF_INET;
-  inAddrtemp.port:=0;
-  inAddrtemp.addr:=0;{htonl(longip('0.0.0.0'));}
-  If {$ifndef win32}Not{$endif} Bind(fd,inAddrtemp,SizeOf(inAddrtemp)) Then begin
-    {$ifdef win32}
-      raise Exception.create('unable to bind '+inttostr(WSAGetLastError));
-    {$else}
-      raise Exception.create('unable to bind '+inttostr(socketError));
-    {$endif}
+  biniptemp := getcurrentsystemnameserverbin(id);
+  //must get the DNS server here so we know to init v4 or v6
+
+  if biniptemp.family = AF_INET6 then biniptemp := ipstrtobinf('::') else biniptemp := ipstrtobinf('0.0.0.0');
+
+
+  for a := 0 to numsockused-1 do begin
+    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;
+
+      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));
+      {$endif}
+    end;
   end;
 end;
 
-procedure resolveloop(timeout:integer);
+procedure cleanupsockets;
 var
-  selectresult   : integer;
-  fds            : fdset;
-  {$ifdef win32}
-    endtime      : longint;
-    starttime    : longint;
-    wrapmode     : boolean;
-    currenttime  : integer;
-  {$else}
-    endtime      : ttimeval;
-    currenttime    : ttimeval;
+  a:integer;
+begin
+  for a := 0 to numsockused-1 do closesocket(fd[a]);
+end;
 
-  {$endif}
-  lag            : ttimeval;
-  currenttimeout : ttimeval;
-  selecttimeout	 : ttimeval;
+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}
+
+  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
-  {$ifdef win32}
-    starttime := GetTickCount and $3fff;
-    endtime := starttime +(timeout*1000);
-    if (endtime and $4000)=0 then begin
-      wrapmode := false;
-    end else begin
-      wrapmode := true;
-    end;
-    endtime := endtime and $3fff;
-  {$else}
-    gettimeofday(endtime);
-    endtime.tv_sec := endtime.tv_sec + timeout;
-  {$endif}
+  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;
 
   setupsocket;
+
+
+  for socknum := 0 to numsockused-1 do begin
+    needprocessing[socknum] := true;
+    finished[socknum] := false;
+  end;
+
   repeat
-    state_process(state);
-    case state.resultaction of
-      action_ignore: begin
-{        writeln('ignore');}
-        {do nothing}
-      end;
-      action_done: begin
-{        writeln('done');}
-        exit;
-        //onrequestdone(self,0);
-      end;
-      action_sendquery:begin
+    for socknum := numsockused-1 downto 0 do if needprocessing[socknum] then begin
+      state_process(state[socknum]);
+      case state[socknum].resultaction of
+        action_ignore: begin
+          {do nothing}
+        end;
+        action_done: begin
+          finished[socknum] := true;
+          //exit if all resolvers are finished
+          b := 0;
+          for a := 0 to numsockused-1 do begin
+            if finished[a] then inc(b);
+          end;
+          if (b = numsockused) then begin
+            cleanupsockets;
+            exit;
+          end;
+          //onrequestdone(self,0);
+        end;
+        action_sendquery:begin
 {        writeln('send query');}
-        sendquery(state.sendpacket,state.sendpacketlen);
+          sendquery(socknum,state[socknum].sendpacket,state[socknum].sendpacketlen);
+        end;
       end;
+      needprocessing[socknum] := false;
     end;
-    {$ifdef win32}
-      currenttime := GetTickCount and $3fff;
-      msectotimeval(selecttimeout, (endtime-currenttime)and$3fff);
-    {$else}
-      gettimeofday(currenttime);
-      selecttimeout := endtime;
-      tv_substract(selecttimeout,currenttime);
-    {$endif}
+
+    currenttime := getts;
+    msectotimeval(selecttimeout, (endtime-currenttime) and tsmask);
+
     fd_zero(fds);
-    fd_set(fd,fds);
+    for socknum := numsockused-1 downto 0 do if not finished[socknum] then fd_set(fd[socknum],fds);
     if (selecttimeout.tv_sec > 0) or (selecttimeout.tv_usec > retryafter) then begin
       selecttimeout.tv_sec := 0;
       selecttimeout.tv_usec := retryafter;
     end;
-    selectresult := select(fd+1,@fds,nil,nil,@selecttimeout);
+    //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);
     if selectresult > 0 then begin
-{      writeln('selectresult>0');}
-      //why the hell are we zeroing out the packet buffer before reading into it?! --plugwash
-      fillchar(state.recvpacket,sizeof(state.recvpacket),0);
-      {$ifdef win32}
-        msectotimeval(lag,(currenttime-sendquerytime)and$3fff);
-      {$else}
-        lag := currenttime;
-        tv_substract(lag,sendquerytime);
+      currenttime := getts;
+      for socknum := numsockused-1 downto 0 do if fd_isset(fd[socknum],fds) then begin
+  {      writeln('selectresult>0');}
+        //why the hell are we zeroing out the packet buffer before reading into it?! --plugwash
 
-      {$endif}
+        fillchar(state[socknum].recvpacket,sizeof(state[socknum].recvpacket),0);
+        msectotimeval(lag,(currenttime-sendquerytime[socknum]) and tsmask);
+
+        reportlag(id,(lag.tv_sec*1000000)+lag.tv_usec);
 
-      reportlag(id,(lag.tv_sec*1000000)+lag.tv_usec);
-      state.recvpacketlen := recv(fd,state.recvpacket, SizeOf(state.recvpacket),0);
-      state.parsepacket := true;
+        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;
     if selectresult = 0 then begin
-      {$ifdef win32}
-        currenttime := GetTickCount;
-      {$else}
-        gettimeofday(currenttime);
-      {$endif}
+
+      currenttime := getts;
+
       reportlag(id,-1);
-      if {$ifdef win32}(currenttime >= endtime)and ((not wrapmode) or (currenttime < starttime)) {$else}tv_compare(currenttime,endtime){$endif} {currenttime >= endtime } then begin
+      if (currenttime >= endtime) and ((not wrapmode) or (currenttime < starttime)) then begin
+        cleanupsockets;
         exit;
       end else begin
         //resend
-        sendquery(state.sendpacket,state.sendpacketlen);
+        for socknum := numsockused-1 downto 0 do begin
+          sendquery(socknum,state[socknum].sendpacket,state[socknum].sendpacketlen);
+        end;
       end;
     end;
   until false;
 end;
+{$endif}
+
+
 
-function forwardlookup(name:string;timeout:integer):tbinip;
+function forwardlookuplist(name:ansistring;timeout:integer):tbiniplist;
 var
   dummy : integer;
+  a:integer;
+  biniptemp:tbinip;
+  l:tbiniplist;
+
+  numsockused:integer;
+  state:tdnsstatearr;
+
 begin
-  ipstrtobin(name,result);
-  if result.family <> 0 then exit; //it was an IP address, no need for dns
-                                   //lookup
-  {$ifdef win32}
-    if usewindns then begin
-      result := winforwardlookup(name,false,dummy);
-      exit;
+  ipstrtobin(name,biniptemp);
+  if biniptemp.family <> 0 then begin
+    result := biniplist_new;
+    biniplist_add(result,biniptemp);
+    exit; //it was an IP address, no need for dns
+  end;
+
+  {$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);
+    {$ifdef ipv6}
+    if (useaf = useaf_preferv4) then begin
+      {prefer mode: sort the IP's}
+      l := biniplist_new;
+      addipsoffamily(l,result,af_inet);
+      addipsoffamily(l,result,af_inet6);
+      result := l;
+    end;
+    if (useaf = useaf_preferv6) then begin
+      {prefer mode: sort the IP's}
+      l := biniplist_new;
+      addipsoffamily(l,result,af_inet6);
+      addipsoffamily(l,result,af_inet);
+      result := l;
     end;
+    {$endif}
+  end else
   {$endif}
-  setstate_forward(name,state,0);
-  resolveloop(timeout);
-  result := state.resultbin;
+  begin
+  {$ifdef syncdnscore}
+    {$ifdef ipv6}initpreferredmode;{$endif}
+
+    numsockused := 0;
+
+    result := biniplist_new;
+    if (useaf <> useaf_v6) then begin
+      setstate_forward(name,state[numsockused],af_inet);
+      inc(numsockused);
+    end;
+    {$ifdef ipv6}
+    if (useaf <> useaf_v4) then begin
+      setstate_forward(name,state[numsockused],af_inet6);
+      inc(numsockused);
+    end;
+    {$endif}
+
+    resolveloop(timeout,state,numsockused);
+
+    if (numsockused = 1) then begin
+      biniplist_addlist(result,state[0].resultlist);
+    {$ifdef ipv6}
+    end else if (useaf = useaf_preferv6) then begin
+      biniplist_addlist(result,state[1].resultlist);
+      biniplist_addlist(result,state[0].resultlist);
+    end else begin
+      biniplist_addlist(result,state[0].resultlist);
+      biniplist_addlist(result,state[1].resultlist);
+    {$endif}
+    end;
+    {$endif}
+  end;
 end;
 
-function reverselookup(ip:tbinip;timeout:integer):string;
+function forwardlookup(name:ansistring;timeout:integer):tbinip;
+var
+  listtemp:tbiniplist;
+begin
+  listtemp := forwardlookuplist(name,timeout);
+  result := biniplist_get(listtemp,0);
+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;
     end;
   {$endif}
-  setstate_reverse(ip,state);
-  resolveloop(timeout);
-  result := state.resultstr;
+  {$ifdef syncdnscore}
+  setstate_reverse(ip,state[0]);
+  numsockused := 1;
+  resolveloop(timeout,state,numsockused);
+  result := state[0].resultstr;
+  {$endif}
 end;
 
-{$ifdef win32}
+{$ifdef mswindows}
   var
     wsadata : twsadata;