/[lcore]/trunk/lcorelocalips.pas
ViewVC logotype

Contents of /trunk/lcorelocalips.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 149 - (show annotations)
Sun Sep 10 20:02:13 2017 UTC (3 months ago) by plugwash
File size: 10876 byte(s)
Replace obsolete/broken lcoregtklaz with new lcorelazarus
Rename lmessages to lcoremessages due to unit name conflict with Lazarus

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

No admin address has been configured">No admin address has been configured
ViewVC Help
Powered by ViewVC 1.1.5