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

Annotation of /trunk/dnssync.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 13 - (hide annotations)
Mon Mar 31 01:26:50 2008 UTC (12 years, 7 months ago) by plugwash
File size: 10518 byte(s)
* add multiip support to dnsasync

1 plugwash 1 { Copyright (C) 2005 Bas Steendijk and Peter Green
2     For conditions of distribution and use, see copyright notice in zlib_license.txt
3     which is included in the package
4     ----------------------------------------------------------------------------- }
5     unit dnssync;
6     {$ifdef fpc}
7     {$mode delphi}
8     {$endif}
9    
10 beware 2 {$include lcoreconfig.inc}
11    
12 plugwash 1 interface
13     uses
14     dnscore,
15     binipstuff,
16     {$ifdef win32}
17     winsock,
18     windows,
19     {$else}
20     {$ifdef VER1_0}
21     linux,
22     {$else}
23     baseunix,unix,unixutil,
24     {$endif}
25     sockets,
26     fd_utils,
27     {$endif}
28     sysutils;
29    
30     //convert a name to an IP
31 beware 2 //will return v4 or v6 depending on what seems favorable, or manual preference setting
32 plugwash 1 //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)
34 beware 2 //timeout is in miliseconds, it is ignored when using windows dns
35 plugwash 1 function forwardlookup(name:string;timeout:integer):tbinip;
36    
37 beware 2 //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 plugwash 1
42 beware 2
43     //convert an IP to a name, on error a null string will be returned, other
44 plugwash 1 //details as above
45     function reverselookup(ip:tbinip;timeout:integer):string;
46    
47    
48 beware 2
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
58 plugwash 1 dnssyncserver:string;
59 beware 2 id:integer;
60    
61     sendquerytime:array[0..numsock-1] of integer;
62 plugwash 1 implementation
63 beware 2
64 plugwash 1 {$ifdef win32}
65     uses dnswin;
66     {$endif}
67    
68 beware 2
69     {$ifndef win32}
70     {$define syncdnscore}
71     {$endif}
72    
73 plugwash 1 {$i unixstuff.inc}
74     {$i ltimevalstuff.inc}
75    
76     var
77 beware 2 numsockused:integer;
78     fd:array[0..numsock-1] of integer;
79     state:array[0..numsock-1] of tdnsstate;
80    
81     {$ifdef syncdnscore}
82    
83 plugwash 1 {$ifdef win32}
84     const
85     winsocket = 'wsock32.dll';
86 beware 2 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: TinetSockAddrV; namelen: Integer): Longbool; stdcall; external winsocket name 'bind';
88 plugwash 1 type
89     fdset=tfdset;
90     {$endif}
91    
92 beware 2
93     function getts:integer;
94     {$ifdef win32}
95     begin
96     result := GetTickCount and tsmask;
97     {$else}
98 plugwash 1 var
99 beware 2 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
109 plugwash 1 a:integer;
110     addr : string;
111     port : string;
112 beware 2 inaddr : TInetSockAddrV;
113 plugwash 1 begin
114     { writeln('sendquery ',decodename(state.packet,state.packetlen,12,0,a),' ',state.requesttype);}
115     result := false;
116     if len = 0 then exit; {no packet}
117    
118     if dnssyncserver <> '' then addr := dnssyncserver else addr := getcurrentsystemnameserver(id);
119     port := '53';
120    
121 beware 2 makeinaddrv(ipstrtobinf(addr),port,inaddr);
122 plugwash 1
123 beware 2 sendto(fd[socknum],packet,len,0,inaddr,inaddrsize(inaddr));
124     sendquerytime[socknum] := getts;
125 plugwash 1 result := true;
126     end;
127    
128     procedure setupsocket;
129     var
130 beware 2 inAddrtemp : TInetSockAddrV;
131     a:integer;
132     biniptemp:tbinip;
133     addr:string;
134 plugwash 1 begin
135 beware 2 //init both sockets smultaneously, always, so they get succesive fd's
136     if fd[0] > 0 then exit;
137 plugwash 1
138 beware 2 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     for a := 0 to numsockused-1 do begin
148     fd[a] := Socket(biniptemp.family,SOCK_DGRAM,0);
149    
150     If {$ifndef win32}Not{$endif} Bind(fd[a],inAddrtemp,inaddrsize(inaddrtemp)) Then begin
151     {$ifdef win32}
152     raise Exception.create('unable to bind '+inttostr(WSAGetLastError));
153     {$else}
154     raise Exception.create('unable to bind '+inttostr(socketError));
155     {$endif}
156     end;
157 plugwash 1 end;
158     end;
159    
160     procedure resolveloop(timeout:integer);
161     var
162     selectresult : integer;
163     fds : fdset;
164    
165 beware 2 endtime : longint;
166     starttime : longint;
167     wrapmode : boolean;
168     currenttime : integer;
169    
170 plugwash 1 lag : ttimeval;
171     currenttimeout : ttimeval;
172     selecttimeout : ttimeval;
173 beware 2 socknum:integer;
174     needprocessing:array[0..numsock-1] of boolean;
175     finished:array[0..numsock-1] of boolean;
176     a,b:integer;
177 plugwash 1
178 beware 2 begin
179     if timeout < mintimeout then timeout := defaulttimeout;
180 plugwash 1
181 beware 2 starttime := getts;
182     endtime := starttime + timeout;
183     if (endtime and tswrap)=0 then begin
184 plugwash 1 wrapmode := false;
185     end else begin
186     wrapmode := true;
187     end;
188 beware 2 endtime := endtime and tsmask;
189 plugwash 1
190     setupsocket;
191 beware 2 for socknum := 0 to numsockused-1 do begin
192     needprocessing[socknum] := true;
193     finished[socknum] := false;
194     end;
195    
196 plugwash 1 repeat
197 beware 2 for socknum := numsockused-1 downto 0 do if needprocessing[socknum] then begin
198     state_process(state[socknum]);
199     case state[socknum].resultaction of
200     action_ignore: begin
201     {do nothing}
202     end;
203     action_done: begin
204     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;
212     end;
213     //onrequestdone(self,0);
214     end;
215     action_sendquery:begin
216 plugwash 1 { writeln('send query');}
217 beware 2 sendquery(socknum,state[socknum].sendpacket,state[socknum].sendpacketlen);
218     end;
219 plugwash 1 end;
220 beware 2 needprocessing[socknum] := false;
221 plugwash 1 end;
222 beware 2
223     currenttime := getts;
224     msectotimeval(selecttimeout, (endtime-currenttime) and tsmask);
225    
226 plugwash 1 fd_zero(fds);
227 beware 2 for socknum := numsockused-1 downto 0 do if not finished[socknum] then fd_set(fd[socknum],fds);
228 plugwash 1 if (selecttimeout.tv_sec > 0) or (selecttimeout.tv_usec > retryafter) then begin
229     selecttimeout.tv_sec := 0;
230     selecttimeout.tv_usec := retryafter;
231     end;
232 beware 2 //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 plugwash 1 if selectresult > 0 then begin
237 beware 2 currenttime := getts;
238     for socknum := numsockused-1 downto 0 do if fd_isset(fd[socknum],fds) then begin
239     { writeln('selectresult>0');}
240     //why the hell are we zeroing out the packet buffer before reading into it?! --plugwash
241 plugwash 1
242 beware 2 fillchar(state[socknum].recvpacket,sizeof(state[socknum].recvpacket),0);
243     msectotimeval(lag,(currenttime-sendquerytime[socknum]) and tsmask);
244 plugwash 1
245 beware 2 if dnssyncserver = '' then reportlag(id,(lag.tv_sec*1000000)+lag.tv_usec);
246     state[socknum].recvpacketlen := recv(fd[socknum],state[socknum].recvpacket, SizeOf(state[socknum].recvpacket),0);
247     state[socknum].parsepacket := true;
248     needprocessing[socknum] := true;
249     end;
250 plugwash 1 end;
251     if selectresult < 0 then exit;
252     if selectresult = 0 then begin
253 beware 2
254     currenttime := getts;
255    
256     if dnssyncserver = '' then reportlag(id,-1);
257     if (currenttime >= endtime) and ((not wrapmode) or (currenttime < starttime)) then begin
258 plugwash 1 exit;
259     end else begin
260     //resend
261 beware 2 for socknum := numsockused-1 downto 0 do begin
262     sendquery(socknum,state[socknum].sendpacket,state[socknum].sendpacketlen);
263     end;
264 plugwash 1 end;
265     end;
266     until false;
267     end;
268 beware 2 {$endif}
269 plugwash 1
270 beware 2
271    
272     function forwardlookuplist(name:string;timeout:integer):tbiniplist;
273     var
274 plugwash 1 dummy : integer;
275 beware 2 a,b:integer;
276     biniptemp:tbinip;
277     l:tbiniplist;
278 plugwash 1 begin
279 beware 2 ipstrtobin(name,biniptemp);
280     if biniptemp.family <> 0 then begin
281     result := biniplist_new;
282     biniplist_add(result,biniptemp);
283     exit; //it was an IP address, no need for dns
284     end;
285    
286 plugwash 1 {$ifdef win32}
287 beware 2 if usewindns then begin
288     if (useaf = useaf_v4) then a := af_inet else if (useaf = useaf_v6) then a := af_inet6 else a := 0;
289     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 plugwash 1 end;
298 beware 2 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 plugwash 1 {$endif}
308 beware 2 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;
324     {$endif}
325    
326     resolveloop(timeout);
327    
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 plugwash 1 end;
342    
343 beware 2 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;
350    
351 plugwash 1 function reverselookup(ip:tbinip;timeout:integer):string;
352     var
353     dummy : integer;
354     begin
355     {$ifdef win32}
356     if usewindns then begin
357     result := winreverselookup(ip,dummy);
358     exit;
359     end;
360     {$endif}
361 beware 2 {$ifdef syncdnscore}
362     setstate_reverse(ip,state[0]);
363     numsockused := 1;
364 plugwash 1 resolveloop(timeout);
365 beware 2 result := state[0].resultstr;
366     {$endif}
367 plugwash 1 end;
368    
369     {$ifdef win32}
370     var
371     wsadata : twsadata;
372    
373     initialization
374     WSAStartUp($2,wsadata);
375     finalization
376     WSACleanUp;
377     {$endif}
378     end.
379    
380    

Properties

Name Value
svn:executable

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