X-Git-Url: http://www.lcore.org/git/lcore.git/blobdiff_plain/85edf7ed5948e0efe59301680f79ea0bac4367e8..560d0547386a23a8fb79d1919d60dfdd04b49f62:/lcorelocalips.pas?ds=inline

diff --git a/lcorelocalips.pas b/lcorelocalips.pas
index edd306c..453ce81 100644
--- a/lcorelocalips.pas
+++ b/lcorelocalips.pas
@@ -53,25 +53,32 @@ function getv6localips:tbiniplist;
 
 function getsystemdnsservers:tbiniplist;
 
+function have_ipv6_connectivity:boolean;
+
+function lcgethostname:ansistring;
+
 {$ifdef mswindows}
-function gethostname:ansistring;
+function getlocalipforip(const ip:tbinip):tbinip;
 {$endif}
 
+const
+  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.
+
 implementation
 
 {$ifdef unix}
 
 uses
-  baseunix,sockets,sysutils;
+  baseunix,unix,sockets,sysutils;
 
 
 function getlocalips_internal(wantfamily:integer):tbiniplist;
 const
   IF_NAMESIZE=16;
-  
+
   {$ifdef linux}SIOCGIFCONF=$8912;{$endif}
   {$ifdef bsd}{$ifdef cpu386}SIOCGIFCONF=$C0086924;{$endif}{$endif}
-  
+
   {amd64: mac OS X: $C00C6924; freeBSD: $c0106924}
 type
   tifconf=packed record
@@ -172,7 +179,7 @@ begin
   end;
   closefile(t);
 end;
-{$endif}
+{$endif}    //ipv6
 
 function getv4localips:tbiniplist;
 begin
@@ -187,27 +194,36 @@ begin
   {$endif}
 end;
 
-{$else}
+{$else}   //unix
 
 uses
-  sysutils,windows,winsock,dnswin;
+  sysutils,windows,winsock,dnswin,registry;
 
 {the following code's purpose is to determine what IP windows would come from, to reach an IP
 it can be abused to find if there's any global v6 IPs on a local interface}
 const
   SIO_ROUTING_INTERFACE_QUERY = $c8000014;
-  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';
+  type tWSAIoctl=function(s: TSocket; code:integer; const Buf; len: Integer; var output; outlen:integer; var outreturned: Integer; overlapped:pointer; completion: pointer): Integer; stdcall;
 
 function getlocalipforip(const ip:tbinip):tbinip;
 var
-  handle:integer;
+  libraryhandle : hmodule;
+  WSAIoctl:tWSAIoctl;
+  handle:Tsocket;
   a,b:integer;
   inaddrv,inaddrv2:tinetsockaddrv;
   srcx:winsock.tsockaddr absolute inaddrv2;
 begin
+  libraryhandle := LoadLibraryA('Ws2_32.dll');
+  if (libraryhandle = 0) then raise exception.create('getlocalipforip: no winsock2');
+  WSAIoctl := getprocaddress(libraryhandle,'WSAIoctl');
+  handle := INVALID_SOCKET;
+ try
+  if not assigned(WSAIoctl) then raise exception.create('getlocalipforip: no winsock2 WSAIoctl');
+
   makeinaddrv(ip,'0',inaddrv);
   handle := Socket(inaddrv.inaddr.family,SOCK_DGRAM,IPPROTO_UDP);
-  if (handle < 0) then begin
+  if (handle = INVALID_SOCKET) then begin
     {this happens on XP without an IPv6 stack
     i can either fail with an exception, or with a "null result". an exception is annoying in the IDE}
     {fillchar(result,sizeof(result),0);
@@ -217,7 +233,10 @@ begin
   if WSAIoctl(handle, SIO_ROUTING_INTERFACE_QUERY, inaddrv, sizeof(inaddrv), inaddrv2, sizeof(inaddrv2), a, nil, nil) <> 0
   then raise exception.create('getlocalipforip failed with error: '+inttostr(wsagetlasterror));
   result := inaddrvtobinip(inaddrv2);
-  closesocket(handle);
+ finally
+  if (handle <> INVALID_SOCKET) then closesocket(handle);
+  if (libraryhandle <> 0) then freelibrary(libraryhandle);
+ end;
 end;
 
 
@@ -260,7 +279,7 @@ var
   usewindnstemp:boolean;
   error:integer;
 begin
-  result := winforwardlookuplist('',0,error);
+  result := winforwardlookuplist(lcgethostname,0,error);
 
   {$ifdef ipv6}
 
@@ -272,7 +291,7 @@ begin
   end;
 
   try
-    ip := getlocalipforip(ipstrtobinf('2001:200::'));
+    ip := getlocalipforip(ipstrtobinf(v6_check_ip));
     if (ip.family = AF_INET6) then biniplist_add(result,ip);
   except
   end;
@@ -335,8 +354,9 @@ var
 begin
   result := nil;
   if iphlpapi=0 then iphlpapi := loadlibrary('iphlpapi.dll');
-    if not assigned(getnetworkparams) then @getnetworkparams := getprocaddress(iphlpapi,'GetNetworkParams');
-    if not assigned(getnetworkparams) then exit;
+
+  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);
@@ -355,6 +375,9 @@ var
   {$ifdef mswindows}
     fixed_info : pfixed_info;
     currentdnsserver : pip_addr_string;
+    reg:Tregistry;
+    nameserver,s:ansistring;
+    a:integer;
   {$else}
     t:textfile;
     s:ansistring;
@@ -368,7 +391,41 @@ begin
 
   {$ifdef mswindows}
     fixed_info := callgetnetworkparams;
-    if fixed_info = nil then exit;
+    if fixed_info = nil then begin
+      //2000 and up method not supported. use the 9x or NT 4 method.
+      nameserver := '';
+      reg := TRegistry.Create();
+      reg.RootKey := HKEY_LOCAL_MACHINE;
+      //9x
+      if not reg.OpenKey('\System\CurrentControlSet\Services\VxD\MSTCP',false) then
+      //NT
+      if not reg.OpenKey('\System\CurrentControlSet\Services\Tcpip\Parameters',false) then begin
+        reg.destroy;
+        exit;
+      end;
+
+      nameserver := reg.ReadString('NameServer');
+      //DhcpNameServer is actually only set on NT
+      if (nameserver = '') then nameserver := reg.ReadString('DhcpNameServer');
+
+      reg.destroy;
+
+      //parse as comma separated list
+      repeat
+        if (nameserver = '') then exit; //done
+        a := pos(',',nameserver);
+        if (a > 1) then begin
+          s := copy(nameserver,1,a-1);
+          nameserver := copy(nameserver,a+1,9999);
+        end else begin
+          s := nameserver;
+          nameserver := '';
+        end;
+        s := trim(s);
+        ip := ipstrtobinf(s);
+        if (ip.family <> 0) then biniplist_add(result,ip);
+      until false;
+    end;
 
     currentdnsserver := @(fixed_info.dnsserverlist);
     while assigned(currentdnsserver) do begin
@@ -402,21 +459,69 @@ begin
   {$endif}
 end;
 
-{$ifdef mswindows}
-function gethostname:ansistring;
+
+function have_ipv6_connectivity:boolean;
 var
-    fixed_info : pfixed_info;
+  l:tbiniplist;
+  a:integer;
+  ip:tbinip;
+  ipmask_global,ipmask_6to4,ipmask_teredo:tbinip;
+
+function ip_is_suitable_v6:boolean;
 begin
-  result := '';
-    fixed_info := callgetnetworkparams;
-    if fixed_info = nil then exit;
+  result := false;
+  if (ip.family <> AF_INET6) then exit;
+  if not comparebinipmask(ip,ipmask_global,3) then exit;
+  if comparebinipmask(ip,ipmask_teredo,32) then exit;
+  if comparebinipmask(ip,ipmask_6to4,16) then exit;
+  result := true;
+end;
 
-    result := fixed_info.hostname;
-    if fixed_info.domainname <> '' then result := result + '.'+fixed_info.domainname;
+begin
+  result := false;
 
-    freemem(fixed_info);
+  ipstrtobin('2000::',ipmask_global);
+  ipstrtobin('2001::',ipmask_teredo);
+  ipstrtobin('2002::',ipmask_6to4);
+
+  {$ifdef mswindows}
+  //better way on windows to check for ipv6 that works (returns no ipv6) if a v6 IP is assigned, but there is no connectivity
+  try
+    ip := getlocalipforip(ipstrtobinf(v6_check_ip));
+    if ip_is_suitable_v6 then result := true;
+  except
+  end;
+  {$else} {unix}
+
+  l := getv6localips;
+  if biniplist_getcount(l) = 0 then exit;
+
+  {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 ip_is_suitable_v6 then continue;
+    result := true;
+    exit;
+  end;
+  {$endif}
+end;
+
+
+function lcgethostname:ansistring;
+{$ifdef mswindows}
+var
+  buf:array[0..255] of ansichar;
+  i:integer;
+begin
+  result := '';
+  fillchar(buf,sizeof(buf),0);
+  i := winsock.gethostname(@buf,sizeof(buf));
+  if (i = 0) then result := pansichar(@buf[0]);
+end;
+{$else}
+begin
+  result := unix.gethostname;
 end;
 {$endif}
 
 end.
-