btime overhaul. newer APIs. added btime_gettime. now requires int64.

[lcore.git] / lcorelocalips.pas

diff --git a/lcorelocalips.pas b/lcorelocalips.pas
index ae2a00b03e8f5f2feb90672b084b07e24178fadd..07752ca5b55184cf630a8aac69b0e6fb0eeb8068 100644 (file)
--- a/lcorelocalips.pas
+++ b/lcorelocalips.pas
@@ -36,7 +36,9 @@ notes:
 }\r
 \r
 unit lcorelocalips;\r
 }\r
 \r
 unit lcorelocalips;\r

-\r
+{$ifdef fpc}\r
+  {$mode delphi}\r
+{$endif}\r

 interface\r
 \r
 uses binipstuff,pgtypes;\r
 interface\r
 \r
 uses binipstuff,pgtypes;\r


@@ -51,35 +53,47 @@ function getv6localips:tbiniplist;
 \r
 function getsystemdnsservers:tbiniplist;\r
 \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
 {$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
 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
 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
   {$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
   {amd64: mac OS X: $C00C6924; freeBSD: $c0106924}\r
 type\r
   tifconf=packed record\r

-    ifc_len:longint;\r
+    ifc_len:taddrint;\r

     ifcu_rec:pointer;\r
   end;\r
 \r
   tifrec=packed record\r
     ifr_ifrn:array [0..IF_NAMESIZE-1] of char;\r
     ifcu_rec:pointer;\r
   end;\r
 \r
   tifrec=packed record\r
     ifr_ifrn:array [0..IF_NAMESIZE-1] of char;\r

-    ifru_addr:TSockAddr;\r
+     case integer of\r
+       0: (ifru_addr: Tsockaddr);\r
+     {$ifdef cpu64}\r
+     //tifrec is 40 bytes on 64 bits due to a union with one of the other data types\r
+       1: (sizefor64: array[0..23] of byte);\r
+     {$endif}\r

   end;\r
 \r
 var\r
   end;\r
 \r
 var\r


@@ -170,7 +184,7 @@ begin
   end;\r
   closefile(t);\r
 end;\r
   end;\r
   closefile(t);\r
 end;\r

-{$endif}\r
+{$endif}    //ipv6\r

 \r
 function getv4localips:tbiniplist;\r
 begin\r
 \r
 function getv4localips:tbiniplist;\r
 begin\r


@@ -185,27 +199,36 @@ begin
   {$endif}\r
 end;\r
 \r
   {$endif}\r
 end;\r
 \r

-{$else}\r
+{$else}   //unix\r

 \r
 uses\r
 \r
 uses\r

-  sysutils,windows,winsock,dnssync;\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
 \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
 \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
   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
   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
     {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


@@ -215,7 +238,10 @@ begin
   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
   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
 end;\r
 \r
 \r


@@ -255,8 +281,10 @@ function getlocalips:tbiniplist;
 var\r
   a:integer;\r
   ip:tbinip;\r
 var\r
   a:integer;\r
   ip:tbinip;\r

+  usewindnstemp:boolean;\r
+  error:integer;\r

 begin\r
 begin\r

-  result := forwardlookuplist('',0);\r
+  result := winforwardlookuplist(lcgethostname,0,error);\r

 \r
   {$ifdef ipv6}\r
 \r
 \r
   {$ifdef ipv6}\r
 \r


@@ -268,7 +296,7 @@ begin
   end;\r
 \r
   try\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
     if (ip.family = AF_INET6) then biniplist_add(result,ip);\r
   except\r
   end;\r


@@ -282,7 +310,7 @@ end;
 \r
 \r
 \r
 \r
 \r
 \r

-{$ifdef win32}\r
+{$ifdef mswindows}\r

   const\r
     MAX_HOSTNAME_LEN = 132;\r
     MAX_DOMAIN_NAME_LEN = 132;\r
   const\r
     MAX_HOSTNAME_LEN = 132;\r
     MAX_DOMAIN_NAME_LEN = 132;\r


@@ -331,8 +359,9 @@ var
 begin\r
   result := nil;\r
   if iphlpapi=0 then iphlpapi := loadlibrary('iphlpapi.dll');\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
     fixed_info_len := 0;\r
     if GetNetworkParams(nil,@fixed_info_len)<>ERROR_BUFFER_OVERFLOW then exit;\r
     //fixed_info_len :=sizeof(tfixed_info);\r


@@ -348,9 +377,12 @@ end;
 \r
 function getsystemdnsservers:tbiniplist;\r
 var\r
 \r
 function getsystemdnsservers:tbiniplist;\r
 var\r

-  {$ifdef win32}\r
+  {$ifdef mswindows}\r

     fixed_info : pfixed_info;\r
     currentdnsserver : pip_addr_string;\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
   {$else}\r
     t:textfile;\r
     s:ansistring;\r


@@ -362,9 +394,43 @@ begin
 \r
   result := biniplist_new;\r
 \r
 \r
   result := biniplist_new;\r
 \r

-  {$ifdef win32}\r
+  {$ifdef mswindows}\r

     fixed_info := callgetnetworkparams;\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
 \r
     currentdnsserver := @(fixed_info.dnsserverlist);\r
     while assigned(currentdnsserver) do begin\r


@@ -398,19 +464,68 @@ begin
   {$endif}\r
 end;\r
 \r
   {$endif}\r
 end;\r
 \r

-{$ifdef win32}\r
-function gethostname:ansistring;\r
+\r
+function have_ipv6_connectivity:boolean;\r

 var\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
 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
 \r

-    result := fixed_info.hostname;\r
-    if fixed_info.domainname <> '' then result := result + '.'+fixed_info.domainname;\r
+begin\r
+  result := false;\r

 \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
 end;\r
 {$endif}\r
 \r