lcorelocalips.pas

   1 { Copyright (C) 2005 Bas Steendijk and Peter Green
   2   For conditions of distribution and use, see copyright notice in zlib_license.txt
   3   which is included in the package
   4   ----------------------------------------------------------------------------- }
   5
   6 {
   7 unit to get various local system config
   8
   9
  10 - get IP addresses assigned to local interfaces.
  11 both IPv4 and IPv6, or one address family in isolation.
  12 works on both windows and linux.
  13
  14 notes:
  15
  16 - localhost IPs (127.0.0.1, ::1) may be returned, the app must not expect them to be in or not in.
  17   (typically, they're returned on linux and not on windows)
  18
  19 - normal behavior is to return all v6 IPs, including link local (fe80::).
  20   an app that doesn't want link local IPs has to filter them out.
  21   windows XP returns only one, global scope, v6 IP, due to shortcomings.
  22
  23
  24
  25 - get system DNS servers
  26
  27 - get system hostname
  28
  29 }
  30
  31 unit lcorelocalips;
  32
  33 interface
  34
  35 uses binipstuff;
  36
  37 {$include lcoreconfig.inc}
  38
  39 function getlocalips:tbiniplist;
  40 function getv4localips:tbiniplist;
  41 {$ifdef ipv6}
  42 function getv6localips:tbiniplist;
  43 {$endif}
  44
  45 function getsystemdnsservers:tbiniplist;
  46 function getsystemhostname:ansistring;
  47
  48 implementation
  49
  50 {$ifdef linux}
  51
  52 uses
  53   baseunix,sockets,sysutils;
  54
  55 function getv6localips:tbiniplist;
  56 var
  57   t:textfile;
  58   s,s2:ansistring;
  59   ip:tbinip;
  60   a:integer;
  61 begin
  62   result := biniplist_new;
  63
  64   assignfile(t,'/proc/net/if_inet6');
  65   {$i-}reset(t);{$i+}
  66   if ioresult <> 0 then exit; {none found, return empty list}
  67   while not eof(t) do begin
  68     readln(t,s);
  69     s2 := '';
  70     for a := 0 to 7 do begin
  71       if (s2 <> '') then s2 := s2 + ':';
  72       s2 := s2 + copy(s,(a shl 2)+1,4);
  73     end;
  74     ipstrtobin(s2,ip);
  75     if ip.family <> 0 then biniplist_add(result,ip);
  76   end;
  77   closefile(t);
  78 end;
  79
  80 function getv4localips:tbiniplist;
  81 const
  82   IF_NAMESIZE=16;
  83   SIOCGIFCONF=$8912;
  84 type
  85   tifconf=packed record
  86     ifc_len:longint;
  87     ifcu_rec:pointer;
  88   end;
  89
  90   tifrec=packed record
  91     ifr_ifrn:array [0..IF_NAMESIZE-1] of char;
  92     ifru_addr:TSockAddr;
  93   end;
  94
  95   tifrecarr=array[0..999] of tifrec;
  96 var
  97   s:integer;
  98   ifc:tifconf;
  99   ifr:^tifrecarr;
 100   a:integer;
 101   ip:tbinip;
 102   ad:^TinetSockAddrV;
 103 begin
 104   result := biniplist_new;
 105
 106   {must create a socket for this}
 107   s := fpsocket(AF_INET,SOCK_DGRAM,0);
 108   if (s < 0) then raise exception.create('getv4localips unable to create socket');
 109
 110   fillchar(ifc,sizeof(ifc),0);
 111
 112   {get size of IP record list}
 113   if (fpioctl(s,SIOCGIFCONF,@ifc) < 0) then raise exception.create('getv4localips ioctl failed 1');
 114
 115   {allocate it, with extra room in case there's more interfaces added (as recommended)}
 116   getmem(ifr,ifc.ifc_len shl 1);
 117   ifc.ifcu_rec := ifr;
 118
 119   {get IP record list}
 120   if (fpioctl(s,SIOCGIFCONF,@ifc) < 0) then raise exception.create('getv4localips ioctl failed 2');
 121
 122   fillchar(ad,sizeof(ad),0);
 123
 124   for a := (ifc.ifc_len div sizeof (tifrec))-1 downto 0 do begin
 125     ad := @ifr[a].ifru_addr;
 126     ip := inaddrvtobinip(ad^);
 127     biniplist_add(result,ip);
 128   end;
 129
 130   freemem(ifr);
 131   FileClose(s);
 132 end;
 133
 134 function getlocalips:tbiniplist;
 135 begin
 136   result := getv4localips;
 137   {$ifdef ipv6}
 138   biniplist_addlist(result,getv6localips);
 139   {$endif}
 140 end;
 141
 142 {$else}
 143
 144 uses
 145   sysutils,windows,winsock,dnssync;
 146
 147 {the following code's purpose is to determine what IP windows would come from, to reach an IP
 148 it can be abused to find if there's any global v6 IPs on a local interface}
 149 const
 150   SIO_ROUTING_INTERFACE_QUERY = $c8000014;
 151   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';
 152
 153 function getlocalipforip(const ip:tbinip):tbinip;
 154 var
 155   handle:integer;
 156   a,b:integer;
 157   inaddrv,inaddrv2:tinetsockaddrv;
 158   srcx:winsock.tsockaddr absolute inaddrv2;
 159 begin
 160   makeinaddrv(ip,'0',inaddrv);
 161   handle := Socket(inaddrv.inaddr.family,SOCK_DGRAM,IPPROTO_UDP);
 162   if (handle < 0) then begin
 163     {this happens on XP without an IPv6 stack
 164     i can either fail with an exception, or with a "null result". an exception is annoying in the IDE}
 165     {fillchar(result,sizeof(result),0);
 166     exit; }
 167     raise exception.create('getlocalipforip: can''t create socket');
 168   end;
 169   if WSAIoctl(handle, SIO_ROUTING_INTERFACE_QUERY, inaddrv, sizeof(inaddrv), inaddrv2, sizeof(inaddrv2), a, nil, nil) <> 0
 170   then raise exception.create('getlocalipforip failed with error: '+inttostr(wsagetlasterror));
 171   result := inaddrvtobinip(inaddrv2);
 172   closesocket(handle);
 173 end;
 174
 175
 176 function getv4localips:tbiniplist;
 177 var
 178   templist:tbiniplist;
 179   biniptemp:tbinip;
 180   a:integer;
 181 begin
 182   result := biniplist_new;
 183
 184   templist := getlocalips;
 185   for a := biniplist_getcount(templist)-1 downto 0 do begin
 186     biniptemp := biniplist_get(templist,a);
 187     if biniptemp.family = AF_INET then biniplist_add(result,biniptemp);
 188   end;
 189 end;
 190
 191 {$ifdef ipv6}
 192 function getv6localips:tbiniplist;
 193 var
 194   templist:tbiniplist;
 195   biniptemp:tbinip;
 196   a:integer;
 197 begin
 198   result := biniplist_new;
 199
 200   templist := getlocalips;
 201   for a := biniplist_getcount(templist)-1 downto 0 do begin
 202     biniptemp := biniplist_get(templist,a);
 203     if biniptemp.family = AF_INET6 then biniplist_add(result,biniptemp);
 204   end;
 205 end;
 206 {$endif}
 207
 208 function getlocalips:tbiniplist;
 209 var
 210   a:integer;
 211   ip:tbinip;
 212 begin
 213   result := forwardlookuplist('',0);
 214
 215   {$ifdef ipv6}
 216
 217   {windows XP doesn't add v6 IPs
 218   if we find no v6 IPs in the list, add one using a hack}
 219   for a := biniplist_getcount(result)-1 downto 0 do begin
 220     ip := biniplist_get(result,a);
 221     if ip.family = AF_INET6 then exit;
 222   end;
 223
 224   try
 225     ip := getlocalipforip(ipstrtobinf('2001:200::'));
 226     if (ip.family = AF_INET6) then biniplist_add(result,ip);
 227   except
 228   end;
 229   {$endif}
 230
 231 end;
 232
 233 {$endif}
 234
 235
 236
 237
 238
 239 {$ifdef win32}
 240   const
 241     MAX_HOSTNAME_LEN = 132;
 242     MAX_DOMAIN_NAME_LEN = 132;
 243     MAX_SCOPE_ID_LEN = 260    ;
 244     MAX_ADAPTER_NAME_LENGTH = 260;
 245     MAX_ADAPTER_ADDRESS_LENGTH = 8;
 246     MAX_ADAPTER_DESCRIPTION_LENGTH = 132;
 247     ERROR_BUFFER_OVERFLOW = 111;
 248     MIB_IF_TYPE_ETHERNET = 6;
 249     MIB_IF_TYPE_TOKENRING = 9;
 250     MIB_IF_TYPE_FDDI = 15;
 251     MIB_IF_TYPE_PPP = 23;
 252     MIB_IF_TYPE_LOOPBACK = 24;
 253     MIB_IF_TYPE_SLIP = 28;
 254
 255
 256   type
 257     tip_addr_string=packed record
 258       Next :pointer;
 259       IpAddress : array[0..15] of ansichar;
 260       ipmask    : array[0..15] of ansichar;
 261       context   : dword;
 262     end;
 263     pip_addr_string=^tip_addr_string;
 264     tFIXED_INFO=packed record
 265        HostName         : array[0..MAX_HOSTNAME_LEN-1] of ansichar;
 266        DomainName       : array[0..MAX_DOMAIN_NAME_LEN-1] of ansichar;
 267        currentdnsserver : pip_addr_string;
 268        dnsserverlist    : tip_addr_string;
 269        nodetype         : longint;
 270        ScopeId          : array[0..MAX_SCOPE_ID_LEN + 4] of ansichar;
 271        enablerouting    : longbool;
 272        enableproxy      : longbool;
 273        enabledns        : longbool;
 274     end;
 275     pFIXED_INFO=^tFIXED_INFO;
 276
 277   var
 278     iphlpapi : thandle;
 279     getnetworkparams : function(pFixedInfo : PFIXED_INFO;OutBufLen : plongint) : longint;stdcall;
 280
 281 function callGetNetworkParams:pFIXED_INFO;
 282 var
 283     fixed_info : pfixed_info;
 284     fixed_info_len : longint;
 285 begin
 286   result := nil;
 287   if iphlpapi=0 then iphlpapi := loadlibrary('iphlpapi.dll');
 288     if not assigned(getnetworkparams) then @getnetworkparams := getprocaddress(iphlpapi,'GetNetworkParams');
 289     if not assigned(getnetworkparams) then exit;
 290     fixed_info_len := 0;
 291     if GetNetworkParams(nil,@fixed_info_len)<>ERROR_BUFFER_OVERFLOW then exit;
 292     //fixed_info_len :=sizeof(tfixed_info);
 293     getmem(fixed_info,fixed_info_len);
 294     if GetNetworkParams(fixed_info,@fixed_info_len)<>0 then begin
 295       freemem(fixed_info);
 296       exit;
 297     end;
 298     result := fixed_info;
 299 end;
 300
 301 {$endif}
 302
 303 function getsystemdnsservers:tbiniplist;
 304 var
 305   {$ifdef win32}
 306     fixed_info : pfixed_info;
 307     currentdnsserver : pip_addr_string;
 308   {$else}
 309     t:textfile;
 310     s:ansistring;
 311     a:integer;
 312   {$endif}
 313   ip:tbinip;
 314 begin
 315   //result := '';
 316
 317   result := biniplist_new;
 318
 319   {$ifdef win32}
 320     fixed_info := callgetnetworkparams;
 321     if fixed_info = nil then exit;
 322
 323     currentdnsserver := @(fixed_info.dnsserverlist);
 324     while assigned(currentdnsserver) do begin
 325       ip := ipstrtobinf(currentdnsserver.IpAddress);
 326       if (ip.family <> 0) then biniplist_add(result,ip);
 327       currentdnsserver := currentdnsserver.next;
 328     end;
 329     freemem(fixed_info);
 330   {$else}
 331     filemode := 0;
 332     assignfile(t,'/etc/resolv.conf');
 333     {$i-}reset(t);{$i+}
 334     if ioresult <> 0 then exit;
 335
 336     while not eof(t) do begin
 337       readln(t,s);
 338       if not (copy(s,1,10) = 'nameserver') then continue;
 339       s := copy(s,11,500);
 340       while s <> '' do begin
 341         if (s[1] = #32) or (s[1] = #9) then s := copy(s,2,500) else break;
 342       end;
 343       a := pos(' ',s);
 344       if a <> 0 then s := copy(s,1,a-1);
 345       a := pos(#9,s);
 346       if a <> 0 then s := copy(s,1,a-1);
 347
 348       ip := ipstrtobinf(s);
 349       if (ip.family <> 0) then biniplist_add(result,ip);
 350     end;
 351     closefile(t);
 352   {$endif}
 353 end;
 354
 355
 356 function getsystemhostname:ansistring;
 357 var
 358   {$ifdef win32}
 359     fixed_info : pfixed_info;
 360   {$else}
 361     t:textfile;
 362   {$endif}
 363 begin
 364   result := '';
 365   {$ifdef win32}
 366     fixed_info := callgetnetworkparams;
 367     if fixed_info = nil then exit;
 368
 369     result := fixed_info.hostname;
 370     if fixed_info.domainname <> '' then result := result + '.'+fixed_info.domainname;
 371
 372     freemem(fixed_info);
 373   {$else}
 374     filemode := 0;
 375     assignfile(t,'/etc/hostname');
 376     {$i-}reset(t);{$i+}
 377     if ioresult <> 0 then exit;
 378     readln(t,result);
 379     closefile(t);
 380   {$endif}
 381 end;
 382
 383 end.