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