}\r
\r
unit lcorelocalips;\r
-\r
+{$ifdef fpc}\r
+ {$mode delphi}\r
+{$endif}\r
interface\r
\r
uses binipstuff,pgtypes;\r
\r
function getsystemdnsservers:tbiniplist;\r
\r
-{$ifdef win32}\r
-function gethostname:ansistring;\r
+function have_ipv6_connectivity:boolean;\r
+\r
+function lcgethostname:ansistring;\r
+\r
+{$ifdef mswindows}\r
+function getlocalipforip(const ip:tbinip):tbinip;\r
{$endif}\r
\r
+const\r
+ v6_check_ip='2001:200::'; //a globally routeable v6 IP that is used in "get local IP for IP" etc, it should never actually be communicated with.\r
+\r
implementation\r
\r
{$ifdef unix}\r
\r
uses\r
- baseunix,sockets,sysutils;\r
+ baseunix,unix,sockets,sysutils;\r
\r
\r
function getlocalips_internal(wantfamily:integer):tbiniplist;\r
const\r
IF_NAMESIZE=16;\r
- \r
+\r
{$ifdef linux}SIOCGIFCONF=$8912;{$endif}\r
{$ifdef bsd}{$ifdef cpu386}SIOCGIFCONF=$C0086924;{$endif}{$endif}\r
- \r
+\r
{amd64: mac OS X: $C00C6924; freeBSD: $c0106924}\r
type\r
tifconf=packed record\r
end;\r
closefile(t);\r
end;\r
-{$endif}\r
+{$endif} //ipv6\r
\r
function getv4localips:tbiniplist;\r
begin\r
{$endif}\r
end;\r
\r
-{$else}\r
+{$else} //unix\r
\r
uses\r
- sysutils,windows,winsock,dnssync,dnscore;\r
+ sysutils,windows,winsock,dnswin,registry;\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 on a local interface}\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
+ type tWSAIoctl=function(s: TSocket; code:integer; const Buf; len: Integer; var output; outlen:integer; var outreturned: Integer; overlapped:pointer; completion: pointer): Integer; stdcall;\r
\r
function getlocalipforip(const ip:tbinip):tbinip;\r
var\r
- handle:integer;\r
+ libraryhandle : hmodule;\r
+ WSAIoctl:tWSAIoctl;\r
+ handle:Tsocket;\r
a,b:integer;\r
inaddrv,inaddrv2:tinetsockaddrv;\r
srcx:winsock.tsockaddr absolute inaddrv2;\r
begin\r
+ libraryhandle := LoadLibraryA('Ws2_32.dll');\r
+ if (libraryhandle = 0) then raise exception.create('getlocalipforip: no winsock2');\r
+ WSAIoctl := getprocaddress(libraryhandle,'WSAIoctl');\r
+ handle := INVALID_SOCKET;\r
+ try\r
+ if not assigned(WSAIoctl) then raise exception.create('getlocalipforip: no winsock2 WSAIoctl');\r
+\r
makeinaddrv(ip,'0',inaddrv);\r
handle := Socket(inaddrv.inaddr.family,SOCK_DGRAM,IPPROTO_UDP);\r
- if (handle < 0) then begin\r
+ if (handle = INVALID_SOCKET) then begin\r
{this happens on XP without an IPv6 stack\r
i can either fail with an exception, or with a "null result". an exception is annoying in the IDE}\r
{fillchar(result,sizeof(result),0);\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
+ finally\r
+ if (handle <> INVALID_SOCKET) then closesocket(handle);\r
+ if (libraryhandle <> 0) then freelibrary(libraryhandle);\r
+ end;\r
end;\r
\r
\r
a:integer;\r
ip:tbinip;\r
usewindnstemp:boolean;\r
+ error:integer;\r
begin\r
- {this lookup must always be done with the windows API lookup\r
- setting usewindns to false on windows will fail with infinite recursion}\r
- usewindnstemp := usewindns;\r
- usewindns := true;\r
- result := forwardlookuplist('',0);\r
- usewindns := usewindnstemp;\r
+ result := winforwardlookuplist(lcgethostname,0,error);\r
\r
{$ifdef ipv6}\r
\r
end;\r
\r
try\r
- ip := getlocalipforip(ipstrtobinf('2001:200::'));\r
+ ip := getlocalipforip(ipstrtobinf(v6_check_ip));\r
if (ip.family = AF_INET6) then biniplist_add(result,ip);\r
except\r
end;\r
\r
\r
\r
-{$ifdef win32}\r
+{$ifdef mswindows}\r
const\r
MAX_HOSTNAME_LEN = 132;\r
MAX_DOMAIN_NAME_LEN = 132;\r
begin\r
result := nil;\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
+\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
\r
function getsystemdnsservers:tbiniplist;\r
var\r
- {$ifdef win32}\r
+ {$ifdef mswindows}\r
fixed_info : pfixed_info;\r
currentdnsserver : pip_addr_string;\r
+ reg:Tregistry;\r
+ nameserver,s:ansistring;\r
+ a:integer;\r
{$else}\r
t:textfile;\r
s:ansistring;\r
\r
result := biniplist_new;\r
\r
- {$ifdef win32}\r
+ {$ifdef mswindows}\r
fixed_info := callgetnetworkparams;\r
- if fixed_info = nil then exit;\r
+ if fixed_info = nil then begin\r
+ //2000 and up method not supported. use the 9x or NT 4 method.\r
+ nameserver := '';\r
+ reg := TRegistry.Create();\r
+ reg.RootKey := HKEY_LOCAL_MACHINE;\r
+ //9x\r
+ if not reg.OpenKey('\System\CurrentControlSet\Services\VxD\MSTCP',false) then\r
+ //NT\r
+ if not reg.OpenKey('\System\CurrentControlSet\Services\Tcpip\Parameters',false) then begin\r
+ reg.destroy;\r
+ exit;\r
+ end;\r
+\r
+ nameserver := reg.ReadString('NameServer');\r
+ //DhcpNameServer is actually only set on NT\r
+ if (nameserver = '') then nameserver := reg.ReadString('DhcpNameServer');\r
+\r
+ reg.destroy;\r
+\r
+ //parse as comma separated list\r
+ repeat\r
+ if (nameserver = '') then exit; //done\r
+ a := pos(',',nameserver);\r
+ if (a > 1) then begin\r
+ s := copy(nameserver,1,a-1);\r
+ nameserver := copy(nameserver,a+1,9999);\r
+ end else begin\r
+ s := nameserver;\r
+ nameserver := '';\r
+ end;\r
+ s := trim(s);\r
+ ip := ipstrtobinf(s);\r
+ if (ip.family <> 0) then biniplist_add(result,ip);\r
+ until false;\r
+ end;\r
\r
currentdnsserver := @(fixed_info.dnsserverlist);\r
while assigned(currentdnsserver) do begin\r
{$endif}\r
end;\r
\r
-{$ifdef win32}\r
-function gethostname:ansistring;\r
+\r
+function have_ipv6_connectivity:boolean;\r
var\r
- fixed_info : pfixed_info;\r
+ l:tbiniplist;\r
+ a:integer;\r
+ ip:tbinip;\r
+ ipmask_global,ipmask_6to4,ipmask_teredo:tbinip;\r
+\r
+function ip_is_suitable_v6:boolean;\r
begin\r
- result := '';\r
- fixed_info := callgetnetworkparams;\r
- if fixed_info = nil then exit;\r
+ result := false;\r
+ if (ip.family <> AF_INET6) then exit;\r
+ if not comparebinipmask(ip,ipmask_global,3) then exit;\r
+ if comparebinipmask(ip,ipmask_teredo,32) then exit;\r
+ if comparebinipmask(ip,ipmask_6to4,16) then exit;\r
+ result := true;\r
+end;\r
\r
- result := fixed_info.hostname;\r
- if fixed_info.domainname <> '' then result := result + '.'+fixed_info.domainname;\r
+begin\r
+ result := false;\r
\r
- freemem(fixed_info);\r
+ ipstrtobin('2000::',ipmask_global);\r
+ ipstrtobin('2001::',ipmask_teredo);\r
+ ipstrtobin('2002::',ipmask_6to4);\r
+\r
+ {$ifdef mswindows}\r
+ //better way on windows to check for ipv6 that works (returns no ipv6) if a v6 IP is assigned, but there is no connectivity\r
+ try\r
+ ip := getlocalipforip(ipstrtobinf(v6_check_ip));\r
+ if ip_is_suitable_v6 then result := true;\r
+ except\r
+ end;\r
+ {$else} {unix}\r
+\r
+ l := getv6localips;\r
+ if biniplist_getcount(l) = 0 then exit;\r
+\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 ip_is_suitable_v6 then continue;\r
+ result := true;\r
+ exit;\r
+ end;\r
+ {$endif}\r
+end;\r
+\r
+\r
+function lcgethostname:ansistring;\r
+{$ifdef mswindows}\r
+var\r
+ buf:array[0..255] of ansichar;\r
+ i:integer;\r
+begin\r
+ result := '';\r
+ fillchar(buf,sizeof(buf),0);\r
+ i := winsock.gethostname(@buf,sizeof(buf));\r
+ if (i = 0) then result := pansichar(@buf[0]);\r
+end;\r
+{$else}\r
+begin\r
+ result := unix.gethostname;\r
end;\r
{$endif}\r
\r
lcore.org gitweb / lcore.git / blobdiff