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.19"; # $Id: //depot/libnet/Net/Domain.pm#21 $
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)/);
178 while(length($dom)) {
179 push(@h, "$host.$dom");
180 $dom =~ s/^[^.]+.+// or last;
186 # Attempt to locate FQDN
188 foreach (grep {defined $_} @hosts) {
189 my @info = gethostbyname($_);
193 # look at real name & aliases
195 foreach $site ($info[0], split(/ /,$info[1])) {
196 if(rindex($site,".") > 0) {
198 # Extract domain from FQDN
200 ($domain = $site) =~ s/\A[^\.]+\.//;
206 # Look for environment variable
208 $domain ||= $ENV{LOCALDOMAIN} || $ENV{DOMAIN};
210 if(defined $domain) {
211 $domain =~ s/[\r\n\0]+//g;
212 $domain =~ s/(\A\.+|\.+\Z)//g;
213 $domain =~ s/\.\.+/\./g;
227 # Assumption: If the host name does not contain a period
228 # and the domain name does, then assume that they are correct
229 # this helps to eliminate calls to gethostbyname, and therefore
230 # eleminate DNS lookups
232 return $fqdn = $host . "." . $domain
233 if(defined $host and defined $domain
234 and $host !~ /\./ and $domain =~ /\./);
236 # For hosts that have no name, just an IP address
237 return $fqdn = $host if defined $host and $host =~ /^\d+(\.\d+){3}$/;
239 my @host = defined $host ? split(/\./, $host) : ('localhost');
240 my @domain = defined $domain ? split(/\./, $domain) : ();
243 # Determine from @host & @domain the FQDN
251 my $tmp = join(".",@h,@d);
252 if((gethostbyname($tmp))[0]) {
259 last unless shift @d;
264 until((gethostbyname($host))[0]) {
265 $host .= "." . shift @fqdn;
267 $domain = join(".", @fqdn);
278 sub hostfqdn { domainname() }
282 unless(defined $host);
288 unless(defined $domain);
292 1; # Keep require happy
298 Net::Domain - Attempt to evaluate the current host's internet name and domain
302 use Net::Domain qw(hostname hostfqdn hostdomain);
306 Using various methods B<attempt> to find the Fully Qualified Domain Name (FQDN)
307 of the current host. From this determine the host-name and the host-domain.
309 Each of the functions will return I<undef> if the FQDN cannot be determined.
315 Identify and return the FQDN of the current host.
319 Returns the smallest part of the FQDN which can be used to identify the host.
323 Returns the remainder of the FQDN after the I<hostname> has been removed.
329 Graham Barr <gbarr@pobox.com>.
330 Adapted from Sys::Hostname by David Sundstrom <sunds@asictest.sc.ti.com>
334 Copyright (c) 1995-1998 Graham Barr. All rights reserved.
335 This program is free software; you can redistribute it and/or modify
336 it under the same terms as Perl itself.
340 I<$Id: //depot/libnet/Net/Domain.pm#21 $>