/[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 57 by plugwash, Sat Oct 31 00:20:41 2009 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 23  Line 25 
25        sockets,        sockets,
26        fd_utils,        fd_utils,
27      {$endif}      {$endif}
28      sysutils;      lcorernd,
29        sysutils,
30        ltimevalstuff;
31    
32  //convert a name to an IP  //convert a name to an IP
33  //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)  
34  //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
35  //zeroed out but may be used for further error information in future)  //zeroed out but may be used for further error information in future)
36  //timeout is in seconds, it is ignored when using windows dns  //timeout is in miliseconds, it is ignored when using windows dns
37  function forwardlookup(name:string;timeout:integer):tbinip;  function forwardlookup(name:string;timeout:integer):tbinip;
38    
39    //convert a name to a list of all IP's returned
40    //this returns both v4 and v6 IP's, or possibly only v4 or v6, depending on settings
41    //on error, returns an empty list
42    function forwardlookuplist(name:string;timeout:integer):tbiniplist;
43    
44    
45  //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
46  //details as above  //details as above
47  function reverselookup(ip:tbinip;timeout:integer):string;  function reverselookup(ip:tbinip;timeout:integer):string;
48    
49    
50    
51    const
52      tswrap=$4000;
53      tsmask=tswrap-1;
54    
55      numsock=1{$ifdef ipv6}+1{$endif};
56      defaulttimeout=10000;
57      const mintimeout=16;
58    
59      toport='53';
60    
61  var  var
   dnssyncserver:string;  
62    id : integer;    id : integer;
63    {$ifdef win32}  
64      sendquerytime : integer;    sendquerytime:array[0..numsock-1] of integer;
   {$else}  
     sendquerytime : ttimeval;  
   {$endif}  
65  implementation  implementation
66    
67  {$ifdef win32}  {$ifdef win32}
68    uses dnswin;    uses dnswin;
69  {$endif}  {$endif}
70    
71    
72    {$ifndef win32}
73    {$define syncdnscore}
74    {$endif}
75    
76  {$i unixstuff.inc}  {$i unixstuff.inc}
 {$i ltimevalstuff.inc}  
77    
78  var  var
79    fd:integer;    numsockused:integer;
80    state:tdnsstate;    fd:array[0..numsock-1] of integer;
81      state:array[0..numsock-1] of tdnsstate;
82      toaddr:array[0..numsock-1] of tbinip;
83    
84    {$ifdef syncdnscore}
85    
86  {$ifdef win32}  {$ifdef win32}
87    const    const
88      winsocket = 'wsock32.dll';      winsocket = 'wsock32.dll';
89    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';
90    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';
91    type    type
92      fdset=tfdset;      fdset=tfdset;
93  {$endif}  {$endif}
94    
95  function sendquery(const packet:tdnspacket;len:integer):boolean;  
96    function getts:integer;
97    {$ifdef win32}
98    begin
99      result := GetTickCount and tsmask;
100    {$else}
101    var
102      temp:ttimeval;
103    begin
104      gettimeofday(temp);
105      result := ((temp.tv_usec div 1000) + (temp.tv_sec * 1000)) and tsmask;
106    {$endif}
107    end;
108    
109    
110    function sendquery(socknum:integer;const packet:tdnspacket;len:integer):boolean;
111  var  var
112    a:integer;    a:integer;
113    addr       : string;    addr       : string;
114    port       : string;    port       : string;
115    inaddr     : TInetSockAddr;    inaddr     : TInetSockAddrV;
   
116  begin  begin
117  {  writeln('sendquery ',decodename(state.packet,state.packetlen,12,0,a),' ',state.requesttype);}  {  writeln('sendquery ',decodename(state.packet,state.packetlen,12,0,a),' ',state.requesttype);}
118    result := false;    result := false;
119    if len = 0 then exit; {no packet}    if len = 0 then exit; {no packet}
120    
121    if dnssyncserver <> '' then addr := dnssyncserver else addr := getcurrentsystemnameserver(id);    if overridednsserver <> '' then addr := overridednsserver else addr := getcurrentsystemnameserver(id);
   port := '53';  
122    
123    inAddr.family:=AF_INET;    {$ifdef ipv6}{$ifdef win32}
124    inAddr.port:=htons(strtointdef(port,0));    if toaddr[socknum].family = AF_INET6 then if (useaf = 0) then useaf := useaf_preferv6;
125    inAddr.addr:=htonl(longip(addr));    {$endif}{$endif}
126    
127      port := toport;
128      toaddr[socknum] := ipstrtobinf(addr);
129      makeinaddrv(toaddr[socknum],port,inaddr);
130    
131    sendto(fd,packet,len,0,inaddr,sizeof(inaddr));    sendto(fd[socknum],packet,len,0,inaddr,inaddrsize(inaddr));
132    {$ifdef win32}    sendquerytime[socknum] := getts;
     sendquerytime := GetTickCount and $3fff;  
   {$else}  
     gettimeofday(sendquerytime);  
   {$endif}  
133    result := true;    result := true;
134  end;  end;
135    
136  procedure setupsocket;  procedure setupsocket;
137  var  var
138    inAddrtemp : TInetSockAddr;    inAddrtemp : TInetSockAddrV;
139      a:integer;
140      biniptemp:tbinip;
141      addr:string;
142  begin  begin
143    if fd > 0 then exit;    //init both sockets smultaneously, always, so they get succesive fd's
144      if fd[0] > 0 then exit;
145    
146      if overridednsserver <> '' then addr := overridednsserver else addr := getcurrentsystemnameserver(id);
147      //must get the DNS server here so we know to init v4 or v6
148    
149      ipstrtobin(addr,biniptemp);
150    
151      if biniptemp.family = AF_INET6 then biniptemp := ipstrtobinf('::') else biniptemp := ipstrtobinf('0.0.0.0');
152    
153    
154      for a := 0 to numsockused-1 do begin
155        makeinaddrv(biniptemp,inttostr( 1024 + randominteger(65536 - 1024) ),inaddrtemp);
156    
157    fd := Socket(AF_INET,SOCK_DGRAM,0);      fd[a] := Socket(biniptemp.family,SOCK_DGRAM,0);
158    inAddrtemp.family:=AF_INET;  
159    inAddrtemp.port:=0;      If {$ifndef win32}Not{$endif} Bind(fd[a],inAddrtemp,inaddrsize(inaddrtemp)) Then begin
   inAddrtemp.addr:=0;{htonl(longip('0.0.0.0'));}  
   If {$ifndef win32}Not{$endif} Bind(fd,inAddrtemp,SizeOf(inAddrtemp)) Then begin  
160      {$ifdef win32}      {$ifdef win32}
161        raise Exception.create('unable to bind '+inttostr(WSAGetLastError));        raise Exception.create('unable to bind '+inttostr(WSAGetLastError));
162      {$else}      {$else}
# Line 113  Line 164 
164      {$endif}      {$endif}
165    end;    end;
166  end;  end;
167    end;
168    
169  procedure resolveloop(timeout:integer);  procedure resolveloop(timeout:integer);
170  var  var
171    selectresult   : integer;    selectresult   : integer;
172    fds            : fdset;    fds            : fdset;
173    {$ifdef win32}  
174      endtime      : longint;      endtime      : longint;
175      starttime    : longint;      starttime    : longint;
176      wrapmode     : boolean;      wrapmode     : boolean;
177      currenttime  : integer;      currenttime  : integer;
   {$else}  
     endtime      : ttimeval;  
     currenttime    : ttimeval;  
178    
   {$endif}  
179    lag            : ttimeval;    lag            : ttimeval;
180    currenttimeout : ttimeval;    currenttimeout : ttimeval;
181    selecttimeout  : ttimeval;    selecttimeout  : ttimeval;
182      socknum:integer;
183      needprocessing:array[0..numsock-1] of boolean;
184      finished:array[0..numsock-1] of boolean;
185      a,b:integer;
186    
187      Src    : TInetSockAddrV;
188      Srcx   : {$ifdef win32}sockaddr_in{$else}TInetSockAddrV{$endif} absolute Src;
189      SrcLen : Integer;
190      fromip:tbinip;
191      fromport:string;
192    
193  begin  begin
194    {$ifdef win32}    if timeout < mintimeout then timeout := defaulttimeout;
195      starttime := GetTickCount and $3fff;  
196      endtime := starttime +(timeout*1000);      starttime := getts;
197      if (endtime and $4000)=0 then begin      endtime := starttime + timeout;
198        if (endtime and tswrap)=0 then begin
199        wrapmode := false;        wrapmode := false;
200      end else begin      end else begin
201        wrapmode := true;        wrapmode := true;
202      end;      end;
203      endtime := endtime and $3fff;      endtime := endtime and tsmask;
   {$else}  
     gettimeofday(endtime);  
     endtime.tv_sec := endtime.tv_sec + timeout;  
   {$endif}  
204    
205    setupsocket;    setupsocket;
206      for socknum := 0 to numsockused-1 do begin
207        needprocessing[socknum] := true;
208        finished[socknum] := false;
209      end;
210    
211    repeat    repeat
212      state_process(state);      for socknum := numsockused-1 downto 0 do if needprocessing[socknum] then begin
213      case state.resultaction of        state_process(state[socknum]);
214          case state[socknum].resultaction of
215        action_ignore: begin        action_ignore: begin
 {        writeln('ignore');}  
216          {do nothing}          {do nothing}
217        end;        end;
218        action_done: begin        action_done: begin
219  {        writeln('done');}            finished[socknum] := true;
220              //exit if all resolvers are finished
221              b := 0;
222              for a := 0 to numsockused-1 do begin
223                if finished[a] then inc(b);
224              end;
225              if (b = numsockused) then begin
226          exit;          exit;
227              end;
228          //onrequestdone(self,0);          //onrequestdone(self,0);
229        end;        end;
230        action_sendquery:begin        action_sendquery:begin
231  {        writeln('send query');}  {        writeln('send query');}
232          sendquery(state.sendpacket,state.sendpacketlen);            sendquery(socknum,state[socknum].sendpacket,state[socknum].sendpacketlen);
233        end;        end;
234      end;      end;
235      {$ifdef win32}        needprocessing[socknum] := false;
236        currenttime := GetTickCount and $3fff;      end;
237        msectotimeval(selecttimeout, (endtime-currenttime)and$3fff);  
238      {$else}      currenttime := getts;
239        gettimeofday(currenttime);      msectotimeval(selecttimeout, (endtime-currenttime) and tsmask);
240        selecttimeout := endtime;  
       tv_substract(selecttimeout,currenttime);  
     {$endif}  
241      fd_zero(fds);      fd_zero(fds);
242      fd_set(fd,fds);      for socknum := numsockused-1 downto 0 do if not finished[socknum] then fd_set(fd[socknum],fds);
243      if (selecttimeout.tv_sec > 0) or (selecttimeout.tv_usec > retryafter) then begin      if (selecttimeout.tv_sec > 0) or (selecttimeout.tv_usec > retryafter) then begin
244        selecttimeout.tv_sec := 0;        selecttimeout.tv_sec := 0;
245        selecttimeout.tv_usec := retryafter;        selecttimeout.tv_usec := retryafter;
246      end;      end;
247      selectresult := select(fd+1,@fds,nil,nil,@selecttimeout);      //find the highest of the used fd's
248        b := 0;
249        for socknum := numsockused-1 downto 0 do if fd[socknum] > b then b := fd[socknum];
250        selectresult := select(b+1,@fds,nil,nil,@selecttimeout);
251      if selectresult > 0 then begin      if selectresult > 0 then begin
252          currenttime := getts;
253          for socknum := numsockused-1 downto 0 do if fd_isset(fd[socknum],fds) then begin
254  {      writeln('selectresult>0');}  {      writeln('selectresult>0');}
255        //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);  
256    
257        {$endif}          fillchar(state[socknum].recvpacket,sizeof(state[socknum].recvpacket),0);
258            msectotimeval(lag,(currenttime-sendquerytime[socknum]) and tsmask);
259    
260            if overridednsserver = '' then reportlag(id,(lag.tv_sec*1000000)+lag.tv_usec);
261    
262        reportlag(id,(lag.tv_sec*1000000)+lag.tv_usec);          SrcLen := SizeOf(Src);
263        state.recvpacketlen := recv(fd,state.recvpacket, SizeOf(state.recvpacket),0);          state[socknum].recvpacketlen := recvfrom(fd[socknum],state[socknum].recvpacket, SizeOf(state[socknum].recvpacket),0,Srcx,SrcLen);
264        state.parsepacket := true;  
265            if (state[socknum].recvpacketlen > 0) then begin
266              fromip := inaddrvtobinip(Src);
267              fromport := inttostr(htons(src.InAddr.port));
268              if ((not comparebinip(toaddr[socknum],fromip)) or (fromport <> toport)) then begin
269    //            writeln('dnssync received from wrong IP:port ',ipbintostr(fromip),'#',fromport);
270                state[socknum].recvpacketlen := 0;
271              end else begin
272                state[socknum].parsepacket := true;
273                needprocessing[socknum] := true;
274              end;
275            end;
276          end;
277      end;      end;
278      if selectresult < 0 then exit;      if selectresult < 0 then exit;
279      if selectresult = 0 then begin      if selectresult = 0 then begin
280        {$ifdef win32}  
281          currenttime := GetTickCount;        currenttime := getts;
282        {$else}  
283          gettimeofday(currenttime);        if overridednsserver = '' then reportlag(id,-1);
284        {$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  
285          exit;          exit;
286        end else begin        end else begin
287          //resend          //resend
288          sendquery(state.sendpacket,state.sendpacketlen);          for socknum := numsockused-1 downto 0 do begin
289              sendquery(socknum,state[socknum].sendpacket,state[socknum].sendpacketlen);
290            end;
291        end;        end;
292      end;      end;
293    until false;    until false;
294  end;  end;
295    {$endif}
296    
297  function forwardlookup(name:string;timeout:integer):tbinip;  
298    
299    function forwardlookuplist(name:string;timeout:integer):tbiniplist;
300  var  var
301    dummy : integer;    dummy : integer;
302      a,b:integer;
303      biniptemp:tbinip;
304      l:tbiniplist;
305  begin  begin
306    ipstrtobin(name,result);    ipstrtobin(name,biniptemp);
307    if result.family <> 0 then exit; //it was an IP address, no need for dns    if biniptemp.family <> 0 then begin
308                                     //lookup      result := biniplist_new;
309        biniplist_add(result,biniptemp);
310        exit; //it was an IP address, no need for dns
311      end;
312    
313    {$ifdef win32}    {$ifdef win32}
314      if usewindns then begin      if usewindns then begin
315        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;
316        exit;      result := winforwardlookuplist(name,a,dummy);
317        {$ifdef ipv6}
318        if (useaf = useaf_preferv4) then begin
319          {prefer mode: sort the IP's}
320          l := biniplist_new;
321          addipsoffamily(l,result,af_inet);
322          addipsoffamily(l,result,af_inet6);
323          result := l;
324        end;
325        if (useaf = useaf_preferv6) then begin
326          {prefer mode: sort the IP's}
327          l := biniplist_new;
328          addipsoffamily(l,result,af_inet6);
329          addipsoffamily(l,result,af_inet);
330          result := l;
331      end;      end;
332    {$endif}    {$endif}
333    setstate_forward(name,state,0);    end else
334      {$endif}
335      begin
336      {$ifdef syncdnscore}
337        {$ifdef ipv6}initpreferredmode;{$endif}
338    
339        numsockused := 0;
340    
341        result := biniplist_new;
342        if (useaf <> useaf_v6) then begin
343          setstate_forward(name,state[numsockused],af_inet);
344          inc(numsockused);
345        end;
346        {$ifdef ipv6}
347        if (useaf <> useaf_v4) then begin
348          setstate_forward(name,state[numsockused],af_inet6);
349          inc(numsockused);
350        end;
351        {$endif}
352    
353    resolveloop(timeout);    resolveloop(timeout);
354    result := state.resultbin;  
355        if (numsockused = 1) then begin
356          biniplist_addlist(result,state[0].resultlist);
357        {$ifdef ipv6}
358        end else if (useaf = useaf_preferv6) then begin
359          biniplist_addlist(result,state[1].resultlist);
360          biniplist_addlist(result,state[0].resultlist);
361        end else begin
362          biniplist_addlist(result,state[0].resultlist);
363          biniplist_addlist(result,state[1].resultlist);
364        {$endif}
365        end;
366        {$endif}
367      end;
368    end;
369    
370    function forwardlookup(name:string;timeout:integer):tbinip;
371    var
372      listtemp:tbiniplist;
373    begin
374      listtemp := forwardlookuplist(name,timeout);
375      result := biniplist_get(listtemp,0);
376  end;  end;
377    
378  function reverselookup(ip:tbinip;timeout:integer):string;  function reverselookup(ip:tbinip;timeout:integer):string;
# Line 243  Line 385 
385        exit;        exit;
386      end;      end;
387    {$endif}    {$endif}
388    setstate_reverse(ip,state);    {$ifdef syncdnscore}
389      setstate_reverse(ip,state[0]);
390      numsockused := 1;
391    resolveloop(timeout);    resolveloop(timeout);
392    result := state.resultstr;    result := state[0].resultstr;
393      {$endif}
394  end;  end;
395    
396  {$ifdef win32}  {$ifdef win32}
Legend:
Removed from v.1  
changed lines
  Added in v.57
No admin address has been configured">No admin address has been configured
 ViewVC Help
Powered by ViewVC 1.1.26