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 function lcgethostname:ansistring;\r
  59 \r
  60 {$ifdef mswindows}\r
  61 function getlocalipforip(const ip:tbinip):tbinip;\r
  62 {$endif}\r
  63 \r
  64 const\r
  65   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
  66 \r
  67 implementation\r
  68 \r
  69 {$ifdef unix}\r
  70 \r
  71 uses\r
  72   baseunix,unix,sockets,sysutils;\r
  73 \r
  74 \r
  75 function getlocalips_internal(wantfamily:integer):tbiniplist;\r
  76 const\r
  77   IF_NAMESIZE=16;\r
  78 \r
  79   {$ifdef linux}SIOCGIFCONF=$8912;{$endif}\r
  80   {$ifdef bsd}{$ifdef cpu386}SIOCGIFCONF=$C0086924;{$endif}{$endif}\r
  81 \r
  82   {amd64: mac OS X: $C00C6924; freeBSD: $c0106924}\r
  83 type\r
  84   tifconf=packed record\r
  85     ifc_len:taddrint;\r
  86     ifcu_rec:pointer;\r
  87   end;\r
  88 \r
  89   tifrec=packed record\r
  90     ifr_ifrn:array [0..IF_NAMESIZE-1] of char;\r
  91      case integer of\r
  92        0: (ifru_addr: Tsockaddr);\r
  93      {$ifdef cpu64}\r
  94      //tifrec is 40 bytes on 64 bits due to a union with one of the other data types\r
  95        1: (sizefor64: array[0..23] of byte);\r
  96      {$endif}\r
  97   end;\r
  98 \r
  99 var\r
 100   s:integer;\r
 101   ifc:tifconf;\r
 102   ifr,ifr2,ifrmax:^tifrec;\r
 103   lastlen,len:integer;\r
 104   ip:tbinip;\r
 105   ad:^TinetSockAddrV;\r
 106 begin\r
 107   result := biniplist_new;\r
 108 \r
 109   {must create a socket for this}\r
 110   s := fpsocket(AF_INET,SOCK_DGRAM,0);\r
 111   if (s < 0) then raise exception.create('getv4localips unable to create socket');\r
 112 \r
 113   fillchar(ifc,sizeof(ifc),0);\r
 114 \r
 115 \r
 116   ifr := nil;\r
 117 \r
 118   len := 2*sizeof(tifrec);\r
 119   lastlen := 0;\r
 120   repeat\r
 121     reallocmem(ifr,len);\r
 122     ifc.ifc_len := len;\r
 123     ifc.ifcu_rec := ifr;\r
 124     {get IP record list}\r
 125     if (fpioctl(s,SIOCGIFCONF,@ifc) < 0) then begin\r
 126       raise exception.create('getv4localips ioctl failed');\r
 127     end;\r
 128     if (lastlen = ifc.ifc_len) then break; \r
 129     lastlen := ifc.ifc_len;\r
 130     len := len * 2;\r
 131   until false;\r
 132   \r
 133   ifr2 := ifr;\r
 134   ifrmax := pointer(taddrint(ifr) + ifc.ifc_len);\r
 135   while (ifr2 < ifrmax) do begin\r
 136     lastlen := taddrint(ifrmax) - taddrint(ifr2);\r
 137     if (lastlen < sizeof(tifrec)) then break; {not enough left}\r
 138     {calculate len}\r
 139     ad := @ifr2.ifru_addr;\r
 140 \r
 141     {$ifdef bsd}\r
 142     len := ad.inaddr.len + IF_NAMESIZE;\r
 143     if (len < sizeof(tifrec)) then \r
 144     {$endif}\r
 145     len := sizeof(tifrec);\r
 146 \r
 147     if (len < sizeof(tifrec)) then break; {not enough left}\r
 148 \r
 149     ip := inaddrvtobinip(ad^);\r
 150     if (ip.family <> 0) and ((ip.family = wantfamily) or (wantfamily = 0)) then biniplist_add(result,ip);\r
 151     inc(taddrint(ifr2),len);\r
 152   end;\r
 153 \r
 154   freemem(ifr);\r
 155   FileClose(s);\r
 156 end;\r
 157 \r
 158 {$ifdef ipv6}\r
 159 function getv6localips:tbiniplist;\r
 160 var\r
 161   t:textfile;\r
 162   s,s2:ansistring;\r
 163   ip:tbinip;\r
 164   a:integer;\r
 165 begin\r
 166   result := biniplist_new;\r
 167 \r
 168   assignfile(t,'/proc/net/if_inet6');\r
 169   {$i-}reset(t);{$i+}\r
 170   if ioresult <> 0 then begin\r
 171     {not on linux, try if this OS uses the other way to return v6 addresses}\r
 172     result := getlocalips_internal(AF_INET6);\r
 173     exit;\r
 174   end;\r
 175   while not eof(t) do begin\r
 176     readln(t,s);\r
 177     s2 := '';\r
 178     for a := 0 to 7 do begin\r
 179       if (s2 <> '') then s2 := s2 + ':';\r
 180       s2 := s2 + copy(s,(a shl 2)+1,4);\r
 181     end;\r
 182     ipstrtobin(s2,ip);\r
 183     if ip.family <> 0 then biniplist_add(result,ip);\r
 184   end;\r
 185   closefile(t);\r
 186 end;\r
 187 {$endif}    //ipv6\r
 188 \r
 189 function getv4localips:tbiniplist;\r
 190 begin\r
 191   result := getlocalips_internal(AF_INET);\r
 192 end;\r
 193 \r
 194 function getlocalips:tbiniplist;\r
 195 begin\r
 196   result := getv4localips;\r
 197   {$ifdef ipv6}\r
 198   biniplist_addlist(result,getv6localips);\r
 199   {$endif}\r
 200 end;\r
 201 \r
 202 {$else}   //unix\r
 203 \r
 204 uses\r
 205   sysutils,windows,winsock,dnswin,registry;\r
 206 \r
 207 {the following code's purpose is to determine what IP windows would come from, to reach an IP\r
 208 it can be abused to find if there's any global v6 IPs on a local interface}\r
 209 const\r
 210   SIO_ROUTING_INTERFACE_QUERY = $c8000014;\r
 211   type tWSAIoctl=function(s: TSocket; code:integer; const Buf; len: Integer; var output; outlen:integer; var outreturned: Integer; overlapped:pointer; completion: pointer): Integer; stdcall;\r
 212 \r
 213 function getlocalipforip(const ip:tbinip):tbinip;\r
 214 var\r
 215   libraryhandle : hmodule;\r
 216   WSAIoctl:tWSAIoctl;\r
 217   handle:Tsocket;\r
 218   a,b:integer;\r
 219   inaddrv,inaddrv2:tinetsockaddrv;\r
 220   srcx:winsock.tsockaddr absolute inaddrv2;\r
 221 begin\r
 222   libraryhandle := LoadLibraryA('Ws2_32.dll');\r
 223   if (libraryhandle = 0) then raise exception.create('getlocalipforip: no winsock2');\r
 224   WSAIoctl := getprocaddress(libraryhandle,'WSAIoctl');\r
 225   handle := INVALID_SOCKET;\r
 226  try\r
 227   if not assigned(WSAIoctl) then raise exception.create('getlocalipforip: no winsock2 WSAIoctl');\r
 228 \r
 229   makeinaddrv(ip,'0',inaddrv);\r
 230   handle := Socket(inaddrv.inaddr.family,SOCK_DGRAM,IPPROTO_UDP);\r
 231   if (handle = INVALID_SOCKET) then begin\r
 232     {this happens on XP without an IPv6 stack\r
 233     i can either fail with an exception, or with a "null result". an exception is annoying in the IDE}\r
 234     {fillchar(result,sizeof(result),0);\r
 235     exit; }\r
 236     raise exception.create('getlocalipforip: can''t create socket');\r
 237   end;\r
 238   if WSAIoctl(handle, SIO_ROUTING_INTERFACE_QUERY, inaddrv, sizeof(inaddrv), inaddrv2, sizeof(inaddrv2), a, nil, nil) <> 0\r
 239   then raise exception.create('getlocalipforip failed with error: '+inttostr(wsagetlasterror));\r
 240   result := inaddrvtobinip(inaddrv2);\r
 241  finally\r
 242   if (handle <> INVALID_SOCKET) then closesocket(handle);\r
 243   if (libraryhandle <> 0) then freelibrary(libraryhandle);\r
 244  end;\r
 245 end;\r
 246 \r
 247 \r
 248 function getv4localips:tbiniplist;\r
 249 var\r
 250   templist:tbiniplist;\r
 251   biniptemp:tbinip;\r
 252   a:integer;\r
 253 begin\r
 254   result := biniplist_new;\r
 255 \r
 256   templist := getlocalips;\r
 257   for a := biniplist_getcount(templist)-1 downto 0 do begin\r
 258     biniptemp := biniplist_get(templist,a);\r
 259     if biniptemp.family = AF_INET then biniplist_add(result,biniptemp);\r
 260   end;\r
 261 end;\r
 262 \r
 263 {$ifdef ipv6}\r
 264 function getv6localips:tbiniplist;\r
 265 var\r
 266   templist:tbiniplist;\r
 267   biniptemp:tbinip;\r
 268   a:integer;\r
 269 begin\r
 270   result := biniplist_new;\r
 271 \r
 272   templist := getlocalips;\r
 273   for a := biniplist_getcount(templist)-1 downto 0 do begin\r
 274     biniptemp := biniplist_get(templist,a);\r
 275     if biniptemp.family = AF_INET6 then biniplist_add(result,biniptemp);\r
 276   end;\r
 277 end;\r
 278 {$endif}\r
 279 \r
 280 function getlocalips:tbiniplist;\r
 281 var\r
 282   a:integer;\r
 283   ip:tbinip;\r
 284   usewindnstemp:boolean;\r
 285   error:integer;\r
 286 begin\r
 287   result := winforwardlookuplist(lcgethostname,0,error);\r
 288 \r
 289   {$ifdef ipv6}\r
 290 \r
 291   {windows XP doesn't add v6 IPs\r
 292   if we find no v6 IPs in the list, add one using a hack}\r
 293   for a := biniplist_getcount(result)-1 downto 0 do begin\r
 294     ip := biniplist_get(result,a);\r
 295     if ip.family = AF_INET6 then exit;\r
 296   end;\r
 297 \r
 298   try\r
 299     ip := getlocalipforip(ipstrtobinf(v6_check_ip));\r
 300     if (ip.family = AF_INET6) then biniplist_add(result,ip);\r
 301   except\r
 302   end;\r
 303   {$endif}\r
 304 \r
 305 end;\r
 306 \r
 307 {$endif}\r
 308 \r
 309 \r
 310 \r
 311 \r
 312 \r
 313 {$ifdef mswindows}\r
 314   const\r
 315     MAX_HOSTNAME_LEN = 132;\r
 316     MAX_DOMAIN_NAME_LEN = 132;\r
 317     MAX_SCOPE_ID_LEN = 260    ;\r
 318     MAX_ADAPTER_NAME_LENGTH = 260;\r
 319     MAX_ADAPTER_ADDRESS_LENGTH = 8;\r
 320     MAX_ADAPTER_DESCRIPTION_LENGTH = 132;\r
 321     ERROR_BUFFER_OVERFLOW = 111;\r
 322     MIB_IF_TYPE_ETHERNET = 6;\r
 323     MIB_IF_TYPE_TOKENRING = 9;\r
 324     MIB_IF_TYPE_FDDI = 15;\r
 325     MIB_IF_TYPE_PPP = 23;\r
 326     MIB_IF_TYPE_LOOPBACK = 24;\r
 327     MIB_IF_TYPE_SLIP = 28;\r
 328 \r
 329 \r
 330   type\r
 331     tip_addr_string=packed record\r
 332       Next :pointer;\r
 333       IpAddress : array[0..15] of ansichar;\r
 334       ipmask    : array[0..15] of ansichar;\r
 335       context   : dword;\r
 336     end;\r
 337     pip_addr_string=^tip_addr_string;\r
 338     tFIXED_INFO=packed record\r
 339        HostName         : array[0..MAX_HOSTNAME_LEN-1] of ansichar;\r
 340        DomainName       : array[0..MAX_DOMAIN_NAME_LEN-1] of ansichar;\r
 341        currentdnsserver : pip_addr_string;\r
 342        dnsserverlist    : tip_addr_string;\r
 343        nodetype         : longint;\r
 344        ScopeId          : array[0..MAX_SCOPE_ID_LEN + 4] of ansichar;\r
 345        enablerouting    : longbool;\r
 346        enableproxy      : longbool;\r
 347        enabledns        : longbool;\r
 348     end;\r
 349     pFIXED_INFO=^tFIXED_INFO;\r
 350 \r
 351   var\r
 352     iphlpapi : thandle;\r
 353     getnetworkparams : function(pFixedInfo : PFIXED_INFO;OutBufLen : plongint) : longint;stdcall;\r
 354 \r
 355 function callGetNetworkParams:pFIXED_INFO;\r
 356 var\r
 357     fixed_info : pfixed_info;\r
 358     fixed_info_len : longint;\r
 359 begin\r
 360   result := nil;\r
 361   if iphlpapi=0 then iphlpapi := loadlibrary('iphlpapi.dll');\r
 362 \r
 363   if not assigned(getnetworkparams) then getnetworkparams := getprocaddress(iphlpapi,'GetNetworkParams');\r
 364   if not assigned(getnetworkparams) then exit;\r
 365     fixed_info_len := 0;\r
 366     if GetNetworkParams(nil,@fixed_info_len)<>ERROR_BUFFER_OVERFLOW then exit;\r
 367     //fixed_info_len :=sizeof(tfixed_info);\r
 368     getmem(fixed_info,fixed_info_len);\r
 369     if GetNetworkParams(fixed_info,@fixed_info_len)<>0 then begin\r
 370       freemem(fixed_info);\r
 371       exit;\r
 372     end;\r
 373     result := fixed_info;\r
 374 end;\r
 375 \r
 376 {$endif}\r
 377 \r
 378 function getsystemdnsservers:tbiniplist;\r
 379 var\r
 380   {$ifdef mswindows}\r
 381     fixed_info : pfixed_info;\r
 382     currentdnsserver : pip_addr_string;\r
 383     reg:Tregistry;\r
 384     nameserver,s:ansistring;\r
 385     a:integer;\r
 386   {$else}\r
 387     t:textfile;\r
 388     s:ansistring;\r
 389     a:integer;\r
 390   {$endif}\r
 391   ip:tbinip;\r
 392 begin\r
 393   //result := '';\r
 394 \r
 395   result := biniplist_new;\r
 396 \r
 397   {$ifdef mswindows}\r
 398     fixed_info := callgetnetworkparams;\r
 399     if fixed_info = nil then begin\r
 400       //2000 and up method not supported. use the 9x or NT 4 method.\r
 401       nameserver := '';\r
 402       reg := TRegistry.Create();\r
 403       reg.RootKey := HKEY_LOCAL_MACHINE;\r
 404       //9x\r
 405       if not reg.OpenKey('\System\CurrentControlSet\Services\VxD\MSTCP',false) then\r
 406       //NT\r
 407       if not reg.OpenKey('\System\CurrentControlSet\Services\Tcpip\Parameters',false) then begin\r
 408         reg.destroy;\r
 409         exit;\r
 410       end;\r
 411 \r
 412       nameserver := reg.ReadString('NameServer');\r
 413       //DhcpNameServer is actually only set on NT\r
 414       if (nameserver = '') then nameserver := reg.ReadString('DhcpNameServer');\r
 415 \r
 416       reg.destroy;\r
 417 \r
 418       //parse as comma separated list\r
 419       repeat\r
 420         if (nameserver = '') then exit; //done\r
 421         a := pos(',',nameserver);\r
 422         if (a > 1) then begin\r
 423           s := copy(nameserver,1,a-1);\r
 424           nameserver := copy(nameserver,a+1,9999);\r
 425         end else begin\r
 426           s := nameserver;\r
 427           nameserver := '';\r
 428         end;\r
 429         s := trim(s);\r
 430         ip := ipstrtobinf(s);\r
 431         if (ip.family <> 0) then biniplist_add(result,ip);\r
 432       until false;\r
 433     end;\r
 434 \r
 435     currentdnsserver := @(fixed_info.dnsserverlist);\r
 436     while assigned(currentdnsserver) do begin\r
 437       ip := ipstrtobinf(currentdnsserver.IpAddress);\r
 438       if (ip.family <> 0) then biniplist_add(result,ip);\r
 439       currentdnsserver := currentdnsserver.next;\r
 440     end;\r
 441     freemem(fixed_info);\r
 442   {$else}\r
 443     filemode := 0;\r
 444     assignfile(t,'/etc/resolv.conf');\r
 445     {$i-}reset(t);{$i+}\r
 446     if ioresult <> 0 then exit;\r
 447 \r
 448     while not eof(t) do begin\r
 449       readln(t,s);\r
 450       if not (copy(s,1,10) = 'nameserver') then continue;\r
 451       s := copy(s,11,500);\r
 452       while s <> '' do begin\r
 453         if (s[1] = #32) or (s[1] = #9) then s := copy(s,2,500) else break;\r
 454       end;\r
 455       a := pos(' ',s);\r
 456       if a <> 0 then s := copy(s,1,a-1);\r
 457       a := pos(#9,s);\r
 458       if a <> 0 then s := copy(s,1,a-1);\r
 459 \r
 460       ip := ipstrtobinf(s);\r
 461       if (ip.family <> 0) then biniplist_add(result,ip);\r
 462     end;\r
 463     closefile(t);\r
 464   {$endif}\r
 465 end;\r
 466 \r
 467 \r
 468 function have_ipv6_connectivity:boolean;\r
 469 var\r
 470   l:tbiniplist;\r
 471   a:integer;\r
 472   ip:tbinip;\r
 473   ipmask_global,ipmask_6to4,ipmask_teredo:tbinip;\r
 474 \r
 475 function ip_is_suitable_v6:boolean;\r
 476 begin\r
 477   result := false;\r
 478   if (ip.family <> AF_INET6) then exit;\r
 479   if not comparebinipmask(ip,ipmask_global,3) then exit;\r
 480   if comparebinipmask(ip,ipmask_teredo,32) then exit;\r
 481   if comparebinipmask(ip,ipmask_6to4,16) then exit;\r
 482   result := true;\r
 483 end;\r
 484 \r
 485 begin\r
 486   result := false;\r
 487 \r
 488   ipstrtobin('2000::',ipmask_global);\r
 489   ipstrtobin('2001::',ipmask_teredo);\r
 490   ipstrtobin('2002::',ipmask_6to4);\r
 491 \r
 492   {$ifdef mswindows}\r
 493   //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
 494   try\r
 495     ip := getlocalipforip(ipstrtobinf(v6_check_ip));\r
 496     if ip_is_suitable_v6 then result := true;\r
 497   except\r
 498   end;\r
 499   {$else} {unix}\r
 500 \r
 501   l := getv6localips;\r
 502   if biniplist_getcount(l) = 0 then exit;\r
 503 \r
 504   {if there is any v6 IP which is globally routable and not 6to4 and not teredo, prefer v6}\r
 505   for a := biniplist_getcount(l)-1 downto 0 do begin\r
 506     ip := biniplist_get(l,a);\r
 507     if not ip_is_suitable_v6 then continue;\r
 508     result := true;\r
 509     exit;\r
 510   end;\r
 511   {$endif}\r
 512 end;\r
 513 \r
 514 \r
 515 function lcgethostname:ansistring;\r
 516 {$ifdef mswindows}\r
 517 var\r
 518   buf:array[0..255] of ansichar;\r
 519   i:integer;\r
 520 begin\r
 521   result := '';\r
 522   fillchar(buf,sizeof(buf),0);\r
 523   i := winsock.gethostname(@buf,sizeof(buf));\r
 524   if (i = 0) then result := pansichar(@buf[0]);\r
 525 end;\r
 526 {$else}\r
 527 begin\r
 528   result := unix.gethostname;\r
 529 end;\r
 530 {$endif}\r
 531 \r
 532 end.\r