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