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
implementation\r
\r
uses\r
- {$ifdef win32}\r
- windows,winsock,\r
- {$endif}\r
-\r
+ lcorelocalips,\r
sysutils;\r
\r
\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 whereever 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 availible');\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
lcore.org gitweb / lcore.git / blobdiff