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;\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 begin\r
 259   result := forwardlookuplist('',0);\r
 260 \r
 261   {$ifdef ipv6}\r
 262 \r
 263   {windows XP doesn't add v6 IPs\r
 264   if we find no v6 IPs in the list, add one using a hack}\r
 265   for a := biniplist_getcount(result)-1 downto 0 do begin\r
 266     ip := biniplist_get(result,a);\r
 267     if ip.family = AF_INET6 then exit;\r
 268   end;\r
 269 \r
 270   try\r
 271     ip := getlocalipforip(ipstrtobinf('2001:200::'));\r
 272     if (ip.family = AF_INET6) then biniplist_add(result,ip);\r
 273   except\r
 274   end;\r
 275   {$endif}\r
 276 \r
 277 end;\r
 278 \r
 279 {$endif}\r
 280 \r
 281 \r
 282 \r
 283 \r
 284 \r
 285 {$ifdef win32}\r
 286   const\r
 287     MAX_HOSTNAME_LEN = 132;\r
 288     MAX_DOMAIN_NAME_LEN = 132;\r
 289     MAX_SCOPE_ID_LEN = 260    ;\r
 290     MAX_ADAPTER_NAME_LENGTH = 260;\r
 291     MAX_ADAPTER_ADDRESS_LENGTH = 8;\r
 292     MAX_ADAPTER_DESCRIPTION_LENGTH = 132;\r
 293     ERROR_BUFFER_OVERFLOW = 111;\r
 294     MIB_IF_TYPE_ETHERNET = 6;\r
 295     MIB_IF_TYPE_TOKENRING = 9;\r
 296     MIB_IF_TYPE_FDDI = 15;\r
 297     MIB_IF_TYPE_PPP = 23;\r
 298     MIB_IF_TYPE_LOOPBACK = 24;\r
 299     MIB_IF_TYPE_SLIP = 28;\r
 300 \r
 301 \r
 302   type\r
 303     tip_addr_string=packed record\r
 304       Next :pointer;\r
 305       IpAddress : array[0..15] of ansichar;\r
 306       ipmask    : array[0..15] of ansichar;\r
 307       context   : dword;\r
 308     end;\r
 309     pip_addr_string=^tip_addr_string;\r
 310     tFIXED_INFO=packed record\r
 311        HostName         : array[0..MAX_HOSTNAME_LEN-1] of ansichar;\r
 312        DomainName       : array[0..MAX_DOMAIN_NAME_LEN-1] of ansichar;\r
 313        currentdnsserver : pip_addr_string;\r
 314        dnsserverlist    : tip_addr_string;\r
 315        nodetype         : longint;\r
 316        ScopeId          : array[0..MAX_SCOPE_ID_LEN + 4] of ansichar;\r
 317        enablerouting    : longbool;\r
 318        enableproxy      : longbool;\r
 319        enabledns        : longbool;\r
 320     end;\r
 321     pFIXED_INFO=^tFIXED_INFO;\r
 322 \r
 323   var\r
 324     iphlpapi : thandle;\r
 325     getnetworkparams : function(pFixedInfo : PFIXED_INFO;OutBufLen : plongint) : longint;stdcall;\r
 326 \r
 327 function callGetNetworkParams:pFIXED_INFO;\r
 328 var\r
 329     fixed_info : pfixed_info;\r
 330     fixed_info_len : longint;\r
 331 begin\r
 332   result := nil;\r
 333   if iphlpapi=0 then iphlpapi := loadlibrary('iphlpapi.dll');\r
 334     if not assigned(getnetworkparams) then @getnetworkparams := getprocaddress(iphlpapi,'GetNetworkParams');\r
 335     if not assigned(getnetworkparams) then exit;\r
 336     fixed_info_len := 0;\r
 337     if GetNetworkParams(nil,@fixed_info_len)<>ERROR_BUFFER_OVERFLOW then exit;\r
 338     //fixed_info_len :=sizeof(tfixed_info);\r
 339     getmem(fixed_info,fixed_info_len);\r
 340     if GetNetworkParams(fixed_info,@fixed_info_len)<>0 then begin\r
 341       freemem(fixed_info);\r
 342       exit;\r
 343     end;\r
 344     result := fixed_info;\r
 345 end;\r
 346 \r
 347 {$endif}\r
 348 \r
 349 function getsystemdnsservers:tbiniplist;\r
 350 var\r
 351   {$ifdef win32}\r
 352     fixed_info : pfixed_info;\r
 353     currentdnsserver : pip_addr_string;\r
 354   {$else}\r
 355     t:textfile;\r
 356     s:ansistring;\r
 357     a:integer;\r
 358   {$endif}\r
 359   ip:tbinip;\r
 360 begin\r
 361   //result := '';\r
 362 \r
 363   result := biniplist_new;\r
 364 \r
 365   {$ifdef win32}\r
 366     fixed_info := callgetnetworkparams;\r
 367     if fixed_info = nil then exit;\r
 368 \r
 369     currentdnsserver := @(fixed_info.dnsserverlist);\r
 370     while assigned(currentdnsserver) do begin\r
 371       ip := ipstrtobinf(currentdnsserver.IpAddress);\r
 372       if (ip.family <> 0) then biniplist_add(result,ip);\r
 373       currentdnsserver := currentdnsserver.next;\r
 374     end;\r
 375     freemem(fixed_info);\r
 376   {$else}\r
 377     filemode := 0;\r
 378     assignfile(t,'/etc/resolv.conf');\r
 379     {$i-}reset(t);{$i+}\r
 380     if ioresult <> 0 then exit;\r
 381 \r
 382     while not eof(t) do begin\r
 383       readln(t,s);\r
 384       if not (copy(s,1,10) = 'nameserver') then continue;\r
 385       s := copy(s,11,500);\r
 386       while s <> '' do begin\r
 387         if (s[1] = #32) or (s[1] = #9) then s := copy(s,2,500) else break;\r
 388       end;\r
 389       a := pos(' ',s);\r
 390       if a <> 0 then s := copy(s,1,a-1);\r
 391       a := pos(#9,s);\r
 392       if a <> 0 then s := copy(s,1,a-1);\r
 393 \r
 394       ip := ipstrtobinf(s);\r
 395       if (ip.family <> 0) then biniplist_add(result,ip);\r
 396     end;\r
 397     closefile(t);\r
 398   {$endif}\r
 399 end;\r
 400 \r
 401 {$ifdef win32}\r
 402 function gethostname:ansistring;\r
 403 var\r
 404     fixed_info : pfixed_info;\r
 405 begin\r
 406   result := '';\r
 407     fixed_info := callgetnetworkparams;\r
 408     if fixed_info = nil then exit;\r
 409 \r
 410     result := fixed_info.hostname;\r
 411     if fixed_info.domainname <> '' then result := result + '.'+fixed_info.domainname;\r
 412 \r
 413     freemem(fixed_info);\r
 414 end;\r
 415 {$endif}\r
 416 \r
 417 end.\r