made getlocalips work on mac OS X (BSD)

git-svn-id: file:///svnroot/lcore/trunk@98 b1de8a11-f9be-4011-bde0-cc7ace90066a

diff --git a/lcorelocalips.pas b/lcorelocalips.pas
index d20a04f3de223053b4f53d35975e658268edef50..76a410e951ecffff9620baccede525430cd743b3 100644 (file)
--- a/lcorelocalips.pas
+++ b/lcorelocalips.pas
@@ -11,6 +11,13 @@ unit to get various local system config
 both IPv4 and IPv6, or one address family in isolation.
 works on both windows and linux.
 
 both IPv4 and IPv6, or one address family in isolation.
 works on both windows and linux.
 

+tested on:
+
+- windows XP
+- windows vista
+- linux (2.6)
+- mac OS X (probably works on freeBSD too)
+

 notes:
 
 - localhost IPs (127.0.0.1, ::1) may be returned, the app must not expect them to be in or not in.
 notes:
 
 - localhost IPs (127.0.0.1, ::1) may be returned, the app must not expect them to be in or not in.


@@ -24,7 +31,7 @@ notes:
 
 - get system DNS servers
 
 
 - get system DNS servers
 

-- get system hostname
+- get system hostname (if not on windows, use freepascal's "unix")

 
 }
 
 
 }
 


@@ -32,7 +39,7 @@ unit lcorelocalips;
 
 interface
 
 
 interface
 

-uses binipstuff;
+uses binipstuff,pgtypes;

 
 {$include lcoreconfig.inc}
 
 
 {$include lcoreconfig.inc}
 


@@ -43,44 +50,27 @@ function getv6localips:tbiniplist;
 {$endif}
 
 function getsystemdnsservers:tbiniplist;
 {$endif}
 
 function getsystemdnsservers:tbiniplist;

-function getsystemhostname:ansistring;
+
+{$ifdef win32}
+function gethostname:ansistring;
+{$endif}

 
 implementation
 
 
 implementation
 

-{$ifdef linux}
+{$ifdef unix}

 
 uses
   baseunix,sockets,sysutils;
 
 
 uses
   baseunix,sockets,sysutils;
 

-function getv6localips:tbiniplist;
-var
-  t:textfile;
-  s,s2:ansistring;
-  ip:tbinip;
-  a:integer;
-begin
-  result := biniplist_new;

 
 

-  assignfile(t,'/proc/net/if_inet6');
-  {$i-}reset(t);{$i+}
-  if ioresult <> 0 then exit; {none found, return empty list}
-  while not eof(t) do begin
-    readln(t,s);
-    s2 := '';
-    for a := 0 to 7 do begin
-      if (s2 <> '') then s2 := s2 + ':';
-      s2 := s2 + copy(s,(a shl 2)+1,4);
-    end;
-    ipstrtobin(s2,ip);
-    if ip.family <> 0 then biniplist_add(result,ip);
-  end;
-  closefile(t);
-end;
-
-function getv4localips:tbiniplist;
+function getlocalips_internal(wantfamily:integer):tbiniplist;

 const
   IF_NAMESIZE=16;
 const
   IF_NAMESIZE=16;

-  SIOCGIFCONF=$8912;
+  
+  {$ifdef linux}SIOCGIFCONF=$8912;{$endif}
+  {$ifdef bsd}{$ifdef cpu386}SIOCGIFCONF=$C0086924;{$endif}{$endif}
+  
+  {amd64: mac OS X: $C00C6924; freeBSD: $c0106924}

 type
   tifconf=packed record
     ifc_len:longint;
 type
   tifconf=packed record
     ifc_len:longint;


@@ -92,12 +82,11 @@ type
     ifru_addr:TSockAddr;
   end;
 
     ifru_addr:TSockAddr;
   end;
 

-  tifrecarr=array[0..999] of tifrec;

 var
   s:integer;
   ifc:tifconf;
 var
   s:integer;
   ifc:tifconf;

-  ifr:^tifrecarr;
-  a:integer;
+  ifr,ifr2,ifrmax:^tifrec;
+  lastlen,len:integer;

   ip:tbinip;
   ad:^TinetSockAddrV;
 begin
   ip:tbinip;
   ad:^TinetSockAddrV;
 begin


@@ -109,28 +98,85 @@ begin
 
   fillchar(ifc,sizeof(ifc),0);
 
 
   fillchar(ifc,sizeof(ifc),0);
 

-  {get size of IP record list}
-  if (fpioctl(s,SIOCGIFCONF,@ifc) < 0) then raise exception.create('getv4localips ioctl failed 1');

 
 

-  {allocate it, with extra room in case there's more interfaces added (as recommended)}
-  getmem(ifr,ifc.ifc_len shl 1);
-  ifc.ifcu_rec := ifr;
+  ifr := nil;

 
 

-  {get IP record list}
-  if (fpioctl(s,SIOCGIFCONF,@ifc) < 0) then raise exception.create('getv4localips ioctl failed 2');
-
-  fillchar(ad,sizeof(ad),0);
+  len := 2*sizeof(tifrec);
+  lastlen := 0;
+  repeat
+    reallocmem(ifr,len);
+    ifc.ifc_len := len;
+    ifc.ifcu_rec := ifr;
+    {get IP record list}
+    if (fpioctl(s,SIOCGIFCONF,@ifc) < 0) then begin
+      raise exception.create('getv4localips ioctl failed');
+    end;
+    if (lastlen = ifc.ifc_len) then break; 
+    lastlen := ifc.ifc_len;
+    len := len * 2;
+  until false;
+  
+  ifr2 := ifr;
+  ifrmax := pointer(taddrint(ifr) + ifc.ifc_len);
+  while (ifr2 < ifrmax) do begin
+    lastlen := taddrint(ifrmax) - taddrint(ifr2);
+    if (lastlen < sizeof(tifrec)) then break; {not enough left}
+    {calculate len}
+    ad := @ifr2.ifru_addr;
+
+    {$ifdef bsd}
+    len := ad.inaddr.len + IF_NAMESIZE;
+    if (len < sizeof(tifrec)) then 
+    {$endif}
+    len := sizeof(tifrec);
+
+    if (len < sizeof(tifrec)) then break; {not enough left}

 
 

-  for a := (ifc.ifc_len div sizeof (tifrec))-1 downto 0 do begin
-    ad := @ifr[a].ifru_addr;

     ip := inaddrvtobinip(ad^);
     ip := inaddrvtobinip(ad^);

-    biniplist_add(result,ip);
+    if (ip.family <> 0) and ((ip.family = wantfamily) or (wantfamily = 0)) then biniplist_add(result,ip);
+    inc(taddrint(ifr2),len);

   end;
 
   freemem(ifr);
   FileClose(s);
 end;
 
   end;
 
   freemem(ifr);
   FileClose(s);
 end;
 

+{$ifdef ipv6}
+function getv6localips:tbiniplist;
+var
+  t:textfile;
+  s,s2:ansistring;
+  ip:tbinip;
+  a:integer;
+begin
+  result := biniplist_new;
+
+  assignfile(t,'/proc/net/if_inet6');
+  {$i-}reset(t);{$i+}
+  if ioresult <> 0 then begin
+    {not on linux, try if this OS uses the other way to return v6 addresses}
+    result := getlocalips_internal(AF_INET6);
+    exit;
+  end;
+  while not eof(t) do begin
+    readln(t,s);
+    s2 := '';
+    for a := 0 to 7 do begin
+      if (s2 <> '') then s2 := s2 + ':';
+      s2 := s2 + copy(s,(a shl 2)+1,4);
+    end;
+    ipstrtobin(s2,ip);
+    if ip.family <> 0 then biniplist_add(result,ip);
+  end;
+  closefile(t);
+end;
+{$endif}
+
+function getv4localips:tbiniplist;
+begin
+  result := getlocalips_internal(AF_INET);
+end;
+

 function getlocalips:tbiniplist;
 begin
   result := getv4localips;
 function getlocalips:tbiniplist;
 begin
   result := getv4localips;


@@ -352,17 +398,12 @@ begin
   {$endif}
 end;
 
   {$endif}
 end;
 

-
-function getsystemhostname:ansistring;
+{$ifdef win32}
+function gethostname:ansistring;

 var
 var

-  {$ifdef win32}

     fixed_info : pfixed_info;
     fixed_info : pfixed_info;

-  {$else}
-    t:textfile;
-  {$endif}

 begin
   result := '';
 begin
   result := '';

-  {$ifdef win32}

     fixed_info := callgetnetworkparams;
     if fixed_info = nil then exit;
 
     fixed_info := callgetnetworkparams;
     if fixed_info = nil then exit;
 


@@ -370,14 +411,7 @@ begin
     if fixed_info.domainname <> '' then result := result + '.'+fixed_info.domainname;
 
     freemem(fixed_info);
     if fixed_info.domainname <> '' then result := result + '.'+fixed_info.domainname;
 
     freemem(fixed_info);

-  {$else}
-    filemode := 0;
-    assignfile(t,'/etc/hostname');
-    {$i-}reset(t);{$i+}
-    if ioresult <> 0 then exit;
-    readln(t,result);
-    closefile(t);
-  {$endif}

 end;
 end;

+{$endif}

 
 end.
 
 end.