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

Contents of /trunk/dnssync.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2 - (show annotations)
Sun Mar 30 00:16:07 2008 UTC (12 years, 7 months ago) by beware
File size: 12447 byte(s)
the big lot of changes by beware

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 {$include lcoreconfig.inc}
11
12 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 //will return v4 or v6 depending on what seems favorable, or manual preference setting
32 //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 //timeout is in miliseconds, it is ignored when using windows dns
35 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
44 //details as above
45 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
65 dnssyncserver:string;
66 id:integer;
67
68 sendquerytime:array[0..numsock-1] of integer;
69 implementation
70
71 {$ifdef win32}
72 uses dnswin;
73 {$endif}
74
75
76 {$ifndef win32}
77 {$define syncdnscore}
78 {$endif}
79
80 {$i unixstuff.inc}
81 {$i ltimevalstuff.inc}
82
83 var
84 numsockused:integer;
85 fd:array[0..numsock-1] of integer;
86 state:array[0..numsock-1] of tdnsstate;
87
88 {$ifdef syncdnscore}
89
90 {$ifdef win32}
91 const
92 winsocket = 'wsock32.dll';
93 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: TinetSockAddrV; namelen: Integer): Longbool; stdcall; external winsocket name 'bind';
95 type
96 fdset=tfdset;
97 {$endif}
98
99
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
116 a:integer;
117 addr : string;
118 port : string;
119 inaddr : TInetSockAddrV;
120 begin
121 { writeln('sendquery ',decodename(state.packet,state.packetlen,12,0,a),' ',state.requesttype);}
122 result := false;
123 if len = 0 then exit; {no packet}
124
125 if dnssyncserver <> '' then addr := dnssyncserver else addr := getcurrentsystemnameserver(id);
126 port := '53';
127
128 makeinaddrv(ipstrtobinf(addr),port,inaddr);
129
130 sendto(fd[socknum],packet,len,0,inaddr,inaddrsize(inaddr));
131 sendquerytime[socknum] := getts;
132 result := true;
133 end;
134
135 procedure setupsocket;
136 var
137 inAddrtemp : TInetSockAddrV;
138 a:integer;
139 biniptemp:tbinip;
140 addr:string;
141 begin
142 //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 for a := 0 to numsockused-1 do begin
155 fd[a] := Socket(biniptemp.family,SOCK_DGRAM,0);
156
157 If {$ifndef win32}Not{$endif} Bind(fd[a],inAddrtemp,inaddrsize(inaddrtemp)) Then begin
158 {$ifdef win32}
159 raise Exception.create('unable to bind '+inttostr(WSAGetLastError));
160 {$else}
161 raise Exception.create('unable to bind '+inttostr(socketError));
162 {$endif}
163 end;
164 end;
165 end;
166
167 procedure resolveloop(timeout:integer);
168 var
169 selectresult : integer;
170 fds : fdset;
171
172 endtime : longint;
173 starttime : longint;
174 wrapmode : boolean;
175 currenttime : integer;
176
177 lag : ttimeval;
178 currenttimeout : ttimeval;
179 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
186 if timeout < mintimeout then timeout := defaulttimeout;
187
188 starttime := getts;
189 endtime := starttime + timeout;
190 if (endtime and tswrap)=0 then begin
191 wrapmode := false;
192 end else begin
193 wrapmode := true;
194 end;
195 endtime := endtime and tsmask;
196
197 setupsocket;
198 for socknum := 0 to numsockused-1 do begin
199 needprocessing[socknum] := true;
200 finished[socknum] := false;
201 end;
202
203 repeat
204 for socknum := numsockused-1 downto 0 do if needprocessing[socknum] then begin
205 state_process(state[socknum]);
206 case state[socknum].resultaction of
207 action_ignore: begin
208 {do nothing}
209 end;
210 action_done: begin
211 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;
219 end;
220 //onrequestdone(self,0);
221 end;
222 action_sendquery:begin
223 { writeln('send query');}
224 sendquery(socknum,state[socknum].sendpacket,state[socknum].sendpacketlen);
225 end;
226 end;
227 needprocessing[socknum] := false;
228 end;
229
230 currenttime := getts;
231 msectotimeval(selecttimeout, (endtime-currenttime) and tsmask);
232
233 fd_zero(fds);
234 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
236 selecttimeout.tv_sec := 0;
237 selecttimeout.tv_usec := retryafter;
238 end;
239 //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
244 currenttime := getts;
245 for socknum := numsockused-1 downto 0 do if fd_isset(fd[socknum],fds) then begin
246 { writeln('selectresult>0');}
247 //why the hell are we zeroing out the packet buffer before reading into it?! --plugwash
248
249 fillchar(state[socknum].recvpacket,sizeof(state[socknum].recvpacket),0);
250 msectotimeval(lag,(currenttime-sendquerytime[socknum]) and tsmask);
251
252 if dnssyncserver = '' then reportlag(id,(lag.tv_sec*1000000)+lag.tv_usec);
253 state[socknum].recvpacketlen := recv(fd[socknum],state[socknum].recvpacket, SizeOf(state[socknum].recvpacket),0);
254 state[socknum].parsepacket := true;
255 needprocessing[socknum] := true;
256 end;
257 end;
258 if selectresult < 0 then exit;
259 if selectresult = 0 then begin
260
261 currenttime := getts;
262
263 if dnssyncserver = '' then reportlag(id,-1);
264 if (currenttime >= endtime) and ((not wrapmode) or (currenttime < starttime)) then begin
265 exit;
266 end else begin
267 //resend
268 for socknum := numsockused-1 downto 0 do begin
269 sendquery(socknum,state[socknum].sendpacket,state[socknum].sendpacketlen);
270 end;
271 end;
272 end;
273 until false;
274 end;
275 {$endif}
276
277 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
291 dummy : integer;
292 a,b:integer;
293 biniptemp:tbinip;
294 l:tbiniplist;
295 begin
296 ipstrtobin(name,biniptemp);
297 if biniptemp.family <> 0 then begin
298 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}
304 if usewindns then begin
305 if (useaf = useaf_v4) then a := af_inet else if (useaf = useaf_v6) then a := af_inet6 else a := 0;
306 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;
322 {$endif}
323 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);
344
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;
367
368 function reverselookup(ip:tbinip;timeout:integer):string;
369 var
370 dummy : integer;
371 begin
372 {$ifdef win32}
373 if usewindns then begin
374 result := winreverselookup(ip,dummy);
375 exit;
376 end;
377 {$endif}
378 {$ifdef syncdnscore}
379 setstate_reverse(ip,state[0]);
380 numsockused := 1;
381 resolveloop(timeout);
382 result := state[0].resultstr;
383 {$endif}
384 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}
443 var
444 wsadata : twsadata;
445
446 initialization
447 WSAStartUp($2,wsadata);
448 finalization
449 WSACleanUp;
450 {$endif}
451 end.
452
453

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