lcorelocalips.pas

   1 { Copyright (C) 2005 Bas Steendijk and Peter Green
   2   For conditions of distribution and use, see copyright notice in zlib_license.txt
   3   which is included in the package
   4   ----------------------------------------------------------------------------- }
   5
   6 {
   7 unit to get various local system config
   8
   9
  10 - get IP addresses assigned to local interfaces.
  11 both IPv4 and IPv6, or one address family in isolation.
  12 works on both windows and linux.
  13
  14 tested on:
  15
  16 - windows XP
  17 - windows vista
  18 - linux (2.6)
  19 - mac OS X (probably works on freeBSD too)
  20
  21 notes:
  22
  23 - localhost IPs (127.0.0.1, ::1) may be returned, the app must not expect them to be in or not in.
  24   (typically, they're returned on linux and not on windows)
  25
  26 - normal behavior is to return all v6 IPs, including link local (fe80::).
  27   an app that doesn't want link local IPs has to filter them out.
  28   windows XP returns only one, global scope, v6 IP, due to shortcomings.
  29
  30
  31
  32 - get system DNS servers
  33
  34 - get system hostname (if not on windows, use freepascal's "unix")
  35
  36 }
  37
  38 unit lcorelocalips;
  39
  40 interface
  41
  42 uses binipstuff,pgtypes;
  43
  44 {$include lcoreconfig.inc}
  45
  46 function getlocalips:tbiniplist;
  47 function getv4localips:tbiniplist;
  48 {$ifdef ipv6}
  49 function getv6localips:tbiniplist;
  50 {$endif}
  51
  52 function getsystemdnsservers:tbiniplist;
  53
  54 {$ifdef win32}
  55 function gethostname:ansistring;
  56 {$endif}
  57
  58 implementation
  59
  60 {$ifdef unix}
  61
  62 uses
  63   baseunix,sockets,sysutils;
  64
  65
  66 function getlocalips_internal(wantfamily:integer):tbiniplist;
  67 const
  68   IF_NAMESIZE=16;
  69
  70   {$ifdef linux}SIOCGIFCONF=$8912;{$endif}
  71   {$ifdef bsd}{$ifdef cpu386}SIOCGIFCONF=$C0086924;{$endif}{$endif}
  72
  73   {amd64: mac OS X: $C00C6924; freeBSD: $c0106924}
  74 type
  75   tifconf=packed record
  76     ifc_len:longint;
  77     ifcu_rec:pointer;
  78   end;
  79
  80   tifrec=packed record
  81     ifr_ifrn:array [0..IF_NAMESIZE-1] of char;
  82     ifru_addr:TSockAddr;
  83   end;
  84
  85 var
  86   s:integer;
  87   ifc:tifconf;
  88   ifr,ifr2,ifrmax:^tifrec;
  89   lastlen,len:integer;
  90   ip:tbinip;
  91   ad:^TinetSockAddrV;
  92 begin
  93   result := biniplist_new;
  94
  95   {must create a socket for this}
  96   s := fpsocket(AF_INET,SOCK_DGRAM,0);
  97   if (s < 0) then raise exception.create('getv4localips unable to create socket');
  98
  99   fillchar(ifc,sizeof(ifc),0);
 100
 101
 102   ifr := nil;
 103
 104   len := 2*sizeof(tifrec);
 105   lastlen := 0;
 106   repeat
 107     reallocmem(ifr,len);
 108     ifc.ifc_len := len;
 109     ifc.ifcu_rec := ifr;
 110     {get IP record list}
 111     if (fpioctl(s,SIOCGIFCONF,@ifc) < 0) then begin
 112       raise exception.create('getv4localips ioctl failed');
 113     end;
 114     if (lastlen = ifc.ifc_len) then break;
 115     lastlen := ifc.ifc_len;
 116     len := len * 2;
 117   until false;
 118
 119   ifr2 := ifr;
 120   ifrmax := pointer(taddrint(ifr) + ifc.ifc_len);
 121   while (ifr2 < ifrmax) do begin
 122     lastlen := taddrint(ifrmax) - taddrint(ifr2);
 123     if (lastlen < sizeof(tifrec)) then break; {not enough left}
 124     {calculate len}
 125     ad := @ifr2.ifru_addr;
 126
 127     {$ifdef bsd}
 128     len := ad.inaddr.len + IF_NAMESIZE;
 129     if (len < sizeof(tifrec)) then
 130     {$endif}
 131     len := sizeof(tifrec);
 132
 133     if (len < sizeof(tifrec)) then break; {not enough left}
 134
 135     ip := inaddrvtobinip(ad^);
 136     if (ip.family <> 0) and ((ip.family = wantfamily) or (wantfamily = 0)) then biniplist_add(result,ip);
 137     inc(taddrint(ifr2),len);
 138   end;
 139
 140   freemem(ifr);
 141   FileClose(s);
 142 end;
 143
 144 {$ifdef ipv6}
 145 function getv6localips:tbiniplist;
 146 var
 147   t:textfile;
 148   s,s2:ansistring;
 149   ip:tbinip;
 150   a:integer;
 151 begin
 152   result := biniplist_new;
 153
 154   assignfile(t,'/proc/net/if_inet6');
 155   {$i-}reset(t);{$i+}
 156   if ioresult <> 0 then begin
 157     {not on linux, try if this OS uses the other way to return v6 addresses}
 158     result := getlocalips_internal(AF_INET6);
 159     exit;
 160   end;
 161   while not eof(t) do begin
 162     readln(t,s);
 163     s2 := '';
 164     for a := 0 to 7 do begin
 165       if (s2 <> '') then s2 := s2 + ':';
 166       s2 := s2 + copy(s,(a shl 2)+1,4);
 167     end;
 168     ipstrtobin(s2,ip);
 169     if ip.family <> 0 then biniplist_add(result,ip);
 170   end;
 171   closefile(t);
 172 end;
 173 {$endif}
 174
 175 function getv4localips:tbiniplist;
 176 begin
 177   result := getlocalips_internal(AF_INET);
 178 end;
 179
 180 function getlocalips:tbiniplist;
 181 begin
 182   result := getv4localips;
 183   {$ifdef ipv6}
 184   biniplist_addlist(result,getv6localips);
 185   {$endif}
 186 end;
 187
 188 {$else}
 189
 190 uses
 191   sysutils,windows,winsock,dnssync;
 192
 193 {the following code's purpose is to determine what IP windows would come from, to reach an IP
 194 it can be abused to find if there's any global v6 IPs on a local interface}
 195 const
 196   SIO_ROUTING_INTERFACE_QUERY = $c8000014;
 197   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';
 198
 199 function getlocalipforip(const ip:tbinip):tbinip;
 200 var
 201   handle:integer;
 202   a,b:integer;
 203   inaddrv,inaddrv2:tinetsockaddrv;
 204   srcx:winsock.tsockaddr absolute inaddrv2;
 205 begin
 206   makeinaddrv(ip,'0',inaddrv);
 207   handle := Socket(inaddrv.inaddr.family,SOCK_DGRAM,IPPROTO_UDP);
 208   if (handle < 0) then begin
 209     {this happens on XP without an IPv6 stack
 210     i can either fail with an exception, or with a "null result". an exception is annoying in the IDE}
 211     {fillchar(result,sizeof(result),0);
 212     exit; }
 213     raise exception.create('getlocalipforip: can''t create socket');
 214   end;
 215   if WSAIoctl(handle, SIO_ROUTING_INTERFACE_QUERY, inaddrv, sizeof(inaddrv), inaddrv2, sizeof(inaddrv2), a, nil, nil) <> 0
 216   then raise exception.create('getlocalipforip failed with error: '+inttostr(wsagetlasterror));
 217   result := inaddrvtobinip(inaddrv2);
 218   closesocket(handle);
 219 end;
 220
 221
 222 function getv4localips:tbiniplist;
 223 var
 224   templist:tbiniplist;
 225   biniptemp:tbinip;
 226   a:integer;
 227 begin
 228   result := biniplist_new;
 229
 230   templist := getlocalips;
 231   for a := biniplist_getcount(templist)-1 downto 0 do begin
 232     biniptemp := biniplist_get(templist,a);
 233     if biniptemp.family = AF_INET then biniplist_add(result,biniptemp);
 234   end;
 235 end;
 236
 237 {$ifdef ipv6}
 238 function getv6localips:tbiniplist;
 239 var
 240   templist:tbiniplist;
 241   biniptemp:tbinip;
 242   a:integer;
 243 begin
 244   result := biniplist_new;
 245
 246   templist := getlocalips;
 247   for a := biniplist_getcount(templist)-1 downto 0 do begin
 248     biniptemp := biniplist_get(templist,a);
 249     if biniptemp.family = AF_INET6 then biniplist_add(result,biniptemp);
 250   end;
 251 end;
 252 {$endif}
 253
 254 function getlocalips:tbiniplist;
 255 var
 256   a:integer;
 257   ip:tbinip;
 258 begin
 259   result := forwardlookuplist('',0);
 260
 261   {$ifdef ipv6}
 262
 263   {windows XP doesn't add v6 IPs
 264   if we find no v6 IPs in the list, add one using a hack}
 265   for a := biniplist_getcount(result)-1 downto 0 do begin
 266     ip := biniplist_get(result,a);
 267     if ip.family = AF_INET6 then exit;
 268   end;
 269
 270   try
 271     ip := getlocalipforip(ipstrtobinf('2001:200::'));
 272     if (ip.family = AF_INET6) then biniplist_add(result,ip);
 273   except
 274   end;
 275   {$endif}
 276
 277 end;
 278
 279 {$endif}
 280
 281
 282
 283
 284
 285 {$ifdef win32}
 286   const
 287     MAX_HOSTNAME_LEN = 132;
 288     MAX_DOMAIN_NAME_LEN = 132;
 289     MAX_SCOPE_ID_LEN = 260    ;
 290     MAX_ADAPTER_NAME_LENGTH = 260;
 291     MAX_ADAPTER_ADDRESS_LENGTH = 8;
 292     MAX_ADAPTER_DESCRIPTION_LENGTH = 132;
 293     ERROR_BUFFER_OVERFLOW = 111;
 294     MIB_IF_TYPE_ETHERNET = 6;
 295     MIB_IF_TYPE_TOKENRING = 9;
 296     MIB_IF_TYPE_FDDI = 15;
 297     MIB_IF_TYPE_PPP = 23;
 298     MIB_IF_TYPE_LOOPBACK = 24;
 299     MIB_IF_TYPE_SLIP = 28;
 300
 301
 302   type
 303     tip_addr_string=packed record
 304       Next :pointer;
 305       IpAddress : array[0..15] of ansichar;
 306       ipmask    : array[0..15] of ansichar;
 307       context   : dword;
 308     end;
 309     pip_addr_string=^tip_addr_string;
 310     tFIXED_INFO=packed record
 311        HostName         : array[0..MAX_HOSTNAME_LEN-1] of ansichar;
 312        DomainName       : array[0..MAX_DOMAIN_NAME_LEN-1] of ansichar;
 313        currentdnsserver : pip_addr_string;
 314        dnsserverlist    : tip_addr_string;
 315        nodetype         : longint;
 316        ScopeId          : array[0..MAX_SCOPE_ID_LEN + 4] of ansichar;
 317        enablerouting    : longbool;
 318        enableproxy      : longbool;
 319        enabledns        : longbool;
 320     end;
 321     pFIXED_INFO=^tFIXED_INFO;
 322
 323   var
 324     iphlpapi : thandle;
 325     getnetworkparams : function(pFixedInfo : PFIXED_INFO;OutBufLen : plongint) : longint;stdcall;
 326
 327 function callGetNetworkParams:pFIXED_INFO;
 328 var
 329     fixed_info : pfixed_info;
 330     fixed_info_len : longint;
 331 begin
 332   result := nil;
 333   if iphlpapi=0 then iphlpapi := loadlibrary('iphlpapi.dll');
 334     if not assigned(getnetworkparams) then @getnetworkparams := getprocaddress(iphlpapi,'GetNetworkParams');
 335     if not assigned(getnetworkparams) then exit;
 336     fixed_info_len := 0;
 337     if GetNetworkParams(nil,@fixed_info_len)<>ERROR_BUFFER_OVERFLOW then exit;
 338     //fixed_info_len :=sizeof(tfixed_info);
 339     getmem(fixed_info,fixed_info_len);
 340     if GetNetworkParams(fixed_info,@fixed_info_len)<>0 then begin
 341       freemem(fixed_info);
 342       exit;
 343     end;
 344     result := fixed_info;
 345 end;
 346
 347 {$endif}
 348
 349 function getsystemdnsservers:tbiniplist;
 350 var
 351   {$ifdef win32}
 352     fixed_info : pfixed_info;
 353     currentdnsserver : pip_addr_string;
 354   {$else}
 355     t:textfile;
 356     s:ansistring;
 357     a:integer;
 358   {$endif}
 359   ip:tbinip;
 360 begin
 361   //result := '';
 362
 363   result := biniplist_new;
 364
 365   {$ifdef win32}
 366     fixed_info := callgetnetworkparams;
 367     if fixed_info = nil then exit;
 368
 369     currentdnsserver := @(fixed_info.dnsserverlist);
 370     while assigned(currentdnsserver) do begin
 371       ip := ipstrtobinf(currentdnsserver.IpAddress);
 372       if (ip.family <> 0) then biniplist_add(result,ip);
 373       currentdnsserver := currentdnsserver.next;
 374     end;
 375     freemem(fixed_info);
 376   {$else}
 377     filemode := 0;
 378     assignfile(t,'/etc/resolv.conf');
 379     {$i-}reset(t);{$i+}
 380     if ioresult <> 0 then exit;
 381
 382     while not eof(t) do begin
 383       readln(t,s);
 384       if not (copy(s,1,10) = 'nameserver') then continue;
 385       s := copy(s,11,500);
 386       while s <> '' do begin
 387         if (s[1] = #32) or (s[1] = #9) then s := copy(s,2,500) else break;
 388       end;
 389       a := pos(' ',s);
 390       if a <> 0 then s := copy(s,1,a-1);
 391       a := pos(#9,s);
 392       if a <> 0 then s := copy(s,1,a-1);
 393
 394       ip := ipstrtobinf(s);
 395       if (ip.family <> 0) then biniplist_add(result,ip);
 396     end;
 397     closefile(t);
 398   {$endif}
 399 end;
 400
 401 {$ifdef win32}
 402 function gethostname:ansistring;
 403 var
 404     fixed_info : pfixed_info;
 405 begin
 406   result := '';
 407     fixed_info := callgetnetworkparams;
 408     if fixed_info = nil then exit;
 409
 410     result := fixed_info.hostname;
 411     if fixed_info.domainname <> '' then result := result + '.'+fixed_info.domainname;
 412
 413     freemem(fixed_info);
 414 end;
 415 {$endif}
 416
 417 end.