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

Contents of /trunk/dnssync.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 136 - (show annotations)
Fri Mar 28 03:18:52 2014 UTC (3 years, 8 months ago) by beware
File size: 11836 byte(s)
fix spelling mistakes
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 mswindows}
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 lcorernd,
29 sysutils,
30 ltimevalstuff;
31
32 //convert a name to an IP
33 //will return v4 or v6 depending on what seems favorable, or manual preference setting
34 //on error the binip will have a family of 0 (other fields are also currently
35 //zeroed out but may be used for further error information in future)
36 //timeout is in milliseconds, it is ignored when using windows dns
37 function forwardlookup(name:ansistring;timeout:integer):tbinip;
38
39 //convert a name to a list of all IP's returned
40 //this returns both v4 and v6 IP's, or possibly only v4 or v6, depending on settings
41 //on error, returns an empty list
42 function forwardlookuplist(name:ansistring;timeout:integer):tbiniplist;
43
44
45 //convert an IP to a name, on error a null string will be returned, other
46 //details as above
47 function reverselookup(ip:tbinip;timeout:integer):ansistring;
48
49
50
51 const
52 tswrap=$4000;
53 tsmask=tswrap-1;
54
55 numsock=1{$ifdef ipv6}+1{$endif};
56 defaulttimeout=10000;
57 const mintimeout=16;
58
59 toport='53';
60
61 implementation
62
63 {$ifdef mswindows}
64 uses dnswin;
65 {$endif}
66
67
68 {$ifndef mswindows}
69 {$define syncdnscore}
70 {$endif}
71
72 {$i unixstuff.inc}
73
74 type tdnsstatearr=array[0..numsock-1] of tdnsstate;
75
76 {$ifdef syncdnscore}
77
78
79 {$ifdef mswindows}
80 const
81 winsocket = 'wsock32.dll';
82 function sendto(s: TSocket; const Buf; len, flags: Integer; var addrto: TinetSockAddrV; tolen: Integer): Integer; stdcall; external winsocket name 'sendto';
83 function bind(s: TSocket; var addr: TinetSockAddrV; namelen: Integer): Longbool; stdcall; external winsocket name 'bind';
84 type
85 fdset=tfdset;
86 {$endif}
87
88
89 function getts:integer;
90 {$ifdef mswindows}
91 begin
92 result := GetTickCount and tsmask;
93 {$else}
94 var
95 temp:ttimeval;
96 begin
97 gettimeofday(temp);
98 result := ((temp.tv_usec div 1000) + (temp.tv_sec * 1000)) and tsmask;
99 {$endif}
100 end;
101
102 procedure resolveloop(timeout:integer;var state:tdnsstatearr;numsockused:integer);
103 var
104 selectresult : integer;
105 fds : fdset;
106
107 endtime : longint;
108 starttime : longint;
109 wrapmode : boolean;
110 currenttime : integer;
111
112 lag : ttimeval;
113 selecttimeout : ttimeval;
114 socknum:integer;
115 needprocessing:array[0..numsock-1] of boolean;
116 finished:array[0..numsock-1] of boolean;
117 a,b:integer;
118
119 Src : TInetSockAddrV;
120 Srcx : {$ifdef mswindows}sockaddr_in{$else}TInetSockAddrV{$endif} absolute Src;
121 SrcLen : Integer;
122 fromip:tbinip;
123 fromport:ansistring;
124
125 fd:array[0..numsock-1] of integer;
126 toaddr:array[0..numsock-1] of tbinip;
127 id:integer;
128 sendquerytime:array[0..numsock-1] of integer;
129
130
131 procedure setupsocket;
132 var
133 inAddrtemp : TInetSockAddrV;
134 biniptemp:tbinip;
135 a,retrycount,porttemp:integer;
136 bindresult:boolean;
137 begin
138 biniptemp := getcurrentsystemnameserverbin(id);
139 //must get the DNS server here so we know to init v4 or v6
140
141 if biniptemp.family = AF_INET6 then biniptemp := ipstrtobinf('::') else biniptemp := ipstrtobinf('0.0.0.0');
142
143
144 for a := 0 to numsockused-1 do begin
145 retrycount := 5;
146 repeat
147 if (retrycount <= 1) then begin
148 porttemp := 0; //for the last attempt let the OS decide
149 end else begin
150 porttemp := 1024 + randominteger(65536 - 1024);
151 end;
152
153 makeinaddrv(biniptemp,inttostr( porttemp ),inaddrtemp);
154
155 fd[a] := Socket(biniptemp.family,SOCK_DGRAM,0);
156 bindresult := {$ifdef mswindows}Not{$endif} Bind(fd[a],inAddrtemp,inaddrsize(inaddrtemp));
157 dec(retrycount);
158 until (retrycount <= 0) or (bindresult);
159
160 If (not bindresult) Then begin
161 {$ifdef mswindows}
162 raise Exception.create('unable to bind '+inttostr(WSAGetLastError));
163 {$else}
164 raise Exception.create('unable to bind '+inttostr(socketError));
165 {$endif}
166 end;
167 end;
168 end;
169
170 procedure cleanupsockets;
171 var
172 a:integer;
173 begin
174 for a := 0 to numsockused-1 do closesocket(fd[a]);
175 end;
176
177 function sendquery(socknum:integer;const packet:tdnspacket;len:integer):boolean;
178 var
179 ip : tbinip;
180 port : ansistring;
181 inaddr : TInetSockAddrV;
182 begin
183 { writeln('sendquery ',decodename(state.packet,state.packetlen,12,0,a),' ',state.requesttype);}
184 result := false;
185 if len = 0 then exit; {no packet}
186
187 ip := getcurrentsystemnameserverbin(id);
188
189 {$ifdef ipv6}{$ifdef mswindows}
190 if toaddr[socknum].family = AF_INET6 then if (useaf = 0) then useaf := useaf_preferv6;
191 {$endif}{$endif}
192
193 port := toport;
194 toaddr[socknum] := ip;
195 makeinaddrv(toaddr[socknum],port,inaddr);
196
197 sendto(fd[socknum],packet,len,0,inaddr,inaddrsize(inaddr));
198 sendquerytime[socknum] := getts;
199 result := true;
200 end;
201
202 begin
203 if timeout < mintimeout then timeout := defaulttimeout;
204
205 starttime := getts;
206 endtime := starttime + timeout;
207 if (endtime and tswrap)=0 then begin
208 wrapmode := false;
209 end else begin
210 wrapmode := true;
211 end;
212 endtime := endtime and tsmask;
213
214 setupsocket;
215
216
217 for socknum := 0 to numsockused-1 do begin
218 needprocessing[socknum] := true;
219 finished[socknum] := false;
220 end;
221
222 repeat
223 for socknum := numsockused-1 downto 0 do if needprocessing[socknum] then begin
224 state_process(state[socknum]);
225 case state[socknum].resultaction of
226 action_ignore: begin
227 {do nothing}
228 end;
229 action_done: begin
230 finished[socknum] := true;
231 //exit if all resolvers are finished
232 b := 0;
233 for a := 0 to numsockused-1 do begin
234 if finished[a] then inc(b);
235 end;
236 if (b = numsockused) then begin
237 cleanupsockets;
238 exit;
239 end;
240 //onrequestdone(self,0);
241 end;
242 action_sendquery:begin
243 { writeln('send query');}
244 sendquery(socknum,state[socknum].sendpacket,state[socknum].sendpacketlen);
245 end;
246 end;
247 needprocessing[socknum] := false;
248 end;
249
250 currenttime := getts;
251 msectotimeval(selecttimeout, (endtime-currenttime) and tsmask);
252
253 fd_zero(fds);
254 for socknum := numsockused-1 downto 0 do if not finished[socknum] then fd_set(fd[socknum],fds);
255 if (selecttimeout.tv_sec > 0) or (selecttimeout.tv_usec > retryafter) then begin
256 selecttimeout.tv_sec := 0;
257 selecttimeout.tv_usec := retryafter;
258 end;
259 //find the highest of the used fd's
260 b := 0;
261 for socknum := numsockused-1 downto 0 do if fd[socknum] > b then b := fd[socknum];
262 selectresult := select(b+1,@fds,nil,nil,@selecttimeout);
263 if selectresult > 0 then begin
264 currenttime := getts;
265 for socknum := numsockused-1 downto 0 do if fd_isset(fd[socknum],fds) then begin
266 { writeln('selectresult>0');}
267 //why the hell are we zeroing out the packet buffer before reading into it?! --plugwash
268
269 fillchar(state[socknum].recvpacket,sizeof(state[socknum].recvpacket),0);
270 msectotimeval(lag,(currenttime-sendquerytime[socknum]) and tsmask);
271
272 reportlag(id,(lag.tv_sec*1000000)+lag.tv_usec);
273
274 SrcLen := SizeOf(Src);
275 state[socknum].recvpacketlen := recvfrom(fd[socknum],state[socknum].recvpacket, SizeOf(state[socknum].recvpacket),0,Srcx,SrcLen);
276
277 if (state[socknum].recvpacketlen > 0) then begin
278 fromip := inaddrvtobinip(Src);
279 fromport := inttostr(htons(src.InAddr.port));
280 if ((not comparebinip(toaddr[socknum],fromip)) or (fromport <> toport)) then begin
281 // writeln('dnssync received from wrong IP:port ',ipbintostr(fromip),'#',fromport);
282 state[socknum].recvpacketlen := 0;
283 end else begin
284 state[socknum].parsepacket := true;
285 needprocessing[socknum] := true;
286 end;
287 end;
288 end;
289 end;
290 if selectresult < 0 then exit;
291 if selectresult = 0 then begin
292
293 currenttime := getts;
294
295 reportlag(id,-1);
296 if (currenttime >= endtime) and ((not wrapmode) or (currenttime < starttime)) then begin
297 cleanupsockets;
298 exit;
299 end else begin
300 //resend
301 for socknum := numsockused-1 downto 0 do begin
302 sendquery(socknum,state[socknum].sendpacket,state[socknum].sendpacketlen);
303 end;
304 end;
305 end;
306 until false;
307 end;
308 {$endif}
309
310
311
312 function forwardlookuplist(name:ansistring;timeout:integer):tbiniplist;
313 var
314 dummy : integer;
315 a:integer;
316 biniptemp:tbinip;
317 l:tbiniplist;
318
319 numsockused:integer;
320 state:tdnsstatearr;
321
322 begin
323 ipstrtobin(name,biniptemp);
324 if biniptemp.family <> 0 then begin
325 result := biniplist_new;
326 biniplist_add(result,biniptemp);
327 exit; //it was an IP address, no need for dns
328 end;
329
330 {$ifdef mswindows}
331 if usewindns then begin
332 if (useaf = useaf_v4) then a := af_inet else if (useaf = useaf_v6) then a := af_inet6 else a := 0;
333 result := winforwardlookuplist(name,a,dummy);
334 {$ifdef ipv6}
335 if (useaf = useaf_preferv4) then begin
336 {prefer mode: sort the IP's}
337 l := biniplist_new;
338 addipsoffamily(l,result,af_inet);
339 addipsoffamily(l,result,af_inet6);
340 result := l;
341 end;
342 if (useaf = useaf_preferv6) then begin
343 {prefer mode: sort the IP's}
344 l := biniplist_new;
345 addipsoffamily(l,result,af_inet6);
346 addipsoffamily(l,result,af_inet);
347 result := l;
348 end;
349 {$endif}
350 end else
351 {$endif}
352 begin
353 {$ifdef syncdnscore}
354 {$ifdef ipv6}initpreferredmode;{$endif}
355
356 numsockused := 0;
357
358 result := biniplist_new;
359 if (useaf <> useaf_v6) then begin
360 setstate_forward(name,state[numsockused],af_inet);
361 inc(numsockused);
362 end;
363 {$ifdef ipv6}
364 if (useaf <> useaf_v4) then begin
365 setstate_forward(name,state[numsockused],af_inet6);
366 inc(numsockused);
367 end;
368 {$endif}
369
370 resolveloop(timeout,state,numsockused);
371
372 if (numsockused = 1) then begin
373 biniplist_addlist(result,state[0].resultlist);
374 {$ifdef ipv6}
375 end else if (useaf = useaf_preferv6) then begin
376 biniplist_addlist(result,state[1].resultlist);
377 biniplist_addlist(result,state[0].resultlist);
378 end else begin
379 biniplist_addlist(result,state[0].resultlist);
380 biniplist_addlist(result,state[1].resultlist);
381 {$endif}
382 end;
383 {$endif}
384 end;
385 end;
386
387 function forwardlookup(name:ansistring;timeout:integer):tbinip;
388 var
389 listtemp:tbiniplist;
390 begin
391 listtemp := forwardlookuplist(name,timeout);
392 result := biniplist_get(listtemp,0);
393 end;
394
395 function reverselookup(ip:tbinip;timeout:integer):ansistring;
396 var
397 dummy : integer;
398 numsockused:integer;
399 state:tdnsstatearr;
400 begin
401 {$ifdef mswindows}
402 if usewindns then begin
403 result := winreverselookup(ip,dummy);
404 exit;
405 end;
406 {$endif}
407 {$ifdef syncdnscore}
408 setstate_reverse(ip,state[0]);
409 numsockused := 1;
410 resolveloop(timeout,state,numsockused);
411 result := state[0].resultstr;
412 {$endif}
413 end;
414
415 {$ifdef mswindows}
416 var
417 wsadata : twsadata;
418
419 initialization
420 WSAStartUp($2,wsadata);
421 finalization
422 WSACleanUp;
423 {$endif}
424 end.
425
426

Properties

Name Value
svn:eol-style CRLF

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