lcorelocalips.pas

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