# Copyright (c) 1995-1998 Graham Barr <gbarr@pobox.com>. All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
use vars
qw($VERSION @ISA @EXPORT_OK);
@EXPORT_OK = qw(hostname hostdomain hostfqdn domainname);
$VERSION = "2.17"; # $Id: //depot/libnet/Net/Domain.pm#19 $
my($host,$domain,$fqdn) = (undef,undef,undef);
# Try every conceivable way to get hostname.
my ($name,$alias,$type,$len,@addr) = gethostbyname($ENV{'COMPUTERNAME'}||'localhost');
$host = gethostbyaddr($a,Socket
::AF_INET
());
if (defined($host) && index($host,'.') > 0) {
($host,$domain) = $fqdn =~ /^([^\.]+)\.(.*)$/;
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) {
($host,$domain) = $fqdn =~ /^([^\.]+)\.(.*)$/;
# syscall is preferred since it avoids tainting problems
my $tmp = "\0" x
256; ## preload scalar
defined(&main
::SYS_gethostname
);
require "sys/syscall.ph";
defined(&main
::SYS_gethostname
);
and $host = (syscall(&main
::SYS_gethostname
, $tmp, 256) == 0)
$host = (POSIX
::uname
())[1];
# trusty old hostname command
chop($host = `(hostname) 2>/dev/null`); # BSD'ish
# sysV/POSIX uname command (may truncate)
chop($host = `uname -n 2>/dev/null`); ## SYSV'ish && POSIX'ish
$host = (split(/[:\. ]/,`/com/host`,6))[0];
$host =~ s/[\0\r\n]+//go;
$host =~ s/(\A\.+|\.+\Z)//go;
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.
if(open(RES
,"/etc/resolv.conf")) {
if(/\A\s*(?:domain|search)\s+(\S+)/);
# just try hostname and system calls
@hosts = ($host,"localhost");
unless (defined($host) && $host =~ /\./) {
my $tmp = "\0" x
256; ## preload scalar
require "sys/syscall.ph";
and $dom = (syscall(&main
::SYS_getdomainname
, $tmp, 256) == 0)
chop($dom = `domainname 2>/dev/null`)
unless(defined $dom || $^O
=~ /^(?:cygwin|MSWin32)/);
foreach (grep {defined $_} @hosts) {
my @info = gethostbyname($_);
# look at real name & aliases
foreach $site ($info[0], split(/ /,$info[1])) {
if(rindex($site,".") > 0) {
# Extract domain from FQDN
($domain = $site) =~ s/\A[^\.]+\.//;
# Look for environment variable
$domain ||= $ENV{LOCALDOMAIN
} || $ENV{DOMAIN
};
$domain =~ s/[\r\n\0]+//g;
$domain =~ s/(\A\.+|\.+\Z)//g;
# 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
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) : ();
# Determine from @host & @domain the FQDN
my $tmp = join(".",@h,@d);
if((gethostbyname($tmp))[0]) {
until((gethostbyname($host))[0]) {
$host .= "." . shift @fqdn;
$domain = join(".", @fqdn);
sub hostfqdn
{ domainname
() }
Net::Domain - Attempt to evaluate the current host's internet name and domain
use Net::Domain qw(hostname hostfqdn hostdomain);
Using various methods B<attempt> 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<undef> if the FQDN cannot be determined.
Identify and return the FQDN of the current host.
Returns the smallest part of the FQDN which can be used to identify the host.
Returns the remainder of the FQDN after the I<hostname> has been removed.
Graham Barr <gbarr@pobox.com>.
Adapted from Sys::Hostname by David Sundstrom <sunds@asictest.sc.ti.com>
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.
I<$Id: //depot/libnet/Net/Domain.pm#19 $>