X-Git-Url: http://www.lcore.org/git/lcore.git/blobdiff_plain/31d4361fb52761b6486f55af10268a51ee536a6f..a2d002aadb85c6411b55e3966247efb21eeff2b8:/lcorelocalips.pas?ds=inline

diff --git a/lcorelocalips.pas b/lcorelocalips.pas
index 7e03c1b..76a410e 100644
--- a/lcorelocalips.pas
+++ b/lcorelocalips.pas
@@ -4,10 +4,20 @@
   ----------------------------------------------------------------------------- }
 
 {
-unit to get IP addresses assigned to local interfaces.
+unit to get various local system config
+
+
+- get IP addresses assigned to local interfaces.
 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.
@@ -17,13 +27,19 @@ notes:
   an app that doesn't want link local IPs has to filter them out.
   windows XP returns only one, global scope, v6 IP, due to shortcomings.
 
+
+
+- get system DNS servers
+
+- get system hostname (if not on windows, use freepascal's "unix")
+
 }
 
 unit lcorelocalips;
 
 interface
 
-uses binipstuff;
+uses binipstuff,pgtypes;
 
 {$include lcoreconfig.inc}
 
@@ -33,42 +49,28 @@ function getv4localips:tbiniplist;
 function getv6localips:tbiniplist;
 {$endif}
 
+function getsystemdnsservers:tbiniplist;
+
+{$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;
@@ -80,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
@@ -97,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;
@@ -130,7 +188,7 @@ end;
 {$else}
 
 uses
-  sysutils,winsock,dnssync;
+  sysutils,windows,winsock,dnssync;
 
 {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}
@@ -222,4 +280,138 @@ end;
 
 
 
+
+
+{$ifdef win32}
+  const
+    MAX_HOSTNAME_LEN = 132;
+    MAX_DOMAIN_NAME_LEN = 132;
+    MAX_SCOPE_ID_LEN = 260    ;
+    MAX_ADAPTER_NAME_LENGTH = 260;
+    MAX_ADAPTER_ADDRESS_LENGTH = 8;
+    MAX_ADAPTER_DESCRIPTION_LENGTH = 132;
+    ERROR_BUFFER_OVERFLOW = 111;
+    MIB_IF_TYPE_ETHERNET = 6;
+    MIB_IF_TYPE_TOKENRING = 9;
+    MIB_IF_TYPE_FDDI = 15;
+    MIB_IF_TYPE_PPP = 23;
+    MIB_IF_TYPE_LOOPBACK = 24;
+    MIB_IF_TYPE_SLIP = 28;
+
+
+  type
+    tip_addr_string=packed record
+      Next :pointer;
+      IpAddress : array[0..15] of ansichar;
+      ipmask    : array[0..15] of ansichar;
+      context   : dword;
+    end;
+    pip_addr_string=^tip_addr_string;
+    tFIXED_INFO=packed record
+       HostName         : array[0..MAX_HOSTNAME_LEN-1] of ansichar;
+       DomainName       : array[0..MAX_DOMAIN_NAME_LEN-1] of ansichar;
+       currentdnsserver : pip_addr_string;
+       dnsserverlist    : tip_addr_string;
+       nodetype         : longint;
+       ScopeId          : array[0..MAX_SCOPE_ID_LEN + 4] of ansichar;
+       enablerouting    : longbool;
+       enableproxy      : longbool;
+       enabledns        : longbool;
+    end;
+    pFIXED_INFO=^tFIXED_INFO;
+
+  var
+    iphlpapi : thandle;
+    getnetworkparams : function(pFixedInfo : PFIXED_INFO;OutBufLen : plongint) : longint;stdcall;
+
+function callGetNetworkParams:pFIXED_INFO;
+var
+    fixed_info : pfixed_info;
+    fixed_info_len : longint;
+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;
+    fixed_info_len := 0;
+    if GetNetworkParams(nil,@fixed_info_len)<>ERROR_BUFFER_OVERFLOW then exit;
+    //fixed_info_len :=sizeof(tfixed_info);
+    getmem(fixed_info,fixed_info_len);
+    if GetNetworkParams(fixed_info,@fixed_info_len)<>0 then begin
+      freemem(fixed_info);
+      exit;
+    end;
+    result := fixed_info;
+end;
+
+{$endif}
+
+function getsystemdnsservers:tbiniplist;
+var
+  {$ifdef win32}
+    fixed_info : pfixed_info;
+    currentdnsserver : pip_addr_string;
+  {$else}
+    t:textfile;
+    s:ansistring;
+    a:integer;
+  {$endif}
+  ip:tbinip;
+begin
+  //result := '';
+
+  result := biniplist_new;
+
+  {$ifdef win32}
+    fixed_info := callgetnetworkparams;
+    if fixed_info = nil then exit;
+
+    currentdnsserver := @(fixed_info.dnsserverlist);
+    while assigned(currentdnsserver) do begin
+      ip := ipstrtobinf(currentdnsserver.IpAddress);
+      if (ip.family <> 0) then biniplist_add(result,ip);
+      currentdnsserver := currentdnsserver.next;
+    end;
+    freemem(fixed_info);
+  {$else}
+    filemode := 0;
+    assignfile(t,'/etc/resolv.conf');
+    {$i-}reset(t);{$i+}
+    if ioresult <> 0 then exit;
+
+    while not eof(t) do begin
+      readln(t,s);
+      if not (copy(s,1,10) = 'nameserver') then continue;
+      s := copy(s,11,500);
+      while s <> '' do begin
+        if (s[1] = #32) or (s[1] = #9) then s := copy(s,2,500) else break;
+      end;
+      a := pos(' ',s);
+      if a <> 0 then s := copy(s,1,a-1);
+      a := pos(#9,s);
+      if a <> 0 then s := copy(s,1,a-1);
+
+      ip := ipstrtobinf(s);
+      if (ip.family <> 0) then biniplist_add(result,ip);
+    end;
+    closefile(t);
+  {$endif}
+end;
+
+{$ifdef win32}
+function gethostname:ansistring;
+var
+    fixed_info : pfixed_info;
+begin
+  result := '';
+    fixed_info := callgetnetworkparams;
+    if fixed_info = nil then exit;
+
+    result := fixed_info.hostname;
+    if fixed_info.domainname <> '' then result := result + '.'+fixed_info.domainname;
+
+    freemem(fixed_info);
+end;
+{$endif}
+
 end.