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