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

Contents of /trunk/dnssync.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 13 - (show 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 { 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
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
58 dnssyncserver:string;
59 id:integer;
60
61 sendquerytime:array[0..numsock-1] of integer;
62 implementation
63
64 {$ifdef win32}
65 uses dnswin;
66 {$endif}
67
68
69 {$ifndef win32}
70 {$define syncdnscore}
71 {$endif}
72
73 {$i unixstuff.inc}
74 {$i ltimevalstuff.inc}
75
76 var
77 numsockused:integer;
78 fd:array[0..numsock-1] of integer;
79 state:array[0..numsock-1] of tdnsstate;
80
81 {$ifdef syncdnscore}
82
83 {$ifdef win32}
84 const
85 winsocket = 'wsock32.dll';
86 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 type
89 fdset=tfdset;
90 {$endif}
91
92
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
109 a:integer;
110 addr : string;
111 port : string;
112 inaddr : TInetSockAddrV;
113 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 makeinaddrv(ipstrtobinf(addr),port,inaddr);
122
123 sendto(fd[socknum],packet,len,0,inaddr,inaddrsize(inaddr));
124 sendquerytime[socknum] := getts;
125 result := true;
126 end;
127
128 procedure setupsocket;
129 var
130 inAddrtemp : TInetSockAddrV;
131 a:integer;
132 biniptemp:tbinip;
133 addr:string;
134 begin
135 //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 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 end;
158 end;
159
160 procedure resolveloop(timeout:integer);
161 var
162 selectresult : integer;
163 fds : fdset;
164
165 endtime : longint;
166 starttime : longint;
167 wrapmode : boolean;
168 currenttime : integer;
169
170 lag : ttimeval;
171 currenttimeout : ttimeval;
172 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
179 if timeout < mintimeout then timeout := defaulttimeout;
180
181 starttime := getts;
182 endtime := starttime + timeout;
183 if (endtime and tswrap)=0 then begin
184 wrapmode := false;
185 end else begin
186 wrapmode := true;
187 end;
188 endtime := endtime and tsmask;
189
190 setupsocket;
191 for socknum := 0 to numsockused-1 do begin
192 needprocessing[socknum] := true;
193 finished[socknum] := false;
194 end;
195
196 repeat
197 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 { writeln('send query');}
217 sendquery(socknum,state[socknum].sendpacket,state[socknum].sendpacketlen);
218 end;
219 end;
220 needprocessing[socknum] := false;
221 end;
222
223 currenttime := getts;
224 msectotimeval(selecttimeout, (endtime-currenttime) and tsmask);
225
226 fd_zero(fds);
227 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
229 selecttimeout.tv_sec := 0;
230 selecttimeout.tv_usec := retryafter;
231 end;
232 //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
237 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
242 fillchar(state[socknum].recvpacket,sizeof(state[socknum].recvpacket),0);
243 msectotimeval(lag,(currenttime-sendquerytime[socknum]) and tsmask);
244
245 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 end;
251 if selectresult < 0 then exit;
252 if selectresult = 0 then begin
253
254 currenttime := getts;
255
256 if dnssyncserver = '' then reportlag(id,-1);
257 if (currenttime >= endtime) and ((not wrapmode) or (currenttime < starttime)) then begin
258 exit;
259 end else begin
260 //resend
261 for socknum := numsockused-1 downto 0 do begin
262 sendquery(socknum,state[socknum].sendpacket,state[socknum].sendpacketlen);
263 end;
264 end;
265 end;
266 until false;
267 end;
268 {$endif}
269
270
271
272 function forwardlookuplist(name:string;timeout:integer):tbiniplist;
273 var
274 dummy : integer;
275 a,b:integer;
276 biniptemp:tbinip;
277 l:tbiniplist;
278 begin
279 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 {$ifdef win32}
287 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 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;
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 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;
350
351 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 {$ifdef syncdnscore}
362 setstate_reverse(ip,state[0]);
363 numsockused := 1;
364 resolveloop(timeout);
365 result := state[0].resultstr;
366 {$endif}
367 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