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