123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880 |
- { Copyright (C) 2005 Bas Steendijk and Peter Green
- For conditions of distribution and use, see copyright notice in zlib_license.txt
- which is included in the package
- ----------------------------------------------------------------------------- }
-
- {
-
- code wanting to use this dns system should act as follows (note: app
- developers will probablly want to use dnsasync or dnssync or write a similar
- wrapper unit of thier own).
-
- for normal lookups call setstate_forward or setstate_reverse to set up the
- state, for more obscure lookups use setstate_request_init and fill in other
- relavent state manually.
-
- call state_process which will do processing on the information in the state
- and return an action
- action_ignore means that dnscore wants the code that calls it to go
- back to waiting for packets
- action_sendpacket means that dnscore wants the code that calls it to send
- the packet in sendpacket/sendpacketlen and then start (or go back to) listening
- for
- action_done means the request has completed (either suceeded or failed)
-
- callers should resend the last packet they tried to send if they have not
- been asked to send a new packet for more than some timeout value they choose.
-
- when a packet is received the application should put the packet in
- recvbuf/recvbuflen , set state.parsepacket and call state_process again
-
- once the app gets action_done it can determine sucess or failure in the
- following ways.
-
- on failure state.resultstr will be an empty string and state.resultbin will
- be zeroed out (easilly detected by the fact that it will have a family of 0)
-
- on success for a A or AAAA lookup state.resultstr will be an empty string
- and state.resultbin will contain the result (note: AAAA lookups require IPV6
- enabled).
-
- if an A lookup fails and the code is built with ipv6 enabled then the code
- will return any AAAA records with the same name. The reverse does not apply
- so if an application preffers IPV6 but wants IPV4 results as well it must
- check them seperately.
-
- on success for any other type of lookup state.resultstr will be an empty
-
- note the state contains ansistrings, setstate_init with a null name parameter
- can be used to clean theese up if required.
-
- callers may use setstate_failure to mark the state as failed themseleves
- before passing it on to other code, for example this may be done in the event
- of a timeout.
- }
- unit dnscore;
-
- {$ifdef fpc}{$mode delphi}{$endif}
-
- {$include lcoreconfig.inc}
-
- interface
-
- uses binipstuff,classes,pgtypes,lcorernd;
-
- var usewindns : boolean = {$ifdef win32}true{$else}false{$endif};
- {hint to users of this unit that they should use windows dns instead.
- May be disabled by applications if desired. (e.g. if setting a custom
- dnsserverlist).
-
- note: this unit will not be able to self populate it's dns server list on
- older versions of windows.}
-
- const
- useaf_default=0;
- useaf_preferv4=1;
- useaf_preferv6=2;
- useaf_v4=3;
- useaf_v6=4;
- {
- hint to users of this unit to how to deal with connecting to hostnames regarding ipv4 or ipv6 usage
- can be set by apps as desired
- }
- var useaf:integer = useaf_default;
-
- {
- (temporarily) use a different nameserver, regardless of the dnsserverlist
- }
- var overridednsserver:string;
-
- const
- maxnamelength=127;
- maxnamefieldlen=63;
- //note: when using action_ignore the dnscore code *must* preserve the contents of state.sendpacket to allow for retries
- //note: action_ignore must not be used in response to the original request but there is no valid reason for doing this anyway
- action_ignore=0;
- action_done=1;
- action_sendquery=2;
- querytype_a=1;
- querytype_cname=5;
- querytype_aaaa=28;
- querytype_a6=38;
- querytype_ptr=12;
- querytype_ns=2;
- querytype_soa=6;
- querytype_mx=15;
- querytype_txt=16;
- querytype_spf=99;
- maxrecursion=50;
- maxrrofakind=20;
-
- retryafter=300000; //microseconds must be less than one second;
- timeoutlag=1000000000; // penalty value to be treated as lag in the event of a timeout (microseconds)
- type
- dvar=array[0..0] of byte;
- pdvar=^dvar;
- tdnspacket=packed record
- id:word;
- flags:word;
- rrcount:array[0..3] of word;
- payload:array[0..511-12] of byte;
- end;
-
-
-
- tdnsstate=record
- id:word;
- recursioncount:integer;
- queryname:string;
- requesttype:word;
- parsepacket:boolean;
- resultstr:string;
- resultbin:tbinip;
- resultlist:tbiniplist;
- resultaction:integer;
- numrr1:array[0..3] of integer;
- numrr2:integer;
- rrdata:string;
- sendpacketlen:integer;
- sendpacket:tdnspacket;
- recvpacketlen:integer;
- recvpacket:tdnspacket;
- forwardfamily:integer;
- end;
-
- trr=packed record
- requesttypehi:byte;
- requesttype:byte;
- clas:word;
- ttl:integer;
- datalen:word;
- data:array[0..511] of byte;
- end;
-
- trrpointer=packed record
- p:pointer;
- ofs:integer;
- len:integer;
- namelen:integer;
- end;
-
- //commenting out functions from interface that do not have documented semantics
- //and probablly should not be called from outside this unit, reenable them
- //if you must but please document them at the same time --plugwash
-
- //function buildrequest(const name:string;var packet:tdnspacket;requesttype:word):integer;
-
- //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
- function makereversename(const binip:tbinip):string;
-
- procedure setstate_request_init(const name:string;var state:tdnsstate);
-
- //set up state for a foward lookup. A family value of AF_INET6 will give only
- //ipv6 results. Any other value will give only ipv4 results
- procedure setstate_forward(const name:string;var state:tdnsstate;family:integer);
-
- procedure setstate_reverse(const binip:tbinip;var state:tdnsstate);
- procedure setstate_failure(var state:tdnsstate);
- //procedure setstate_return(const rrp:trrpointer;len:integer;var state:tdnsstate);
-
- //for custom raw lookups such as TXT, as desired by the user
- procedure setstate_custom(const name:string; requesttype:integer; var state:tdnsstate);
-
- procedure state_process(var state:tdnsstate);
-
- //function decodename(const packet:tdnspacket;len,start,recursion:integer;var numread:integer):string;
-
- procedure populatednsserverlist;
- procedure cleardnsservercache;
-
- var
- dnsserverlist : tstringlist;
- // currentdnsserverno : integer;
-
-
- //getcurrentsystemnameserver returns the nameserver the app should use and sets
- //id to the id of that nameserver. id should later be used to report how laggy
- //the servers response was and if it was timed out.
- function getcurrentsystemnameserver(var id:integer) :string;
- procedure reportlag(id:integer;lag:integer); //lag should be in microseconds and should be -1 to report a timeout
-
- //var
- // unixnameservercache:string;
- { $endif}
-
-
- {$ifdef ipv6}
- function getv6localips:tbiniplist;
- procedure initpreferredmode;
-
- var
- preferredmodeinited:boolean;
-
- {$endif}
-
- var
- failurereason:string;
-
- function getquerytype(s:string):integer;
-
- implementation
-
- uses
- {$ifdef win32}
- windows,
- {$endif}
-
- sysutils;
-
-
-
- function getquerytype(s:string):integer;
- begin
- s := uppercase(s);
- result := 0;
- if (s = 'A') then result := querytype_a else
- if (s = 'CNAME') then result := querytype_cname else
- if (s = 'AAAA') then result := querytype_aaaa else
- if (s = 'PTR') then result := querytype_ptr else
- if (s = 'NS') then result := querytype_ns else
- if (s = 'MX') then result := querytype_mx else
- if (s = 'A6') then result := querytype_a6 else
- if (s = 'TXT') then result := querytype_txt else
- if (s = 'SOA') then result := querytype_soa else
- if (s = 'SPF') then result := querytype_spf;
- end;
-
- function buildrequest(const name:string;var packet:tdnspacket;requesttype:word):integer;
- var
- a,b:integer;
- s:string;
- arr:array[0..sizeof(packet)-1] of byte absolute packet;
- begin
- { writeln('buildrequest: name: ',name);}
- result := 0;
- fillchar(packet,sizeof(packet),0);
- packet.id := randominteger($10000);
-
- packet.flags := htons($0100);
- packet.rrcount[0] := htons($0001);
-
-
- s := copy(name,1,maxnamelength);
- if s = '' then exit;
- if s[length(s)] <> '.' then s := s + '.';
- b := 0;
- {encode name}
- if (s = '.') then begin
- packet.payload[0] := 0;
- result := 12+5;
- end else begin
- for a := 1 to length(s) do begin
- if s[a] = '.' then begin
- if b > maxnamefieldlen then exit;
- if (b = 0) then exit;
- packet.payload[a-b-1] := b;
- b := 0;
- end else begin
- packet.payload[a] := byte(s[a]);
- inc(b);
- end;
- end;
- if b > maxnamefieldlen then exit;
- packet.payload[length(s)-b] := b;
- result := length(s) + 12+5;
- end;
-
- arr[result-1] := 1;
- arr[result-3] := requesttype and $ff;
- arr[result-4] := requesttype shr 8;
- end;
-
- function makereversename(const binip:tbinip):string;
- var
- name:string;
- a,b:integer;
- begin
- name := '';
- if binip.family = AF_INET then begin
- b := htonl(binip.ip);
- for a := 0 to 3 do begin
- name := name + inttostr(b shr (a shl 3) and $ff)+'.';
- end;
- name := name + 'in-addr.arpa';
- end else
- {$ifdef ipv6}
- if binip.family = AF_INET6 then begin
- for a := 15 downto 0 do begin
- b := binip.ip6.u6_addr8[a];
- name := name + hexchars[b and $f]+'.'+hexchars[b shr 4]+'.';
- end;
- name := name + 'ip6.arpa';
- end else
- {$endif}
- begin
- {empty name}
- end;
- result := name;
- end;
-
- {
- decodes DNS format name to a string. does not includes the root dot.
- doesnt read beyond len.
- empty result + non null failurereason: failure
- empty result + null failurereason: internal use
- }
- function decodename(const packet:tdnspacket;len,start,recursion:integer;var numread:integer):string;
- var
- arr:array[0..sizeof(packet)-1] of byte absolute packet;
- s:string;
- a,b:integer;
- begin
- numread := 0;
- repeat
- if (start+numread < 0) or (start+numread >= len) then begin
- result := '';
- failurereason := 'decoding name: got out of range1';
- exit;
- end;
- b := arr[start+numread];
- if b >= $c0 then begin
- {recursive sub call}
- if recursion > 10 then begin
- result := '';
- failurereason := 'decoding name: max recursion';
- exit;
- end;
- if ((start+numread+1) >= len) then begin
- result := '';
- failurereason := 'decoding name: got out of range3';
- exit;
- end;
- a := ((b shl 8) or arr[start+numread+1]) and $3fff;
- s := decodename(packet,len,a,recursion+1,a);
- if (s = '') and (failurereason <> '') then begin
- result := '';
- exit;
- end;
- if result <> '' then result := result + '.';
- result := result + s;
- inc(numread,2);
- exit;
- end else if b < 64 then begin
- if (numread <> 0) and (b <> 0) then result := result + '.';
- for a := start+numread+1 to start+numread+b do begin
- if (a >= len) then begin
- result := '';
- failurereason := 'decoding name: got out of range2';
- exit;
- end;
- result := result + char(arr[a]);
- end;
- inc(numread,b+1);
-
- if b = 0 then begin
- if (result = '') and (recursion = 0) then result := '.';
- exit; {reached end of name}
- end;
- end else begin
- failurereason := 'decoding name: read invalid char';
- result := '';
- exit; {invalid}
- end;
- until false;
- end;
-
- {==============================================================================}
-
- function getrawfromrr(const rrp:trrpointer;len:integer):string;
- begin
- setlength(result,htons(trr(rrp.p^).datalen));
- uniquestring(result);
- move(trr(rrp.p^).data,result[1],length(result));
- end;
-
-
- function getipfromrr(const rrp:trrpointer;len:integer):tbinip;
- begin
- fillchar(result,sizeof(result),0);
- case trr(rrp.p^).requesttype of
- querytype_a: begin
- if htons(trr(rrp.p^).datalen) <> 4 then exit;
- move(trr(rrp.p^).data,result.ip,4);
- result.family :=AF_INET;
- end;
- {$ifdef ipv6}
- querytype_aaaa: begin
- if htons(trr(rrp.p^).datalen) <> 16 then exit;
- result.family := AF_INET6;
- move(trr(rrp.p^).data,result.ip6,16);
- end;
- {$endif}
- else
- {}
- end;
- end;
-
- procedure setstate_return(const rrp:trrpointer;len:integer;var state:tdnsstate);
- var
- a:integer;
- begin
- state.resultaction := action_done;
- state.resultstr := '';
- case trr(rrp.p^).requesttype of
- querytype_a{$ifdef ipv6},querytype_aaaa{$endif}: begin
- state.resultbin := getipfromrr(rrp,len);
- end;
- querytype_txt:begin
- {TXT returns a raw string}
- state.resultstr := copy(getrawfromrr(rrp,len),2,9999);
- fillchar(state.resultbin,sizeof(state.resultbin),0);
- end;
- querytype_mx:begin
- {MX is a name after a 16 bits word}
- state.resultstr := decodename(state.recvpacket,state.recvpacketlen,taddrint(rrp.p)-taddrint(@state.recvpacket)+12,0,a);
- fillchar(state.resultbin,sizeof(state.resultbin),0);
- end;
- else
- {other reply types (PTR, MX) return a hostname}
- state.resultstr := decodename(state.recvpacket,state.recvpacketlen,taddrint(rrp.p)-taddrint(@state.recvpacket)+10,0,a);
- fillchar(state.resultbin,sizeof(state.resultbin),0);
- end;
- end;
-
- procedure setstate_request_init(const name:string;var state:tdnsstate);
- begin
- {destroy things properly}
- state.resultstr := '';
- state.queryname := '';
- state.rrdata := '';
- fillchar(state,sizeof(state),0);
- state.queryname := name;
- state.parsepacket := false;
- end;
-
- procedure setstate_forward(const name:string;var state:tdnsstate;family:integer);
- begin
- setstate_request_init(name,state);
- state.forwardfamily := family;
- {$ifdef ipv6}
- if family = AF_INET6 then state.requesttype := querytype_aaaa else
- {$endif}
- state.requesttype := querytype_a;
- end;
-
- procedure setstate_reverse(const binip:tbinip;var state:tdnsstate);
- begin
- setstate_request_init(makereversename(binip),state);
- state.requesttype := querytype_ptr;
- end;
-
- procedure setstate_custom(const name:string; requesttype:integer; var state:tdnsstate);
- begin
- setstate_request_init(name,state);
- state.requesttype := requesttype;
- end;
-
-
- procedure setstate_failure(var state:tdnsstate);
- begin
- state.resultstr := '';
- fillchar(state.resultbin,sizeof(state.resultbin),0);
- state.resultaction := action_done;
- end;
-
- procedure state_process(var state:tdnsstate);
- label recursed;
- label failure;
- var
- a,b,ofs:integer;
- rrtemp:^trr;
- rrptemp:^trrpointer;
- begin
- if state.parsepacket then begin
- if state.recvpacketlen < 12 then begin
- failurereason := 'Undersized packet';
- state.resultaction := action_ignore;
- exit;
- end;
- if state.id <> state.recvpacket.id then begin
- failurereason := 'ID mismatch';
- state.resultaction := action_ignore;
- exit;
- end;
- state.numrr2 := 0;
- for a := 0 to 3 do begin
- state.numrr1[a] := htons(state.recvpacket.rrcount[a]);
- if state.numrr1[a] > maxrrofakind then goto failure;
- inc(state.numrr2,state.numrr1[a]);
- end;
-
- setlength(state.rrdata,state.numrr2*sizeof(trrpointer));
-
- {- put all replies into a list}
-
- ofs := 12;
- {get all queries}
- for a := 0 to state.numrr1[0]-1 do begin
- if (ofs < 12) or (ofs > state.recvpacketlen-4) then goto failure;
- rrptemp := @state.rrdata[1+a*sizeof(trrpointer)];
- rrptemp.p := @state.recvpacket.payload[ofs-12];
- rrptemp.ofs := ofs;
- decodename(state.recvpacket,state.recvpacketlen,ofs,0,b);
- rrptemp.len := b + 4;
- inc(ofs,rrptemp.len);
- end;
-
- for a := state.numrr1[0] to state.numrr2-1 do begin
- if (ofs < 12) or (ofs > state.recvpacketlen-12) then goto failure;
- rrptemp := @state.rrdata[1+a*sizeof(trrpointer)];
- if decodename(state.recvpacket,state.recvpacketlen,ofs,0,b) = '' then goto failure;
- rrtemp := @state.recvpacket.payload[ofs-12+b]; {rrtemp points to values and result, after initial name}
- rrptemp.p := rrtemp;
- rrptemp.ofs := ofs; {ofs is start of RR before initial name from start of packet}
- rrptemp.namelen := b;
- b := htons(rrtemp.datalen);
- rrptemp.len := b + 10 + rrptemp.namelen;
- inc(ofs,rrptemp.len);
- end;
- if (ofs <> state.recvpacketlen) then begin
- failurereason := 'ofs <> state.packetlen';
- goto failure;
- end;
-
- {if we requested A or AAAA build a list of all replies}
- if (state.requesttype = querytype_a) or (state.requesttype = querytype_aaaa) then begin
- state.resultlist := biniplist_new;
- for a := state.numrr1[0] to (state.numrr1[0]+state.numrr1[1]-1) do begin
- rrptemp := @state.rrdata[1+a*sizeof(trrpointer)];
- rrtemp := rrptemp.p;
- b := rrptemp.len;
- if rrtemp.requesttype = state.requesttype then begin
- biniplist_add(state.resultlist,getipfromrr(rrptemp^,b));
- end;
- end;
- end;
-
- {- check for items of the requested type in answer section, if so return success first}
- for a := state.numrr1[0] to (state.numrr1[0]+state.numrr1[1]-1) do begin
- rrptemp := @state.rrdata[1+a*sizeof(trrpointer)];
- rrtemp := rrptemp.p;
- b := rrptemp.len;
- if rrtemp.requesttype = state.requesttype then begin
- setstate_return(rrptemp^,b,state);
- exit;
- end;
- end;
-
- {if no items of correct type found, follow first cname in answer section}
- for a := state.numrr1[0] to (state.numrr1[0]+state.numrr1[1]-1) do begin
- rrptemp := @state.rrdata[1+a*sizeof(trrpointer)];
- rrtemp := rrptemp.p;
- b := rrptemp.len;
- if rrtemp.requesttype = querytype_cname then begin
- state.queryname := decodename(state.recvpacket,state.recvpacketlen,rrptemp.ofs+12,0,b);
- goto recursed;
- end;
- end;
-
- {no cnames found, no items of correct type found}
- if state.forwardfamily <> 0 then goto failure;
-
- goto failure;
- recursed:
- {here it needs recursed lookup}
- {if needing to follow a cname, change state to do so}
- inc(state.recursioncount);
- if state.recursioncount > maxrecursion then goto failure;
- end;
-
- {here, a name needs to be resolved}
- if state.queryname = '' then begin
- failurereason := 'empty query name';
- goto failure;
- end;
-
- {do /ets/hosts lookup here}
- state.sendpacketlen := buildrequest(state.queryname,state.sendpacket,state.requesttype);
- if state.sendpacketlen = 0 then begin
- failurereason := 'building request packet failed';
- goto failure;
- end;
- state.id := state.sendpacket.id;
- state.resultaction := action_sendquery;
-
- exit;
- failure:
- setstate_failure(state);
- end;
- {$ifdef win32}
- const
- MAX_HOSTNAME_LEN = 132;
- MAX_DOMAIN_NAME_LEN = 132;
- MAX_SCOPE_ID_LEN = 260 ;
- MAX_ADAPTER_NAME_LENGTH = 260;
- MAX_ADAPTER_ADDRESS_LENGTH = 8;
- MAX_ADAPTER_DESCRIPTION_LENGTH = 132;
- ERROR_BUFFER_OVERFLOW = 111;
- MIB_IF_TYPE_ETHERNET = 6;
- MIB_IF_TYPE_TOKENRING = 9;
- MIB_IF_TYPE_FDDI = 15;
- MIB_IF_TYPE_PPP = 23;
- MIB_IF_TYPE_LOOPBACK = 24;
- MIB_IF_TYPE_SLIP = 28;
-
-
- type
- tip_addr_string=packed record
- Next :pointer;
- IpAddress : array[0..15] of char;
- ipmask : array[0..15] of char;
- context : dword;
- end;
- pip_addr_string=^tip_addr_string;
- tFIXED_INFO=packed record
- HostName : array[0..MAX_HOSTNAME_LEN-1] of char;
- DomainName : array[0..MAX_DOMAIN_NAME_LEN-1] of char;
- currentdnsserver : pip_addr_string;
- dnsserverlist : tip_addr_string;
- nodetype : longint;
- ScopeId : array[0..MAX_SCOPE_ID_LEN + 4] of char;
- enablerouting : longbool;
- enableproxy : longbool;
- enabledns : longbool;
- end;
- pFIXED_INFO=^tFIXED_INFO;
-
- var
- iphlpapi : thandle;
- getnetworkparams : function(pFixedInfo : PFIXED_INFO;OutBufLen : plongint) : longint;stdcall;
- {$endif}
- procedure populatednsserverlist;
- var
- {$ifdef win32}
- fixed_info : pfixed_info;
- fixed_info_len : longint;
- currentdnsserver : pip_addr_string;
- {$else}
- t:textfile;
- s:string;
- a:integer;
- {$endif}
- begin
- //result := '';
- if assigned(dnsserverlist) then begin
- dnsserverlist.clear;
- end else begin
- dnsserverlist := tstringlist.Create;
- end;
- {$ifdef win32}
- if iphlpapi=0 then iphlpapi := loadlibrary('iphlpapi.dll');
- if not assigned(getnetworkparams) then @getnetworkparams := getprocaddress(iphlpapi,'GetNetworkParams');
- if not assigned(getnetworkparams) then exit;
- fixed_info_len := 0;
- if GetNetworkParams(nil,@fixed_info_len)<>ERROR_BUFFER_OVERFLOW then exit;
- //fixed_info_len :=sizeof(tfixed_info);
- getmem(fixed_info,fixed_info_len);
- if GetNetworkParams(fixed_info,@fixed_info_len)<>0 then begin
- freemem(fixed_info);
- exit;
- end;
- currentdnsserver := @(fixed_info.dnsserverlist);
- while assigned(currentdnsserver) do begin
- dnsserverlist.Add(currentdnsserver.IpAddress);
- currentdnsserver := currentdnsserver.next;
- end;
- freemem(fixed_info);
- {$else}
- filemode := 0;
- assignfile(t,'/etc/resolv.conf');
- {$i-}reset(t);{$i+}
- if ioresult <> 0 then exit;
-
- while not eof(t) do begin
- readln(t,s);
- if not (copy(s,1,10) = 'nameserver') then continue;
- s := copy(s,11,500);
- while s <> '' do begin
- if (s[1] = #32) or (s[1] = #9) then s := copy(s,2,500) else break;
- end;
- a := pos(' ',s);
- if a <> 0 then s := copy(s,1,a-1);
- a := pos(#9,s);
- if a <> 0 then s := copy(s,1,a-1);
- //result := s;
- //if result <> '' then break;
- dnsserverlist.Add(s);
- end;
- close(t);
- {$endif}
- end;
-
- procedure cleardnsservercache;
- begin
- if assigned(dnsserverlist) then begin
- dnsserverlist.destroy;
- dnsserverlist := nil;
- end;
- end;
-
- function getcurrentsystemnameserver(var id:integer):string;
- var
- counter : integer;
-
- begin
- if not assigned(dnsserverlist) then populatednsserverlist;
- if dnsserverlist.count=0 then raise exception.create('no dns servers availible');
- id := 0;
- if dnsserverlist.count >1 then begin
-
- for counter := 1 to dnsserverlist.count-1 do begin
- if taddrint(dnsserverlist.objects[counter]) < taddrint(dnsserverlist.objects[id]) then id := counter;
- end;
- end;
- result := dnsserverlist[id]
- end;
-
- procedure reportlag(id:integer;lag:integer); //lag should be in microseconds and should be -1 to report a timeout
- var
- counter : integer;
- temp : integer;
- begin
- if (id < 0) or (id >= dnsserverlist.count) then exit;
- if lag = -1 then lag := timeoutlag;
- for counter := 0 to dnsserverlist.count-1 do begin
- temp := taddrint(dnsserverlist.objects[counter]) *15;
- if counter=id then temp := temp + lag;
- dnsserverlist.objects[counter] := tobject(temp div 16);
- end;
-
- end;
-
-
-
- {$ifdef ipv6}
-
- {$ifdef linux}
- function getv6localips:tbiniplist;
- var
- t:textfile;
- s,s2:string;
- ip:tbinip;
- a:integer;
- begin
- result := biniplist_new;
-
- assignfile(t,'/proc/net/if_inet6');
- {$i-}reset(t);{$i+}
- if ioresult <> 0 then exit; {none found, return empty list}
-
- while not eof(t) do begin
- readln(t,s);
- s2 := '';
- for a := 0 to 7 do begin
- if (s2 <> '') then s2 := s2 + ':';
- s2 := s2 + copy(s,(a shl 2)+1,4);
- end;
- ipstrtobin(s2,ip);
- if ip.family <> 0 then biniplist_add(result,ip);
- end;
- closefile(t);
- end;
-
- {$else}
- function getv6localips:tbiniplist;
- begin
- result := biniplist_new;
- end;
- {$endif}
-
- procedure initpreferredmode;
- var
- l:tbiniplist;
- a:integer;
- ip:tbinip;
- ipmask_global,ipmask_6to4,ipmask_teredo:tbinip;
-
- begin
- if preferredmodeinited then exit;
- if useaf <> useaf_default then exit;
- l := getv6localips;
- if biniplist_getcount(l) = 0 then exit;
- useaf := useaf_preferv4;
- ipstrtobin('2000::',ipmask_global);
- ipstrtobin('2001::',ipmask_teredo);
- ipstrtobin('2002::',ipmask_6to4);
- {if there is any v6 IP which is globally routable and not 6to4 and not teredo, prefer v6}
- for a := biniplist_getcount(l)-1 downto 0 do begin
- ip := biniplist_get(l,a);
- if not comparebinipmask(ip,ipmask_global,3) then continue;
- if comparebinipmask(ip,ipmask_teredo,32) then continue;
- if comparebinipmask(ip,ipmask_6to4,16) then continue;
- useaf := useaf_preferv6;
- preferredmodeinited := true;
- exit;
- end;
- end;
-
- {$endif}
-
-
- { quick and dirty description of dns packet structure to aid writing and
- understanding of parser code, refer to appropriate RFCs for proper specs
- - all words are network order
-
- www.google.com A request:
-
- 0, 2: random transaction ID
- 2, 2: flags: only the "recursion desired" bit set. (bit 8 of word)
- 4, 2: questions: 1
- 6, 2: answer RR's: 0.
- 8, 2: authority RR's: 0.
- 10, 2: additional RR's: 0.
- 12, n: payload:
- query:
- #03 "www" #06 "google" #03 "com" #00
- size-4, 2: type: host address (1)
- size-2, 2: class: inet (1)
-
- reply:
-
- 0,2: random transaction ID
- 2,2: flags: set: response (bit 15), recursion desired (8), recursion available (7)
- 4,4: questions: 1
- 6,4: answer RR's: 2
- 8,4: authority RR's: 9
- 10,4: additional RR's: 9
- 12: payload:
- query:
- ....
- answer: CNAME
- 0,2 "c0 0c" "name: www.google.com"
- 2,2 "00 05" "type: cname for an alias"
- 4,2 "00 01" "class: inet"
- 6,4: TTL
- 10,2: data length "00 17" (23)
- 12: the cname name (www.google.akadns.net)
- answer: A
- 0,2 ..
- 2,2 "00 01" host address
- 4,2 ...
- 6,4 ...
- 10,2: data length (4)
- 12,4: binary IP
- authority - 9 records
- additional - 9 records
-
-
- ipv6 AAAA reply:
- 0,2: ...
- 2,2: type: 001c
- 4,2: class: inet (0001)
- 6,2: TTL
- 10,2: data size (16)
- 12,16: binary IP
-
- ptr request: query type 000c
-
- name compression: word "cxxx" in the name, xxx points to offset in the packet}
-
- end.
|