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

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

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