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

Annotation of /trunk/dnscore.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 136 - (hide annotations)
Fri Mar 28 03:18:52 2014 UTC (5 years, 7 months ago) by beware
File size: 23894 byte(s)
fix spelling mistakes
1 plugwash 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 beware 136 developers will probably want to use dnsasync or dnssync or write a similar
10     wrapper unit of their own).
11 plugwash 1
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 beware 136 relevant state manually.
15 plugwash 1
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 beware 136 action_done means the request has completed (either succeeded or failed)
24 plugwash 1
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 zipplet 79 once the app gets action_done it can determine success or failure in the
32 plugwash 1 following ways.
33    
34     on failure state.resultstr will be an empty string and state.resultbin will
35 beware 136 be zeroed out (easily detected by the fact that it will have a family of 0)
36 plugwash 1
37     on success for a A or AAAA lookup state.resultstr will be an empty string
38 beware 136 and state.resultbin will contain the result (note: AAAA lookups require IPv6
39 plugwash 1 enabled).
40    
41 beware 136 if an A lookup fails and the code is built with IPv6 enabled then the code
42 plugwash 1 will return any AAAA records with the same name. The reverse does not apply
43 beware 136 so if an application prefers IPv6 but wants IPv4 results as well it must
44     check them separately.
45 plugwash 1
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 beware 136 can be used to clean these up if required.
50 plugwash 1
51 beware 136 callers may use setstate_failure to mark the state as failed themselves
52 plugwash 1 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 beware 2 {$include lcoreconfig.inc}
60 plugwash 1
61     interface
62    
63 beware 20 uses binipstuff,classes,pgtypes,lcorernd;
64 plugwash 1
65 beware 127 var usewindns : boolean = {$ifdef mswindows}true{$else}false{$endif};
66 beware 2 {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 plugwash 1
70 beware 2 note: this unit will not be able to self populate it's dns server list on
71     older versions of windows.}
72 plugwash 1
73     const
74 beware 2 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 beware 20 {
86     (temporarily) use a different nameserver, regardless of the dnsserverlist
87     }
88 zipplet 79 var overridednsserver:ansistring;
89 beware 20
90 beware 2 const
91 plugwash 1 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 beware 20 querytype_a6=38;
102 plugwash 1 querytype_ptr=12;
103     querytype_ns=2;
104     querytype_soa=6;
105     querytype_mx=15;
106 beware 20 querytype_txt=16;
107     querytype_spf=99;
108     maxrecursion=50;
109 beware 99 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 plugwash 1
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 zipplet 79 queryname:ansistring;
132 plugwash 1 requesttype:word;
133     parsepacket:boolean;
134 zipplet 79 resultstr:ansistring;
135 plugwash 1 resultbin:tbinip;
136 beware 2 resultlist:tbiniplist;
137 plugwash 1 resultaction:integer;
138     numrr1:array[0..3] of integer;
139     numrr2:integer;
140 zipplet 79 rrdata:ansistring;
141 plugwash 1 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 beware 136 //and probably should not be called from outside this unit, reenable them
166 plugwash 1 //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 beware 2 //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 zipplet 79 function makereversename(const binip:tbinip):ansistring;
172 beware 2
173 zipplet 79 procedure setstate_request_init(const name:ansistring;var state:tdnsstate);
174 plugwash 1
175 beware 136 //set up state for a forward lookup. A family value of AF_INET6 will give only
176 plugwash 13 //ipv6 results. Any other value will give only ipv4 results
177 zipplet 79 procedure setstate_forward(const name:ansistring;var state:tdnsstate;family:integer);
178 plugwash 1
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 beware 20 //for custom raw lookups such as TXT, as desired by the user
184 zipplet 79 procedure setstate_custom(const name:ansistring; requesttype:integer; var state:tdnsstate);
185 plugwash 1
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 beware 97 dnsserverlist : tbiniplist;
195     dnsserverlag:tlist;
196 plugwash 1 // currentdnsserverno : integer;
197    
198 plugwash 13
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 zipplet 79 function getcurrentsystemnameserver(var id:integer) :ansistring;
203 beware 97 function getcurrentsystemnameserverbin(var id:integer) :tbinip;
204 plugwash 13 procedure reportlag(id:integer;lag:integer); //lag should be in microseconds and should be -1 to report a timeout
205 plugwash 1
206     //var
207     // unixnameservercache:string;
208     { $endif}
209    
210    
211 beware 20 {$ifdef ipv6}
212 plugwash 13 procedure initpreferredmode;
213    
214 plugwash 1 var
215 plugwash 13 preferredmodeinited:boolean;
216    
217 beware 20 {$endif}
218 plugwash 13
219     var
220 zipplet 79 failurereason:ansistring;
221 plugwash 1
222 zipplet 79 function getquerytype(s:ansistring):integer;
223 beware 20
224 plugwash 1 implementation
225    
226     uses
227 beware 96 lcorelocalips,
228 plugwash 1 sysutils;
229    
230 beware 20
231    
232 zipplet 79 function getquerytype(s:ansistring):integer;
233 beware 20 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 zipplet 79 function buildrequest(const name:ansistring;var packet:tdnspacket;requesttype:word):integer;
249 plugwash 1 var
250     a,b:integer;
251 zipplet 79 s:ansistring;
252 plugwash 1 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 beware 20 packet.id := randominteger($10000);
258    
259 plugwash 1 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 zipplet 79 function makereversename(const binip:tbinip):ansistring;
294 plugwash 1 var
295 zipplet 79 name:ansistring;
296 plugwash 1 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 zipplet 79 function decodename(const packet:tdnspacket;len,start,recursion:integer;var numread:integer):ansistring;
328 plugwash 1 var
329     arr:array[0..sizeof(packet)-1] of byte absolute packet;
330 zipplet 79 s:ansistring;
331 plugwash 1 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 zipplet 79 result := result + ansichar(arr[a]);
372 plugwash 1 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 zipplet 79 function getrawfromrr(const rrp:trrpointer;len:integer):ansistring;
390 beware 20 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 beware 2 function getipfromrr(const rrp:trrpointer;len:integer):tbinip;
398 plugwash 1 begin
399 beware 2 fillchar(result,sizeof(result),0);
400 plugwash 1 case trr(rrp.p^).requesttype of
401     querytype_a: begin
402     if htons(trr(rrp.p^).datalen) <> 4 then exit;
403 beware 2 move(trr(rrp.p^).data,result.ip,4);
404     result.family :=AF_INET;
405 plugwash 1 end;
406     {$ifdef ipv6}
407     querytype_aaaa: begin
408     if htons(trr(rrp.p^).datalen) <> 16 then exit;
409 beware 2 result.family := AF_INET6;
410     move(trr(rrp.p^).data,result.ip6,16);
411 plugwash 1 end;
412     {$endif}
413     else
414 beware 2 {}
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 beware 20 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 beware 2 else
439 plugwash 1 {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 zipplet 79 procedure setstate_request_init(const name:ansistring;var state:tdnsstate);
446 plugwash 1 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 zipplet 79 procedure setstate_forward(const name:ansistring;var state:tdnsstate;family:integer);
457 plugwash 1 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 zipplet 79 procedure setstate_custom(const name:ansistring; requesttype:integer; var state:tdnsstate);
473 beware 20 begin
474     setstate_request_init(name,state);
475     state.requesttype := requesttype;
476     end;
477    
478    
479 plugwash 1 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 beware 99 if state.numrr1[a] > maxrrofakind then begin
509     failurereason := 'exceeded maximum RR of a kind';
510     goto failure;
511     end;
512 plugwash 1 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 beware 2 {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 plugwash 1 {- 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 plugwash 13
586 plugwash 1 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 beware 136 {do /etc/hosts lookup here}
601 plugwash 1 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 beware 97 a:integer;
618 plugwash 1 begin
619 beware 97 if assigned(dnsserverlag) then begin
620     dnsserverlag.clear;
621 plugwash 1 end else begin
622 beware 97 dnsserverlag := tlist.Create;
623 plugwash 1 end;
624    
625 beware 97 dnsserverlist := getsystemdnsservers;
626     for a := biniplist_getcount(dnsserverlist)-1 downto 0 do dnsserverlag.Add(nil);
627 plugwash 1 end;
628    
629     procedure cleardnsservercache;
630     begin
631 beware 97 if assigned(dnsserverlag) then begin
632     dnsserverlag.destroy;
633     dnsserverlag := nil;
634     dnsserverlist := '';
635 plugwash 1 end;
636     end;
637    
638 beware 97 function getcurrentsystemnameserverbin(var id:integer):tbinip;
639 beware 2 var
640 plugwash 1 counter : integer;
641 beware 97 begin
642 beware 136 {override the name server choice here, instead of overriding it wherever it's called
643 beware 97 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 plugwash 1
652 beware 97 if not assigned(dnsserverlag) then populatednsserverlist;
653 beware 136 if dnsserverlag.count=0 then raise exception.create('no dns servers available');
654 plugwash 1 id := 0;
655 beware 97 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 plugwash 1 end;
659     end;
660 beware 97 result := biniplist_get(dnsserverlist,id);
661 plugwash 1 end;
662    
663 beware 97 function getcurrentsystemnameserver(var id:integer):ansistring;
664     begin
665     result := ipbintostr(getcurrentsystemnameserverbin(id));
666     end;
667    
668 plugwash 1 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 beware 97 if (id < 0) or (id >= dnsserverlag.count) then exit;
674 plugwash 1 if lag = -1 then lag := timeoutlag;
675 beware 97 for counter := 0 to dnsserverlag.count-1 do begin
676     temp := taddrint(dnsserverlag[counter]) *15;
677 plugwash 1 if counter=id then temp := temp + lag;
678 beware 97 dnsserverlag[counter] := tobject(temp div 16);
679 plugwash 1 end;
680    
681     end;
682    
683 plugwash 13
684 beware 20 {$ifdef ipv6}
685    
686 plugwash 13 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 beware 20 l := getv6localips;
697     if biniplist_getcount(l) = 0 then exit;
698 plugwash 13 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 beware 20 {$endif}
715 plugwash 13
716    
717 plugwash 1 { 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.

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.22