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 IP addresses assigned to local interfaces.
   8 both IPv4 and IPv6, or one address family in isolation.
   9 works on both windows and linux.
  10
  11 notes:
  12
  13 - localhost IPs (127.0.0.1, ::1) may be returned, the app must not expect them to be in or not in.
  14   (typically, they're returned on linux and not on windows)
  15
  16 - normal behavior is to return all v6 IPs, including link local (fe80::).
  17   an app that doesn't want link local IPs has to filter them out.
  18   windows XP returns only one, global scope, v6 IP, due to shortcomings.
  19
  20 }
  21
  22 unit lcorelocalips;
  23
  24 interface
  25
  26 uses binipstuff;
  27
  28 {$include lcoreconfig.inc}
  29
  30 function getlocalips:tbiniplist;
  31 function getv4localips:tbiniplist;
  32 {$ifdef ipv6}
  33 function getv6localips:tbiniplist;
  34 {$endif}
  35
  36 implementation
  37
  38 {$ifdef linux}
  39
  40 uses
  41   baseunix,sockets,sysutils;
  42
  43 function getv6localips:tbiniplist;
  44 var
  45   t:textfile;
  46   s,s2:ansistring;
  47   ip:tbinip;
  48   a:integer;
  49 begin
  50   result := biniplist_new;
  51
  52   assignfile(t,'/proc/net/if_inet6');
  53   {$i-}reset(t);{$i+}
  54   if ioresult <> 0 then exit; {none found, return empty list}
  55   while not eof(t) do begin
  56     readln(t,s);
  57     s2 := '';
  58     for a := 0 to 7 do begin
  59       if (s2 <> '') then s2 := s2 + ':';
  60       s2 := s2 + copy(s,(a shl 2)+1,4);
  61     end;
  62     ipstrtobin(s2,ip);
  63     if ip.family <> 0 then biniplist_add(result,ip);
  64   end;
  65   closefile(t);
  66 end;
  67
  68 function getv4localips:tbiniplist;
  69 const
  70   IF_NAMESIZE=16;
  71   SIOCGIFCONF=$8912;
  72 type
  73   tifconf=packed record
  74     ifc_len:longint;
  75     ifcu_rec:pointer;
  76   end;
  77
  78   tifrec=packed record
  79     ifr_ifrn:array [0..IF_NAMESIZE-1] of char;
  80     ifru_addr:TSockAddr;
  81   end;
  82
  83   tifrecarr=array[0..999] of tifrec;
  84 var
  85   s:integer;
  86   ifc:tifconf;
  87   ifr:^tifrecarr;
  88   a:integer;
  89   ip:tbinip;
  90   ad:^TinetSockAddrV;
  91 begin
  92   result := biniplist_new;
  93
  94   {must create a socket for this}
  95   s := fpsocket(AF_INET,SOCK_DGRAM,0);
  96   if (s < 0) then raise exception.create('getv4localips unable to create socket');
  97
  98   fillchar(ifc,sizeof(ifc),0);
  99
 100   {get size of IP record list}
 101   if (fpioctl(s,SIOCGIFCONF,@ifc) < 0) then raise exception.create('getv4localips ioctl failed 1');
 102
 103   {allocate it, with extra room in case there's more interfaces added (as recommended)}
 104   getmem(ifr,ifc.ifc_len shl 1);
 105   ifc.ifcu_rec := ifr;
 106
 107   {get IP record list}
 108   if (fpioctl(s,SIOCGIFCONF,@ifc) < 0) then raise exception.create('getv4localips ioctl failed 2');
 109
 110   fillchar(ad,sizeof(ad),0);
 111
 112   for a := (ifc.ifc_len div sizeof (tifrec))-1 downto 0 do begin
 113     ad := @ifr[a].ifru_addr;
 114     ip := inaddrvtobinip(ad^);
 115     biniplist_add(result,ip);
 116   end;
 117
 118   freemem(ifr);
 119   FileClose(s);
 120 end;
 121
 122 function getlocalips:tbiniplist;
 123 begin
 124   result := getv4localips;
 125   {$ifdef ipv6}
 126   biniplist_addlist(result,getv6localips);
 127   {$endif}
 128 end;
 129
 130 {$else}
 131
 132 uses
 133   sysutils,winsock,dnssync;
 134
 135 {the following code's purpose is to determine what IP windows would come from, to reach an IP
 136 it can be abused to find if there's any global v6 IPs on a local interface}
 137 const
 138   SIO_ROUTING_INTERFACE_QUERY = $c8000014;
 139   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';
 140
 141 function getlocalipforip(const ip:tbinip):tbinip;
 142 var
 143   handle:integer;
 144   a,b:integer;
 145   inaddrv,inaddrv2:tinetsockaddrv;
 146   srcx:winsock.tsockaddr absolute inaddrv2;
 147 begin
 148   makeinaddrv(ip,'0',inaddrv);
 149   handle := Socket(inaddrv.inaddr.family,SOCK_DGRAM,IPPROTO_UDP);
 150   if (handle < 0) then begin
 151     {this happens on XP without an IPv6 stack
 152     i can either fail with an exception, or with a "null result". an exception is annoying in the IDE}
 153     {fillchar(result,sizeof(result),0);
 154     exit; }
 155     raise exception.create('getlocalipforip: can''t create socket');
 156   end;
 157   if WSAIoctl(handle, SIO_ROUTING_INTERFACE_QUERY, inaddrv, sizeof(inaddrv), inaddrv2, sizeof(inaddrv2), a, nil, nil) <> 0
 158   then raise exception.create('getlocalipforip failed with error: '+inttostr(wsagetlasterror));
 159   result := inaddrvtobinip(inaddrv2);
 160   closesocket(handle);
 161 end;
 162
 163
 164 function getv4localips:tbiniplist;
 165 var
 166   templist:tbiniplist;
 167   biniptemp:tbinip;
 168   a:integer;
 169 begin
 170   result := biniplist_new;
 171
 172   templist := getlocalips;
 173   for a := biniplist_getcount(templist)-1 downto 0 do begin
 174     biniptemp := biniplist_get(templist,a);
 175     if biniptemp.family = AF_INET then biniplist_add(result,biniptemp);
 176   end;
 177 end;
 178
 179 {$ifdef ipv6}
 180 function getv6localips:tbiniplist;
 181 var
 182   templist:tbiniplist;
 183   biniptemp:tbinip;
 184   a:integer;
 185 begin
 186   result := biniplist_new;
 187
 188   templist := getlocalips;
 189   for a := biniplist_getcount(templist)-1 downto 0 do begin
 190     biniptemp := biniplist_get(templist,a);
 191     if biniptemp.family = AF_INET6 then biniplist_add(result,biniptemp);
 192   end;
 193 end;
 194 {$endif}
 195
 196 function getlocalips:tbiniplist;
 197 var
 198   a:integer;
 199   ip:tbinip;
 200 begin
 201   result := forwardlookuplist('',0);
 202
 203   {$ifdef ipv6}
 204
 205   {windows XP doesn't add v6 IPs
 206   if we find no v6 IPs in the list, add one using a hack}
 207   for a := biniplist_getcount(result)-1 downto 0 do begin
 208     ip := biniplist_get(result,a);
 209     if ip.family = AF_INET6 then exit;
 210   end;
 211
 212   try
 213     ip := getlocalipforip(ipstrtobinf('2001:200::'));
 214     if (ip.family = AF_INET6) then biniplist_add(result,ip);
 215   except
 216   end;
 217   {$endif}
 218
 219 end;
 220
 221 {$endif}
 222
 223
 224
 225 end.