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

Annotation of /trunk/lcorelocalips.pas

Parent Directory Parent Directory | Revision Log Revision Log


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

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