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

Annotation of /trunk/dnssync.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2 - (hide 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 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 beware 2 {$ifdef linux}{$ifdef ipv6}
48     function getv6localips:tbiniplist;
49     procedure initpreferredmode;
50 plugwash 1
51     var
52 beware 2 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 plugwash 1 dnssyncserver:string;
66 beware 2 id:integer;
67    
68     sendquerytime:array[0..numsock-1] of integer;
69 plugwash 1 implementation
70 beware 2
71 plugwash 1 {$ifdef win32}
72     uses dnswin;
73     {$endif}
74    
75 beware 2
76     {$ifndef win32}
77     {$define syncdnscore}
78     {$endif}
79    
80 plugwash 1 {$i unixstuff.inc}
81     {$i ltimevalstuff.inc}
82    
83     var
84 beware 2 numsockused:integer;
85     fd:array[0..numsock-1] of integer;
86     state:array[0..numsock-1] of tdnsstate;
87    
88     {$ifdef syncdnscore}
89    
90 plugwash 1 {$ifdef win32}
91     const
92     winsocket = 'wsock32.dll';
93 beware 2 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 plugwash 1 type
96     fdset=tfdset;
97     {$endif}
98    
99 beware 2
100     function getts:integer;
101     {$ifdef win32}
102     begin
103     result := GetTickCount and tsmask;
104     {$else}
105 plugwash 1 var
106 beware 2 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 plugwash 1 a:integer;
117     addr : string;
118     port : string;
119 beware 2 inaddr : TInetSockAddrV;
120 plugwash 1 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 beware 2 makeinaddrv(ipstrtobinf(addr),port,inaddr);
129 plugwash 1
130 beware 2 sendto(fd[socknum],packet,len,0,inaddr,inaddrsize(inaddr));
131     sendquerytime[socknum] := getts;
132 plugwash 1 result := true;
133     end;
134    
135     procedure setupsocket;
136     var
137 beware 2 inAddrtemp : TInetSockAddrV;
138     a:integer;
139     biniptemp:tbinip;
140     addr:string;
141 plugwash 1 begin
142 beware 2 //init both sockets smultaneously, always, so they get succesive fd's
143     if fd[0] > 0 then exit;
144 plugwash 1
145 beware 2 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 plugwash 1 end;
165     end;
166    
167     procedure resolveloop(timeout:integer);
168     var
169     selectresult : integer;
170     fds : fdset;
171    
172 beware 2 endtime : longint;
173     starttime : longint;
174     wrapmode : boolean;
175     currenttime : integer;
176    
177 plugwash 1 lag : ttimeval;
178     currenttimeout : ttimeval;
179     selecttimeout : ttimeval;
180 beware 2 socknum:integer;
181     needprocessing:array[0..numsock-1] of boolean;
182     finished:array[0..numsock-1] of boolean;
183     a,b:integer;
184 plugwash 1
185 beware 2 begin
186     if timeout < mintimeout then timeout := defaulttimeout;
187 plugwash 1
188 beware 2 starttime := getts;
189     endtime := starttime + timeout;
190     if (endtime and tswrap)=0 then begin
191 plugwash 1 wrapmode := false;
192     end else begin
193     wrapmode := true;
194     end;
195 beware 2 endtime := endtime and tsmask;
196 plugwash 1
197     setupsocket;
198 beware 2 for socknum := 0 to numsockused-1 do begin
199     needprocessing[socknum] := true;
200     finished[socknum] := false;
201     end;
202    
203 plugwash 1 repeat
204 beware 2 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 plugwash 1 { writeln('send query');}
224 beware 2 sendquery(socknum,state[socknum].sendpacket,state[socknum].sendpacketlen);
225     end;
226 plugwash 1 end;
227 beware 2 needprocessing[socknum] := false;
228 plugwash 1 end;
229 beware 2
230     currenttime := getts;
231     msectotimeval(selecttimeout, (endtime-currenttime) and tsmask);
232    
233 plugwash 1 fd_zero(fds);
234 beware 2 for socknum := numsockused-1 downto 0 do if not finished[socknum] then fd_set(fd[socknum],fds);
235 plugwash 1 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 beware 2 //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 plugwash 1 if selectresult > 0 then begin
244 beware 2 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 plugwash 1
249 beware 2 fillchar(state[socknum].recvpacket,sizeof(state[socknum].recvpacket),0);
250     msectotimeval(lag,(currenttime-sendquerytime[socknum]) and tsmask);
251 plugwash 1
252 beware 2 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 plugwash 1 end;
258     if selectresult < 0 then exit;
259     if selectresult = 0 then begin
260 beware 2
261     currenttime := getts;
262    
263     if dnssyncserver = '' then reportlag(id,-1);
264     if (currenttime >= endtime) and ((not wrapmode) or (currenttime < starttime)) then begin
265 plugwash 1 exit;
266     end else begin
267     //resend
268 beware 2 for socknum := numsockused-1 downto 0 do begin
269     sendquery(socknum,state[socknum].sendpacket,state[socknum].sendpacketlen);
270     end;
271 plugwash 1 end;
272     end;
273     until false;
274     end;
275 beware 2 {$endif}
276 plugwash 1
277 beware 2 procedure addipsoffamily(var l:tbiniplist;const l2:tbiniplist;family:integer);
278 plugwash 1 var
279 beware 2 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 plugwash 1 dummy : integer;
292 beware 2 a,b:integer;
293     biniptemp:tbinip;
294     l:tbiniplist;
295 plugwash 1 begin
296 beware 2 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 plugwash 1 {$ifdef win32}
304 beware 2 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 plugwash 1 end;
315 beware 2 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 plugwash 1 {$endif}
325 beware 2 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 plugwash 1 end;
359    
360 beware 2 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 plugwash 1 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 beware 2 {$ifdef syncdnscore}
379     setstate_reverse(ip,state[0]);
380     numsockused := 1;
381 plugwash 1 resolveloop(timeout);
382 beware 2 result := state[0].resultstr;
383     {$endif}
384 plugwash 1 end;
385    
386 beware 2 {$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 plugwash 1 {$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