Domain.pm revision 7c478bd95313f5f23a4c958a745db2134aa03244
# Net::Domain.pm
#
# Copyright (c) 1995-1998 Graham Barr <gbarr@pobox.com>. All rights reserved.
# modify it under the same terms as Perl itself.
require Exporter;
use Carp;
use strict;
# Try every conceivable way to get hostname.
sub _hostname {
# we already know it
return $host
if(defined $host);
if ($^O eq 'MSWin32') {
require Socket;
while (@addr)
{
my $a = shift(@addr);
last if defined $host;
}
}
return $host;
}
elsif ($^O eq 'MacOS') {
}
elsif ($^O eq 'VMS') { ## multiple varieties of net s/w makes this hard
}
return $host;
}
else {
local $SIG{'__DIE__'};
# syscall is preferred since it avoids tainting problems
eval {
eval {
package main;
require "syscall.ph";
defined(&main::SYS_gethostname);
}
|| eval {
package main;
require "sys/syscall.ph";
defined(&main::SYS_gethostname);
}
? $tmp
: undef;
}
# POSIX
|| eval {
require POSIX;
}
# trusty old hostname command
|| eval {
}
|| eval {
}
# Apollo pre-SR10
|| eval {
}
|| eval {
$host = "";
};
}
# remove garbage
$host;
}
sub _hostdomain {
# we already know it
return $domain
if(defined $domain);
local $SIG{'__DIE__'};
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(<RES>) {
$domain = $1
}
close(RES);
return $domain
if(defined $domain);
}
# just try hostname and system calls
my(@hosts);
my $dom = undef;
eval {
eval {
package main;
require "syscall.ph";
}
|| eval {
package main;
require "sys/syscall.ph";
}
? $tmp
: undef;
};
if ( $^O eq 'VMS' ) {
|| $ENV{'UCX$INET_DOMAIN'};
}
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;
# Extract domain from FQDN
return $domain;
}
}
}
# Look for environment variable
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
# For hosts that have no name, just an IP address
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);
last LOOP;
}
pop @h;
}
last unless shift @d;
}
if(@fqdn) {
until((gethostbyname($host))[0]) {
}
}
else {
undef $host;
undef $domain;
undef $fqdn;
}
$fqdn;
}
sub hostfqdn { domainname() }
sub hostname {
unless(defined $host);
return $host;
}
sub hostdomain {
unless(defined $domain);
return $domain;
}
1; # Keep require happy
=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<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.
=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<hostname> has been removed.
=back
=head1 AUTHOR
Graham Barr <gbarr@pobox.com>.
Adapted from Sys::Hostname by David Sundstrom <sunds@asictest.sc.ti.com>
=head1 COPYRIGHT
Copyright (c) 1995-1998 Graham Barr. All rights reserved.
it under the same terms as Perl itself.
=for html <hr>
=cut