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

Annotation of /trunk/lcorelocalips.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 100 - (hide annotations)
Sun May 8 00:01:47 2011 UTC (8 years, 10 months ago) by plugwash
File size: 10765 byte(s)
fix line endings in lcorelocalips.pas

1 plugwash 100 { 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