made getlocalips work on mac OS X (BSD)
[lcore.git] / lcorelocalips.pas
index d20a04f3de223053b4f53d35975e658268edef50..76a410e951ecffff9620baccede525430cd743b3 100644 (file)
@@ -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.
 
+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.
@@ -24,7 +31,7 @@ notes:
 
 - 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
 
-uses binipstuff;
+uses binipstuff,pgtypes;
 
 {$include lcoreconfig.inc}
 
@@ -43,44 +50,27 @@ function getv6localips:tbiniplist;
 {$endif}
 
 function getsystemdnsservers:tbiniplist;
-function getsystemhostname:ansistring;
+
+{$ifdef win32}
+function gethostname:ansistring;
+{$endif}
 
 implementation
 
-{$ifdef linux}
+{$ifdef unix}
 
 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;
-  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;
@@ -92,12 +82,11 @@ type
     ifru_addr:TSockAddr;
   end;
 
-  tifrecarr=array[0..999] of tifrec;
 var
   s:integer;
   ifc:tifconf;
-  ifr:^tifrecarr;
-  a:integer;
+  ifr,ifr2,ifrmax:^tifrec;
+  lastlen,len:integer;
   ip:tbinip;
   ad:^TinetSockAddrV;
 begin
@@ -109,28 +98,85 @@ begin
 
   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^);
-    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;
 
+{$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;
@@ -352,17 +398,12 @@ begin
   {$endif}
 end;
 
-
-function getsystemhostname:ansistring;
+{$ifdef win32}
+function gethostname:ansistring;
 var
-  {$ifdef win32}
     fixed_info : pfixed_info;
-  {$else}
-    t:textfile;
-  {$endif}
 begin
   result := '';
-  {$ifdef win32}
     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);
-  {$else}
-    filemode := 0;
-    assignfile(t,'/etc/hostname');
-    {$i-}reset(t);{$i+}
-    if ioresult <> 0 then exit;
-    readln(t,result);
-    closefile(t);
-  {$endif}
 end;
+{$endif}
 
 end.