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.18"; # $Id: //depot/libnet/Net/Domain.pm#20 $
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 if ( $^O eq 'VMS' ) {
168 $dom ||= $ENV{'TCPIP$INET_DOMAIN'}
169 || $ENV{'UCX$INET_DOMAIN'};
172 chop($dom = `domainname 2>/dev/null`)
173 unless(defined $dom || $^O =~ /^(?:cygwin|MSWin32)/);
177 while(length($dom)) {
178 push(@h, "$host.$dom");
185 # Attempt to locate FQDN
187 foreach (grep {defined $_} @hosts) {
188 my @info = gethostbyname($_);
192 # look at real name & aliases
194 foreach $site ($info[0], split(/ /,$info[1])) {
195 if(rindex($site,".") > 0) {
197 # Extract domain from FQDN
199 ($domain = $site) =~ s/\A[^\.]+\.//;
205 # Look for environment variable
207 $domain ||= $ENV{LOCALDOMAIN} || $ENV{DOMAIN};
209 if(defined $domain) {
210 $domain =~ s/[\r\n\0]+//g;
211 $domain =~ s/(\A\.+|\.+\Z)//g;
212 $domain =~ s/\.\.+/\./g;
226 # Assumption: If the host name does not contain a period
227 # and the domain name does, then assume that they are correct
228 # this helps to eliminate calls to gethostbyname, and therefore
229 # eleminate DNS lookups
231 return $fqdn = $host . "." . $domain
232 if(defined $host and defined $domain
233 and $host !~ /\./ and $domain =~ /\./);
235 # For hosts that have no name, just an IP address
236 return $fqdn = $host if defined $host and $host =~ /^\d+(\.\d+){3}$/;
238 my @host = defined $host ? split(/\./, $host) : ('localhost');
239 my @domain = defined $domain ? split(/\./, $domain) : ();
242 # Determine from @host & @domain the FQDN
250 my $tmp = join(".",@h,@d);
251 if((gethostbyname($tmp))[0]) {
258 last unless shift @d;
263 until((gethostbyname($host))[0]) {
264 $host .= "." . shift @fqdn;
266 $domain = join(".", @fqdn);
277 sub hostfqdn { domainname() }
281 unless(defined $host);
287 unless(defined $domain);
291 1; # Keep require happy
297 Net::Domain - Attempt to evaluate the current host's internet name and domain
301 use Net::Domain qw(hostname hostfqdn hostdomain);
305 Using various methods B<attempt> to find the Fully Qualified Domain Name (FQDN)
306 of the current host. From this determine the host-name and the host-domain.
308 Each of the functions will return I<undef> if the FQDN cannot be determined.
314 Identify and return the FQDN of the current host.
318 Returns the smallest part of the FQDN which can be used to identify the host.
322 Returns the remainder of the FQDN after the I<hostname> has been removed.
328 Graham Barr <gbarr@pobox.com>.
329 Adapted from Sys::Hostname by David Sundstrom <sunds@asictest.sc.ti.com>
333 Copyright (c) 1995-1998 Graham Barr. All rights reserved.
334 This program is free software; you can redistribute it and/or modify
335 it under the same terms as Perl itself.
339 I<$Id: //depot/libnet/Net/Domain.pm#20 $>