-{ 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.
+{ Copyright (C) 2005 Bas Steendijk and Peter Green\r
+ For conditions of distribution and use, see copyright notice in zlib_license.txt\r
+ which is included in the package\r
+ ----------------------------------------------------------------------------- }\r
+\r
+{\r
+unit to get various local system config\r
+\r
+\r
+- get IP addresses assigned to local interfaces.\r
+both IPv4 and IPv6, or one address family in isolation.\r
+works on both windows and linux.\r
+\r
+tested on:\r
+\r
+- windows XP\r
+- windows vista\r
+- linux (2.6)\r
+- mac OS X (probably works on freeBSD too)\r
+\r
+notes:\r
+\r
+- localhost IPs (127.0.0.1, ::1) may be returned, the app must not expect them to be in or not in.\r
+ (typically, they're returned on linux and not on windows)\r
+\r
+- normal behavior is to return all v6 IPs, including link local (fe80::).\r
+ an app that doesn't want link local IPs has to filter them out.\r
+ windows XP returns only one, global scope, v6 IP, due to shortcomings.\r
+\r
+\r
+\r
+- get system DNS servers\r
+\r
+- get system hostname (if not on windows, use freepascal's "unix")\r
+\r
+}\r
+\r
+unit lcorelocalips;\r
+{$ifdef fpc}\r
+ {$mode delphi}\r
+{$endif}\r
+interface\r
+\r
+uses binipstuff,pgtypes;\r
+\r
+{$include lcoreconfig.inc}\r
+\r
+function getlocalips:tbiniplist;\r
+function getv4localips:tbiniplist;\r
+{$ifdef ipv6}\r
+function getv6localips:tbiniplist;\r
+{$endif}\r
+\r
+function getsystemdnsservers:tbiniplist;\r
+\r
+{$ifdef mswindows}\r
+function gethostname:ansistring;\r
+{$endif}\r
+\r
+implementation\r
+\r
+{$ifdef unix}\r
+\r
+uses\r
+ baseunix,sockets,sysutils;\r
+\r
+\r
+function getlocalips_internal(wantfamily:integer):tbiniplist;\r
+const\r
+ IF_NAMESIZE=16;\r
+ \r
+ {$ifdef linux}SIOCGIFCONF=$8912;{$endif}\r
+ {$ifdef bsd}{$ifdef cpu386}SIOCGIFCONF=$C0086924;{$endif}{$endif}\r
+ \r
+ {amd64: mac OS X: $C00C6924; freeBSD: $c0106924}\r
+type\r
+ tifconf=packed record\r
+ ifc_len:longint;\r
+ ifcu_rec:pointer;\r
+ end;\r
+\r
+ tifrec=packed record\r
+ ifr_ifrn:array [0..IF_NAMESIZE-1] of char;\r
+ ifru_addr:TSockAddr;\r
+ end;\r
+\r
+var\r
+ s:integer;\r
+ ifc:tifconf;\r
+ ifr,ifr2,ifrmax:^tifrec;\r
+ lastlen,len:integer;\r
+ ip:tbinip;\r
+ ad:^TinetSockAddrV;\r
+begin\r
+ result := biniplist_new;\r
+\r
+ {must create a socket for this}\r
+ s := fpsocket(AF_INET,SOCK_DGRAM,0);\r
+ if (s < 0) then raise exception.create('getv4localips unable to create socket');\r
+\r
+ fillchar(ifc,sizeof(ifc),0);\r
+\r
+\r
+ ifr := nil;\r
+\r
+ len := 2*sizeof(tifrec);\r
+ lastlen := 0;\r
+ repeat\r
+ reallocmem(ifr,len);\r
+ ifc.ifc_len := len;\r
+ ifc.ifcu_rec := ifr;\r
+ {get IP record list}\r
+ if (fpioctl(s,SIOCGIFCONF,@ifc) < 0) then begin\r
+ raise exception.create('getv4localips ioctl failed');\r
+ end;\r
+ if (lastlen = ifc.ifc_len) then break; \r
+ lastlen := ifc.ifc_len;\r
+ len := len * 2;\r
+ until false;\r
+ \r
+ ifr2 := ifr;\r
+ ifrmax := pointer(taddrint(ifr) + ifc.ifc_len);\r
+ while (ifr2 < ifrmax) do begin\r
+ lastlen := taddrint(ifrmax) - taddrint(ifr2);\r
+ if (lastlen < sizeof(tifrec)) then break; {not enough left}\r
+ {calculate len}\r
+ ad := @ifr2.ifru_addr;\r
+\r
+ {$ifdef bsd}\r
+ len := ad.inaddr.len + IF_NAMESIZE;\r
+ if (len < sizeof(tifrec)) then \r
+ {$endif}\r
+ len := sizeof(tifrec);\r
+\r
+ if (len < sizeof(tifrec)) then break; {not enough left}\r
+\r
+ ip := inaddrvtobinip(ad^);\r
+ if (ip.family <> 0) and ((ip.family = wantfamily) or (wantfamily = 0)) then biniplist_add(result,ip);\r
+ inc(taddrint(ifr2),len);\r
+ end;\r
+\r
+ freemem(ifr);\r
+ FileClose(s);\r
+end;\r
+\r
+{$ifdef ipv6}\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 begin\r
+ {not on linux, try if this OS uses the other way to return v6 addresses}\r
+ result := getlocalips_internal(AF_INET6);\r
+ exit;\r
+ end;\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
+{$endif}\r
+\r
+function getv4localips:tbiniplist;\r
+begin\r
+ result := getlocalips_internal(AF_INET);\r
+end;\r
+\r
+function getlocalips:tbiniplist;\r
+begin\r
+ result := getv4localips;\r
+ {$ifdef ipv6}\r
+ biniplist_addlist(result,getv6localips);\r
+ {$endif}\r
+end;\r
+\r
+{$else}\r
+\r
+uses\r
+ sysutils,windows,winsock,dnswin;\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 on a local interface}\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 (handle < 0) then begin\r
+ {this happens on XP without an IPv6 stack\r
+ i can either fail with an exception, or with a "null result". an exception is annoying in the IDE}\r
+ {fillchar(result,sizeof(result),0);\r
+ exit; }\r
+ raise exception.create('getlocalipforip: can''t create socket');\r
+ end;\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
+\r
+function getv4localips:tbiniplist;\r
+var\r
+ templist:tbiniplist;\r
+ biniptemp:tbinip;\r
+ a:integer;\r
+begin\r
+ result := biniplist_new;\r
+\r
+ templist := getlocalips;\r
+ for a := biniplist_getcount(templist)-1 downto 0 do begin\r
+ biniptemp := biniplist_get(templist,a);\r
+ if biniptemp.family = AF_INET then biniplist_add(result,biniptemp);\r
+ end;\r
+end;\r
+\r
+{$ifdef ipv6}\r
+function getv6localips:tbiniplist;\r
+var\r
+ templist:tbiniplist;\r
+ biniptemp:tbinip;\r
+ a:integer;\r
+begin\r
+ result := biniplist_new;\r
+\r
+ templist := getlocalips;\r
+ for a := biniplist_getcount(templist)-1 downto 0 do begin\r
+ biniptemp := biniplist_get(templist,a);\r
+ if biniptemp.family = AF_INET6 then biniplist_add(result,biniptemp);\r
+ end;\r
+end;\r
+{$endif}\r
+\r
+function getlocalips:tbiniplist;\r
+var\r
+ a:integer;\r
+ ip:tbinip;\r
+ usewindnstemp:boolean;\r
+ error:integer;\r
+begin\r
+ result := winforwardlookuplist('',0,error);\r
+\r
+ {$ifdef ipv6}\r
+\r
+ {windows XP doesn't add v6 IPs\r
+ if we find no v6 IPs in the list, add one using a hack}\r
+ for a := biniplist_getcount(result)-1 downto 0 do begin\r
+ ip := biniplist_get(result,a);\r
+ if ip.family = AF_INET6 then exit;\r
+ end;\r
+\r
+ try\r
+ ip := getlocalipforip(ipstrtobinf('2001:200::'));\r
+ if (ip.family = AF_INET6) then biniplist_add(result,ip);\r
+ except\r
+ end;\r
+ {$endif}\r
+\r
+end;\r
+\r
+{$endif}\r
+\r
+\r
+\r
+\r
+\r
+{$ifdef mswindows}\r
+ const\r
+ MAX_HOSTNAME_LEN = 132;\r
+ MAX_DOMAIN_NAME_LEN = 132;\r
+ MAX_SCOPE_ID_LEN = 260 ;\r
+ MAX_ADAPTER_NAME_LENGTH = 260;\r
+ MAX_ADAPTER_ADDRESS_LENGTH = 8;\r
+ MAX_ADAPTER_DESCRIPTION_LENGTH = 132;\r
+ ERROR_BUFFER_OVERFLOW = 111;\r
+ MIB_IF_TYPE_ETHERNET = 6;\r
+ MIB_IF_TYPE_TOKENRING = 9;\r
+ MIB_IF_TYPE_FDDI = 15;\r
+ MIB_IF_TYPE_PPP = 23;\r
+ MIB_IF_TYPE_LOOPBACK = 24;\r
+ MIB_IF_TYPE_SLIP = 28;\r
+\r
+\r
+ type\r
+ tip_addr_string=packed record\r
+ Next :pointer;\r
+ IpAddress : array[0..15] of ansichar;\r
+ ipmask : array[0..15] of ansichar;\r
+ context : dword;\r
+ end;\r
+ pip_addr_string=^tip_addr_string;\r
+ tFIXED_INFO=packed record\r
+ HostName : array[0..MAX_HOSTNAME_LEN-1] of ansichar;\r
+ DomainName : array[0..MAX_DOMAIN_NAME_LEN-1] of ansichar;\r
+ currentdnsserver : pip_addr_string;\r
+ dnsserverlist : tip_addr_string;\r
+ nodetype : longint;\r
+ ScopeId : array[0..MAX_SCOPE_ID_LEN + 4] of ansichar;\r
+ enablerouting : longbool;\r
+ enableproxy : longbool;\r
+ enabledns : longbool;\r
+ end;\r
+ pFIXED_INFO=^tFIXED_INFO;\r
+\r
+ var\r
+ iphlpapi : thandle;\r
+ getnetworkparams : function(pFixedInfo : PFIXED_INFO;OutBufLen : plongint) : longint;stdcall;\r
+\r
+function callGetNetworkParams:pFIXED_INFO;\r
+var\r
+ fixed_info : pfixed_info;\r
+ fixed_info_len : longint;\r
+begin\r
+ result := nil;\r
+ if iphlpapi=0 then iphlpapi := loadlibrary('iphlpapi.dll');\r
+ if not assigned(getnetworkparams) then @getnetworkparams := getprocaddress(iphlpapi,'GetNetworkParams');\r
+ if not assigned(getnetworkparams) then exit;\r
+ fixed_info_len := 0;\r
+ if GetNetworkParams(nil,@fixed_info_len)<>ERROR_BUFFER_OVERFLOW then exit;\r
+ //fixed_info_len :=sizeof(tfixed_info);\r
+ getmem(fixed_info,fixed_info_len);\r
+ if GetNetworkParams(fixed_info,@fixed_info_len)<>0 then begin\r
+ freemem(fixed_info);\r
+ exit;\r
+ end;\r
+ result := fixed_info;\r
+end;\r
+\r
+{$endif}\r
+\r
+function getsystemdnsservers:tbiniplist;\r
+var\r
+ {$ifdef mswindows}\r
+ fixed_info : pfixed_info;\r
+ currentdnsserver : pip_addr_string;\r
+ {$else}\r
+ t:textfile;\r
+ s:ansistring;\r
+ a:integer;\r
+ {$endif}\r
+ ip:tbinip;\r
+begin\r
+ //result := '';\r
+\r
+ result := biniplist_new;\r
+\r
+ {$ifdef mswindows}\r
+ fixed_info := callgetnetworkparams;\r
+ if fixed_info = nil then exit;\r
+\r
+ currentdnsserver := @(fixed_info.dnsserverlist);\r
+ while assigned(currentdnsserver) do begin\r
+ ip := ipstrtobinf(currentdnsserver.IpAddress);\r
+ if (ip.family <> 0) then biniplist_add(result,ip);\r
+ currentdnsserver := currentdnsserver.next;\r
+ end;\r
+ freemem(fixed_info);\r
+ {$else}\r
+ filemode := 0;\r
+ assignfile(t,'/etc/resolv.conf');\r
+ {$i-}reset(t);{$i+}\r
+ if ioresult <> 0 then exit;\r
+\r
+ while not eof(t) do begin\r
+ readln(t,s);\r
+ if not (copy(s,1,10) = 'nameserver') then continue;\r
+ s := copy(s,11,500);\r
+ while s <> '' do begin\r
+ if (s[1] = #32) or (s[1] = #9) then s := copy(s,2,500) else break;\r
+ end;\r
+ a := pos(' ',s);\r
+ if a <> 0 then s := copy(s,1,a-1);\r
+ a := pos(#9,s);\r
+ if a <> 0 then s := copy(s,1,a-1);\r
+\r
+ ip := ipstrtobinf(s);\r
+ if (ip.family <> 0) then biniplist_add(result,ip);\r
+ end;\r
+ closefile(t);\r
+ {$endif}\r
+end;\r
+\r
+{$ifdef mswindows}\r
+function gethostname:ansistring;\r
+var\r
+ fixed_info : pfixed_info;\r
+begin\r
+ result := '';\r
+ fixed_info := callgetnetworkparams;\r
+ if fixed_info = nil then exit;\r
+\r
+ result := fixed_info.hostname;\r
+ if fixed_info.domainname <> '' then result := result + '.'+fixed_info.domainname;\r
+\r
+ freemem(fixed_info);\r
+end;\r
+{$endif}\r
+\r
+end.\r
\ No newline at end of file
lcore.org gitweb / lcore.git / blobdiff