3 # Copyright (c) 1995-1998 Graham Barr <gbarr@pobox.com>. All rights reserved.
4 # This program is free software; you can redistribute it and/or
5 # modify it under the same terms as Perl itself.
13 use vars qw($VERSION @ISA @EXPORT_OK);
17 @EXPORT_OK = qw(hostname hostdomain hostfqdn domainname);
19 $VERSION = "2.17"; # $Id: //depot/libnet/Net/Domain.pm#19 $
21 my($host,$domain,$fqdn) = (undef,undef,undef);
23 # Try every conceivable way to get hostname.
31 if ($^O eq 'MSWin32') {
33 my ($name,$alias,$type,$len,@addr) = gethostbyname($ENV{'COMPUTERNAME'}||'localhost');
37 $host = gethostbyaddr($a,Socket::AF_INET());
38 last if defined $host;
40 if (defined($host) && index($host,'.') > 0) {
42 ($host,$domain) = $fqdn =~ /^([^\.]+)\.(.*)$/;
46 elsif ($^O eq 'MacOS') {
47 chomp ($host = `hostname`);
49 elsif ($^O eq 'VMS') { ## multiple varieties of net s/w makes this hard
50 $host = $ENV{'UCX$INET_HOST'} if defined($ENV{'UCX$INET_HOST'});
51 $host = $ENV{'MULTINET_HOST_NAME'} if defined($ENV{'MULTINET_HOST_NAME'});
52 if (index($host,'.') > 0) {
54 ($host,$domain) = $fqdn =~ /^([^\.]+)\.(.*)$/;
59 local $SIG{'__DIE__'};
61 # syscall is preferred since it avoids tainting problems
63 my $tmp = "\0" x 256; ## preload scalar
67 defined(&main::SYS_gethostname);
71 require "sys/syscall.ph";
72 defined(&main::SYS_gethostname);
74 and $host = (syscall(&main::SYS_gethostname, $tmp, 256) == 0)
82 $host = (POSIX::uname())[1];
85 # trusty old hostname command
87 chop($host = `(hostname) 2>/dev/null`); # BSD'ish
90 # sysV/POSIX uname command (may truncate)
92 chop($host = `uname -n 2>/dev/null`); ## SYSV'ish && POSIX'ish
97 $host = (split(/[:\. ]/,`/com/host`,6))[0];
106 $host =~ s/[\0\r\n]+//go;
107 $host =~ s/(\A\.+|\.+\Z)//go;
108 $host =~ s/\.\.+/\./go;
119 local $SIG{'__DIE__'};
121 return $domain = $NetConfig{'inet_domain'}
122 if defined $NetConfig{'inet_domain'};
124 # try looking in /etc/resolv.conf
125 # putting this here and assuming that it is correct, eliminates
126 # calls to gethostbyname, and therefore DNS lookups. This helps
127 # those on dialup systems.
132 if(open(RES,"/etc/resolv.conf")) {
135 if(/\A\s*(?:domain|search)\s+(\S+)/);
143 # just try hostname and system calls
145 my $host = _hostname();
148 @hosts = ($host,"localhost");
150 unless (defined($host) && $host =~ /\./) {
153 my $tmp = "\0" x 256; ## preload scalar
156 require "syscall.ph";
160 require "sys/syscall.ph";
162 and $dom = (syscall(&main::SYS_getdomainname, $tmp, 256) == 0)
167 chop($dom = `domainname 2>/dev/null`)
168 unless(defined $dom || $^O =~ /^(?:cygwin|MSWin32)/);
172 while(length($dom)) {
173 push(@h, "$host.$dom");
180 # Attempt to locate FQDN
182 foreach (grep {defined $_} @hosts) {
183 my @info = gethostbyname($_);
187 # look at real name & aliases
189 foreach $site ($info[0], split(/ /,$info[1])) {
190 if(rindex($site,".") > 0) {
192 # Extract domain from FQDN
194 ($domain = $site) =~ s/\A[^\.]+\.//;
200 # Look for environment variable
202 $domain ||= $ENV{LOCALDOMAIN} || $ENV{DOMAIN};
204 if(defined $domain) {
205 $domain =~ s/[\r\n\0]+//g;
206 $domain =~ s/(\A\.+|\.+\Z)//g;
207 $domain =~ s/\.\.+/\./g;
221 # Assumption: If the host name does not contain a period
222 # and the domain name does, then assume that they are correct
223 # this helps to eliminate calls to gethostbyname, and therefore
224 # eleminate DNS lookups
226 return $fqdn = $host . "." . $domain
227 if(defined $host and defined $domain
228 and $host !~ /\./ and $domain =~ /\./);
230 # For hosts that have no name, just an IP address
231 return $fqdn = $host if defined $host and $host =~ /^\d+(\.\d+){3}$/;
233 my @host = defined $host ? split(/\./, $host) : ('localhost');
234 my @domain = defined $domain ? split(/\./, $domain) : ();
237 # Determine from @host & @domain the FQDN
245 my $tmp = join(".",@h,@d);
246 if((gethostbyname($tmp))[0]) {
253 last unless shift @d;
258 until((gethostbyname($host))[0]) {
259 $host .= "." . shift @fqdn;
261 $domain = join(".", @fqdn);
272 sub hostfqdn { domainname() }
276 unless(defined $host);
282 unless(defined $domain);
286 1; # Keep require happy
292 Net::Domain - Attempt to evaluate the current host's internet name and domain
296 use Net::Domain qw(hostname hostfqdn hostdomain);
300 Using various methods B<attempt> to find the Fully Qualified Domain Name (FQDN)
301 of the current host. From this determine the host-name and the host-domain.
303 Each of the functions will return I<undef> if the FQDN cannot be determined.
309 Identify and return the FQDN of the current host.
313 Returns the smallest part of the FQDN which can be used to identify the host.
317 Returns the remainder of the FQDN after the I<hostname> has been removed.
323 Graham Barr <gbarr@pobox.com>.
324 Adapted from Sys::Hostname by David Sundstrom <sunds@asictest.sc.ti.com>
328 Copyright (c) 1995-1998 Graham Barr. All rights reserved.
329 This program is free software; you can redistribute it and/or modify
330 it under the same terms as Perl itself.
334 I<$Id: //depot/libnet/Net/Domain.pm#19 $>