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