# Net::Domain.pm # # Copyright (c) 1995-1998 Graham Barr . All rights reserved. # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. package Net::Domain; require Exporter; use Carp; use strict; use vars qw($VERSION @ISA @EXPORT_OK); use Net::Config; @ISA = qw(Exporter); @EXPORT_OK = qw(hostname hostdomain hostfqdn domainname); $VERSION = "2.19"; # $Id: //depot/libnet/Net/Domain.pm#21 $ my($host,$domain,$fqdn) = (undef,undef,undef); # Try every conceivable way to get hostname. sub _hostname { # we already know it return $host if(defined $host); if ($^O eq 'MSWin32') { require Socket; my ($name,$alias,$type,$len,@addr) = gethostbyname($ENV{'COMPUTERNAME'}||'localhost'); while (@addr) { my $a = shift(@addr); $host = gethostbyaddr($a,Socket::AF_INET()); last if defined $host; } if (defined($host) && index($host,'.') > 0) { $fqdn = $host; ($host,$domain) = $fqdn =~ /^([^\.]+)\.(.*)$/; } return $host; } elsif ($^O eq 'MacOS') { chomp ($host = `hostname`); } elsif ($^O eq 'VMS') { ## multiple varieties of net s/w makes this hard $host = $ENV{'UCX$INET_HOST'} if defined($ENV{'UCX$INET_HOST'}); $host = $ENV{'MULTINET_HOST_NAME'} if defined($ENV{'MULTINET_HOST_NAME'}); if (index($host,'.') > 0) { $fqdn = $host; ($host,$domain) = $fqdn =~ /^([^\.]+)\.(.*)$/; } return $host; } else { local $SIG{'__DIE__'}; # syscall is preferred since it avoids tainting problems eval { my $tmp = "\0" x 256; ## preload scalar eval { package main; require "syscall.ph"; defined(&main::SYS_gethostname); } || eval { package main; require "sys/syscall.ph"; defined(&main::SYS_gethostname); } and $host = (syscall(&main::SYS_gethostname, $tmp, 256) == 0) ? $tmp : undef; } # POSIX || eval { require POSIX; $host = (POSIX::uname())[1]; } # trusty old hostname command || eval { chop($host = `(hostname) 2>/dev/null`); # BSD'ish } # sysV/POSIX uname command (may truncate) || eval { chop($host = `uname -n 2>/dev/null`); ## SYSV'ish && POSIX'ish } # Apollo pre-SR10 || eval { $host = (split(/[:\. ]/,`/com/host`,6))[0]; } || eval { $host = ""; }; } # remove garbage $host =~ s/[\0\r\n]+//go; $host =~ s/(\A\.+|\.+\Z)//go; $host =~ s/\.\.+/\./go; $host; } sub _hostdomain { # we already know it return $domain if(defined $domain); local $SIG{'__DIE__'}; return $domain = $NetConfig{'inet_domain'} if defined $NetConfig{'inet_domain'}; # try looking in /etc/resolv.conf # putting this here and assuming that it is correct, eliminates # calls to gethostbyname, and therefore DNS lookups. This helps # those on dialup systems. local *RES; local($_); if(open(RES,"/etc/resolv.conf")) { while() { $domain = $1 if(/\A\s*(?:domain|search)\s+(\S+)/); } close(RES); return $domain if(defined $domain); } # just try hostname and system calls my $host = _hostname(); my(@hosts); @hosts = ($host,"localhost"); unless (defined($host) && $host =~ /\./) { my $dom = undef; eval { my $tmp = "\0" x 256; ## preload scalar eval { package main; require "syscall.ph"; } || eval { package main; require "sys/syscall.ph"; } and $dom = (syscall(&main::SYS_getdomainname, $tmp, 256) == 0) ? $tmp : undef; }; if ( $^O eq 'VMS' ) { $dom ||= $ENV{'TCPIP$INET_DOMAIN'} || $ENV{'UCX$INET_DOMAIN'}; } chop($dom = `domainname 2>/dev/null`) unless(defined $dom || $^O =~ /^(?:cygwin|MSWin32)/); if(defined $dom) { my @h = (); $dom =~ s/^\.+//; while(length($dom)) { push(@h, "$host.$dom"); $dom =~ s/^[^.]+.+// or last; } unshift(@hosts,@h); } } # Attempt to locate FQDN foreach (grep {defined $_} @hosts) { my @info = gethostbyname($_); next unless @info; # look at real name & aliases my $site; foreach $site ($info[0], split(/ /,$info[1])) { if(rindex($site,".") > 0) { # Extract domain from FQDN ($domain = $site) =~ s/\A[^\.]+\.//; return $domain; } } } # Look for environment variable $domain ||= $ENV{LOCALDOMAIN} || $ENV{DOMAIN}; if(defined $domain) { $domain =~ s/[\r\n\0]+//g; $domain =~ s/(\A\.+|\.+\Z)//g; $domain =~ s/\.\.+/\./g; } $domain; } sub domainname { return $fqdn if(defined $fqdn); _hostname(); _hostdomain(); # Assumption: If the host name does not contain a period # and the domain name does, then assume that they are correct # this helps to eliminate calls to gethostbyname, and therefore # eleminate DNS lookups return $fqdn = $host . "." . $domain if(defined $host and defined $domain and $host !~ /\./ and $domain =~ /\./); # For hosts that have no name, just an IP address return $fqdn = $host if defined $host and $host =~ /^\d+(\.\d+){3}$/; my @host = defined $host ? split(/\./, $host) : ('localhost'); my @domain = defined $domain ? split(/\./, $domain) : (); my @fqdn = (); # Determine from @host & @domain the FQDN my @d = @domain; LOOP: while(1) { my @h = @host; while(@h) { my $tmp = join(".",@h,@d); if((gethostbyname($tmp))[0]) { @fqdn = (@h,@d); $fqdn = $tmp; last LOOP; } pop @h; } last unless shift @d; } if(@fqdn) { $host = shift @fqdn; until((gethostbyname($host))[0]) { $host .= "." . shift @fqdn; } $domain = join(".", @fqdn); } else { undef $host; undef $domain; undef $fqdn; } $fqdn; } sub hostfqdn { domainname() } sub hostname { domainname() unless(defined $host); return $host; } sub hostdomain { domainname() unless(defined $domain); return $domain; } 1; # Keep require happy __END__ =head1 NAME Net::Domain - Attempt to evaluate the current host's internet name and domain =head1 SYNOPSIS use Net::Domain qw(hostname hostfqdn hostdomain); =head1 DESCRIPTION Using various methods B to find the Fully Qualified Domain Name (FQDN) of the current host. From this determine the host-name and the host-domain. Each of the functions will return I if the FQDN cannot be determined. =over 4 =item hostfqdn () Identify and return the FQDN of the current host. =item hostname () Returns the smallest part of the FQDN which can be used to identify the host. =item hostdomain () Returns the remainder of the FQDN after the I has been removed. =back =head1 AUTHOR Graham Barr . Adapted from Sys::Hostname by David Sundstrom =head1 COPYRIGHT Copyright (c) 1995-1998 Graham Barr. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =for html
I<$Id: //depot/libnet/Net/Domain.pm#21 $> =cut