X-Git-Url: http://www.lcore.org/git/lcore.git/blobdiff_plain/055fa6bf18e0733d1bf2f97075d6bb33c76e72b5..560d0547386a23a8fb79d1919d60dfdd04b49f62:/dnscore.pas diff --git a/dnscore.pas b/dnscore.pas index 4cb52e2..ac985e6 100644 --- a/dnscore.pas +++ b/dnscore.pas @@ -6,12 +6,12 @@ { 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). + developers will probably want to use dnsasync or dnssync or write a similar + wrapper unit of their 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. + relevant state manually. call state_process which will do processing on the information in the state and return an action @@ -20,7 +20,7 @@ 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) + action_done means the request has completed (either succeeded 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. @@ -28,29 +28,46 @@ 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 + once the app gets action_done it can determine success 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) + be zeroed out (easily 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 + 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 + 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. + so if an application prefers IPv6 but wants IPv4 results as well it must + check them separately. 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. + can be used to clean these up if required. - callers may use setstate_failure to mark the state as failed themseleves + callers may use setstate_failure to mark the state as failed themselves before passing it on to other code, for example this may be done in the event of a timeout. + + + hosts file support: + + code is here to do hosts file lookups. this is not done automatically by + dnscore, the caller (this is dnssync and dnsasync) has to call the hosts file + functions if it wants hosts file lookups. + + the current implementation will automatically periodically reload the file into + a fast lookup cache if the file changed. + + both forward and reverse lookups are supported. + + a single IP having multiple hostnames, so "192.0.2.1 foo bar" is supported. + + local hostnames under the locally configured domain (so domain "example.org", + a "192.0.2.1 foo" entry causing "foo.example.org" to resolve) is not supported. } unit dnscore; @@ -62,7 +79,7 @@ interface uses binipstuff,classes,pgtypes,lcorernd; -var usewindns : boolean = {$ifdef win32}true{$else}false{$endif}; +var usewindns : boolean = {$ifdef mswindows}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). @@ -85,7 +102,7 @@ var useaf:integer = useaf_default; { (temporarily) use a different nameserver, regardless of the dnsserverlist } -var overridednsserver:string; +var overridednsserver:ansistring; const maxnamelength=127; @@ -106,7 +123,10 @@ const querytype_txt=16; querytype_spf=99; maxrecursion=50; - maxrrofakind=20; + maxrrofakind=32; + {the maximum number of RR of a kind of purely an extra sanity check and could be omitted. + before, i set it to 20, but valid replies can have more. dnscore only does udp requests, + and ordinary DNS, so up to 512 bytes. the maximum number of A records that fits seems to be 29} 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) @@ -125,16 +145,16 @@ type tdnsstate=record id:word; recursioncount:integer; - queryname:string; + queryname:ansistring; requesttype:word; parsepacket:boolean; - resultstr:string; + resultstr:ansistring; resultbin:tbinip; resultlist:tbiniplist; resultaction:integer; numrr1:array[0..3] of integer; numrr2:integer; - rrdata:string; + rrdata:ansistring; sendpacketlen:integer; sendpacket:tdnspacket; recvpacketlen:integer; @@ -159,26 +179,26 @@ type end; //commenting out functions from interface that do not have documented semantics -//and probablly should not be called from outside this unit, reenable them +//and probably 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; +function makereversename(const binip:tbinip):ansistring; -procedure setstate_request_init(const name:string;var state:tdnsstate); +procedure setstate_request_init(const name:ansistring;var state:tdnsstate); -//set up state for a foward lookup. A family value of AF_INET6 will give only +//set up state for a forward 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_forward(const name:ansistring;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 setstate_custom(const name:ansistring; requesttype:integer; var state:tdnsstate); procedure state_process(var state:tdnsstate); @@ -188,14 +208,16 @@ procedure populatednsserverlist; procedure cleardnsservercache; var - dnsserverlist : tstringlist; + dnsserverlist : tbiniplist; + dnsserverlag:tlist; // 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; +function getcurrentsystemnameserver(var id:integer) :ansistring; +function getcurrentsystemnameserverbin(var id:integer) :tbinip; procedure reportlag(id:integer;lag:integer); //lag should be in microseconds and should be -1 to report a timeout //var @@ -204,7 +226,6 @@ procedure reportlag(id:integer;lag:integer); //lag should be in microseconds and {$ifdef ipv6} -function getv6localips:tbiniplist; procedure initpreferredmode; var @@ -213,22 +234,474 @@ var {$endif} var - failurereason:string; + failurereason:ansistring; -function getquerytype(s:string):integer; +function getquerytype(s:ansistring):integer; + +//optionally do any time consuming initing in advance, in case one wants the first dns lookup to be as fast as possible +procedure dnscore_preinit(alsoreverse:boolean); + +var + hostsfile_inited:boolean; + hostsfile_reverseinited:boolean; + hostsfile_filename:ansistring; //the app can change this, to use a custom hosts file + hostsfile_entries:tstringlist; + hostsfile_lastfileage:longint; //fileage is longint on freepascal, integer on delphi + hostsfile_lastcheckts:integer; + hostsfile_reverseentries:tstringlist; + + //parameter settings + hostsfile_disabled:boolean; //the app can set this to disable all hosts file lookup functionality, including localhost + hostsfile_onlylocalhost:boolean; //the app can set this to disable the hosts file but keep localhost + hostsfile_alsocustomserver:boolean; //the app can set this to use hosts file functionality even when a custom nameserver is set + hostsfile_manualreload:boolean; //don't check if the hosts file changed and auto reload it, the app can call hostsfile_reload to reload + +procedure hostsfile_init; +procedure hostsfile_initreverse; +procedure hostsfile_reload; +procedure hostsfile_reloadifneeded; +procedure hostsfile_add(const name:ansistring;const ip:tbinip); +function hostsfile_forwardlookuplist(const name:ansistring):tbiniplist; +function hostsfile_reverselookup(ip:tbinip):ansistring; +function gethostsfilename:ansistring; implementation uses - {$ifdef win32} - windows, + {$ifdef mswindows}windows,{$endif} + {$ifdef unix}unix,{$endif} + lcorelocalips, + readtxt2, + ltimevalstuff, + sysutils; + +type + pbiniplist=^tbiniplist; + thostsfile_entry=record + l:tbiniplist; + end; + phostsfile_entry=^thostsfile_entry; + + thostsfile_reverseentry=record + name:ansistring; + end; + phostsfile_reverseentry=^thostsfile_reverseentry; + + +function hostsfile_findbyname(const name:ansistring):integer; +begin + if not hostsfile_entries.Find(name,result) then begin + if (copy(name,length(name),1) = '.') then begin + //if the name has a trailing dot, try to find without it + if not hostsfile_entries.Find(copy(name,1,length(name)-1),result) then result := -1; + end else begin + //if the name has no trailing dot, try to find with it + if not hostsfile_entries.Find(name + '.',result) then result := -1; + end; + end; +end; + + +function hostsfile_forwardlookuplist(const name:ansistring):tbiniplist; +var + index:integer; + l:tbiniplist; +begin + hostsfile_init; + index := hostsfile_findbyname(name); + + result := biniplist_new; + + if (index >= 0) then begin + l := phostsfile_entry(hostsfile_entries.objects[index]).l; + + {$ifdef ipv6} + if (useaf <> useaf_v6) and (useaf <> useaf_preferv6) then + {$endif} + begin + addipsoffamily(result,l,af_inet); + end; + {$ifdef ipv6} + if (useaf <> useaf_v4) then begin + addipsoffamily(result,l,af_inet6); + if (useaf = useaf_preferv6) then begin + addipsoffamily(result,l,af_inet); + end; + end; + {$endif} + end; +end; + +procedure hostsfile_clearreverse; +var + index:integer; +begin + for index := hostsfile_reverseentries.count-1 downto 0 do begin + phostsfile_reverseentry(hostsfile_reverseentries.objects[index]).name := ''; + dispose(phostsfile_reverseentry(hostsfile_reverseentries.objects[index])); + end; + hostsfile_reverseentries.clear; +end; + + +procedure hostsfile_initreverse; +var + index,index2:integer; + l:tbiniplist; + a,countbefore:integer; + ip:tbinip; + s:ansistring; + he:phostsfile_reverseentry; +begin + hostsfile_init; + if hostsfile_reverseinited then exit; + hostsfile_reverseinited := true; + + hostsfile_clearreverse; + + //build fast search table for reverse lookups + for index := hostsfile_entries.count-1 downto 0 do begin + l := phostsfile_entry(hostsfile_entries.objects[index]).l; + for a := biniplist_getcount(l)-1 downto 0 do begin + ip := biniplist_get(l,a); + s := ipbintostr(ip); + + countbefore := hostsfile_reverseentries.count; + index2 := hostsfile_reverseentries.Add(s); + if (hostsfile_reverseentries.count > countbefore) then begin + new(he); + hostsfile_reverseentries.objects[index2] := tobject(he); + he.name := hostsfile_entries[index]; + end; + + end; + end; +end; + +function hostsfile_reverselookup(ip:tbinip):ansistring; +var + index:integer; + s:ansistring; +begin + hostsfile_initreverse; + result := ''; + s := ipbintostr(ip); + + if hostsfile_reverseentries.find(s,index) then begin + result := phostsfile_reverseentry(hostsfile_reverseentries.objects[index]).name; + end; +end; + +procedure hostsfile_clear; +var + index:integer; +begin + for index := hostsfile_entries.count-1 downto 0 do begin + biniplist_free(phostsfile_entry(hostsfile_entries.objects[index]).l); + dispose(phostsfile_entry(hostsfile_entries.objects[index])); + end; + hostsfile_entries.clear; + + hostsfile_clearreverse; + + hostsfile_lastfileage := 0; + hostsfile_lastcheckts := 0; +end; + +procedure hostsfile_add(const name:ansistring;const ip:tbinip); +var + + a,index,countbefore:integer; + + ip2:tbinip; + he:phostsfile_entry; + l:tbiniplist; +begin + + countbefore := hostsfile_entries.count; + //add, with dupignore, will add it if it's not in the list. if it is in the list, it returns the index + //to know if it was added, see if the count went up. this saves on duplicate searches in the list, for speed + index := hostsfile_entries.add(name); + + if (hostsfile_entries.count > countbefore) then begin + // writeln('name newly added ',name,' ',ipbintostr(ip),' ',index); + + new(he); + hostsfile_entries.objects[index] := tobject(he); + he.l := biniplist_new; + //he.name := name; + end else begin + // writeln('name found ',name,' ',ipbintostr(ip),' ',index); + //search for IP match + + he := phostsfile_entry(hostsfile_entries.objects[index]); + l := he.l; + for a := biniplist_getcount(l)-1 downto 0 do begin + ip2 := biniplist_get(l,a); + if comparebinip(ip,ip2) then begin + // writeln('duplicate ip ',name,' ',ipbintostr(ip)); + exit; //duplicate + end; + end; + end; + //add it + biniplist_add(he.l,ip); +end; + + +function getts:integer; +{$ifdef mswindows} +begin + result := GetTickCount; +{$else} +var + temp:ttimeval; +begin + gettimemonotonic(temp); + result := ((temp.tv_usec div 1000) + (temp.tv_sec * 1000)); +{$endif} +end; + + +function gethostsfilename:ansistring; +var +{$ifdef mswindows} + windir:array [0..255] of ansichar; + + GetSystemWindowsDirectoryA:function(buffer:pansichar;size:integer):integer; stdcall; + dllhandle:thandle; + OsVersion : TOSVersionInfo; +{$endif} + filenamesuffix:ansistring; +begin + {$ifdef mswindows} + + ZeroMemory(@OsVersion, SizeOf(OsVersion)); + OsVersion.dwOSVersionInfoSize := SizeOf(TOSVERSIONINFO); + + if ((GetVersionEx(OsVersion)) and (OsVersion.dwPlatformId = VER_PLATFORM_WIN32_NT)) then begin + filenamesuffix := '\system32\drivers\etc\hosts'; + end else begin + filenamesuffix := '\hosts'; + end; + + //first try "user" windows directory. on a multiuser this may not be c:\windows + GetWindowsDirectoryA(windir,255); + result := windir; + if (copy(result,length(result),1) = '\') then result := copy(result,1,length(result)-1); + result := result + filenamesuffix; + + if not fileexists(result) then begin + //then try "system" windows directory which is typically c:\windows on a multiuser system + dllhandle := loadlibrary('kernel32.dll'); + if (dllhandle <> 0) then begin + GetSystemWindowsDirectoryA := getprocaddress(dllhandle,'GetSystemWindowsDirectoryA'); + if assigned(GetSystemWindowsDirectoryA) then begin + GetSystemWindowsDirectoryA(windir,255); + freelibrary(dllhandle); + result := windir; + if (copy(result,length(result),1) = '\') then result := copy(result,1,length(result)-1); + result := result + filenamesuffix; + end; + end; + end; + + {$else} + result := '/etc/hosts'; + {$endif} +end; + +procedure hostsfile_reload; +label lineend; +var + t:treadtxt; + + validchar:array[0..255] of boolean; + ipv4char:array[0..255] of boolean; + s:ansistring; + ch:ansichar; + a,len,field,startindex,labellen:integer; + lastwasspace,onlyipv4chars:boolean; + ipstring,hostname:ansistring; + biniptemp:tbinip; +begin + hostsfile_clear; + + if hostsfile_disabled then exit; + hostsfile_reverseinited := false; + + //add builtin entries + hostsfile_add('localhost',ipstrtobinf('127.0.0.1')); + {$ifdef ipv6} + hostsfile_add('localhost',ipstrtobinf('::1')); {$endif} - sysutils; + if hostsfile_onlylocalhost then exit; + + if (hostsfile_filename = '') then hostsfile_filename := gethostsfilename; + + //DNS names can only contain lower and uppercase, digits, dash, and dot + fillchar(validchar,sizeof(validchar),0); + validchar[ord('.')] := true; + validchar[ord('-')] := true; + fillchar(validchar[48],10,1); + fillchar(validchar[65],26,1); + fillchar(validchar[97],26,1); + + //chars that can be in an ipv4 address: digits and dot + fillchar(ipv4char,sizeof(ipv4char),0); + ipv4char[ord('.')] := true; + fillchar(ipv4char[48],10,1); + + hostsfile_lastfileage := fileage(hostsfile_filename); + hostsfile_lastcheckts := getts; + //writeln('------ reloading ',hostsfile_lastfileage); + try + t := treadtxt.createf(hostsfile_filename); + except + exit; + end; + if not assigned(t) then exit; + + while not t.eof do begin + s := t.readline; + + len := length(s); + if (len > 512) then goto lineend; //sanity check + field := -1; + lastwasspace := true; + + onlyipv4chars := true; + + //one extra loop iteration at the end with a "pretend space" for easy parsing + inc(len); + ipstring := ''; + hostname := ''; + a := 0; + while (a <= len) do begin + inc(a); + if (a >= len) then ch := ' ' else ch := s[a]; + + if (ch = '#') then begin + //pretend the start of a comment is a space and the end of the line + ch := ' '; + len := a; + end; + + if (ch = #9) or (ch = ' ') then begin + if not (lastwasspace) then begin + if (field = 0) then begin + ipstring := copy(s,startindex,a - startindex); + end else if (field >= 1) then begin + //maximum length of hostname + if (a - startindex) > 253 then goto lineend; + + //remove a trailing dot + //if (labellen = 0) then dec(a); + + //hostname must not be an empty string + if (a - startindex) < 1 then goto lineend; + + hostname := copy(s,startindex,a - startindex); + + //reject a hosts entry with a name that is a valid ipv4 address. + //we don't need to check for ipv6 addresses because they have a colon and so aren't valid hostsnames + //the windows resolver does allow it, but i think it has potential security issues + if onlyipv4chars then if ipstrtobin(hostname,biniptemp) then goto lineend; + + if ipstrtobin(ipstring,biniptemp) then begin + //writeln('!!!hosts file adding ip=',ipstring,'@host=',hostname,'@'); + + hostsfile_add(hostname,biniptemp); + end; + + //break scan loop + //a := len; + end; + + end; + lastwasspace := true; + end else begin + if lastwasspace then begin + inc(field); + startindex := a; + lastwasspace := false; + labellen := 0; + end; + //enforce valid characters in hostname + if (field = 1) then begin + if not validchar[ord(ch)] then goto lineend; + onlyipv4chars := onlyipv4chars and ipv4char[ord(ch)]; + if (ch = '.') then begin + if (labellen = 0) then goto lineend; + labellen := 0; + end else begin + inc(labellen); + if (labellen > 63) then goto lineend; + end; + end; + end; + end; +lineend: + end; + t.destroy; + +end; + + +procedure hostsfile_reloadifneeded; +var + ts:integer; +begin + if (hostsfile_disabled or hostsfile_onlylocalhost or hostsfile_manualreload) then exit; + if hostsfile_filename = '' then exit; + + ts := getts; + //writeln('reloadifneeded ts=',ts,' oldts=',hostsfile_lastcheckts); + if not ((ts > hostsfile_lastcheckts + 10000) or (ts < hostsfile_lastcheckts)) then exit; + + hostsfile_lastcheckts := ts; + + //writeln('reloadifneeded new=',fileage(hostsfile_filename),' old=',hostsfile_lastfileage); + if fileage(hostsfile_filename) = hostsfile_lastfileage then exit; + hostsfile_reload; +end; + +procedure hostsfile_init; +begin + //writeln('init ',hostsfile_inited); + if hostsfile_inited then begin + hostsfile_reloadifneeded; + exit; + end; + hostsfile_inited := true; + hostsfile_entries := tstringlist.create; + hostsfile_entries.casesensitive := false; + hostsfile_entries.sorted := true; + hostsfile_entries.duplicates := dupignore; + + hostsfile_reverseentries := tstringlist.create; + hostsfile_reverseentries.casesensitive := true; + hostsfile_reverseentries.sorted := true; + hostsfile_reverseentries.duplicates := dupignore; + + hostsfile_reload; +end; + +procedure dnscore_preinit(alsoreverse:boolean); +begin + {$ifdef ipv6} + initpreferredmode; + {$endif} + hostsfile_init; + populatednsserverlist; + randomdword; + if alsoreverse then hostsfile_initreverse; +end; -function getquerytype(s:string):integer; +function getquerytype(s:ansistring):integer; begin s := uppercase(s); result := 0; @@ -244,10 +717,10 @@ begin if (s = 'SPF') then result := querytype_spf; end; -function buildrequest(const name:string;var packet:tdnspacket;requesttype:word):integer; +function buildrequest(const name:ansistring;var packet:tdnspacket;requesttype:word):integer; var a,b:integer; - s:string; + s:ansistring; arr:array[0..sizeof(packet)-1] of byte absolute packet; begin { writeln('buildrequest: name: ',name);} @@ -289,9 +762,9 @@ begin arr[result-4] := requesttype shr 8; end; -function makereversename(const binip:tbinip):string; +function makereversename(const binip:tbinip):ansistring; var - name:string; + name:ansistring; a,b:integer; begin name := ''; @@ -323,10 +796,10 @@ 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; +function decodename(const packet:tdnspacket;len,start,recursion:integer;var numread:integer):ansistring; var arr:array[0..sizeof(packet)-1] of byte absolute packet; - s:string; + s:ansistring; a,b:integer; begin numread := 0; @@ -367,7 +840,7 @@ begin failurereason := 'decoding name: got out of range2'; exit; end; - result := result + char(arr[a]); + result := result + ansichar(arr[a]); end; inc(numread,b+1); @@ -385,7 +858,7 @@ end; {==============================================================================} -function getrawfromrr(const rrp:trrpointer;len:integer):string; +function getrawfromrr(const rrp:trrpointer;len:integer):ansistring; begin setlength(result,htons(trr(rrp.p^).datalen)); uniquestring(result); @@ -441,7 +914,7 @@ begin end; end; -procedure setstate_request_init(const name:string;var state:tdnsstate); +procedure setstate_request_init(const name:ansistring;var state:tdnsstate); begin {destroy things properly} state.resultstr := ''; @@ -452,7 +925,7 @@ begin state.parsepacket := false; end; -procedure setstate_forward(const name:string;var state:tdnsstate;family:integer); +procedure setstate_forward(const name:ansistring;var state:tdnsstate;family:integer); begin setstate_request_init(name,state); state.forwardfamily := family; @@ -468,7 +941,7 @@ begin state.requesttype := querytype_ptr; end; -procedure setstate_custom(const name:string; requesttype:integer; var state:tdnsstate); +procedure setstate_custom(const name:ansistring; requesttype:integer; var state:tdnsstate); begin setstate_request_init(name,state); state.requesttype := requesttype; @@ -504,7 +977,10 @@ begin 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; + if state.numrr1[a] > maxrrofakind then begin + failurereason := 'exceeded maximum RR of a kind'; + goto failure; + end; inc(state.numrr2,state.numrr1[a]); end; @@ -593,7 +1069,6 @@ recursed: 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'; @@ -606,132 +1081,59 @@ recursed: 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} + a:integer; begin - //result := ''; - if assigned(dnsserverlist) then begin - dnsserverlist.clear; + if assigned(dnsserverlag) then begin + dnsserverlag.clear; end else begin - dnsserverlist := tstringlist.Create; + dnsserverlag := tlist.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} + + dnsserverlist := getsystemdnsservers; + for a := biniplist_getcount(dnsserverlist)-1 downto 0 do dnsserverlag.Add(nil); end; procedure cleardnsservercache; begin - if assigned(dnsserverlist) then begin - dnsserverlist.destroy; - dnsserverlist := nil; + if assigned(dnsserverlag) then begin + dnsserverlag.destroy; + dnsserverlag := nil; + dnsserverlist := ''; end; end; -function getcurrentsystemnameserver(var id:integer):string; +function getcurrentsystemnameserverbin(var id:integer):tbinip; 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 + {override the name server choice here, instead of overriding it wherever it's called + setting ID to -1 causes it to be ignored in reportlag} + if (overridednsserver <> '') then begin + result := ipstrtobinf(overridednsserver); + if result.family <> 0 then begin + id := -1; + exit; + end; + end; - for counter := 1 to dnsserverlist.count-1 do begin - if taddrint(dnsserverlist.objects[counter]) < taddrint(dnsserverlist.objects[id]) then id := counter; + if not assigned(dnsserverlag) then populatednsserverlist; + if dnsserverlag.count=0 then raise exception.create('no dns servers available'); + id := 0; + if dnsserverlag.count >1 then begin + for counter := dnsserverlag.count-1 downto 1 do begin + if taddrint(dnsserverlag[counter]) < taddrint(dnsserverlag[id]) then id := counter; end; end; - result := dnsserverlist[id] + result := biniplist_get(dnsserverlist,id); +end; + +function getcurrentsystemnameserver(var id:integer):ansistring; +begin + result := ipbintostr(getcurrentsystemnameserverbin(id)); end; procedure reportlag(id:integer;lag:integer); //lag should be in microseconds and should be -1 to report a timeout @@ -739,80 +1141,30 @@ var counter : integer; temp : integer; begin - if (id < 0) or (id >= dnsserverlist.count) then exit; + if (id < 0) or (id >= dnsserverlag.count) then exit; if lag = -1 then lag := timeoutlag; - for counter := 0 to dnsserverlist.count-1 do begin - temp := taddrint(dnsserverlist.objects[counter]) *15; + for counter := 0 to dnsserverlag.count-1 do begin + temp := taddrint(dnsserverlag[counter]) *15; if counter=id then temp := temp + lag; - dnsserverlist.objects[counter] := tobject(temp div 16); + dnsserverlag[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; + + if (have_ipv6_connectivity) then + useaf := useaf_preferv6 + else + useaf := useaf_preferv4; + + preferredmodeinited := true; end; {$endif}