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

Contents of /trunk/lcorelocalips.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 98 - (show annotations)
Fri Feb 25 05:56:35 2011 UTC (9 years, 1 month ago) by beware
File size: 10348 byte(s)
made getlocalips work on mac OS X (BSD)
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,dnssync;
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 begin
259 result := forwardlookuplist('',0);
260
261 {$ifdef ipv6}
262
263 {windows XP doesn't add v6 IPs
264 if we find no v6 IPs in the list, add one using a hack}
265 for a := biniplist_getcount(result)-1 downto 0 do begin
266 ip := biniplist_get(result,a);
267 if ip.family = AF_INET6 then exit;
268 end;
269
270 try
271 ip := getlocalipforip(ipstrtobinf('2001:200::'));
272 if (ip.family = AF_INET6) then biniplist_add(result,ip);
273 except
274 end;
275 {$endif}
276
277 end;
278
279 {$endif}
280
281
282
283
284
285 {$ifdef win32}
286 const
287 MAX_HOSTNAME_LEN = 132;
288 MAX_DOMAIN_NAME_LEN = 132;
289 MAX_SCOPE_ID_LEN = 260 ;
290 MAX_ADAPTER_NAME_LENGTH = 260;
291 MAX_ADAPTER_ADDRESS_LENGTH = 8;
292 MAX_ADAPTER_DESCRIPTION_LENGTH = 132;
293 ERROR_BUFFER_OVERFLOW = 111;
294 MIB_IF_TYPE_ETHERNET = 6;
295 MIB_IF_TYPE_TOKENRING = 9;
296 MIB_IF_TYPE_FDDI = 15;
297 MIB_IF_TYPE_PPP = 23;
298 MIB_IF_TYPE_LOOPBACK = 24;
299 MIB_IF_TYPE_SLIP = 28;
300
301
302 type
303 tip_addr_string=packed record
304 Next :pointer;
305 IpAddress : array[0..15] of ansichar;
306 ipmask : array[0..15] of ansichar;
307 context : dword;
308 end;
309 pip_addr_string=^tip_addr_string;
310 tFIXED_INFO=packed record
311 HostName : array[0..MAX_HOSTNAME_LEN-1] of ansichar;
312 DomainName : array[0..MAX_DOMAIN_NAME_LEN-1] of ansichar;
313 currentdnsserver : pip_addr_string;
314 dnsserverlist : tip_addr_string;
315 nodetype : longint;
316 ScopeId : array[0..MAX_SCOPE_ID_LEN + 4] of ansichar;
317 enablerouting : longbool;
318 enableproxy : longbool;
319 enabledns : longbool;
320 end;
321 pFIXED_INFO=^tFIXED_INFO;
322
323 var
324 iphlpapi : thandle;
325 getnetworkparams : function(pFixedInfo : PFIXED_INFO;OutBufLen : plongint) : longint;stdcall;
326
327 function callGetNetworkParams:pFIXED_INFO;
328 var
329 fixed_info : pfixed_info;
330 fixed_info_len : longint;
331 begin
332 result := nil;
333 if iphlpapi=0 then iphlpapi := loadlibrary('iphlpapi.dll');
334 if not assigned(getnetworkparams) then @getnetworkparams := getprocaddress(iphlpapi,'GetNetworkParams');
335 if not assigned(getnetworkparams) then exit;
336 fixed_info_len := 0;
337 if GetNetworkParams(nil,@fixed_info_len)<>ERROR_BUFFER_OVERFLOW then exit;
338 //fixed_info_len :=sizeof(tfixed_info);
339 getmem(fixed_info,fixed_info_len);
340 if GetNetworkParams(fixed_info,@fixed_info_len)<>0 then begin
341 freemem(fixed_info);
342 exit;
343 end;
344 result := fixed_info;
345 end;
346
347 {$endif}
348
349 function getsystemdnsservers:tbiniplist;
350 var
351 {$ifdef win32}
352 fixed_info : pfixed_info;
353 currentdnsserver : pip_addr_string;
354 {$else}
355 t:textfile;
356 s:ansistring;
357 a:integer;
358 {$endif}
359 ip:tbinip;
360 begin
361 //result := '';
362
363 result := biniplist_new;
364
365 {$ifdef win32}
366 fixed_info := callgetnetworkparams;
367 if fixed_info = nil then exit;
368
369 currentdnsserver := @(fixed_info.dnsserverlist);
370 while assigned(currentdnsserver) do begin
371 ip := ipstrtobinf(currentdnsserver.IpAddress);
372 if (ip.family <> 0) then biniplist_add(result,ip);
373 currentdnsserver := currentdnsserver.next;
374 end;
375 freemem(fixed_info);
376 {$else}
377 filemode := 0;
378 assignfile(t,'/etc/resolv.conf');
379 {$i-}reset(t);{$i+}
380 if ioresult <> 0 then exit;
381
382 while not eof(t) do begin
383 readln(t,s);
384 if not (copy(s,1,10) = 'nameserver') then continue;
385 s := copy(s,11,500);
386 while s <> '' do begin
387 if (s[1] = #32) or (s[1] = #9) then s := copy(s,2,500) else break;
388 end;
389 a := pos(' ',s);
390 if a <> 0 then s := copy(s,1,a-1);
391 a := pos(#9,s);
392 if a <> 0 then s := copy(s,1,a-1);
393
394 ip := ipstrtobinf(s);
395 if (ip.family <> 0) then biniplist_add(result,ip);
396 end;
397 closefile(t);
398 {$endif}
399 end;
400
401 {$ifdef win32}
402 function gethostname:ansistring;
403 var
404 fixed_info : pfixed_info;
405 begin
406 result := '';
407 fixed_info := callgetnetworkparams;
408 if fixed_info = nil then exit;
409
410 result := fixed_info.hostname;
411 if fixed_info.domainname <> '' then result := result + '.'+fixed_info.domainname;
412
413 freemem(fixed_info);
414 end;
415 {$endif}
416
417 end.

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