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 |
{
|
7 |
|
8 |
code wanting to use this dns system should act as follows (note: app
|
9 |
developers will probably want to use dnsasync or dnssync or write a similar
|
10 |
wrapper unit of their own).
|
11 |
|
12 |
for normal lookups call setstate_forward or setstate_reverse to set up the
|
13 |
state, for more obscure lookups use setstate_request_init and fill in other
|
14 |
relevant state manually.
|
15 |
|
16 |
call state_process which will do processing on the information in the state
|
17 |
and return an action
|
18 |
action_ignore means that dnscore wants the code that calls it to go
|
19 |
back to waiting for packets
|
20 |
action_sendpacket means that dnscore wants the code that calls it to send
|
21 |
the packet in sendpacket/sendpacketlen and then start (or go back to) listening
|
22 |
for
|
23 |
action_done means the request has completed (either succeeded or failed)
|
24 |
|
25 |
callers should resend the last packet they tried to send if they have not
|
26 |
been asked to send a new packet for more than some timeout value they choose.
|
27 |
|
28 |
when a packet is received the application should put the packet in
|
29 |
recvbuf/recvbuflen , set state.parsepacket and call state_process again
|
30 |
|
31 |
once the app gets action_done it can determine success or failure in the
|
32 |
following ways.
|
33 |
|
34 |
on failure state.resultstr will be an empty string and state.resultbin will
|
35 |
be zeroed out (easily detected by the fact that it will have a family of 0)
|
36 |
|
37 |
on success for a A or AAAA lookup state.resultstr will be an empty string
|
38 |
and state.resultbin will contain the result (note: AAAA lookups require IPv6
|
39 |
enabled).
|
40 |
|
41 |
if an A lookup fails and the code is built with IPv6 enabled then the code
|
42 |
will return any AAAA records with the same name. The reverse does not apply
|
43 |
so if an application prefers IPv6 but wants IPv4 results as well it must
|
44 |
check them separately.
|
45 |
|
46 |
on success for any other type of lookup state.resultstr will be an empty
|
47 |
|
48 |
note the state contains ansistrings, setstate_init with a null name parameter
|
49 |
can be used to clean these up if required.
|
50 |
|
51 |
callers may use setstate_failure to mark the state as failed themselves
|
52 |
before passing it on to other code, for example this may be done in the event
|
53 |
of a timeout.
|
54 |
}
|
55 |
unit dnscore;
|
56 |
|
57 |
{$ifdef fpc}{$mode delphi}{$endif}
|
58 |
|
59 |
{$include lcoreconfig.inc}
|
60 |
|
61 |
interface
|
62 |
|
63 |
uses binipstuff,classes,pgtypes,lcorernd;
|
64 |
|
65 |
var usewindns : boolean = {$ifdef mswindows}true{$else}false{$endif};
|
66 |
{hint to users of this unit that they should use windows dns instead.
|
67 |
May be disabled by applications if desired. (e.g. if setting a custom
|
68 |
dnsserverlist).
|
69 |
|
70 |
note: this unit will not be able to self populate it's dns server list on
|
71 |
older versions of windows.}
|
72 |
|
73 |
const
|
74 |
useaf_default=0;
|
75 |
useaf_preferv4=1;
|
76 |
useaf_preferv6=2;
|
77 |
useaf_v4=3;
|
78 |
useaf_v6=4;
|
79 |
{
|
80 |
hint to users of this unit to how to deal with connecting to hostnames regarding ipv4 or ipv6 usage
|
81 |
can be set by apps as desired
|
82 |
}
|
83 |
var useaf:integer = useaf_default;
|
84 |
|
85 |
{
|
86 |
(temporarily) use a different nameserver, regardless of the dnsserverlist
|
87 |
}
|
88 |
var overridednsserver:ansistring;
|
89 |
|
90 |
const
|
91 |
maxnamelength=127;
|
92 |
maxnamefieldlen=63;
|
93 |
//note: when using action_ignore the dnscore code *must* preserve the contents of state.sendpacket to allow for retries
|
94 |
//note: action_ignore must not be used in response to the original request but there is no valid reason for doing this anyway
|
95 |
action_ignore=0;
|
96 |
action_done=1;
|
97 |
action_sendquery=2;
|
98 |
querytype_a=1;
|
99 |
querytype_cname=5;
|
100 |
querytype_aaaa=28;
|
101 |
querytype_a6=38;
|
102 |
querytype_ptr=12;
|
103 |
querytype_ns=2;
|
104 |
querytype_soa=6;
|
105 |
querytype_mx=15;
|
106 |
querytype_txt=16;
|
107 |
querytype_spf=99;
|
108 |
maxrecursion=50;
|
109 |
maxrrofakind=32;
|
110 |
{the maximum number of RR of a kind of purely an extra sanity check and could be omitted.
|
111 |
before, i set it to 20, but valid replies can have more. dnscore only does udp requests,
|
112 |
and ordinary DNS, so up to 512 bytes. the maximum number of A records that fits seems to be 29}
|
113 |
|
114 |
retryafter=300000; //microseconds must be less than one second;
|
115 |
timeoutlag=1000000000; // penalty value to be treated as lag in the event of a timeout (microseconds)
|
116 |
type
|
117 |
dvar=array[0..0] of byte;
|
118 |
pdvar=^dvar;
|
119 |
tdnspacket=packed record
|
120 |
id:word;
|
121 |
flags:word;
|
122 |
rrcount:array[0..3] of word;
|
123 |
payload:array[0..511-12] of byte;
|
124 |
end;
|
125 |
|
126 |
|
127 |
|
128 |
tdnsstate=record
|
129 |
id:word;
|
130 |
recursioncount:integer;
|
131 |
queryname:ansistring;
|
132 |
requesttype:word;
|
133 |
parsepacket:boolean;
|
134 |
resultstr:ansistring;
|
135 |
resultbin:tbinip;
|
136 |
resultlist:tbiniplist;
|
137 |
resultaction:integer;
|
138 |
numrr1:array[0..3] of integer;
|
139 |
numrr2:integer;
|
140 |
rrdata:ansistring;
|
141 |
sendpacketlen:integer;
|
142 |
sendpacket:tdnspacket;
|
143 |
recvpacketlen:integer;
|
144 |
recvpacket:tdnspacket;
|
145 |
forwardfamily:integer;
|
146 |
end;
|
147 |
|
148 |
trr=packed record
|
149 |
requesttypehi:byte;
|
150 |
requesttype:byte;
|
151 |
clas:word;
|
152 |
ttl:integer;
|
153 |
datalen:word;
|
154 |
data:array[0..511] of byte;
|
155 |
end;
|
156 |
|
157 |
trrpointer=packed record
|
158 |
p:pointer;
|
159 |
ofs:integer;
|
160 |
len:integer;
|
161 |
namelen:integer;
|
162 |
end;
|
163 |
|
164 |
//commenting out functions from interface that do not have documented semantics
|
165 |
//and probably should not be called from outside this unit, reenable them
|
166 |
//if you must but please document them at the same time --plugwash
|
167 |
|
168 |
//function buildrequest(const name:string;var packet:tdnspacket;requesttype:word):integer;
|
169 |
|
170 |
//returns the DNS name used to reverse look up an IP, such as 4.3.2.1.in-addr.arpa for 1.2.3.4
|
171 |
function makereversename(const binip:tbinip):ansistring;
|
172 |
|
173 |
procedure setstate_request_init(const name:ansistring;var state:tdnsstate);
|
174 |
|
175 |
//set up state for a forward lookup. A family value of AF_INET6 will give only
|
176 |
//ipv6 results. Any other value will give only ipv4 results
|
177 |
procedure setstate_forward(const name:ansistring;var state:tdnsstate;family:integer);
|
178 |
|
179 |
procedure setstate_reverse(const binip:tbinip;var state:tdnsstate);
|
180 |
procedure setstate_failure(var state:tdnsstate);
|
181 |
//procedure setstate_return(const rrp:trrpointer;len:integer;var state:tdnsstate);
|
182 |
|
183 |
//for custom raw lookups such as TXT, as desired by the user
|
184 |
procedure setstate_custom(const name:ansistring; requesttype:integer; var state:tdnsstate);
|
185 |
|
186 |
procedure state_process(var state:tdnsstate);
|
187 |
|
188 |
//function decodename(const packet:tdnspacket;len,start,recursion:integer;var numread:integer):string;
|
189 |
|
190 |
procedure populatednsserverlist;
|
191 |
procedure cleardnsservercache;
|
192 |
|
193 |
var
|
194 |
dnsserverlist : tbiniplist;
|
195 |
dnsserverlag:tlist;
|
196 |
// currentdnsserverno : integer;
|
197 |
|
198 |
|
199 |
//getcurrentsystemnameserver returns the nameserver the app should use and sets
|
200 |
//id to the id of that nameserver. id should later be used to report how laggy
|
201 |
//the servers response was and if it was timed out.
|
202 |
function getcurrentsystemnameserver(var id:integer) :ansistring;
|
203 |
function getcurrentsystemnameserverbin(var id:integer) :tbinip;
|
204 |
procedure reportlag(id:integer;lag:integer); //lag should be in microseconds and should be -1 to report a timeout
|
205 |
|
206 |
//var
|
207 |
// unixnameservercache:string;
|
208 |
{ $endif}
|
209 |
|
210 |
|
211 |
{$ifdef ipv6}
|
212 |
procedure initpreferredmode;
|
213 |
|
214 |
var
|
215 |
preferredmodeinited:boolean;
|
216 |
|
217 |
{$endif}
|
218 |
|
219 |
var
|
220 |
failurereason:ansistring;
|
221 |
|
222 |
function getquerytype(s:ansistring):integer;
|
223 |
|
224 |
implementation
|
225 |
|
226 |
uses
|
227 |
lcorelocalips,
|
228 |
sysutils;
|
229 |
|
230 |
|
231 |
|
232 |
function getquerytype(s:ansistring):integer;
|
233 |
begin
|
234 |
s := uppercase(s);
|
235 |
result := 0;
|
236 |
if (s = 'A') then result := querytype_a else
|
237 |
if (s = 'CNAME') then result := querytype_cname else
|
238 |
if (s = 'AAAA') then result := querytype_aaaa else
|
239 |
if (s = 'PTR') then result := querytype_ptr else
|
240 |
if (s = 'NS') then result := querytype_ns else
|
241 |
if (s = 'MX') then result := querytype_mx else
|
242 |
if (s = 'A6') then result := querytype_a6 else
|
243 |
if (s = 'TXT') then result := querytype_txt else
|
244 |
if (s = 'SOA') then result := querytype_soa else
|
245 |
if (s = 'SPF') then result := querytype_spf;
|
246 |
end;
|
247 |
|
248 |
function buildrequest(const name:ansistring;var packet:tdnspacket;requesttype:word):integer;
|
249 |
var
|
250 |
a,b:integer;
|
251 |
s:ansistring;
|
252 |
arr:array[0..sizeof(packet)-1] of byte absolute packet;
|
253 |
begin
|
254 |
{ writeln('buildrequest: name: ',name);}
|
255 |
result := 0;
|
256 |
fillchar(packet,sizeof(packet),0);
|
257 |
packet.id := randominteger($10000);
|
258 |
|
259 |
packet.flags := htons($0100);
|
260 |
packet.rrcount[0] := htons($0001);
|
261 |
|
262 |
|
263 |
s := copy(name,1,maxnamelength);
|
264 |
if s = '' then exit;
|
265 |
if s[length(s)] <> '.' then s := s + '.';
|
266 |
b := 0;
|
267 |
{encode name}
|
268 |
if (s = '.') then begin
|
269 |
packet.payload[0] := 0;
|
270 |
result := 12+5;
|
271 |
end else begin
|
272 |
for a := 1 to length(s) do begin
|
273 |
if s[a] = '.' then begin
|
274 |
if b > maxnamefieldlen then exit;
|
275 |
if (b = 0) then exit;
|
276 |
packet.payload[a-b-1] := b;
|
277 |
b := 0;
|
278 |
end else begin
|
279 |
packet.payload[a] := byte(s[a]);
|
280 |
inc(b);
|
281 |
end;
|
282 |
end;
|
283 |
if b > maxnamefieldlen then exit;
|
284 |
packet.payload[length(s)-b] := b;
|
285 |
result := length(s) + 12+5;
|
286 |
end;
|
287 |
|
288 |
arr[result-1] := 1;
|
289 |
arr[result-3] := requesttype and $ff;
|
290 |
arr[result-4] := requesttype shr 8;
|
291 |
end;
|
292 |
|
293 |
function makereversename(const binip:tbinip):ansistring;
|
294 |
var
|
295 |
name:ansistring;
|
296 |
a,b:integer;
|
297 |
begin
|
298 |
name := '';
|
299 |
if binip.family = AF_INET then begin
|
300 |
b := htonl(binip.ip);
|
301 |
for a := 0 to 3 do begin
|
302 |
name := name + inttostr(b shr (a shl 3) and $ff)+'.';
|
303 |
end;
|
304 |
name := name + 'in-addr.arpa';
|
305 |
end else
|
306 |
{$ifdef ipv6}
|
307 |
if binip.family = AF_INET6 then begin
|
308 |
for a := 15 downto 0 do begin
|
309 |
b := binip.ip6.u6_addr8[a];
|
310 |
name := name + hexchars[b and $f]+'.'+hexchars[b shr 4]+'.';
|
311 |
end;
|
312 |
name := name + 'ip6.arpa';
|
313 |
end else
|
314 |
{$endif}
|
315 |
begin
|
316 |
{empty name}
|
317 |
end;
|
318 |
result := name;
|
319 |
end;
|
320 |
|
321 |
{
|
322 |
decodes DNS format name to a string. does not includes the root dot.
|
323 |
doesnt read beyond len.
|
324 |
empty result + non null failurereason: failure
|
325 |
empty result + null failurereason: internal use
|
326 |
}
|
327 |
function decodename(const packet:tdnspacket;len,start,recursion:integer;var numread:integer):ansistring;
|
328 |
var
|
329 |
arr:array[0..sizeof(packet)-1] of byte absolute packet;
|
330 |
s:ansistring;
|
331 |
a,b:integer;
|
332 |
begin
|
333 |
numread := 0;
|
334 |
repeat
|
335 |
if (start+numread < 0) or (start+numread >= len) then begin
|
336 |
result := '';
|
337 |
failurereason := 'decoding name: got out of range1';
|
338 |
exit;
|
339 |
end;
|
340 |
b := arr[start+numread];
|
341 |
if b >= $c0 then begin
|
342 |
{recursive sub call}
|
343 |
if recursion > 10 then begin
|
344 |
result := '';
|
345 |
failurereason := 'decoding name: max recursion';
|
346 |
exit;
|
347 |
end;
|
348 |
if ((start+numread+1) >= len) then begin
|
349 |
result := '';
|
350 |
failurereason := 'decoding name: got out of range3';
|
351 |
exit;
|
352 |
end;
|
353 |
a := ((b shl 8) or arr[start+numread+1]) and $3fff;
|
354 |
s := decodename(packet,len,a,recursion+1,a);
|
355 |
if (s = '') and (failurereason <> '') then begin
|
356 |
result := '';
|
357 |
exit;
|
358 |
end;
|
359 |
if result <> '' then result := result + '.';
|
360 |
result := result + s;
|
361 |
inc(numread,2);
|
362 |
exit;
|
363 |
end else if b < 64 then begin
|
364 |
if (numread <> 0) and (b <> 0) then result := result + '.';
|
365 |
for a := start+numread+1 to start+numread+b do begin
|
366 |
if (a >= len) then begin
|
367 |
result := '';
|
368 |
failurereason := 'decoding name: got out of range2';
|
369 |
exit;
|
370 |
end;
|
371 |
result := result + ansichar(arr[a]);
|
372 |
end;
|
373 |
inc(numread,b+1);
|
374 |
|
375 |
if b = 0 then begin
|
376 |
if (result = '') and (recursion = 0) then result := '.';
|
377 |
exit; {reached end of name}
|
378 |
end;
|
379 |
end else begin
|
380 |
failurereason := 'decoding name: read invalid char';
|
381 |
result := '';
|
382 |
exit; {invalid}
|
383 |
end;
|
384 |
until false;
|
385 |
end;
|
386 |
|
387 |
{==============================================================================}
|
388 |
|
389 |
function getrawfromrr(const rrp:trrpointer;len:integer):ansistring;
|
390 |
begin
|
391 |
setlength(result,htons(trr(rrp.p^).datalen));
|
392 |
uniquestring(result);
|
393 |
move(trr(rrp.p^).data,result[1],length(result));
|
394 |
end;
|
395 |
|
396 |
|
397 |
function getipfromrr(const rrp:trrpointer;len:integer):tbinip;
|
398 |
begin
|
399 |
fillchar(result,sizeof(result),0);
|
400 |
case trr(rrp.p^).requesttype of
|
401 |
querytype_a: begin
|
402 |
if htons(trr(rrp.p^).datalen) <> 4 then exit;
|
403 |
move(trr(rrp.p^).data,result.ip,4);
|
404 |
result.family :=AF_INET;
|
405 |
end;
|
406 |
{$ifdef ipv6}
|
407 |
querytype_aaaa: begin
|
408 |
if htons(trr(rrp.p^).datalen) <> 16 then exit;
|
409 |
result.family := AF_INET6;
|
410 |
move(trr(rrp.p^).data,result.ip6,16);
|
411 |
end;
|
412 |
{$endif}
|
413 |
else
|
414 |
{}
|
415 |
end;
|
416 |
end;
|
417 |
|
418 |
procedure setstate_return(const rrp:trrpointer;len:integer;var state:tdnsstate);
|
419 |
var
|
420 |
a:integer;
|
421 |
begin
|
422 |
state.resultaction := action_done;
|
423 |
state.resultstr := '';
|
424 |
case trr(rrp.p^).requesttype of
|
425 |
querytype_a{$ifdef ipv6},querytype_aaaa{$endif}: begin
|
426 |
state.resultbin := getipfromrr(rrp,len);
|
427 |
end;
|
428 |
querytype_txt:begin
|
429 |
{TXT returns a raw string}
|
430 |
state.resultstr := copy(getrawfromrr(rrp,len),2,9999);
|
431 |
fillchar(state.resultbin,sizeof(state.resultbin),0);
|
432 |
end;
|
433 |
querytype_mx:begin
|
434 |
{MX is a name after a 16 bits word}
|
435 |
state.resultstr := decodename(state.recvpacket,state.recvpacketlen,taddrint(rrp.p)-taddrint(@state.recvpacket)+12,0,a);
|
436 |
fillchar(state.resultbin,sizeof(state.resultbin),0);
|
437 |
end;
|
438 |
else
|
439 |
{other reply types (PTR, MX) return a hostname}
|
440 |
state.resultstr := decodename(state.recvpacket,state.recvpacketlen,taddrint(rrp.p)-taddrint(@state.recvpacket)+10,0,a);
|
441 |
fillchar(state.resultbin,sizeof(state.resultbin),0);
|
442 |
end;
|
443 |
end;
|
444 |
|
445 |
procedure setstate_request_init(const name:ansistring;var state:tdnsstate);
|
446 |
begin
|
447 |
{destroy things properly}
|
448 |
state.resultstr := '';
|
449 |
state.queryname := '';
|
450 |
state.rrdata := '';
|
451 |
fillchar(state,sizeof(state),0);
|
452 |
state.queryname := name;
|
453 |
state.parsepacket := false;
|
454 |
end;
|
455 |
|
456 |
procedure setstate_forward(const name:ansistring;var state:tdnsstate;family:integer);
|
457 |
begin
|
458 |
setstate_request_init(name,state);
|
459 |
state.forwardfamily := family;
|
460 |
{$ifdef ipv6}
|
461 |
if family = AF_INET6 then state.requesttype := querytype_aaaa else
|
462 |
{$endif}
|
463 |
state.requesttype := querytype_a;
|
464 |
end;
|
465 |
|
466 |
procedure setstate_reverse(const binip:tbinip;var state:tdnsstate);
|
467 |
begin
|
468 |
setstate_request_init(makereversename(binip),state);
|
469 |
state.requesttype := querytype_ptr;
|
470 |
end;
|
471 |
|
472 |
procedure setstate_custom(const name:ansistring; requesttype:integer; var state:tdnsstate);
|
473 |
begin
|
474 |
setstate_request_init(name,state);
|
475 |
state.requesttype := requesttype;
|
476 |
end;
|
477 |
|
478 |
|
479 |
procedure setstate_failure(var state:tdnsstate);
|
480 |
begin
|
481 |
state.resultstr := '';
|
482 |
fillchar(state.resultbin,sizeof(state.resultbin),0);
|
483 |
state.resultaction := action_done;
|
484 |
end;
|
485 |
|
486 |
procedure state_process(var state:tdnsstate);
|
487 |
label recursed;
|
488 |
label failure;
|
489 |
var
|
490 |
a,b,ofs:integer;
|
491 |
rrtemp:^trr;
|
492 |
rrptemp:^trrpointer;
|
493 |
begin
|
494 |
if state.parsepacket then begin
|
495 |
if state.recvpacketlen < 12 then begin
|
496 |
failurereason := 'Undersized packet';
|
497 |
state.resultaction := action_ignore;
|
498 |
exit;
|
499 |
end;
|
500 |
if state.id <> state.recvpacket.id then begin
|
501 |
failurereason := 'ID mismatch';
|
502 |
state.resultaction := action_ignore;
|
503 |
exit;
|
504 |
end;
|
505 |
state.numrr2 := 0;
|
506 |
for a := 0 to 3 do begin
|
507 |
state.numrr1[a] := htons(state.recvpacket.rrcount[a]);
|
508 |
if state.numrr1[a] > maxrrofakind then begin
|
509 |
failurereason := 'exceeded maximum RR of a kind';
|
510 |
goto failure;
|
511 |
end;
|
512 |
inc(state.numrr2,state.numrr1[a]);
|
513 |
end;
|
514 |
|
515 |
setlength(state.rrdata,state.numrr2*sizeof(trrpointer));
|
516 |
|
517 |
{- put all replies into a list}
|
518 |
|
519 |
ofs := 12;
|
520 |
{get all queries}
|
521 |
for a := 0 to state.numrr1[0]-1 do begin
|
522 |
if (ofs < 12) or (ofs > state.recvpacketlen-4) then goto failure;
|
523 |
rrptemp := @state.rrdata[1+a*sizeof(trrpointer)];
|
524 |
rrptemp.p := @state.recvpacket.payload[ofs-12];
|
525 |
rrptemp.ofs := ofs;
|
526 |
decodename(state.recvpacket,state.recvpacketlen,ofs,0,b);
|
527 |
rrptemp.len := b + 4;
|
528 |
inc(ofs,rrptemp.len);
|
529 |
end;
|
530 |
|
531 |
for a := state.numrr1[0] to state.numrr2-1 do begin
|
532 |
if (ofs < 12) or (ofs > state.recvpacketlen-12) then goto failure;
|
533 |
rrptemp := @state.rrdata[1+a*sizeof(trrpointer)];
|
534 |
if decodename(state.recvpacket,state.recvpacketlen,ofs,0,b) = '' then goto failure;
|
535 |
rrtemp := @state.recvpacket.payload[ofs-12+b]; {rrtemp points to values and result, after initial name}
|
536 |
rrptemp.p := rrtemp;
|
537 |
rrptemp.ofs := ofs; {ofs is start of RR before initial name from start of packet}
|
538 |
rrptemp.namelen := b;
|
539 |
b := htons(rrtemp.datalen);
|
540 |
rrptemp.len := b + 10 + rrptemp.namelen;
|
541 |
inc(ofs,rrptemp.len);
|
542 |
end;
|
543 |
if (ofs <> state.recvpacketlen) then begin
|
544 |
failurereason := 'ofs <> state.packetlen';
|
545 |
goto failure;
|
546 |
end;
|
547 |
|
548 |
{if we requested A or AAAA build a list of all replies}
|
549 |
if (state.requesttype = querytype_a) or (state.requesttype = querytype_aaaa) then begin
|
550 |
state.resultlist := biniplist_new;
|
551 |
for a := state.numrr1[0] to (state.numrr1[0]+state.numrr1[1]-1) do begin
|
552 |
rrptemp := @state.rrdata[1+a*sizeof(trrpointer)];
|
553 |
rrtemp := rrptemp.p;
|
554 |
b := rrptemp.len;
|
555 |
if rrtemp.requesttype = state.requesttype then begin
|
556 |
biniplist_add(state.resultlist,getipfromrr(rrptemp^,b));
|
557 |
end;
|
558 |
end;
|
559 |
end;
|
560 |
|
561 |
{- check for items of the requested type in answer section, if so return success first}
|
562 |
for a := state.numrr1[0] to (state.numrr1[0]+state.numrr1[1]-1) do begin
|
563 |
rrptemp := @state.rrdata[1+a*sizeof(trrpointer)];
|
564 |
rrtemp := rrptemp.p;
|
565 |
b := rrptemp.len;
|
566 |
if rrtemp.requesttype = state.requesttype then begin
|
567 |
setstate_return(rrptemp^,b,state);
|
568 |
exit;
|
569 |
end;
|
570 |
end;
|
571 |
|
572 |
{if no items of correct type found, follow first cname in answer section}
|
573 |
for a := state.numrr1[0] to (state.numrr1[0]+state.numrr1[1]-1) do begin
|
574 |
rrptemp := @state.rrdata[1+a*sizeof(trrpointer)];
|
575 |
rrtemp := rrptemp.p;
|
576 |
b := rrptemp.len;
|
577 |
if rrtemp.requesttype = querytype_cname then begin
|
578 |
state.queryname := decodename(state.recvpacket,state.recvpacketlen,rrptemp.ofs+12,0,b);
|
579 |
goto recursed;
|
580 |
end;
|
581 |
end;
|
582 |
|
583 |
{no cnames found, no items of correct type found}
|
584 |
if state.forwardfamily <> 0 then goto failure;
|
585 |
|
586 |
goto failure;
|
587 |
recursed:
|
588 |
{here it needs recursed lookup}
|
589 |
{if needing to follow a cname, change state to do so}
|
590 |
inc(state.recursioncount);
|
591 |
if state.recursioncount > maxrecursion then goto failure;
|
592 |
end;
|
593 |
|
594 |
{here, a name needs to be resolved}
|
595 |
if state.queryname = '' then begin
|
596 |
failurereason := 'empty query name';
|
597 |
goto failure;
|
598 |
end;
|
599 |
|
600 |
{do /etc/hosts lookup here}
|
601 |
state.sendpacketlen := buildrequest(state.queryname,state.sendpacket,state.requesttype);
|
602 |
if state.sendpacketlen = 0 then begin
|
603 |
failurereason := 'building request packet failed';
|
604 |
goto failure;
|
605 |
end;
|
606 |
state.id := state.sendpacket.id;
|
607 |
state.resultaction := action_sendquery;
|
608 |
|
609 |
exit;
|
610 |
failure:
|
611 |
setstate_failure(state);
|
612 |
end;
|
613 |
|
614 |
|
615 |
procedure populatednsserverlist;
|
616 |
var
|
617 |
a:integer;
|
618 |
begin
|
619 |
if assigned(dnsserverlag) then begin
|
620 |
dnsserverlag.clear;
|
621 |
end else begin
|
622 |
dnsserverlag := tlist.Create;
|
623 |
end;
|
624 |
|
625 |
dnsserverlist := getsystemdnsservers;
|
626 |
for a := biniplist_getcount(dnsserverlist)-1 downto 0 do dnsserverlag.Add(nil);
|
627 |
end;
|
628 |
|
629 |
procedure cleardnsservercache;
|
630 |
begin
|
631 |
if assigned(dnsserverlag) then begin
|
632 |
dnsserverlag.destroy;
|
633 |
dnsserverlag := nil;
|
634 |
dnsserverlist := '';
|
635 |
end;
|
636 |
end;
|
637 |
|
638 |
function getcurrentsystemnameserverbin(var id:integer):tbinip;
|
639 |
var
|
640 |
counter : integer;
|
641 |
begin
|
642 |
{override the name server choice here, instead of overriding it wherever it's called
|
643 |
setting ID to -1 causes it to be ignored in reportlag}
|
644 |
if (overridednsserver <> '') then begin
|
645 |
result := ipstrtobinf(overridednsserver);
|
646 |
if result.family <> 0 then begin
|
647 |
id := -1;
|
648 |
exit;
|
649 |
end;
|
650 |
end;
|
651 |
|
652 |
if not assigned(dnsserverlag) then populatednsserverlist;
|
653 |
if dnsserverlag.count=0 then raise exception.create('no dns servers available');
|
654 |
id := 0;
|
655 |
if dnsserverlag.count >1 then begin
|
656 |
for counter := dnsserverlag.count-1 downto 1 do begin
|
657 |
if taddrint(dnsserverlag[counter]) < taddrint(dnsserverlag[id]) then id := counter;
|
658 |
end;
|
659 |
end;
|
660 |
result := biniplist_get(dnsserverlist,id);
|
661 |
end;
|
662 |
|
663 |
function getcurrentsystemnameserver(var id:integer):ansistring;
|
664 |
begin
|
665 |
result := ipbintostr(getcurrentsystemnameserverbin(id));
|
666 |
end;
|
667 |
|
668 |
procedure reportlag(id:integer;lag:integer); //lag should be in microseconds and should be -1 to report a timeout
|
669 |
var
|
670 |
counter : integer;
|
671 |
temp : integer;
|
672 |
begin
|
673 |
if (id < 0) or (id >= dnsserverlag.count) then exit;
|
674 |
if lag = -1 then lag := timeoutlag;
|
675 |
for counter := 0 to dnsserverlag.count-1 do begin
|
676 |
temp := taddrint(dnsserverlag[counter]) *15;
|
677 |
if counter=id then temp := temp + lag;
|
678 |
dnsserverlag[counter] := tobject(temp div 16);
|
679 |
end;
|
680 |
|
681 |
end;
|
682 |
|
683 |
|
684 |
{$ifdef ipv6}
|
685 |
|
686 |
procedure initpreferredmode;
|
687 |
var
|
688 |
l:tbiniplist;
|
689 |
a:integer;
|
690 |
ip:tbinip;
|
691 |
ipmask_global,ipmask_6to4,ipmask_teredo:tbinip;
|
692 |
|
693 |
begin
|
694 |
if preferredmodeinited then exit;
|
695 |
if useaf <> useaf_default then exit;
|
696 |
l := getv6localips;
|
697 |
if biniplist_getcount(l) = 0 then exit;
|
698 |
useaf := useaf_preferv4;
|
699 |
ipstrtobin('2000::',ipmask_global);
|
700 |
ipstrtobin('2001::',ipmask_teredo);
|
701 |
ipstrtobin('2002::',ipmask_6to4);
|
702 |
{if there is any v6 IP which is globally routable and not 6to4 and not teredo, prefer v6}
|
703 |
for a := biniplist_getcount(l)-1 downto 0 do begin
|
704 |
ip := biniplist_get(l,a);
|
705 |
if not comparebinipmask(ip,ipmask_global,3) then continue;
|
706 |
if comparebinipmask(ip,ipmask_teredo,32) then continue;
|
707 |
if comparebinipmask(ip,ipmask_6to4,16) then continue;
|
708 |
useaf := useaf_preferv6;
|
709 |
preferredmodeinited := true;
|
710 |
exit;
|
711 |
end;
|
712 |
end;
|
713 |
|
714 |
{$endif}
|
715 |
|
716 |
|
717 |
{ quick and dirty description of dns packet structure to aid writing and
|
718 |
understanding of parser code, refer to appropriate RFCs for proper specs
|
719 |
- all words are network order
|
720 |
|
721 |
www.google.com A request:
|
722 |
|
723 |
0, 2: random transaction ID
|
724 |
2, 2: flags: only the "recursion desired" bit set. (bit 8 of word)
|
725 |
4, 2: questions: 1
|
726 |
6, 2: answer RR's: 0.
|
727 |
8, 2: authority RR's: 0.
|
728 |
10, 2: additional RR's: 0.
|
729 |
12, n: payload:
|
730 |
query:
|
731 |
#03 "www" #06 "google" #03 "com" #00
|
732 |
size-4, 2: type: host address (1)
|
733 |
size-2, 2: class: inet (1)
|
734 |
|
735 |
reply:
|
736 |
|
737 |
0,2: random transaction ID
|
738 |
2,2: flags: set: response (bit 15), recursion desired (8), recursion available (7)
|
739 |
4,4: questions: 1
|
740 |
6,4: answer RR's: 2
|
741 |
8,4: authority RR's: 9
|
742 |
10,4: additional RR's: 9
|
743 |
12: payload:
|
744 |
query:
|
745 |
....
|
746 |
answer: CNAME
|
747 |
0,2 "c0 0c" "name: www.google.com"
|
748 |
2,2 "00 05" "type: cname for an alias"
|
749 |
4,2 "00 01" "class: inet"
|
750 |
6,4: TTL
|
751 |
10,2: data length "00 17" (23)
|
752 |
12: the cname name (www.google.akadns.net)
|
753 |
answer: A
|
754 |
0,2 ..
|
755 |
2,2 "00 01" host address
|
756 |
4,2 ...
|
757 |
6,4 ...
|
758 |
10,2: data length (4)
|
759 |
12,4: binary IP
|
760 |
authority - 9 records
|
761 |
additional - 9 records
|
762 |
|
763 |
|
764 |
ipv6 AAAA reply:
|
765 |
0,2: ...
|
766 |
2,2: type: 001c
|
767 |
4,2: class: inet (0001)
|
768 |
6,2: TTL
|
769 |
10,2: data size (16)
|
770 |
12,16: binary IP
|
771 |
|
772 |
ptr request: query type 000c
|
773 |
|
774 |
name compression: word "cxxx" in the name, xxx points to offset in the packet}
|
775 |
|
776 |
end.
|