{\r
\r
code wanting to use this dns system should act as follows (note: app\r
- developers will probablly want to use dnsasync or dnssync or write a similar\r
- wrapper unit of thier own).\r
+ developers will probably want to use dnsasync or dnssync or write a similar\r
+ wrapper unit of their own).\r
\r
for normal lookups call setstate_forward or setstate_reverse to set up the\r
state, for more obscure lookups use setstate_request_init and fill in other\r
- relavent state manually.\r
+ relevant state manually.\r
\r
call state_process which will do processing on the information in the state\r
and return an action\r
action_sendpacket means that dnscore wants the code that calls it to send\r
the packet in sendpacket/sendpacketlen and then start (or go back to) listening\r
for\r
- action_done means the request has completed (either suceeded or failed)\r
+ action_done means the request has completed (either succeeded or failed)\r
\r
callers should resend the last packet they tried to send if they have not\r
been asked to send a new packet for more than some timeout value they choose.\r
following ways.\r
\r
on failure state.resultstr will be an empty string and state.resultbin will\r
- be zeroed out (easilly detected by the fact that it will have a family of 0)\r
+ be zeroed out (easily detected by the fact that it will have a family of 0)\r
\r
on success for a A or AAAA lookup state.resultstr will be an empty string\r
- and state.resultbin will contain the result (note: AAAA lookups require IPV6\r
+ and state.resultbin will contain the result (note: AAAA lookups require IPv6\r
enabled).\r
\r
- if an A lookup fails and the code is built with ipv6 enabled then the code\r
+ if an A lookup fails and the code is built with IPv6 enabled then the code\r
will return any AAAA records with the same name. The reverse does not apply\r
- so if an application preffers IPV6 but wants IPV4 results as well it must\r
- check them seperately.\r
+ so if an application prefers IPv6 but wants IPv4 results as well it must\r
+ check them separately.\r
\r
on success for any other type of lookup state.resultstr will be an empty\r
\r
note the state contains ansistrings, setstate_init with a null name parameter\r
- can be used to clean theese up if required.\r
+ can be used to clean these up if required.\r
\r
- callers may use setstate_failure to mark the state as failed themseleves\r
+ callers may use setstate_failure to mark the state as failed themselves\r
before passing it on to other code, for example this may be done in the event\r
of a timeout.\r
+\r
+\r
+ hosts file support:\r
+\r
+ code is here to do hosts file lookups. this is not done automatically by\r
+ dnscore, the caller (this is dnssync and dnsasync) has to call the hosts file\r
+ functions if it wants hosts file lookups.\r
+\r
+ the current implementation will automatically periodically reload the file into\r
+ a fast lookup cache if the file changed.\r
+\r
+ both forward and reverse lookups are supported.\r
+\r
+ a single IP having multiple hostnames, so "192.0.2.1 foo bar" is supported.\r
+\r
+ local hostnames under the locally configured domain (so domain "example.org",\r
+ a "192.0.2.1 foo" entry causing "foo.example.org" to resolve) is not supported.\r
}\r
unit dnscore;\r
\r
\r
uses binipstuff,classes,pgtypes,lcorernd;\r
\r
-var usewindns : boolean = {$ifdef win32}true{$else}false{$endif};\r
+var usewindns : boolean = {$ifdef mswindows}true{$else}false{$endif};\r
{hint to users of this unit that they should use windows dns instead.\r
May be disabled by applications if desired. (e.g. if setting a custom\r
dnsserverlist).\r
querytype_txt=16;\r
querytype_spf=99;\r
maxrecursion=50;\r
- maxrrofakind=20;\r
+ maxrrofakind=32;\r
+ {the maximum number of RR of a kind of purely an extra sanity check and could be omitted.\r
+ before, i set it to 20, but valid replies can have more. dnscore only does udp requests,\r
+ and ordinary DNS, so up to 512 bytes. the maximum number of A records that fits seems to be 29}\r
\r
retryafter=300000; //microseconds must be less than one second;\r
timeoutlag=1000000000; // penalty value to be treated as lag in the event of a timeout (microseconds)\r
end;\r
\r
//commenting out functions from interface that do not have documented semantics\r
-//and probablly should not be called from outside this unit, reenable them\r
+//and probably should not be called from outside this unit, reenable them\r
//if you must but please document them at the same time --plugwash\r
\r
//function buildrequest(const name:string;var packet:tdnspacket;requesttype:word):integer;\r
\r
procedure setstate_request_init(const name:ansistring;var state:tdnsstate);\r
\r
-//set up state for a foward lookup. A family value of AF_INET6 will give only\r
+//set up state for a forward lookup. A family value of AF_INET6 will give only\r
//ipv6 results. Any other value will give only ipv4 results\r
procedure setstate_forward(const name:ansistring;var state:tdnsstate;family:integer);\r
\r
procedure cleardnsservercache;\r
\r
var\r
- dnsserverlist : tstringlist;\r
+ dnsserverlist : tbiniplist;\r
+ dnsserverlag:tlist;\r
// currentdnsserverno : integer;\r
\r
\r
//id to the id of that nameserver. id should later be used to report how laggy\r
//the servers response was and if it was timed out.\r
function getcurrentsystemnameserver(var id:integer) :ansistring;\r
+function getcurrentsystemnameserverbin(var id:integer) :tbinip;\r
procedure reportlag(id:integer;lag:integer); //lag should be in microseconds and should be -1 to report a timeout\r
\r
//var\r
\r
\r
{$ifdef ipv6}\r
-function getv6localips:tbiniplist;\r
procedure initpreferredmode;\r
\r
var\r
\r
function getquerytype(s:ansistring):integer;\r
\r
+//optionally do any time consuming initing in advance, in case one wants the first dns lookup to be as fast as possible\r
+procedure dnscore_preinit(alsoreverse:boolean);\r
+\r
+var\r
+ hostsfile_inited:boolean;\r
+ hostsfile_reverseinited:boolean;\r
+ hostsfile_filename:ansistring; //the app can change this, to use a custom hosts file\r
+ hostsfile_entries:tstringlist;\r
+ hostsfile_lastfileage:longint; //fileage is longint on freepascal, integer on delphi\r
+ hostsfile_lastcheckts:integer;\r
+ hostsfile_reverseentries:tstringlist;\r
+\r
+ //parameter settings\r
+ hostsfile_disabled:boolean; //the app can set this to disable all hosts file lookup functionality, including localhost\r
+ hostsfile_onlylocalhost:boolean; //the app can set this to disable the hosts file but keep localhost\r
+ hostsfile_alsocustomserver:boolean; //the app can set this to use hosts file functionality even when a custom nameserver is set\r
+ hostsfile_manualreload:boolean; //don't check if the hosts file changed and auto reload it, the app can call hostsfile_reload to reload\r
+\r
+procedure hostsfile_init;\r
+procedure hostsfile_initreverse;\r
+procedure hostsfile_reload;\r
+procedure hostsfile_reloadifneeded;\r
+procedure hostsfile_add(const name:ansistring;const ip:tbinip);\r
+function hostsfile_forwardlookuplist(const name:ansistring):tbiniplist;\r
+function hostsfile_reverselookup(ip:tbinip):ansistring;\r
+function gethostsfilename:ansistring;\r
+\r
implementation\r
\r
uses\r
- {$ifdef win32}\r
- windows,winsock,\r
+ {$ifdef mswindows}windows,{$endif}\r
+ {$ifdef unix}unix,{$endif} \r
+ lcorelocalips,\r
+ readtxt2,\r
+ ltimevalstuff,\r
+ sysutils;\r
+\r
+type\r
+ pbiniplist=^tbiniplist;\r
+ thostsfile_entry=record\r
+ l:tbiniplist;\r
+ end;\r
+ phostsfile_entry=^thostsfile_entry;\r
+\r
+ thostsfile_reverseentry=record\r
+ name:ansistring;\r
+ end;\r
+ phostsfile_reverseentry=^thostsfile_reverseentry;\r
+\r
+\r
+function hostsfile_findbyname(const name:ansistring):integer;\r
+begin\r
+ if not hostsfile_entries.Find(name,result) then begin\r
+ if (copy(name,length(name),1) = '.') then begin\r
+ //if the name has a trailing dot, try to find without it\r
+ if not hostsfile_entries.Find(copy(name,1,length(name)-1),result) then result := -1;\r
+ end else begin\r
+ //if the name has no trailing dot, try to find with it\r
+ if not hostsfile_entries.Find(name + '.',result) then result := -1;\r
+ end;\r
+ end;\r
+end;\r
+\r
+\r
+function hostsfile_forwardlookuplist(const name:ansistring):tbiniplist;\r
+var\r
+ index:integer;\r
+ l:tbiniplist;\r
+begin\r
+ hostsfile_init;\r
+ index := hostsfile_findbyname(name);\r
+\r
+ result := biniplist_new;\r
+\r
+ if (index >= 0) then begin\r
+ l := phostsfile_entry(hostsfile_entries.objects[index]).l;\r
+\r
+ {$ifdef ipv6}\r
+ if (useaf <> useaf_v6) and (useaf <> useaf_preferv6) then\r
+ {$endif}\r
+ begin\r
+ addipsoffamily(result,l,af_inet);\r
+ end;\r
+ {$ifdef ipv6}\r
+ if (useaf <> useaf_v4) then begin\r
+ addipsoffamily(result,l,af_inet6);\r
+ if (useaf = useaf_preferv6) then begin\r
+ addipsoffamily(result,l,af_inet);\r
+ end;\r
+ end;\r
+ {$endif}\r
+ end;\r
+end;\r
+\r
+procedure hostsfile_clearreverse;\r
+var\r
+ index:integer;\r
+begin\r
+ for index := hostsfile_reverseentries.count-1 downto 0 do begin\r
+ phostsfile_reverseentry(hostsfile_reverseentries.objects[index]).name := '';\r
+ dispose(phostsfile_reverseentry(hostsfile_reverseentries.objects[index]));\r
+ end;\r
+ hostsfile_reverseentries.clear;\r
+end;\r
+\r
+\r
+procedure hostsfile_initreverse;\r
+var\r
+ index,index2:integer;\r
+ l:tbiniplist;\r
+ a,countbefore:integer;\r
+ ip:tbinip;\r
+ s:ansistring;\r
+ he:phostsfile_reverseentry;\r
+begin\r
+ hostsfile_init;\r
+ if hostsfile_reverseinited then exit;\r
+ hostsfile_reverseinited := true;\r
+\r
+ hostsfile_clearreverse;\r
+\r
+ //build fast search table for reverse lookups\r
+ for index := hostsfile_entries.count-1 downto 0 do begin\r
+ l := phostsfile_entry(hostsfile_entries.objects[index]).l;\r
+ for a := biniplist_getcount(l)-1 downto 0 do begin\r
+ ip := biniplist_get(l,a);\r
+ s := ipbintostr(ip);\r
+\r
+ countbefore := hostsfile_reverseentries.count;\r
+ index2 := hostsfile_reverseentries.Add(s);\r
+ if (hostsfile_reverseentries.count > countbefore) then begin\r
+ new(he);\r
+ hostsfile_reverseentries.objects[index2] := tobject(he);\r
+ he.name := hostsfile_entries[index];\r
+ end;\r
+\r
+ end;\r
+ end;\r
+end;\r
+\r
+function hostsfile_reverselookup(ip:tbinip):ansistring;\r
+var\r
+ index:integer;\r
+ s:ansistring;\r
+begin\r
+ hostsfile_initreverse;\r
+ result := '';\r
+ s := ipbintostr(ip);\r
+\r
+ if hostsfile_reverseentries.find(s,index) then begin\r
+ result := phostsfile_reverseentry(hostsfile_reverseentries.objects[index]).name;\r
+ end;\r
+end;\r
+\r
+procedure hostsfile_clear;\r
+var\r
+ index:integer;\r
+begin\r
+ for index := hostsfile_entries.count-1 downto 0 do begin\r
+ biniplist_free(phostsfile_entry(hostsfile_entries.objects[index]).l);\r
+ dispose(phostsfile_entry(hostsfile_entries.objects[index]));\r
+ end;\r
+ hostsfile_entries.clear;\r
+\r
+ hostsfile_clearreverse;\r
+\r
+ hostsfile_lastfileage := 0;\r
+ hostsfile_lastcheckts := 0;\r
+end;\r
+\r
+procedure hostsfile_add(const name:ansistring;const ip:tbinip);\r
+var\r
+\r
+ a,index,countbefore:integer;\r
+\r
+ ip2:tbinip;\r
+ he:phostsfile_entry;\r
+ l:tbiniplist;\r
+begin\r
+\r
+ countbefore := hostsfile_entries.count;\r
+ //add, with dupignore, will add it if it's not in the list. if it is in the list, it returns the index\r
+ //to know if it was added, see if the count went up. this saves on duplicate searches in the list, for speed\r
+ index := hostsfile_entries.add(name);\r
+\r
+ if (hostsfile_entries.count > countbefore) then begin\r
+ // writeln('name newly added ',name,' ',ipbintostr(ip),' ',index);\r
+\r
+ new(he);\r
+ hostsfile_entries.objects[index] := tobject(he);\r
+ he.l := biniplist_new;\r
+ //he.name := name;\r
+ end else begin\r
+ // writeln('name found ',name,' ',ipbintostr(ip),' ',index);\r
+ //search for IP match\r
+\r
+ he := phostsfile_entry(hostsfile_entries.objects[index]);\r
+ l := he.l;\r
+ for a := biniplist_getcount(l)-1 downto 0 do begin\r
+ ip2 := biniplist_get(l,a);\r
+ if comparebinip(ip,ip2) then begin\r
+ // writeln('duplicate ip ',name,' ',ipbintostr(ip));\r
+ exit; //duplicate\r
+ end;\r
+ end;\r
+ end;\r
+ //add it\r
+ biniplist_add(he.l,ip);\r
+end;\r
+\r
+\r
+function getts:integer;\r
+{$ifdef mswindows}\r
+begin\r
+ result := GetTickCount;\r
+{$else}\r
+var\r
+ temp:ttimeval;\r
+begin\r
+ gettimemonotonic(temp);\r
+ result := ((temp.tv_usec div 1000) + (temp.tv_sec * 1000));\r
+{$endif}\r
+end;\r
+\r
+\r
+function gethostsfilename:ansistring;\r
+var\r
+{$ifdef mswindows}\r
+ windir:array [0..255] of ansichar;\r
+\r
+ GetSystemWindowsDirectoryA:function(buffer:pansichar;size:integer):integer; stdcall;\r
+ dllhandle:thandle;\r
+ OsVersion : TOSVersionInfo;\r
+{$endif}\r
+ filenamesuffix:ansistring;\r
+begin\r
+ {$ifdef mswindows}\r
+\r
+ ZeroMemory(@OsVersion, SizeOf(OsVersion));\r
+ OsVersion.dwOSVersionInfoSize := SizeOf(TOSVERSIONINFO);\r
+\r
+ if ((GetVersionEx(OsVersion)) and (OsVersion.dwPlatformId = VER_PLATFORM_WIN32_NT)) then begin\r
+ filenamesuffix := '\system32\drivers\etc\hosts';\r
+ end else begin\r
+ filenamesuffix := '\hosts';\r
+ end;\r
+\r
+ //first try "user" windows directory. on a multiuser this may not be c:\windows\r
+ GetWindowsDirectoryA(windir,255);\r
+ result := windir;\r
+ if (copy(result,length(result),1) = '\') then result := copy(result,1,length(result)-1);\r
+ result := result + filenamesuffix;\r
+\r
+ if not fileexists(result) then begin\r
+ //then try "system" windows directory which is typically c:\windows on a multiuser system\r
+ dllhandle := loadlibrary('kernel32.dll');\r
+ if (dllhandle <> 0) then begin\r
+ GetSystemWindowsDirectoryA := getprocaddress(dllhandle,'GetSystemWindowsDirectoryA');\r
+ if assigned(GetSystemWindowsDirectoryA) then begin\r
+ GetSystemWindowsDirectoryA(windir,255);\r
+ freelibrary(dllhandle);\r
+ result := windir;\r
+ if (copy(result,length(result),1) = '\') then result := copy(result,1,length(result)-1);\r
+ result := result + filenamesuffix;\r
+ end;\r
+ end;\r
+ end;\r
+\r
+ {$else}\r
+ result := '/etc/hosts';\r
+ {$endif}\r
+end;\r
+\r
+procedure hostsfile_reload;\r
+label lineend;\r
+var\r
+ t:treadtxt;\r
+\r
+ validchar:array[0..255] of boolean;\r
+ ipv4char:array[0..255] of boolean;\r
+ s:ansistring;\r
+ ch:ansichar;\r
+ a,len,field,startindex,labellen:integer;\r
+ lastwasspace,onlyipv4chars:boolean;\r
+ ipstring,hostname:ansistring;\r
+ biniptemp:tbinip;\r
+begin\r
+ hostsfile_clear;\r
+\r
+ if hostsfile_disabled then exit;\r
+ hostsfile_reverseinited := false;\r
+\r
+ //add builtin entries\r
+ hostsfile_add('localhost',ipstrtobinf('127.0.0.1'));\r
+ {$ifdef ipv6}\r
+ hostsfile_add('localhost',ipstrtobinf('::1'));\r
{$endif}\r
\r
- sysutils;\r
+ if hostsfile_onlylocalhost then exit;\r
+\r
+ if (hostsfile_filename = '') then hostsfile_filename := gethostsfilename;\r
+\r
+ //DNS names can only contain lower and uppercase, digits, dash, and dot\r
+ fillchar(validchar,sizeof(validchar),0);\r
+ validchar[ord('.')] := true;\r
+ validchar[ord('-')] := true;\r
+ fillchar(validchar[48],10,1);\r
+ fillchar(validchar[65],26,1);\r
+ fillchar(validchar[97],26,1);\r
+\r
+ //chars that can be in an ipv4 address: digits and dot\r
+ fillchar(ipv4char,sizeof(ipv4char),0);\r
+ ipv4char[ord('.')] := true;\r
+ fillchar(ipv4char[48],10,1);\r
+\r
+ hostsfile_lastfileage := fileage(hostsfile_filename);\r
+ hostsfile_lastcheckts := getts;\r
+ //writeln('------ reloading ',hostsfile_lastfileage);\r
+ try\r
+ t := treadtxt.createf(hostsfile_filename);\r
+ except\r
+ exit;\r
+ end;\r
+ if not assigned(t) then exit;\r
+\r
+ while not t.eof do begin\r
+ s := t.readline;\r
+\r
+ len := length(s);\r
+ if (len > 512) then goto lineend; //sanity check\r
+ field := -1;\r
+ lastwasspace := true;\r
+\r
+ onlyipv4chars := true;\r
+\r
+ //one extra loop iteration at the end with a "pretend space" for easy parsing\r
+ inc(len);\r
+ ipstring := '';\r
+ hostname := '';\r
+ a := 0;\r
+ while (a <= len) do begin\r
+ inc(a);\r
+ if (a >= len) then ch := ' ' else ch := s[a];\r
+\r
+ if (ch = '#') then begin\r
+ //pretend the start of a comment is a space and the end of the line\r
+ ch := ' ';\r
+ len := a;\r
+ end;\r
+\r
+ if (ch = #9) or (ch = ' ') then begin\r
+ if not (lastwasspace) then begin\r
+ if (field = 0) then begin\r
+ ipstring := copy(s,startindex,a - startindex);\r
+ end else if (field >= 1) then begin\r
+ //maximum length of hostname\r
+ if (a - startindex) > 253 then goto lineend;\r
+\r
+ //remove a trailing dot\r
+ //if (labellen = 0) then dec(a);\r
\r
+ //hostname must not be an empty string\r
+ if (a - startindex) < 1 then goto lineend;\r
+\r
+ hostname := copy(s,startindex,a - startindex);\r
+\r
+ //reject a hosts entry with a name that is a valid ipv4 address.\r
+ //we don't need to check for ipv6 addresses because they have a colon and so aren't valid hostsnames\r
+ //the windows resolver does allow it, but i think it has potential security issues\r
+ if onlyipv4chars then if ipstrtobin(hostname,biniptemp) then goto lineend;\r
+\r
+ if ipstrtobin(ipstring,biniptemp) then begin\r
+ //writeln('!!!hosts file adding ip=',ipstring,'@host=',hostname,'@');\r
+\r
+ hostsfile_add(hostname,biniptemp);\r
+ end;\r
+\r
+ //break scan loop\r
+ //a := len;\r
+ end;\r
+\r
+ end;\r
+\r
+ lastwasspace := true;\r
+ end else begin\r
+ if lastwasspace then begin\r
+ inc(field);\r
+ startindex := a;\r
+ lastwasspace := false;\r
+ labellen := 0;\r
+ end;\r
+ //enforce valid characters in hostname\r
+ if (field = 1) then begin\r
+ if not validchar[ord(ch)] then goto lineend;\r
+ onlyipv4chars := onlyipv4chars and ipv4char[ord(ch)];\r
+ if (ch = '.') then begin\r
+ if (labellen = 0) then goto lineend;\r
+ labellen := 0;\r
+ end else begin\r
+ inc(labellen);\r
+ if (labellen > 63) then goto lineend;\r
+ end;\r
+ end;\r
+ end;\r
+ end;\r
+lineend:\r
+ end;\r
+ t.destroy;\r
+\r
+end;\r
+\r
+\r
+procedure hostsfile_reloadifneeded;\r
+var\r
+ ts:integer;\r
+begin\r
+ if (hostsfile_disabled or hostsfile_onlylocalhost or hostsfile_manualreload) then exit;\r
+ if hostsfile_filename = '' then exit;\r
+\r
+ ts := getts;\r
+ //writeln('reloadifneeded ts=',ts,' oldts=',hostsfile_lastcheckts);\r
+ if not ((ts > hostsfile_lastcheckts + 10000) or (ts < hostsfile_lastcheckts)) then exit;\r
+\r
+ hostsfile_lastcheckts := ts;\r
+\r
+ //writeln('reloadifneeded new=',fileage(hostsfile_filename),' old=',hostsfile_lastfileage);\r
+ if fileage(hostsfile_filename) = hostsfile_lastfileage then exit;\r
+ hostsfile_reload;\r
+end;\r
+\r
+procedure hostsfile_init;\r
+begin\r
+ //writeln('init ',hostsfile_inited);\r
+ if hostsfile_inited then begin\r
+ hostsfile_reloadifneeded;\r
+ exit;\r
+ end;\r
+ hostsfile_inited := true;\r
+ hostsfile_entries := tstringlist.create;\r
+ hostsfile_entries.casesensitive := false;\r
+ hostsfile_entries.sorted := true;\r
+ hostsfile_entries.duplicates := dupignore;\r
+\r
+ hostsfile_reverseentries := tstringlist.create;\r
+ hostsfile_reverseentries.casesensitive := true;\r
+ hostsfile_reverseentries.sorted := true;\r
+ hostsfile_reverseentries.duplicates := dupignore;\r
+\r
+ hostsfile_reload;\r
+end;\r
+\r
+procedure dnscore_preinit(alsoreverse:boolean);\r
+begin\r
+ {$ifdef ipv6}\r
+ initpreferredmode;\r
+ {$endif}\r
+ hostsfile_init;\r
+ populatednsserverlist;\r
+ randomdword;\r
+ if alsoreverse then hostsfile_initreverse;\r
+end;\r
\r
\r
function getquerytype(s:ansistring):integer;\r
state.numrr2 := 0;\r
for a := 0 to 3 do begin\r
state.numrr1[a] := htons(state.recvpacket.rrcount[a]);\r
- if state.numrr1[a] > maxrrofakind then goto failure;\r
+ if state.numrr1[a] > maxrrofakind then begin\r
+ failurereason := 'exceeded maximum RR of a kind';\r
+ goto failure;\r
+ end;\r
inc(state.numrr2,state.numrr1[a]);\r
end;\r
\r
goto failure;\r
end;\r
\r
- {do /ets/hosts lookup here}\r
state.sendpacketlen := buildrequest(state.queryname,state.sendpacket,state.requesttype);\r
if state.sendpacketlen = 0 then begin\r
failurereason := 'building request packet failed';\r
failure:\r
setstate_failure(state);\r
end;\r
-{$ifdef win32}\r
- const\r
- MAX_HOSTNAME_LEN = 132;\r
- MAX_DOMAIN_NAME_LEN = 132;\r
- MAX_SCOPE_ID_LEN = 260 ;\r
- MAX_ADAPTER_NAME_LENGTH = 260;\r
- MAX_ADAPTER_ADDRESS_LENGTH = 8;\r
- MAX_ADAPTER_DESCRIPTION_LENGTH = 132;\r
- ERROR_BUFFER_OVERFLOW = 111;\r
- MIB_IF_TYPE_ETHERNET = 6;\r
- MIB_IF_TYPE_TOKENRING = 9;\r
- MIB_IF_TYPE_FDDI = 15;\r
- MIB_IF_TYPE_PPP = 23;\r
- MIB_IF_TYPE_LOOPBACK = 24;\r
- MIB_IF_TYPE_SLIP = 28;\r
-\r
-\r
- type\r
- tip_addr_string=packed record\r
- Next :pointer;\r
- IpAddress : array[0..15] of ansichar;\r
- ipmask : array[0..15] of ansichar;\r
- context : dword;\r
- end;\r
- pip_addr_string=^tip_addr_string;\r
- tFIXED_INFO=packed record\r
- HostName : array[0..MAX_HOSTNAME_LEN-1] of ansichar;\r
- DomainName : array[0..MAX_DOMAIN_NAME_LEN-1] of ansichar;\r
- currentdnsserver : pip_addr_string;\r
- dnsserverlist : tip_addr_string;\r
- nodetype : longint;\r
- ScopeId : array[0..MAX_SCOPE_ID_LEN + 4] of ansichar;\r
- enablerouting : longbool;\r
- enableproxy : longbool;\r
- enabledns : longbool;\r
- end;\r
- pFIXED_INFO=^tFIXED_INFO;\r
\r
- var\r
- iphlpapi : thandle;\r
- getnetworkparams : function(pFixedInfo : PFIXED_INFO;OutBufLen : plongint) : longint;stdcall;\r
-{$endif}\r
+\r
procedure populatednsserverlist;\r
var\r
- {$ifdef win32}\r
- fixed_info : pfixed_info;\r
- fixed_info_len : longint;\r
- currentdnsserver : pip_addr_string;\r
- {$else}\r
- t:textfile;\r
- s:ansistring;\r
- a:integer;\r
- {$endif}\r
+ a:integer;\r
begin\r
- //result := '';\r
- if assigned(dnsserverlist) then begin\r
- dnsserverlist.clear;\r
+ if assigned(dnsserverlag) then begin\r
+ dnsserverlag.clear;\r
end else begin\r
- dnsserverlist := tstringlist.Create;\r
+ dnsserverlag := tlist.Create;\r
end;\r
- {$ifdef win32}\r
- if iphlpapi=0 then iphlpapi := loadlibrary('iphlpapi.dll');\r
- if not assigned(getnetworkparams) then @getnetworkparams := getprocaddress(iphlpapi,'GetNetworkParams');\r
- if not assigned(getnetworkparams) then exit;\r
- fixed_info_len := 0;\r
- if GetNetworkParams(nil,@fixed_info_len)<>ERROR_BUFFER_OVERFLOW then exit;\r
- //fixed_info_len :=sizeof(tfixed_info);\r
- getmem(fixed_info,fixed_info_len);\r
- if GetNetworkParams(fixed_info,@fixed_info_len)<>0 then begin\r
- freemem(fixed_info);\r
- exit;\r
- end;\r
- currentdnsserver := @(fixed_info.dnsserverlist);\r
- while assigned(currentdnsserver) do begin\r
- dnsserverlist.Add(currentdnsserver.IpAddress);\r
- currentdnsserver := currentdnsserver.next;\r
- end;\r
- freemem(fixed_info);\r
- {$else}\r
- filemode := 0;\r
- assignfile(t,'/etc/resolv.conf');\r
- {$i-}reset(t);{$i+}\r
- if ioresult <> 0 then exit;\r
-\r
- while not eof(t) do begin\r
- readln(t,s);\r
- if not (copy(s,1,10) = 'nameserver') then continue;\r
- s := copy(s,11,500);\r
- while s <> '' do begin\r
- if (s[1] = #32) or (s[1] = #9) then s := copy(s,2,500) else break;\r
- end;\r
- a := pos(' ',s);\r
- if a <> 0 then s := copy(s,1,a-1);\r
- a := pos(#9,s);\r
- if a <> 0 then s := copy(s,1,a-1);\r
- //result := s;\r
- //if result <> '' then break;\r
- dnsserverlist.Add(s);\r
- end;\r
- close(t);\r
- {$endif}\r
+\r
+ dnsserverlist := getsystemdnsservers;\r
+ for a := biniplist_getcount(dnsserverlist)-1 downto 0 do dnsserverlag.Add(nil);\r
end;\r
\r
procedure cleardnsservercache;\r
begin\r
- if assigned(dnsserverlist) then begin\r
- dnsserverlist.destroy;\r
- dnsserverlist := nil;\r
+ if assigned(dnsserverlag) then begin\r
+ dnsserverlag.destroy;\r
+ dnsserverlag := nil;\r
+ dnsserverlist := '';\r
end;\r
end;\r
\r
-function getcurrentsystemnameserver(var id:integer):ansistring;\r
+function getcurrentsystemnameserverbin(var id:integer):tbinip;\r
var\r
counter : integer;\r
-\r
begin\r
- if not assigned(dnsserverlist) then populatednsserverlist;\r
- if dnsserverlist.count=0 then raise exception.create('no dns servers availible');\r
- id := 0;\r
- if dnsserverlist.count >1 then begin\r
+ {override the name server choice here, instead of overriding it wherever it's called\r
+ setting ID to -1 causes it to be ignored in reportlag}\r
+ if (overridednsserver <> '') then begin\r
+ result := ipstrtobinf(overridednsserver);\r
+ if result.family <> 0 then begin\r
+ id := -1;\r
+ exit;\r
+ end;\r
+ end;\r
\r
- for counter := 1 to dnsserverlist.count-1 do begin\r
- if taddrint(dnsserverlist.objects[counter]) < taddrint(dnsserverlist.objects[id]) then id := counter;\r
+ if not assigned(dnsserverlag) then populatednsserverlist;\r
+ if dnsserverlag.count=0 then raise exception.create('no dns servers available');\r
+ id := 0;\r
+ if dnsserverlag.count >1 then begin\r
+ for counter := dnsserverlag.count-1 downto 1 do begin\r
+ if taddrint(dnsserverlag[counter]) < taddrint(dnsserverlag[id]) then id := counter;\r
end;\r
end;\r
- result := dnsserverlist[id]\r
+ result := biniplist_get(dnsserverlist,id);\r
+end;\r
+\r
+function getcurrentsystemnameserver(var id:integer):ansistring;\r
+begin\r
+ result := ipbintostr(getcurrentsystemnameserverbin(id));\r
end;\r
\r
procedure reportlag(id:integer;lag:integer); //lag should be in microseconds and should be -1 to report a timeout\r
counter : integer;\r
temp : integer;\r
begin\r
- if (id < 0) or (id >= dnsserverlist.count) then exit;\r
+ if (id < 0) or (id >= dnsserverlag.count) then exit;\r
if lag = -1 then lag := timeoutlag;\r
- for counter := 0 to dnsserverlist.count-1 do begin\r
- temp := taddrint(dnsserverlist.objects[counter]) *15;\r
+ for counter := 0 to dnsserverlag.count-1 do begin\r
+ temp := taddrint(dnsserverlag[counter]) *15;\r
if counter=id then temp := temp + lag;\r
- dnsserverlist.objects[counter] := tobject(temp div 16);\r
+ dnsserverlag[counter] := tobject(temp div 16);\r
end;\r
\r
end;\r
\r
\r
-\r
{$ifdef ipv6}\r
\r
-{$ifdef linux}\r
-function getv6localips:tbiniplist;\r
-var\r
- t:textfile;\r
- s,s2:ansistring;\r
- ip:tbinip;\r
- a:integer;\r
-begin\r
- result := biniplist_new;\r
-\r
- assignfile(t,'/proc/net/if_inet6');\r
- {$i-}reset(t);{$i+}\r
- if ioresult <> 0 then exit; {none found, return empty list}\r
-\r
- while not eof(t) do begin\r
- readln(t,s);\r
- s2 := '';\r
- for a := 0 to 7 do begin\r
- if (s2 <> '') then s2 := s2 + ':';\r
- s2 := s2 + copy(s,(a shl 2)+1,4);\r
- end;\r
- ipstrtobin(s2,ip);\r
- if ip.family <> 0 then biniplist_add(result,ip);\r
- end;\r
- closefile(t);\r
-end;\r
-\r
-{$else}\r
-\r
-{the following code's purpose is to determine what IP windows would come from, to reach an IP\r
-it can be abused to find if there's any global v6 IPs, getaddrinfo seems unreliable (not working on XP atleast)\r
-}\r
-const\r
- SIO_ROUTING_INTERFACE_QUERY = $c8000014;\r
- function WSAIoctl(s: TSocket; code:integer; const Buf; len: Integer; var output; outlen:integer; var outreturned: Integer; overlapped:pointer; completion: pointer): Integer; stdcall; external 'ws2_32.dll' name 'WSAIoctl';\r
-\r
-function getlocalipforip(const ip:tbinip):tbinip;\r
-var\r
- handle:integer;\r
- a,b:integer;\r
- inaddrv,inaddrv2:tinetsockaddrv;\r
- srcx:winsock.tsockaddr absolute inaddrv2;\r
-begin\r
- makeinaddrv(ip,'0',inaddrv);\r
- handle := Socket(inaddrv.inaddr.family,SOCK_DGRAM,IPPROTO_UDP);\r
- if WSAIoctl(handle, SIO_ROUTING_INTERFACE_QUERY, inaddrv, sizeof(inaddrv), inaddrv2, sizeof(inaddrv2), a, nil, nil) <> 0\r
- then raise exception.create('getlocalipforip failed with error: '+inttostr(wsagetlasterror));\r
- result := inaddrvtobinip(inaddrv2);\r
- closesocket(handle);\r
-end;\r
-\r
-function getv6localips:tbiniplist;\r
-begin\r
- result := biniplist_new;\r
- {this IP is chosen because it's the first normal global v6 IP that has no special purpose}\r
- biniplist_add(result,getlocalipforip(ipstrtobinf('2001:200::')));\r
-end;\r
-{$endif}\r
-\r
procedure initpreferredmode;\r
-var\r
- l:tbiniplist;\r
- a:integer;\r
- ip:tbinip;\r
- ipmask_global,ipmask_6to4,ipmask_teredo:tbinip;\r
-\r
begin\r
if preferredmodeinited then exit;\r
if useaf <> useaf_default then exit;\r
- l := getv6localips;\r
- if biniplist_getcount(l) = 0 then exit;\r
- useaf := useaf_preferv4;\r
- ipstrtobin('2000::',ipmask_global);\r
- ipstrtobin('2001::',ipmask_teredo);\r
- ipstrtobin('2002::',ipmask_6to4);\r
- {if there is any v6 IP which is globally routable and not 6to4 and not teredo, prefer v6}\r
- for a := biniplist_getcount(l)-1 downto 0 do begin\r
- ip := biniplist_get(l,a);\r
- if not comparebinipmask(ip,ipmask_global,3) then continue;\r
- if comparebinipmask(ip,ipmask_teredo,32) then continue;\r
- if comparebinipmask(ip,ipmask_6to4,16) then continue;\r
- useaf := useaf_preferv6;\r
- preferredmodeinited := true;\r
- exit;\r
- end;\r
+\r
+ if (have_ipv6_connectivity) then\r
+ useaf := useaf_preferv6\r
+ else\r
+ useaf := useaf_preferv4;\r
+\r
+ preferredmodeinited := true;\r
end;\r
\r
{$endif}\r
lcore.org gitweb / lcore.git / blobdiff