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.14"; # $Id: //depot/libnet/Net/Domain.pm#15 $
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 (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.
131 if(open(RES,"/etc/resolv.conf")) {
134 if(/\A\s*(?:domain|search)\s+(\S+)/);
142 # just try hostname and system calls
144 my $host = _hostname();
148 @hosts = ($host,"localhost");
150 unless($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 eq 'MSWin32');
172 while(length($dom)) {
173 push(@h, "$host.$dom");
180 # Attempt to locate FQDN
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($host !~ /\./ && $domain =~ /\./);
229 # For hosts that have no name, just an IP address
230 return $fqdn = $host if $host =~ /^\d+(\.\d+){3}$/;
232 my @host = split(/\./, $host);
233 my @domain = split(/\./, $domain);
236 # Determine from @host & @domain the FQDN
244 my $tmp = join(".",@h,@d);
245 if((gethostbyname($tmp))[0]) {
252 last unless shift @d;
257 until((gethostbyname($host))[0]) {
258 $host .= "." . shift @fqdn;
260 $domain = join(".", @fqdn);
271 sub hostfqdn { domainname() }
275 unless(defined $host);
281 unless(defined $domain);
285 1; # Keep require happy
291 Net::Domain - Attempt to evaluate the current host's internet name and domain
295 use Net::Domain qw(hostname hostfqdn hostdomain);
299 Using various methods B<attempt> to find the Fully Qualified Domain Name (FQDN)
300 of the current host. From this determine the host-name and the host-domain.
302 Each of the functions will return I<undef> if the FQDN cannot be determined.
308 Identify and return the FQDN of the current host.
312 Returns the smallest part of the FQDN which can be used to identify the host.
316 Returns the remainder of the FQDN after the I<hostname> has been removed.
322 Graham Barr <gbarr@pobox.com>.
323 Adapted from Sys::Hostname by David Sundstrom <sunds@asictest.sc.ti.com>
327 Copyright (c) 1995-1998 Graham Barr. All rights reserved.
328 This program is free software; you can redistribute it and/or modify
329 it under the same terms as Perl itself.
333 I<$Id: //depot/libnet/Net/Domain.pm#15 $>