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

Contents of /trunk/lcorelocalips.pas

Parent Directory Parent Directory | Revision Log Revision Log


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

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