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);
21 my ($host, $domain, $fqdn) = (undef, undef, undef);
23 # Try every conceivable way to get hostname.
32 if ($^O eq 'MSWin32') {
34 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);
75 (syscall(&main::SYS_gethostname, $tmp, 256) == 0)
83 $host = (POSIX::uname())[1];
86 # trusty old hostname command
88 chop($host = `(hostname) 2>/dev/null`); # BSD'ish
91 # sysV/POSIX uname command (may truncate)
93 chop($host = `uname -n 2>/dev/null`); ## SYSV'ish && POSIX'ish
97 || eval { $host = (split(/[:\. ]/, `/com/host`, 6))[0]; }
99 || eval { $host = ""; };
103 $host =~ s/[\0\r\n]+//go;
104 $host =~ s/(\A\.+|\.+\Z)//go;
105 $host =~ s/\.\.+/\./go;
115 if (defined $domain);
117 local $SIG{'__DIE__'};
119 return $domain = $NetConfig{'inet_domain'}
120 if defined $NetConfig{'inet_domain'};
122 # try looking in /etc/resolv.conf
123 # putting this here and assuming that it is correct, eliminates
124 # calls to gethostbyname, and therefore DNS lookups. This helps
125 # those on dialup systems.
130 if (open(RES, "/etc/resolv.conf")) {
133 if (/\A\s*(?:domain|search)\s+(\S+)/);
138 if (defined $domain);
141 # just try hostname and system calls
143 my $host = _hostname();
146 @hosts = ($host, "localhost");
148 unless (defined($host) && $host =~ /\./) {
151 my $tmp = "\0" x 256; ## preload scalar
154 require "syscall.ph";
158 require "sys/syscall.ph";
161 (syscall(&main::SYS_getdomainname, $tmp, 256) == 0)
167 $dom ||= $ENV{'TCPIP$INET_DOMAIN'}
168 || $ENV{'UCX$INET_DOMAIN'};
171 chop($dom = `domainname 2>/dev/null`)
172 unless (defined $dom || $^O =~ /^(?:cygwin|MSWin32)/);
177 while (length($dom)) {
178 push(@h, "$host.$dom");
179 $dom =~ s/^[^.]+.+// or last;
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;
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
236 and $domain =~ /\./);
238 # For hosts that have no name, just an IP address
239 return $fqdn = $host if defined $host and $host =~ /^\d+(\.\d+){3}$/;
241 my @host = defined $host ? split(/\./, $host) : ('localhost');
242 my @domain = defined $domain ? split(/\./, $domain) : ();
245 # Determine from @host & @domain the FQDN
253 my $tmp = join(".", @h, @d);
254 if ((gethostbyname($tmp))[0]) {
261 last unless shift @d;
266 until ((gethostbyname($host))[0]) {
267 $host .= "." . shift @fqdn;
269 $domain = join(".", @fqdn);
281 sub hostfqdn { domainname() }
286 unless (defined $host);
293 unless (defined $domain);
297 1; # Keep require happy
303 Net::Domain - Attempt to evaluate the current host's internet name and domain
307 use Net::Domain qw(hostname hostfqdn hostdomain domainname);
311 Using various methods B<attempt> to find the Fully Qualified Domain Name (FQDN)
312 of the current host. From this determine the host-name and the host-domain.
314 Each of the functions will return I<undef> if the FQDN cannot be determined.
320 Identify and return the FQDN of the current host.
324 An alias for hostfqdn ().
328 Returns the smallest part of the FQDN which can be used to identify the host.
332 Returns the remainder of the FQDN after the I<hostname> has been removed.
338 Graham Barr <gbarr@pobox.com>.
339 Adapted from Sys::Hostname by David Sundstrom <sunds@asictest.sc.ti.com>
343 Copyright (c) 1995-1998 Graham Barr. All rights reserved.
344 This program is free software; you can redistribute it and/or modify
345 it under the same terms as Perl itself.