/[lcore]/trunk/dnssync.pas
ViewVC logotype

Diff of /trunk/dnssync.pas

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1 by plugwash, Fri Mar 28 02:26:58 2008 UTC revision 2 by beware, Sun Mar 30 00:16:07 2008 UTC
# Line 7  Line 7 
7    {$mode delphi}    {$mode delphi}
8  {$endif}  {$endif}
9    
10    {$include lcoreconfig.inc}
11    
12  interface  interface
13    uses    uses
14      dnscore,      dnscore,
# Line 26  Line 28 
28      sysutils;      sysutils;
29    
30  //convert a name to an IP  //convert a name to an IP
31  //IPV4 is preffered if availible, if not IPV6 will be returned (if ipv6 support  //will return v4 or v6 depending on what seems favorable, or manual preference setting
 //compiled in)  
32  //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 fiels are also currently
33  //zeroed out but may be used for further error information in future)  //zeroed out but may be used for further error information in future)
34  //timeout is in seconds, it is ignored when using windows dns  //timeout is in miliseconds, it is ignored when using windows dns
35  function forwardlookup(name:string;timeout:integer):tbinip;  function forwardlookup(name:string;timeout:integer):tbinip;
36    
37    //convert a name to a list of all IP's returned
38    //this returns both v4 and v6 IP's, or possibly only v4 or v6, depending on settings
39    //on error, returns an empty list
40    function forwardlookuplist(name:string;timeout:integer):tbiniplist;
41    
42    
43  //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
44  //details as above  //details as above
45  function reverselookup(ip:tbinip;timeout:integer):string;  function reverselookup(ip:tbinip;timeout:integer):string;
46    
47    {$ifdef linux}{$ifdef ipv6}
48    function getv6localips:tbiniplist;
49    procedure initpreferredmode;
50    
51    var
52      preferredmodeinited:boolean;
53    
54    {$endif}{$endif}
55    
56    const
57      tswrap=$4000;
58      tsmask=tswrap-1;
59    
60      numsock=1{$ifdef ipv6}+1{$endif};
61      defaulttimeout=10000;
62      const mintimeout=16;
63    
64  var  var
65    dnssyncserver:string;    dnssyncserver:string;
66    id : integer;    id : integer;
67    {$ifdef win32}  
68      sendquerytime : integer;    sendquerytime:array[0..numsock-1] of integer;
   {$else}  
     sendquerytime : ttimeval;  
   {$endif}  
69  implementation  implementation
70    
71  {$ifdef win32}  {$ifdef win32}
72    uses dnswin;    uses dnswin;
73  {$endif}  {$endif}
74    
75    
76    {$ifndef win32}
77    {$define syncdnscore}
78    {$endif}
79    
80  {$i unixstuff.inc}  {$i unixstuff.inc}
81  {$i ltimevalstuff.inc}  {$i ltimevalstuff.inc}
82    
83  var  var
84    fd:integer;    numsockused:integer;
85    state:tdnsstate;    fd:array[0..numsock-1] of integer;
86      state:array[0..numsock-1] of tdnsstate;
87    
88    {$ifdef syncdnscore}
89    
90  {$ifdef win32}  {$ifdef win32}
91    const    const
92      winsocket = 'wsock32.dll';      winsocket = 'wsock32.dll';
93    function sendto(s: TSocket; const Buf; len, flags: Integer; var addrto: TinetSockAddr; tolen: Integer): Integer; stdcall; external    winsocket name 'sendto';    function sendto(s: TSocket; const Buf; len, flags: Integer; var addrto: TinetSockAddrV; tolen: Integer): Integer; stdcall; external    winsocket name 'sendto';
94    function bind(s: TSocket; var addr: TinetSockAddr; namelen: Integer): Longbool; stdcall; external    winsocket name 'bind';    function bind(s: TSocket; var addr: TinetSockAddrV; namelen: Integer): Longbool; stdcall; external    winsocket name 'bind';
95    type    type
96      fdset=tfdset;      fdset=tfdset;
97  {$endif}  {$endif}
98    
99  function sendquery(const packet:tdnspacket;len:integer):boolean;  
100    function getts:integer;
101    {$ifdef win32}
102    begin
103      result := GetTickCount and tsmask;
104    {$else}
105    var
106      temp:ttimeval;
107    begin
108      gettimeofday(temp);
109      result := ((temp.tv_usec div 1000) + (temp.tv_sec * 1000)) and tsmask;
110    {$endif}
111    end;
112    
113    
114    function sendquery(socknum:integer;const packet:tdnspacket;len:integer):boolean;
115  var  var
116    a:integer;    a:integer;
117    addr       : string;    addr       : string;
118    port       : string;    port       : string;
119    inaddr     : TInetSockAddr;    inaddr     : TInetSockAddrV;
   
120  begin  begin
121  {  writeln('sendquery ',decodename(state.packet,state.packetlen,12,0,a),' ',state.requesttype);}  {  writeln('sendquery ',decodename(state.packet,state.packetlen,12,0,a),' ',state.requesttype);}
122    result := false;    result := false;
# Line 82  Line 125 
125    if dnssyncserver <> '' then addr := dnssyncserver else addr := getcurrentsystemnameserver(id);    if dnssyncserver <> '' then addr := dnssyncserver else addr := getcurrentsystemnameserver(id);
126    port := '53';    port := '53';
127    
128    inAddr.family:=AF_INET;    makeinaddrv(ipstrtobinf(addr),port,inaddr);
   inAddr.port:=htons(strtointdef(port,0));  
   inAddr.addr:=htonl(longip(addr));  
129    
130    sendto(fd,packet,len,0,inaddr,sizeof(inaddr));    sendto(fd[socknum],packet,len,0,inaddr,inaddrsize(inaddr));
131    {$ifdef win32}    sendquerytime[socknum] := getts;
     sendquerytime := GetTickCount and $3fff;  
   {$else}  
     gettimeofday(sendquerytime);  
   {$endif}  
132    result := true;    result := true;
133  end;  end;
134    
135  procedure setupsocket;  procedure setupsocket;
136  var  var
137    inAddrtemp : TInetSockAddr;    inAddrtemp : TInetSockAddrV;
138      a:integer;
139      biniptemp:tbinip;
140      addr:string;
141  begin  begin
142    if fd > 0 then exit;    //init both sockets smultaneously, always, so they get succesive fd's
143      if fd[0] > 0 then exit;
144    
145      if dnssyncserver <> '' then addr := dnssyncserver else addr := getcurrentsystemnameserver(id);
146      //must get the DNS server here so we know to init v4 or v6
147    
148      fillchar(inaddrtemp,sizeof(inaddrtemp),0);
149      ipstrtobin(addr,biniptemp);
150      if biniptemp.family = 0 then biniptemp.family := AF_INET;
151    
152      inaddrtemp.inaddr.family := biniptemp.family;
153    
154    fd := Socket(AF_INET,SOCK_DGRAM,0);    for a := 0 to numsockused-1 do begin
155    inAddrtemp.family:=AF_INET;      fd[a] := Socket(biniptemp.family,SOCK_DGRAM,0);
156    inAddrtemp.port:=0;  
157    inAddrtemp.addr:=0;{htonl(longip('0.0.0.0'));}      If {$ifndef win32}Not{$endif} Bind(fd[a],inAddrtemp,inaddrsize(inaddrtemp)) Then begin
   If {$ifndef win32}Not{$endif} Bind(fd,inAddrtemp,SizeOf(inAddrtemp)) Then begin  
158      {$ifdef win32}      {$ifdef win32}
159        raise Exception.create('unable to bind '+inttostr(WSAGetLastError));        raise Exception.create('unable to bind '+inttostr(WSAGetLastError));
160      {$else}      {$else}
# Line 113  Line 162 
162      {$endif}      {$endif}
163    end;    end;
164  end;  end;
165    end;
166    
167  procedure resolveloop(timeout:integer);  procedure resolveloop(timeout:integer);
168  var  var
169    selectresult   : integer;    selectresult   : integer;
170    fds            : fdset;    fds            : fdset;
171    {$ifdef win32}  
172      endtime      : longint;      endtime      : longint;
173      starttime    : longint;      starttime    : longint;
174      wrapmode     : boolean;      wrapmode     : boolean;
175      currenttime  : integer;      currenttime  : integer;
   {$else}  
     endtime      : ttimeval;  
     currenttime    : ttimeval;  
176    
   {$endif}  
177    lag            : ttimeval;    lag            : ttimeval;
178    currenttimeout : ttimeval;    currenttimeout : ttimeval;
179    selecttimeout  : ttimeval;    selecttimeout  : ttimeval;
180      socknum:integer;
181      needprocessing:array[0..numsock-1] of boolean;
182      finished:array[0..numsock-1] of boolean;
183      a,b:integer;
184    
185  begin  begin
186    {$ifdef win32}    if timeout < mintimeout then timeout := defaulttimeout;
187      starttime := GetTickCount and $3fff;  
188      endtime := starttime +(timeout*1000);      starttime := getts;
189      if (endtime and $4000)=0 then begin      endtime := starttime + timeout;
190        if (endtime and tswrap)=0 then begin
191        wrapmode := false;        wrapmode := false;
192      end else begin      end else begin
193        wrapmode := true;        wrapmode := true;
194      end;      end;
195      endtime := endtime and $3fff;      endtime := endtime and tsmask;
   {$else}  
     gettimeofday(endtime);  
     endtime.tv_sec := endtime.tv_sec + timeout;  
   {$endif}  
196    
197    setupsocket;    setupsocket;
198      for socknum := 0 to numsockused-1 do begin
199        needprocessing[socknum] := true;
200        finished[socknum] := false;
201      end;
202    
203    repeat    repeat
204      state_process(state);      for socknum := numsockused-1 downto 0 do if needprocessing[socknum] then begin
205      case state.resultaction of        state_process(state[socknum]);
206          case state[socknum].resultaction of
207        action_ignore: begin        action_ignore: begin
 {        writeln('ignore');}  
208          {do nothing}          {do nothing}
209        end;        end;
210        action_done: begin        action_done: begin
211  {        writeln('done');}            finished[socknum] := true;
212              //exit if all resolvers are finished
213              b := 0;
214              for a := 0 to numsockused-1 do begin
215                if finished[a] then inc(b);
216              end;
217              if (b = numsockused) then begin
218          exit;          exit;
219              end;
220          //onrequestdone(self,0);          //onrequestdone(self,0);
221        end;        end;
222        action_sendquery:begin        action_sendquery:begin
223  {        writeln('send query');}  {        writeln('send query');}
224          sendquery(state.sendpacket,state.sendpacketlen);            sendquery(socknum,state[socknum].sendpacket,state[socknum].sendpacketlen);
225        end;        end;
226      end;      end;
227      {$ifdef win32}        needprocessing[socknum] := false;
228        currenttime := GetTickCount and $3fff;      end;
229        msectotimeval(selecttimeout, (endtime-currenttime)and$3fff);  
230      {$else}      currenttime := getts;
231        gettimeofday(currenttime);      msectotimeval(selecttimeout, (endtime-currenttime) and tsmask);
232        selecttimeout := endtime;  
       tv_substract(selecttimeout,currenttime);  
     {$endif}  
233      fd_zero(fds);      fd_zero(fds);
234      fd_set(fd,fds);      for socknum := numsockused-1 downto 0 do if not finished[socknum] then fd_set(fd[socknum],fds);
235      if (selecttimeout.tv_sec > 0) or (selecttimeout.tv_usec > retryafter) then begin      if (selecttimeout.tv_sec > 0) or (selecttimeout.tv_usec > retryafter) then begin
236        selecttimeout.tv_sec := 0;        selecttimeout.tv_sec := 0;
237        selecttimeout.tv_usec := retryafter;        selecttimeout.tv_usec := retryafter;
238      end;      end;
239      selectresult := select(fd+1,@fds,nil,nil,@selecttimeout);      //find the highest of the used fd's
240        b := 0;
241        for socknum := numsockused-1 downto 0 do if fd[socknum] > b then b := fd[socknum];
242        selectresult := select(b+1,@fds,nil,nil,@selecttimeout);
243      if selectresult > 0 then begin      if selectresult > 0 then begin
244          currenttime := getts;
245          for socknum := numsockused-1 downto 0 do if fd_isset(fd[socknum],fds) then begin
246  {      writeln('selectresult>0');}  {      writeln('selectresult>0');}
247        //why the hell are we zeroing out the packet buffer before reading into it?! --plugwash        //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);  
248    
249        {$endif}          fillchar(state[socknum].recvpacket,sizeof(state[socknum].recvpacket),0);
250            msectotimeval(lag,(currenttime-sendquerytime[socknum]) and tsmask);
251    
252        reportlag(id,(lag.tv_sec*1000000)+lag.tv_usec);          if dnssyncserver = '' then reportlag(id,(lag.tv_sec*1000000)+lag.tv_usec);
253        state.recvpacketlen := recv(fd,state.recvpacket, SizeOf(state.recvpacket),0);          state[socknum].recvpacketlen := recv(fd[socknum],state[socknum].recvpacket, SizeOf(state[socknum].recvpacket),0);
254        state.parsepacket := true;          state[socknum].parsepacket := true;
255            needprocessing[socknum] := true;
256          end;
257      end;      end;
258      if selectresult < 0 then exit;      if selectresult < 0 then exit;
259      if selectresult = 0 then begin      if selectresult = 0 then begin
260        {$ifdef win32}  
261          currenttime := GetTickCount;        currenttime := getts;
262        {$else}  
263          gettimeofday(currenttime);        if dnssyncserver = '' then reportlag(id,-1);
264        {$endif}        if (currenttime >= endtime) and ((not wrapmode) or (currenttime < starttime)) then begin
       reportlag(id,-1);  
       if {$ifdef win32}(currenttime >= endtime)and ((not wrapmode) or (currenttime < starttime)) {$else}tv_compare(currenttime,endtime){$endif} {currenttime >= endtime } then begin  
265          exit;          exit;
266        end else begin        end else begin
267          //resend          //resend
268          sendquery(state.sendpacket,state.sendpacketlen);          for socknum := numsockused-1 downto 0 do begin
269              sendquery(socknum,state[socknum].sendpacket,state[socknum].sendpacketlen);
270            end;
271        end;        end;
272      end;      end;
273    until false;    until false;
274  end;  end;
275    {$endif}
276    
277  function forwardlookup(name:string;timeout:integer):tbinip;  procedure addipsoffamily(var l:tbiniplist;const l2:tbiniplist;family:integer);
278    var
279      a:integer;
280      biniptemp:tbinip;
281    begin
282      for a := biniplist_getcount(l2)-1 downto 0 do begin
283        biniptemp := biniplist_get(l2,a);
284        if (biniptemp.family = family) then biniplist_add(l,biniptemp);
285      end;
286    end;
287    
288    
289    function forwardlookuplist(name:string;timeout:integer):tbiniplist;
290  var  var
291    dummy : integer;    dummy : integer;
292      a,b:integer;
293      biniptemp:tbinip;
294      l:tbiniplist;
295  begin  begin
296    ipstrtobin(name,result);    ipstrtobin(name,biniptemp);
297    if result.family <> 0 then exit; //it was an IP address, no need for dns    if biniptemp.family <> 0 then begin
298                                     //lookup      result := biniplist_new;
299        biniplist_add(result,biniptemp);
300        exit; //it was an IP address, no need for dns
301      end;
302    
303    {$ifdef win32}    {$ifdef win32}
304      if usewindns then begin      if usewindns then begin
305        result := winforwardlookup(name,false,dummy);      if (useaf = useaf_v4) then a := af_inet else if (useaf = useaf_v6) then a := af_inet6 else a := 0;
306        exit;      result := winforwardlookuplist(name,a,dummy);
307        {$ifdef ipv6}
308        if (useaf = useaf_preferv4) then begin
309          {prefer mode: sort the IP's}
310          l := biniplist_new;
311          addipsoffamily(l,result,af_inet);
312          addipsoffamily(l,result,af_inet6);
313          result := l;
314        end;
315        if (useaf = useaf_preferv6) then begin
316          {prefer mode: sort the IP's}
317          l := biniplist_new;
318          addipsoffamily(l,result,af_inet6);
319          addipsoffamily(l,result,af_inet);
320          result := l;
321      end;      end;
322    {$endif}    {$endif}
323    setstate_forward(name,state,0);    end else
324      {$endif}
325      begin
326      {$ifdef syncdnscore}
327        {$ifdef linux}{$ifdef ipv6}initpreferredmode;{$endif}{$endif}
328    
329        numsockused := 0;
330    
331        result := biniplist_new;
332        if (useaf <> useaf_v6) then begin
333          setstate_forward(name,state[numsockused],af_inet);
334          inc(numsockused);
335        end;
336        {$ifdef ipv6}
337        if (useaf <> useaf_v4) then begin
338          setstate_forward(name,state[numsockused],af_inet6);
339          inc(numsockused);
340        end;
341        {$endif}
342    
343    resolveloop(timeout);    resolveloop(timeout);
344    result := state.resultbin;  
345        if (numsockused = 1) then begin
346          biniplist_addlist(result,state[0].resultlist);
347        {$ifdef ipv6}
348        end else if (useaf = useaf_preferv6) then begin
349          biniplist_addlist(result,state[1].resultlist);
350          biniplist_addlist(result,state[0].resultlist);
351        end else begin
352          biniplist_addlist(result,state[0].resultlist);
353          biniplist_addlist(result,state[1].resultlist);
354        {$endif}  
355        end;
356        {$endif}
357      end;
358    end;
359    
360    function forwardlookup(name:string;timeout:integer):tbinip;
361    var
362      listtemp:tbiniplist;
363    begin
364      listtemp := forwardlookuplist(name,timeout);
365      result := biniplist_get(listtemp,0);
366  end;  end;
367    
368  function reverselookup(ip:tbinip;timeout:integer):string;  function reverselookup(ip:tbinip;timeout:integer):string;
# Line 243  Line 375 
375        exit;        exit;
376      end;      end;
377    {$endif}    {$endif}
378    setstate_reverse(ip,state);    {$ifdef syncdnscore}
379      setstate_reverse(ip,state[0]);
380      numsockused := 1;
381    resolveloop(timeout);    resolveloop(timeout);
382    result := state.resultstr;    result := state[0].resultstr;
383      {$endif}
384  end;  end;
385    
386    {$ifdef linux}{$ifdef ipv6}{$ifdef syncdnscore}
387    function getv6localips:tbiniplist;
388    var
389      t:textfile;
390      s,s2:string;
391      ip:tbinip;
392      a:integer;
393    begin
394      result := biniplist_new;
395    
396      assignfile(t,'/proc/net/if_inet6');
397      {$i-}reset(t);{$i+}
398      if ioresult <> 0 then exit; {none found, return empty list}
399    
400      while not eof(t) do begin
401        readln(t,s);
402        s2 := '';
403        for a := 0 to 7 do begin
404          if (s2 <> '') then s2 := s2 + ':';
405          s2 := s2 + copy(s,(a shl 2)+1,4);
406        end;
407        ipstrtobin(s2,ip);
408        if ip.family <> 0 then biniplist_add(result,ip);
409      end;
410      closefile(t);
411    end;
412    
413    procedure initpreferredmode;
414    var
415      l:tbiniplist;
416      a:integer;
417      ip:tbinip;
418      ipmask_global,ipmask_6to4,ipmask_teredo:tbinip;
419    
420    begin
421      if preferredmodeinited then exit;
422      if useaf <> useaf_default then exit;
423      useaf := useaf_preferv4;
424      l := getv6localips;
425      ipstrtobin('2000::',ipmask_global);
426      ipstrtobin('2001::',ipmask_teredo);
427      ipstrtobin('2002::',ipmask_6to4);
428      {if there is any v6 IP which is globally routable and not 6to4 and not teredo, prefer v6}
429      for a := biniplist_getcount(l)-1 downto 0 do begin
430        ip := biniplist_get(l,a);
431        if not comparebinipmask(ip,ipmask_global,3) then continue;
432        if comparebinipmask(ip,ipmask_teredo,32) then continue;
433        if comparebinipmask(ip,ipmask_6to4,16) then continue;
434        useaf := useaf_preferv6;
435        preferredmodeinited := true;
436        exit;
437      end;
438    end;
439    
440    {$endif}{$endif}{$endif}
441    
442  {$ifdef win32}  {$ifdef win32}
443    var    var
444      wsadata : twsadata;      wsadata : twsadata;

Legend:
Removed from v.1  
changed lines
  Added in v.2

No admin address has been configured">No admin address has been configured
ViewVC Help
Powered by ViewVC 1.1.22