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

Contents of /trunk/dnsasync.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 59 - (show annotations)
Sun Nov 1 04:42:43 2009 UTC (10 years, 4 months ago) by plugwash
File size: 11802 byte(s)
fix line endings

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
6 //FIXME: this code only ever seems to use one dns server for a request and does
7 //not seem to have any form of retry code.
8
9 unit dnsasync;
10
11 interface
12
13 uses
14 {$ifdef win32}
15 dnswin,
16 {$endif}
17 lsocket,lcore,
18 classes,binipstuff,dnscore,btime,lcorernd;
19
20 {$include lcoreconfig.inc}
21
22 const
23 numsock=1{$ifdef ipv6}+1{$endif};
24
25 type
26
27 //after completion or cancelation a dnswinasync may be reused
28 tdnsasync=class(tcomponent)
29
30 private
31 //made a load of stuff private that does not appear to be part of the main
32 //public interface. If you make any of it public again please consider the
33 //consequences when using windows dns. --plugwash.
34 sockets: array[0..numsock-1] of tlsocket;
35
36 states: array[0..numsock-1] of tdnsstate;
37
38 destinations: array[0..numsock-1] of tbinip;
39
40 dnsserverids : array[0..numsock-1] of integer;
41 startts:double;
42 {$ifdef win32}
43 dwas : tdnswinasync;
44 {$endif}
45
46 numsockused : integer;
47 fresultlist : tbiniplist;
48 requestaf : integer;
49 procedure asyncprocess(socketno:integer);
50 procedure receivehandler(sender:tobject;error:word);
51 function sendquery(socketno:integer;const packet:tdnspacket;len:integer):boolean;
52 {$ifdef win32}
53 procedure winrequestdone(sender:tobject;error:word);
54 {$endif}
55
56 public
57 onrequestdone:tsocketevent;
58
59 //addr and port allow the application to specify a dns server specifically
60 //for this dnsasync object. This is not a reccomended mode of operation
61 //because it limits the app to one dns server but is kept for compatibility
62 //and special uses.
63 addr,port:string;
64
65 overrideaf : integer;
66
67 procedure cancel;//cancel an outstanding dns request
68 function dnsresult:string; //get result of dnslookup as a string
69 procedure dnsresultbin(var binip:tbinip); //get result of dnslookup as a tbinip
70 property dnsresultlist : tbiniplist read fresultlist;
71 procedure forwardlookup(const name:string); //start forward lookup,
72 //preffering ipv4
73 procedure reverselookup(const binip:tbinip); //start reverse lookup
74 procedure customlookup(const name:string;querytype:integer); //start custom type lookup
75
76 constructor create(aowner:tcomponent); override;
77 destructor destroy; override;
78
79 end;
80
81 implementation
82
83 uses sysutils;
84
85 constructor tdnsasync.create;
86 begin
87 inherited create(aowner);
88 dnsserverids[0] := -1;
89 sockets[0] := twsocket.create(self);
90 sockets[0].tag := 0;
91 {$ifdef ipv6}
92 dnsserverids[1] := -1;
93 sockets[1] := twsocket.Create(self);
94 sockets[1].tag := 1;
95 {$endif}
96 end;
97
98 destructor tdnsasync.destroy;
99 var
100 socketno : integer;
101 begin
102 for socketno := 0 to numsock -1 do begin
103 if assigned(sockets[socketno]) then begin
104 if dnsserverids[socketno] >= 0 then begin
105 reportlag(dnsserverids[socketno],-1);
106 dnsserverids[socketno] := -1;
107 end;
108 sockets[socketno].release;
109 setstate_request_init('',states[socketno]);
110 end;
111 end;
112 inherited destroy;
113 end;
114
115 procedure tdnsasync.receivehandler(sender:tobject;error:word);
116 var
117 socketno : integer;
118 Src : TInetSockAddrV;
119 SrcLen : Integer;
120 fromip:tbinip;
121 fromport:string;
122 begin
123 socketno := tlsocket(sender).tag;
124 //writeln('got a reply on socket number ',socketno);
125 fillchar(states[socketno].recvpacket,sizeof(states[socketno].recvpacket),0);
126
127 SrcLen := SizeOf(Src);
128 states[socketno].recvpacketlen := twsocket(sender).ReceiveFrom(@(states[socketno].recvpacket), SizeOf(states[socketno].recvpacket), Src, SrcLen);
129
130 fromip := inaddrvtobinip(Src);
131 fromport := inttostr(htons(src.InAddr.port));
132
133 if ((not comparebinip(fromip,destinations[socketno])) or (fromport <> port)) then begin
134 // writeln('dnsasync received from wrong IP:port ',ipbintostr(fromip),'#',fromport,', expected ',ipbintostr(destinations[socketno]),'#',port);
135 exit;
136 end;
137
138 states[socketno].parsepacket := true;
139 if states[socketno].resultaction <> action_done then begin
140 //we ignore packets that come after we are done
141 if dnsserverids[socketno] >= 0 then begin
142 reportlag(dnsserverids[socketno],trunc((unixtimefloat-startts)*1000000));
143 dnsserverids[socketno] := -1;
144 end;
145 { writeln('received reply');}
146
147 asyncprocess(socketno);
148 //writeln('processed it');
149 end else begin
150 //writeln('ignored it because request is done');
151 end;
152 end;
153
154 function tdnsasync.sendquery(socketno:integer;const packet:tdnspacket;len:integer):boolean;
155 var
156 destination : string;
157 inaddr : tinetsockaddrv;
158 trytolisten:integer;
159 begin
160 { writeln('sendquery ',decodename(state.packet,state.packetlen,12,0,a),' ',state.requesttype);}
161 //writeln('trying to send query on socket number ',socketno);
162 result := false;
163 if len = 0 then exit; {no packet}
164 if sockets[socketno].state <> wsconnected then begin
165 startts := unixtimefloat;
166 if port = '' then port := '53';
167 sockets[socketno].Proto := 'udp';
168 sockets[socketno].ondataavailable := receivehandler;
169
170 {we are going to bind on a random local port for the DNS request, against the kaminsky attack
171 there is a small chance that we're trying to bind on an already used port, so retry a few times}
172 for trytolisten := 3 downto 0 do begin
173 try
174 sockets[socketno].port := inttostr(1024 + randominteger(65536 - 1024));
175 sockets[socketno].listen;
176 except
177 {writeln('failed to listen ',sockets[socketno].localport,' ',trytolisten);}
178 if (trytolisten = 0) then begin
179 result := false;
180 exit;
181 end;
182 end;
183 end;
184
185 end;
186 if addr <> '' then begin
187 dnsserverids[socketno] := -1;
188 destination := addr
189 end else begin
190 destination := getcurrentsystemnameserver(dnsserverids[socketno]);
191 end;
192 destinations[socketno] := ipstrtobinf(destination);
193
194 {$ifdef ipv6}{$ifdef win32}
195 if destinations[socketno].family = AF_INET6 then if (requestaf = useaf_default) then requestaf := useaf_preferv6;
196 {$endif}{$endif}
197
198 makeinaddrv(destinations[socketno],port,inaddr);
199 sockets[socketno].sendto(inaddr,sizeof(inaddr), @packet,len);
200 result := true;
201
202
203 end;
204
205 procedure tdnsasync.asyncprocess(socketno:integer);
206 begin
207 state_process(states[socketno]);
208 case states[socketno].resultaction of
209 action_ignore: begin {do nothing} end;
210 action_done: begin
211 {$ifdef ipv6}
212 if (numsockused = 1) or (states[socketno xor 1].resultaction=action_done) then
213 //if using two sockets we need to wait until both sockets are in the done
214 //state before firing the event
215 {$endif}
216 begin
217 fresultlist := biniplist_new;
218 if (numsockused = 1) then begin
219 //writeln('processing for one state');
220 biniplist_addlist(fresultlist,states[0].resultlist);
221 {$ifdef ipv6}
222 end else if (requestaf = useaf_preferv6) then begin
223 //writeln('processing for two states, ipv6 preference');
224 //writeln('merging lists '+biniplist_tostr(states[1].resultlist)+' and '+biniplist_tostr(states[0].resultlist));
225 biniplist_addlist(fresultlist,states[1].resultlist);
226 biniplist_addlist(fresultlist,states[0].resultlist);
227 end else begin
228 //writeln('processing for two states, ipv4 preference');
229 biniplist_addlist(fresultlist,states[0].resultlist);
230 biniplist_addlist(fresultlist,states[1].resultlist);
231 {$endif}
232 end;
233 //writeln(biniplist_tostr(fresultlist));
234 onrequestdone(self,0);
235 end;
236 end;
237 action_sendquery:begin
238 sendquery(socketno,states[socketno].sendpacket,states[socketno].sendpacketlen);
239 end;
240 end;
241 end;
242
243 procedure tdnsasync.forwardlookup;
244 var
245 bip : tbinip;
246 i : integer;
247 begin
248 ipstrtobin(name,bip);
249
250 if bip.family <> 0 then begin
251 // it was an IP address
252 fresultlist := biniplist_new;
253 biniplist_add(fresultlist,bip);
254 onrequestdone(self,0);
255 exit;
256 end;
257
258 if (overridednsserver <> '') and (addr = '') then addr := overridednsserver;
259
260 if overrideaf = useaf_default then begin
261 {$ifdef ipv6}
262 {$ifdef win32}if not (usewindns and (addr = '')) then{$endif}
263 initpreferredmode;
264 {$endif}
265 requestaf := useaf;
266 end else begin
267 requestaf := overrideaf;
268 end;
269
270 {$ifdef win32}
271 if usewindns and (addr = '') then begin
272 dwas := tdnswinasync.create;
273 dwas.onrequestdone := winrequestdone;
274
275 dwas.forwardlookup(name);
276
277 exit;
278 end;
279 {$endif}
280
281 numsockused := 0;
282 fresultlist := biniplist_new;
283 if (requestaf <> useaf_v6) then begin
284 setstate_forward(name,states[numsockused],af_inet);
285 inc(numsockused);
286 end;
287
288 {$ifdef ipv6}
289 if (requestaf <> useaf_v4) then begin
290 setstate_forward(name,states[numsockused],af_inet6);
291 inc(numsockused);
292 end;
293 {$endif}
294 for i := 0 to numsockused-1 do begin
295 asyncprocess(i);
296 end;
297
298 end;
299
300 procedure tdnsasync.reverselookup;
301 begin
302 if (overridednsserver <> '') and (addr = '') then addr := overridednsserver;
303 {$ifdef win32}
304 if usewindns and (addr = '') then begin
305 dwas := tdnswinasync.create;
306 dwas.onrequestdone := winrequestdone;
307 dwas.reverselookup(binip);
308 exit;
309 end;
310 {$endif}
311
312 setstate_reverse(binip,states[0]);
313 numsockused := 1;
314 asyncprocess(0);
315 end;
316
317 procedure tdnsasync.customlookup;
318 begin
319 if (overridednsserver <> '') and (addr = '') then addr := overridednsserver;
320 setstate_custom(name,querytype,states[0]);
321 numsockused := 1;
322 asyncprocess(0);
323 end;
324
325 function tdnsasync.dnsresult;
326 begin
327 if states[0].resultstr <> '' then result := states[0].resultstr else begin
328 result := ipbintostr(biniplist_get(fresultlist,0));
329 end;
330 end;
331
332 procedure tdnsasync.dnsresultbin(var binip:tbinip);
333 begin
334 binip := biniplist_get(fresultlist,0);
335 end;
336
337 procedure tdnsasync.cancel;
338 var
339 socketno : integer;
340 begin
341 {$ifdef win32}
342 if assigned(dwas) then begin
343 dwas.release;
344 dwas := nil;
345 end else
346 {$endif}
347 begin
348 for socketno := 0 to numsock-1 do begin
349 reportlag(dnsserverids[socketno],-1);
350 dnsserverids[socketno] := -1;
351
352 sockets[socketno].close;
353 end;
354
355 end;
356 for socketno := 0 to numsock-1 do begin
357 setstate_failure(states[socketno]);
358
359 end;
360 fresultlist := biniplist_new;
361 onrequestdone(self,0);
362 end;
363
364 {$ifdef win32}
365 procedure tdnsasync.winrequestdone(sender:tobject;error:word);
366
367 begin
368 if dwas.reverse then begin
369 states[0].resultstr := dwas.name;
370 end else begin
371
372 {$ifdef ipv6}
373 if (requestaf = useaf_preferv4) then begin
374 {prefer mode: sort the IP's}
375 fresultlist := biniplist_new;
376 addipsoffamily(fresultlist,dwas.iplist,af_inet);
377 addipsoffamily(fresultlist,dwas.iplist,af_inet6);
378
379 end else if (requestaf = useaf_preferv6) then begin
380 {prefer mode: sort the IP's}
381 fresultlist := biniplist_new;
382 addipsoffamily(fresultlist,dwas.iplist,af_inet6);
383 addipsoffamily(fresultlist,dwas.iplist,af_inet);
384
385 end else
386 {$endif}
387 begin
388 fresultlist := dwas.iplist;
389 end;
390
391 end;
392 dwas.release;
393 onrequestdone(self,error);
394 end;
395 {$endif}
396 end.

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