\r
\r
{$ifdef ipv6}\r
-function getv6localips:tbiniplist;\r
procedure initpreferredmode;\r
\r
var\r
\r
uses\r
{$ifdef win32}\r
- windows,winsock,\r
+ windows,\r
{$endif}\r
-\r
+ lcorelocalips,\r
sysutils;\r
\r
\r
end;\r
\r
\r
-\r
{$ifdef ipv6}\r
\r
-{$ifdef linux}\r
-function getv6localips:tbiniplist;\r
-var\r
- t:textfile;\r
- s,s2:ansistring;\r
- ip:tbinip;\r
- a:integer;\r
-begin\r
- result := biniplist_new;\r
-\r
- assignfile(t,'/proc/net/if_inet6');\r
- {$i-}reset(t);{$i+}\r
- if ioresult <> 0 then exit; {none found, return empty list}\r
-\r
- while not eof(t) do begin\r
- readln(t,s);\r
- s2 := '';\r
- for a := 0 to 7 do begin\r
- if (s2 <> '') then s2 := s2 + ':';\r
- s2 := s2 + copy(s,(a shl 2)+1,4);\r
- end;\r
- ipstrtobin(s2,ip);\r
- if ip.family <> 0 then biniplist_add(result,ip);\r
- end;\r
- closefile(t);\r
-end;\r
-\r
-{$else}\r
-\r
-{the following code's purpose is to determine what IP windows would come from, to reach an IP\r
-it can be abused to find if there's any global v6 IPs, getaddrinfo seems unreliable (not working on XP atleast)\r
-}\r
-const\r
- SIO_ROUTING_INTERFACE_QUERY = $c8000014;\r
- 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
-\r
-function getlocalipforip(const ip:tbinip):tbinip;\r
-var\r
- handle:integer;\r
- a,b:integer;\r
- inaddrv,inaddrv2:tinetsockaddrv;\r
- srcx:winsock.tsockaddr absolute inaddrv2;\r
-begin\r
- makeinaddrv(ip,'0',inaddrv);\r
- handle := Socket(inaddrv.inaddr.family,SOCK_DGRAM,IPPROTO_UDP);\r
- if WSAIoctl(handle, SIO_ROUTING_INTERFACE_QUERY, inaddrv, sizeof(inaddrv), inaddrv2, sizeof(inaddrv2), a, nil, nil) <> 0\r
- then raise exception.create('getlocalipforip failed with error: '+inttostr(wsagetlasterror));\r
- result := inaddrvtobinip(inaddrv2);\r
- closesocket(handle);\r
-end;\r
-\r
-function getv6localips:tbiniplist;\r
-begin\r
- result := biniplist_new;\r
- {this IP is chosen because it's the first normal global v6 IP that has no special purpose}\r
- biniplist_add(result,getlocalipforip(ipstrtobinf('2001:200::')));\r
-end;\r
-{$endif}\r
-\r
procedure initpreferredmode;\r
var\r
l:tbiniplist;\r
--- /dev/null
+{ Copyright (C) 2005 Bas Steendijk and Peter Green
+ For conditions of distribution and use, see copyright notice in zlib_license.txt
+ which is included in the package
+ ----------------------------------------------------------------------------- }
+
+{
+unit to get IP addresses assigned to local interfaces.
+both IPv4 and IPv6, or one address family in isolation.
+works on both windows and linux.
+
+notes:
+
+- localhost IPs (127.0.0.1, ::1) may be returned, the app must not expect them to be in or not in.
+ (typically, they're returned on linux and not on windows)
+
+- normal behavior is to return all v6 IPs, including link local (fe80::).
+ an app that doesn't want link local IPs has to filter them out.
+ windows XP returns only one, global scope, v6 IP, due to shortcomings.
+
+}
+
+unit lcorelocalips;
+
+interface
+
+uses binipstuff;
+
+{$include lcoreconfig.inc}
+
+function getlocalips:tbiniplist;
+function getv4localips:tbiniplist;
+{$ifdef ipv6}
+function getv6localips:tbiniplist;
+{$endif}
+
+implementation
+
+{$ifdef linux}
+
+uses
+ baseunix,sockets,sysutils;
+
+function getv6localips:tbiniplist;
+var
+ t:textfile;
+ s,s2:ansistring;
+ ip:tbinip;
+ a:integer;
+begin
+ result := biniplist_new;
+
+ assignfile(t,'/proc/net/if_inet6');
+ {$i-}reset(t);{$i+}
+ if ioresult <> 0 then exit; {none found, return empty list}
+ while not eof(t) do begin
+ readln(t,s);
+ s2 := '';
+ for a := 0 to 7 do begin
+ if (s2 <> '') then s2 := s2 + ':';
+ s2 := s2 + copy(s,(a shl 2)+1,4);
+ end;
+ ipstrtobin(s2,ip);
+ if ip.family <> 0 then biniplist_add(result,ip);
+ end;
+ closefile(t);
+end;
+
+function getv4localips:tbiniplist;
+const
+ IF_NAMESIZE=16;
+ SIOCGIFCONF=$8912;
+type
+ tifconf=packed record
+ ifc_len:longint;
+ ifcu_rec:pointer;
+ end;
+
+ tifrec=packed record
+ ifr_ifrn:array [0..IF_NAMESIZE-1] of char;
+ ifru_addr:TSockAddr;
+ end;
+
+ tifrecarr=array[0..999] of tifrec;
+var
+ s:integer;
+ ifc:tifconf;
+ ifr:^tifrecarr;
+ a:integer;
+ ip:tbinip;
+ ad:^TinetSockAddrV;
+begin
+ result := biniplist_new;
+
+ {must create a socket for this}
+ s := fpsocket(AF_INET,SOCK_DGRAM,0);
+ if (s < 0) then raise exception.create('getv4localips unable to create socket');
+
+ fillchar(ifc,sizeof(ifc),0);
+
+ {get size of IP record list}
+ if (fpioctl(s,SIOCGIFCONF,@ifc) < 0) then raise exception.create('getv4localips ioctl failed 1');
+
+ {allocate it, with extra room in case there's more interfaces added (as recommended)}
+ getmem(ifr,ifc.ifc_len shl 1);
+ ifc.ifcu_rec := ifr;
+
+ {get IP record list}
+ if (fpioctl(s,SIOCGIFCONF,@ifc) < 0) then raise exception.create('getv4localips ioctl failed 2');
+
+ fillchar(ad,sizeof(ad),0);
+
+ for a := (ifc.ifc_len div sizeof (tifrec))-1 downto 0 do begin
+ ad := @ifr[a].ifru_addr;
+ ip := inaddrvtobinip(ad^);
+ biniplist_add(result,ip);
+ end;
+
+ freemem(ifr);
+ FileClose(s);
+end;
+
+function getlocalips:tbiniplist;
+begin
+ result := getv4localips;
+ {$ifdef ipv6}
+ biniplist_addlist(result,getv6localips);
+ {$endif}
+end;
+
+{$else}
+
+uses
+ sysutils,winsock,dnssync;
+
+{the following code's purpose is to determine what IP windows would come from, to reach an IP
+it can be abused to find if there's any global v6 IPs on a local interface}
+const
+ SIO_ROUTING_INTERFACE_QUERY = $c8000014;
+ 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';
+
+function getlocalipforip(const ip:tbinip):tbinip;
+var
+ handle:integer;
+ a,b:integer;
+ inaddrv,inaddrv2:tinetsockaddrv;
+ srcx:winsock.tsockaddr absolute inaddrv2;
+begin
+ makeinaddrv(ip,'0',inaddrv);
+ handle := Socket(inaddrv.inaddr.family,SOCK_DGRAM,IPPROTO_UDP);
+ if (handle < 0) then begin
+ {this happens on XP without an IPv6 stack
+ i can either fail with an exception, or with a "null result". an exception is annoying in the IDE}
+ {fillchar(result,sizeof(result),0);
+ exit; }
+ raise exception.create('getlocalipforip: can''t create socket');
+ end;
+ if WSAIoctl(handle, SIO_ROUTING_INTERFACE_QUERY, inaddrv, sizeof(inaddrv), inaddrv2, sizeof(inaddrv2), a, nil, nil) <> 0
+ then raise exception.create('getlocalipforip failed with error: '+inttostr(wsagetlasterror));
+ result := inaddrvtobinip(inaddrv2);
+ closesocket(handle);
+end;
+
+
+function getv4localips:tbiniplist;
+var
+ templist:tbiniplist;
+ biniptemp:tbinip;
+ a:integer;
+begin
+ result := biniplist_new;
+
+ templist := getlocalips;
+ for a := biniplist_getcount(templist)-1 downto 0 do begin
+ biniptemp := biniplist_get(templist,a);
+ if biniptemp.family = AF_INET then biniplist_add(result,biniptemp);
+ end;
+end;
+
+{$ifdef ipv6}
+function getv6localips:tbiniplist;
+var
+ templist:tbiniplist;
+ biniptemp:tbinip;
+ a:integer;
+begin
+ result := biniplist_new;
+
+ templist := getlocalips;
+ for a := biniplist_getcount(templist)-1 downto 0 do begin
+ biniptemp := biniplist_get(templist,a);
+ if biniptemp.family = AF_INET6 then biniplist_add(result,biniptemp);
+ end;
+end;
+{$endif}
+
+function getlocalips:tbiniplist;
+var
+ a:integer;
+ ip:tbinip;
+begin
+ result := forwardlookuplist('',0);
+
+ {$ifdef ipv6}
+
+ {windows XP doesn't add v6 IPs
+ if we find no v6 IPs in the list, add one using a hack}
+ for a := biniplist_getcount(result)-1 downto 0 do begin
+ ip := biniplist_get(result,a);
+ if ip.family = AF_INET6 then exit;
+ end;
+
+ try
+ ip := getlocalipforip(ipstrtobinf('2001:200::'));
+ if (ip.family = AF_INET6) then biniplist_add(result,ip);
+ except
+ end;
+ {$endif}
+
+end;
+
+{$endif}
+
+
+
+end.
lcore.org gitweb / lcore.git / commitdiff