xref: /onnv-gate/usr/src/cmd/perl/5.8.4/distrib/lib/Net/Domain.pm (revision 0:68f95e015346)
1*0Sstevel@tonic-gate# Net::Domain.pm
2*0Sstevel@tonic-gate#
3*0Sstevel@tonic-gate# Copyright (c) 1995-1998 Graham Barr <gbarr@pobox.com>. All rights reserved.
4*0Sstevel@tonic-gate# This program is free software; you can redistribute it and/or
5*0Sstevel@tonic-gate# modify it under the same terms as Perl itself.
6*0Sstevel@tonic-gate
7*0Sstevel@tonic-gatepackage Net::Domain;
8*0Sstevel@tonic-gate
9*0Sstevel@tonic-gaterequire Exporter;
10*0Sstevel@tonic-gate
11*0Sstevel@tonic-gateuse Carp;
12*0Sstevel@tonic-gateuse strict;
13*0Sstevel@tonic-gateuse vars qw($VERSION @ISA @EXPORT_OK);
14*0Sstevel@tonic-gateuse Net::Config;
15*0Sstevel@tonic-gate
16*0Sstevel@tonic-gate@ISA = qw(Exporter);
17*0Sstevel@tonic-gate@EXPORT_OK = qw(hostname hostdomain hostfqdn domainname);
18*0Sstevel@tonic-gate
19*0Sstevel@tonic-gate$VERSION = "2.19"; # $Id: //depot/libnet/Net/Domain.pm#21 $
20*0Sstevel@tonic-gate
21*0Sstevel@tonic-gatemy($host,$domain,$fqdn) = (undef,undef,undef);
22*0Sstevel@tonic-gate
23*0Sstevel@tonic-gate# Try every conceivable way to get hostname.
24*0Sstevel@tonic-gate
25*0Sstevel@tonic-gatesub _hostname {
26*0Sstevel@tonic-gate
27*0Sstevel@tonic-gate    # we already know it
28*0Sstevel@tonic-gate    return $host
29*0Sstevel@tonic-gate    	if(defined $host);
30*0Sstevel@tonic-gate
31*0Sstevel@tonic-gate    if ($^O eq 'MSWin32') {
32*0Sstevel@tonic-gate        require Socket;
33*0Sstevel@tonic-gate        my ($name,$alias,$type,$len,@addr) =  gethostbyname($ENV{'COMPUTERNAME'}||'localhost');
34*0Sstevel@tonic-gate        while (@addr)
35*0Sstevel@tonic-gate         {
36*0Sstevel@tonic-gate          my $a = shift(@addr);
37*0Sstevel@tonic-gate          $host = gethostbyaddr($a,Socket::AF_INET());
38*0Sstevel@tonic-gate          last if defined $host;
39*0Sstevel@tonic-gate         }
40*0Sstevel@tonic-gate        if (defined($host) && index($host,'.') > 0) {
41*0Sstevel@tonic-gate           $fqdn = $host;
42*0Sstevel@tonic-gate           ($host,$domain) = $fqdn =~ /^([^\.]+)\.(.*)$/;
43*0Sstevel@tonic-gate         }
44*0Sstevel@tonic-gate        return $host;
45*0Sstevel@tonic-gate    }
46*0Sstevel@tonic-gate    elsif ($^O eq 'MacOS') {
47*0Sstevel@tonic-gate	chomp ($host = `hostname`);
48*0Sstevel@tonic-gate    }
49*0Sstevel@tonic-gate    elsif ($^O eq 'VMS') {   ## multiple varieties of net s/w makes this hard
50*0Sstevel@tonic-gate        $host = $ENV{'UCX$INET_HOST'} if defined($ENV{'UCX$INET_HOST'});
51*0Sstevel@tonic-gate        $host = $ENV{'MULTINET_HOST_NAME'} if defined($ENV{'MULTINET_HOST_NAME'});
52*0Sstevel@tonic-gate        if (index($host,'.') > 0) {
53*0Sstevel@tonic-gate           $fqdn = $host;
54*0Sstevel@tonic-gate           ($host,$domain) = $fqdn =~ /^([^\.]+)\.(.*)$/;
55*0Sstevel@tonic-gate        }
56*0Sstevel@tonic-gate        return $host;
57*0Sstevel@tonic-gate    }
58*0Sstevel@tonic-gate    else {
59*0Sstevel@tonic-gate	local $SIG{'__DIE__'};
60*0Sstevel@tonic-gate
61*0Sstevel@tonic-gate	# syscall is preferred since it avoids tainting problems
62*0Sstevel@tonic-gate	eval {
63*0Sstevel@tonic-gate    	    my $tmp = "\0" x 256; ## preload scalar
64*0Sstevel@tonic-gate    	    eval {
65*0Sstevel@tonic-gate    		package main;
66*0Sstevel@tonic-gate     		require "syscall.ph";
67*0Sstevel@tonic-gate		defined(&main::SYS_gethostname);
68*0Sstevel@tonic-gate    	    }
69*0Sstevel@tonic-gate    	    || eval {
70*0Sstevel@tonic-gate    		package main;
71*0Sstevel@tonic-gate     		require "sys/syscall.ph";
72*0Sstevel@tonic-gate		defined(&main::SYS_gethostname);
73*0Sstevel@tonic-gate    	    }
74*0Sstevel@tonic-gate            and $host = (syscall(&main::SYS_gethostname, $tmp, 256) == 0)
75*0Sstevel@tonic-gate		    ? $tmp
76*0Sstevel@tonic-gate		    : undef;
77*0Sstevel@tonic-gate	}
78*0Sstevel@tonic-gate
79*0Sstevel@tonic-gate	# POSIX
80*0Sstevel@tonic-gate	|| eval {
81*0Sstevel@tonic-gate	    require POSIX;
82*0Sstevel@tonic-gate	    $host = (POSIX::uname())[1];
83*0Sstevel@tonic-gate	}
84*0Sstevel@tonic-gate
85*0Sstevel@tonic-gate	# trusty old hostname command
86*0Sstevel@tonic-gate	|| eval {
87*0Sstevel@tonic-gate    	    chop($host = `(hostname) 2>/dev/null`); # BSD'ish
88*0Sstevel@tonic-gate	}
89*0Sstevel@tonic-gate
90*0Sstevel@tonic-gate	# sysV/POSIX uname command (may truncate)
91*0Sstevel@tonic-gate	|| eval {
92*0Sstevel@tonic-gate    	    chop($host = `uname -n 2>/dev/null`); ## SYSV'ish && POSIX'ish
93*0Sstevel@tonic-gate	}
94*0Sstevel@tonic-gate
95*0Sstevel@tonic-gate	# Apollo pre-SR10
96*0Sstevel@tonic-gate	|| eval {
97*0Sstevel@tonic-gate    	    $host = (split(/[:\. ]/,`/com/host`,6))[0];
98*0Sstevel@tonic-gate	}
99*0Sstevel@tonic-gate
100*0Sstevel@tonic-gate	|| eval {
101*0Sstevel@tonic-gate    	    $host = "";
102*0Sstevel@tonic-gate	};
103*0Sstevel@tonic-gate    }
104*0Sstevel@tonic-gate
105*0Sstevel@tonic-gate    # remove garbage
106*0Sstevel@tonic-gate    $host =~ s/[\0\r\n]+//go;
107*0Sstevel@tonic-gate    $host =~ s/(\A\.+|\.+\Z)//go;
108*0Sstevel@tonic-gate    $host =~ s/\.\.+/\./go;
109*0Sstevel@tonic-gate
110*0Sstevel@tonic-gate    $host;
111*0Sstevel@tonic-gate}
112*0Sstevel@tonic-gate
113*0Sstevel@tonic-gatesub _hostdomain {
114*0Sstevel@tonic-gate
115*0Sstevel@tonic-gate    # we already know it
116*0Sstevel@tonic-gate    return $domain
117*0Sstevel@tonic-gate    	if(defined $domain);
118*0Sstevel@tonic-gate
119*0Sstevel@tonic-gate    local $SIG{'__DIE__'};
120*0Sstevel@tonic-gate
121*0Sstevel@tonic-gate    return $domain = $NetConfig{'inet_domain'}
122*0Sstevel@tonic-gate	if defined $NetConfig{'inet_domain'};
123*0Sstevel@tonic-gate
124*0Sstevel@tonic-gate    # try looking in /etc/resolv.conf
125*0Sstevel@tonic-gate    # putting this here and assuming that it is correct, eliminates
126*0Sstevel@tonic-gate    # calls to gethostbyname, and therefore DNS lookups. This helps
127*0Sstevel@tonic-gate    # those on dialup systems.
128*0Sstevel@tonic-gate
129*0Sstevel@tonic-gate    local *RES;
130*0Sstevel@tonic-gate    local($_);
131*0Sstevel@tonic-gate
132*0Sstevel@tonic-gate    if(open(RES,"/etc/resolv.conf")) {
133*0Sstevel@tonic-gate    	while(<RES>) {
134*0Sstevel@tonic-gate    	    $domain = $1
135*0Sstevel@tonic-gate    	    	if(/\A\s*(?:domain|search)\s+(\S+)/);
136*0Sstevel@tonic-gate    	}
137*0Sstevel@tonic-gate    	close(RES);
138*0Sstevel@tonic-gate
139*0Sstevel@tonic-gate    	return $domain
140*0Sstevel@tonic-gate    	    if(defined $domain);
141*0Sstevel@tonic-gate    }
142*0Sstevel@tonic-gate
143*0Sstevel@tonic-gate    # just try hostname and system calls
144*0Sstevel@tonic-gate
145*0Sstevel@tonic-gate    my $host = _hostname();
146*0Sstevel@tonic-gate    my(@hosts);
147*0Sstevel@tonic-gate
148*0Sstevel@tonic-gate    @hosts = ($host,"localhost");
149*0Sstevel@tonic-gate
150*0Sstevel@tonic-gate    unless (defined($host) && $host =~ /\./) {
151*0Sstevel@tonic-gate	my $dom = undef;
152*0Sstevel@tonic-gate        eval {
153*0Sstevel@tonic-gate    	    my $tmp = "\0" x 256; ## preload scalar
154*0Sstevel@tonic-gate    	    eval {
155*0Sstevel@tonic-gate    	        package main;
156*0Sstevel@tonic-gate     	        require "syscall.ph";
157*0Sstevel@tonic-gate    	    }
158*0Sstevel@tonic-gate    	    || eval {
159*0Sstevel@tonic-gate    	        package main;
160*0Sstevel@tonic-gate     	        require "sys/syscall.ph";
161*0Sstevel@tonic-gate    	    }
162*0Sstevel@tonic-gate            and $dom = (syscall(&main::SYS_getdomainname, $tmp, 256) == 0)
163*0Sstevel@tonic-gate		    ? $tmp
164*0Sstevel@tonic-gate		    : undef;
165*0Sstevel@tonic-gate        };
166*0Sstevel@tonic-gate
167*0Sstevel@tonic-gate	if ( $^O eq 'VMS' ) {
168*0Sstevel@tonic-gate	    $dom ||= $ENV{'TCPIP$INET_DOMAIN'}
169*0Sstevel@tonic-gate		 || $ENV{'UCX$INET_DOMAIN'};
170*0Sstevel@tonic-gate	}
171*0Sstevel@tonic-gate
172*0Sstevel@tonic-gate	chop($dom = `domainname 2>/dev/null`)
173*0Sstevel@tonic-gate		unless(defined $dom || $^O =~ /^(?:cygwin|MSWin32)/);
174*0Sstevel@tonic-gate
175*0Sstevel@tonic-gate	if(defined $dom) {
176*0Sstevel@tonic-gate	    my @h = ();
177*0Sstevel@tonic-gate	    $dom =~ s/^\.+//;
178*0Sstevel@tonic-gate	    while(length($dom)) {
179*0Sstevel@tonic-gate		push(@h, "$host.$dom");
180*0Sstevel@tonic-gate		$dom =~ s/^[^.]+.+// or last;
181*0Sstevel@tonic-gate	    }
182*0Sstevel@tonic-gate	    unshift(@hosts,@h);
183*0Sstevel@tonic-gate    	}
184*0Sstevel@tonic-gate    }
185*0Sstevel@tonic-gate
186*0Sstevel@tonic-gate    # Attempt to locate FQDN
187*0Sstevel@tonic-gate
188*0Sstevel@tonic-gate    foreach (grep {defined $_} @hosts) {
189*0Sstevel@tonic-gate    	my @info = gethostbyname($_);
190*0Sstevel@tonic-gate
191*0Sstevel@tonic-gate    	next unless @info;
192*0Sstevel@tonic-gate
193*0Sstevel@tonic-gate    	# look at real name & aliases
194*0Sstevel@tonic-gate    	my $site;
195*0Sstevel@tonic-gate    	foreach $site ($info[0], split(/ /,$info[1])) {
196*0Sstevel@tonic-gate    	    if(rindex($site,".") > 0) {
197*0Sstevel@tonic-gate
198*0Sstevel@tonic-gate    	    	# Extract domain from FQDN
199*0Sstevel@tonic-gate
200*0Sstevel@tonic-gate     	    	($domain = $site) =~ s/\A[^\.]+\.//;
201*0Sstevel@tonic-gate     	        return $domain;
202*0Sstevel@tonic-gate    	    }
203*0Sstevel@tonic-gate    	}
204*0Sstevel@tonic-gate    }
205*0Sstevel@tonic-gate
206*0Sstevel@tonic-gate    # Look for environment variable
207*0Sstevel@tonic-gate
208*0Sstevel@tonic-gate    $domain ||= $ENV{LOCALDOMAIN} || $ENV{DOMAIN};
209*0Sstevel@tonic-gate
210*0Sstevel@tonic-gate    if(defined $domain) {
211*0Sstevel@tonic-gate    	$domain =~ s/[\r\n\0]+//g;
212*0Sstevel@tonic-gate    	$domain =~ s/(\A\.+|\.+\Z)//g;
213*0Sstevel@tonic-gate    	$domain =~ s/\.\.+/\./g;
214*0Sstevel@tonic-gate    }
215*0Sstevel@tonic-gate
216*0Sstevel@tonic-gate    $domain;
217*0Sstevel@tonic-gate}
218*0Sstevel@tonic-gate
219*0Sstevel@tonic-gatesub domainname {
220*0Sstevel@tonic-gate
221*0Sstevel@tonic-gate    return $fqdn
222*0Sstevel@tonic-gate    	if(defined $fqdn);
223*0Sstevel@tonic-gate
224*0Sstevel@tonic-gate    _hostname();
225*0Sstevel@tonic-gate    _hostdomain();
226*0Sstevel@tonic-gate
227*0Sstevel@tonic-gate    # Assumption: If the host name does not contain a period
228*0Sstevel@tonic-gate    # and the domain name does, then assume that they are correct
229*0Sstevel@tonic-gate    # this helps to eliminate calls to gethostbyname, and therefore
230*0Sstevel@tonic-gate    # eleminate DNS lookups
231*0Sstevel@tonic-gate
232*0Sstevel@tonic-gate    return $fqdn = $host . "." . $domain
233*0Sstevel@tonic-gate	if(defined $host and defined $domain
234*0Sstevel@tonic-gate		and $host !~ /\./ and $domain =~ /\./);
235*0Sstevel@tonic-gate
236*0Sstevel@tonic-gate    # For hosts that have no name, just an IP address
237*0Sstevel@tonic-gate    return $fqdn = $host if defined $host and $host =~ /^\d+(\.\d+){3}$/;
238*0Sstevel@tonic-gate
239*0Sstevel@tonic-gate    my @host   = defined $host   ? split(/\./, $host)   : ('localhost');
240*0Sstevel@tonic-gate    my @domain = defined $domain ? split(/\./, $domain) : ();
241*0Sstevel@tonic-gate    my @fqdn   = ();
242*0Sstevel@tonic-gate
243*0Sstevel@tonic-gate    # Determine from @host & @domain the FQDN
244*0Sstevel@tonic-gate
245*0Sstevel@tonic-gate    my @d = @domain;
246*0Sstevel@tonic-gate
247*0Sstevel@tonic-gateLOOP:
248*0Sstevel@tonic-gate    while(1) {
249*0Sstevel@tonic-gate    	my @h = @host;
250*0Sstevel@tonic-gate    	while(@h) {
251*0Sstevel@tonic-gate    	    my $tmp = join(".",@h,@d);
252*0Sstevel@tonic-gate    	    if((gethostbyname($tmp))[0]) {
253*0Sstevel@tonic-gate     	        @fqdn = (@h,@d);
254*0Sstevel@tonic-gate     	        $fqdn = $tmp;
255*0Sstevel@tonic-gate     	      last LOOP;
256*0Sstevel@tonic-gate    	    }
257*0Sstevel@tonic-gate    	    pop @h;
258*0Sstevel@tonic-gate    	}
259*0Sstevel@tonic-gate    	last unless shift @d;
260*0Sstevel@tonic-gate    }
261*0Sstevel@tonic-gate
262*0Sstevel@tonic-gate    if(@fqdn) {
263*0Sstevel@tonic-gate    	$host = shift @fqdn;
264*0Sstevel@tonic-gate    	until((gethostbyname($host))[0]) {
265*0Sstevel@tonic-gate    	    $host .= "." . shift @fqdn;
266*0Sstevel@tonic-gate    	}
267*0Sstevel@tonic-gate    	$domain = join(".", @fqdn);
268*0Sstevel@tonic-gate    }
269*0Sstevel@tonic-gate    else {
270*0Sstevel@tonic-gate    	undef $host;
271*0Sstevel@tonic-gate    	undef $domain;
272*0Sstevel@tonic-gate    	undef $fqdn;
273*0Sstevel@tonic-gate    }
274*0Sstevel@tonic-gate
275*0Sstevel@tonic-gate    $fqdn;
276*0Sstevel@tonic-gate}
277*0Sstevel@tonic-gate
278*0Sstevel@tonic-gatesub hostfqdn { domainname() }
279*0Sstevel@tonic-gate
280*0Sstevel@tonic-gatesub hostname {
281*0Sstevel@tonic-gate    domainname()
282*0Sstevel@tonic-gate    	unless(defined $host);
283*0Sstevel@tonic-gate    return $host;
284*0Sstevel@tonic-gate}
285*0Sstevel@tonic-gate
286*0Sstevel@tonic-gatesub hostdomain {
287*0Sstevel@tonic-gate    domainname()
288*0Sstevel@tonic-gate    	unless(defined $domain);
289*0Sstevel@tonic-gate    return $domain;
290*0Sstevel@tonic-gate}
291*0Sstevel@tonic-gate
292*0Sstevel@tonic-gate1; # Keep require happy
293*0Sstevel@tonic-gate
294*0Sstevel@tonic-gate__END__
295*0Sstevel@tonic-gate
296*0Sstevel@tonic-gate=head1 NAME
297*0Sstevel@tonic-gate
298*0Sstevel@tonic-gateNet::Domain - Attempt to evaluate the current host's internet name and domain
299*0Sstevel@tonic-gate
300*0Sstevel@tonic-gate=head1 SYNOPSIS
301*0Sstevel@tonic-gate
302*0Sstevel@tonic-gate    use Net::Domain qw(hostname hostfqdn hostdomain);
303*0Sstevel@tonic-gate
304*0Sstevel@tonic-gate=head1 DESCRIPTION
305*0Sstevel@tonic-gate
306*0Sstevel@tonic-gateUsing various methods B<attempt> to find the Fully Qualified Domain Name (FQDN)
307*0Sstevel@tonic-gateof the current host. From this determine the host-name and the host-domain.
308*0Sstevel@tonic-gate
309*0Sstevel@tonic-gateEach of the functions will return I<undef> if the FQDN cannot be determined.
310*0Sstevel@tonic-gate
311*0Sstevel@tonic-gate=over 4
312*0Sstevel@tonic-gate
313*0Sstevel@tonic-gate=item hostfqdn ()
314*0Sstevel@tonic-gate
315*0Sstevel@tonic-gateIdentify and return the FQDN of the current host.
316*0Sstevel@tonic-gate
317*0Sstevel@tonic-gate=item hostname ()
318*0Sstevel@tonic-gate
319*0Sstevel@tonic-gateReturns the smallest part of the FQDN which can be used to identify the host.
320*0Sstevel@tonic-gate
321*0Sstevel@tonic-gate=item hostdomain ()
322*0Sstevel@tonic-gate
323*0Sstevel@tonic-gateReturns the remainder of the FQDN after the I<hostname> has been removed.
324*0Sstevel@tonic-gate
325*0Sstevel@tonic-gate=back
326*0Sstevel@tonic-gate
327*0Sstevel@tonic-gate=head1 AUTHOR
328*0Sstevel@tonic-gate
329*0Sstevel@tonic-gateGraham Barr <gbarr@pobox.com>.
330*0Sstevel@tonic-gateAdapted from Sys::Hostname by David Sundstrom <sunds@asictest.sc.ti.com>
331*0Sstevel@tonic-gate
332*0Sstevel@tonic-gate=head1 COPYRIGHT
333*0Sstevel@tonic-gate
334*0Sstevel@tonic-gateCopyright (c) 1995-1998 Graham Barr. All rights reserved.
335*0Sstevel@tonic-gateThis program is free software; you can redistribute it and/or modify
336*0Sstevel@tonic-gateit under the same terms as Perl itself.
337*0Sstevel@tonic-gate
338*0Sstevel@tonic-gate=for html <hr>
339*0Sstevel@tonic-gate
340*0Sstevel@tonic-gateI<$Id: //depot/libnet/Net/Domain.pm#21 $>
341*0Sstevel@tonic-gate
342*0Sstevel@tonic-gate=cut
343