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

Contents of /trunk/dnsasync.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1 - (show annotations)
Fri Mar 28 02:26:58 2008 UTC (13 years, 4 months ago) by plugwash
File size: 6315 byte(s)
initial import

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;
19
20
21 type
22 //after completion or cancelation a dnswinasync may be reused
23 tdnsasync=class(tcomponent)
24
25 private
26 //made a load of stuff private that does not appear to be part of the main
27 //public interface. If you make any of it public again please consider the
28 //consequences when using windows dns. --plugwash.
29 sock:twsocket;
30
31 sockopen:boolean;
32
33
34 state:tdnsstate;
35
36 dnsserverid:integer;
37 startts:double;
38 {$ifdef win32}
39 dwas : tdnswinasync;
40 {$endif}
41
42
43 procedure asyncprocess;
44 procedure receivehandler(sender:tobject;error:word);
45 function sendquery(const packet:tdnspacket;len:integer):boolean;
46 {$ifdef win32}
47 procedure winrequestdone(sender:tobject;error:word);
48 {$endif}
49 public
50 onrequestdone:tsocketevent;
51
52 //addr and port allow the application to specify a dns server specifically
53 //for this dnsasync object. This is not a reccomended mode of operation
54 //because it limits the app to one dns server but is kept for compatibility
55 //and special uses.
56 addr,port:string;
57
58 //A family value of AF_INET6 will give only
59 //ipv6 results. Any other value will give ipv4 results in preference and ipv6
60 //results if ipv4 results are not available;
61 forwardfamily:integer;
62
63 procedure cancel;//cancel an outstanding dns request
64 function dnsresult:string; //get result of dnslookup as a string
65 procedure dnsresultbin(var binip:tbinip); //get result of dnslookup as a tbinip
66 procedure forwardlookup(const name:string); //start forward lookup,
67 //preffering ipv4
68 procedure reverselookup(const binip:tbinip); //start reverse lookup
69
70 constructor create(aowner:tcomponent); override;
71 destructor destroy; override;
72
73 end;
74
75 implementation
76
77 uses sysutils;
78
79 constructor tdnsasync.create;
80 begin
81 inherited create(aowner);
82 dnsserverid := -1;
83 sock := twsocket.create(self);
84 end;
85
86 destructor tdnsasync.destroy;
87 begin
88 if dnsserverid >= 0 then begin
89 reportlag(dnsserverid,-1);
90 dnsserverid := -1;
91 end;
92 sock.release;
93 setstate_request_init('',state);
94 inherited destroy;
95 end;
96
97 procedure tdnsasync.receivehandler;
98 begin
99 if dnsserverid >= 0 then begin
100 reportlag(dnsserverid,trunc((unixtimefloat-startts)*1000));
101 dnsserverid := -1;
102 end;
103 { writeln('received reply');}
104 fillchar(state.recvpacket,sizeof(state.recvpacket),0);
105 state.recvpacketlen := twsocket(sender).Receive(@state.recvpacket, SizeOf(state.recvpacket));
106 state.parsepacket := true;
107 asyncprocess;
108 end;
109
110 function tdnsasync.sendquery;
111 begin
112 { writeln('sendquery ',decodename(state.packet,state.packetlen,12,0,a),' ',state.requesttype);}
113 result := false;
114 if len = 0 then exit; {no packet}
115 if not sockopen then begin
116 if addr <> '' then sock.addr := addr else sock.addr := getcurrentsystemnameserver(dnsserverid);//getunixnameservercached;
117 startts := unixtimefloat;
118 if port = '' then port := '53';
119 sock.port := port;
120 sock.Proto := 'udp';
121 sock.ondataavailable := receivehandler;
122 try
123 sock.connect;
124 except
125 on e:exception do begin
126 //writeln('exception '+e.message);
127 exit;
128 end;
129 end;
130 sockopen := true;
131 end;
132 sock.send(@packet,len);
133 result := true;
134 end;
135
136 procedure tdnsasync.asyncprocess;
137 begin
138 state_process(state);
139 case state.resultaction of
140 action_ignore: begin {do nothing} end;
141 action_done: begin
142 onrequestdone(self,0);
143 end;
144 action_sendquery:begin
145 sendquery(state.sendpacket,state.sendpacketlen);
146 end;
147 end;
148 end;
149
150 procedure tdnsasync.forwardlookup;
151 begin
152
153 ipstrtobin(name,state.resultbin);
154
155 {$ifdef win32}
156 if usewindns or (addr = '') then begin
157 dwas := tdnswinasync.create;
158 dwas.onrequestdone := winrequestdone;
159 if forwardfamily = AF_INET6 then begin
160 dwas.forwardlookup(name,true);
161 end else begin
162 dwas.forwardlookup(name,false);
163 end;
164 exit;
165 end;
166 {$endif}
167
168
169 if state.resultbin.family <> 0 then begin
170 onrequestdone(self,0);
171 exit;
172 end;
173
174
175 setstate_forward(name,state,forwardfamily);
176 asyncprocess;
177
178 end;
179
180 procedure tdnsasync.reverselookup;
181
182 begin
183 {$ifdef win32}
184 if usewindns or (addr = '') then begin
185 dwas := tdnswinasync.create;
186 dwas.onrequestdone := winrequestdone;
187 dwas.reverselookup(binip);
188 exit;
189 end;
190 {$endif}
191
192 setstate_reverse(binip,state);
193 asyncprocess;
194 end;
195
196 function tdnsasync.dnsresult;
197 begin
198 if state.resultstr <> '' then result := state.resultstr else begin
199 result := ipbintostr(state.resultbin);
200 end;
201 end;
202
203 procedure tdnsasync.dnsresultbin(var binip:tbinip);
204 begin
205 move(state.resultbin,binip,sizeof(binip));
206 end;
207
208 procedure tdnsasync.cancel;
209 begin
210 {$ifdef win32}
211 if assigned(dwas) then begin
212 dwas.release;
213 dwas := nil;
214 end else
215 {$endif}
216 begin
217
218 if dnsserverid >= 0 then begin
219 reportlag(dnsserverid,-1);
220 dnsserverid := -1;
221 end;
222 if sockopen then begin
223 sock.close;
224 sockopen := false;
225 end;
226 end;
227 setstate_failure(state);
228 onrequestdone(self,0);
229 end;
230
231 {$ifdef win32}
232 procedure tdnsasync.winrequestdone(sender:tobject;error:word);
233
234 begin
235 if dwas.reverse then begin
236 state.resultstr := dwas.name;
237 end else begin
238 state.resultbin := dwas.ip;
239 if (forwardfamily = AF_INET6) and (state.resultbin.family = AF_INET) then begin
240 fillchar(state.resultbin,sizeof(tbinip),0);
241 end;
242 end;
243 dwas.release;
244 onrequestdone(self,error);
245 end;
246 {$endif}
247 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.26