# Net::Domain.pm
#
-# Copyright (c) 1995 Graham Barr <Graham.Barr@tiuk.ti.com>. All rights
-# reserved. This program is free software; you can redistribute it and/or
+# 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.
package Net::Domain;
-=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 <bodg@tiuk.ti.com>.
-Adapted from Sys::Hostname by David Sundstrom <sunds@asictest.sc.ti.com>
-
-=head1 REVISION
-
-$Revision: 2.0 $
-
-=head1 COPYRIGHT
-
-Copyright (c) 1995 Graham Barr. All rights reserved.
-This library is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself.
-
-=cut
-
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 = sprintf("%d.%02d", q$Revision: 2.0 $ =~ /(\d+)\.(\d+)/);
+$VERSION = "2.17"; # $Id: //depot/libnet/Net/Domain.pm#19 $
my($host,$domain,$fqdn) = (undef,undef,undef);
sub _hostname {
- # method 1 - we already know it
+ # we already know it
return $host
if(defined $host);
- # method 2 - syscall is preferred since it avoids tainting problems
- eval {
- {
- package main;
- require "syscall.ph";
- }
- my $tmp = "\0" x 65; ## preload scalar
- $host = (syscall(&main::SYS_gethostname, $tmp, 65) == 0) ? $tmp : undef;
+ 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;
}
-
-
- # method 3 - trusty old hostname command
- || eval {
- chop($host = `(hostname) 2>/dev/null`); # BSD'ish
+ elsif ($^O eq 'MacOS') {
+ chomp ($host = `hostname`);
}
-
- # method 4 - sysV/POSIX uname command (may truncate)
- || eval {
- chop($host = `uname -n 2>/dev/null`); ## SYSV'ish && POSIX'ish
+ 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;
}
-
-
- # method 5 - Apollo pre-SR10
- || eval {
- $host = (split(/[:\. ]/,`/com/host`,6))[0];
+ 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 = "";
+ };
}
- || eval {
- $host = "";
- };
-
- # remove garbage
+ # remove garbage
$host =~ s/[\0\r\n]+//go;
$host =~ s/(\A\.+|\.+\Z)//go;
$host =~ s/\.\.+/\./go;
sub _hostdomain {
- # method 1 - we already know it
+ # we already know it
return $domain
if(defined $domain);
- # method 2 - just try hostname and system calls
+ local $SIG{'__DIE__'};
- my $host = _hostname();
- my($dom,$site,@hosts);
+ 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(<RES>) {
+ $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($host =~ /\./) {
- chop($dom = `domainname 2>/dev/null`);
- unshift(@hosts, "$host.$dom")
- if (defined $dom && $dom ne "");
+ 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;
+ };
+
+ chop($dom = `domainname 2>/dev/null`)
+ unless(defined $dom || $^O =~ /^(?:cygwin|MSWin32)/);
+
+ if(defined $dom) {
+ my @h = ();
+ while(length($dom)) {
+ push(@h, "$host.$dom");
+ $dom =~ s/^[^.]+.//;
+ }
+ unshift(@hosts,@h);
+ }
}
# Attempt to locate FQDN
- foreach (@hosts) {
+ foreach (grep {defined $_} @hosts) {
my @info = gethostbyname($_);
next unless @info;
# look at real name & aliases
- foreach $site ($info[0], split(/ /,$info[1])) {
+ my $site;
+ foreach $site ($info[0], split(/ /,$info[1])) {
if(rindex($site,".") > 0) {
# Extract domain from FQDN
- ($domain = $site) =~ s/\A[^\.]+\.//;
+ ($domain = $site) =~ s/\A[^\.]+\.//;
return $domain;
}
}
}
- # try looking in /etc/resolv.conf
-
- local *RES;
-
- if(open(RES,"/etc/resolv.conf")) {
- while(<RES>) {
- $domain = $1
- if(/\A\s*(?:domain|search)\s+(\S+)/);
- }
- close(RES);
-
- return $domain
- if(defined $domain);
- }
-
# Look for environment variable
- $domain ||= $ENV{DOMAIN} || undef;
+ $domain ||= $ENV{LOCALDOMAIN} || $ENV{DOMAIN};
if(defined $domain) {
$domain =~ s/[\r\n\0]+//g;
_hostname();
_hostdomain();
- my @host = split(/\./, $host);
- my @domain = split(/\./, $domain);
+ # 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;
}
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<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.
+This program is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=for html <hr>
+
+I<$Id: //depot/libnet/Net/Domain.pm#19 $>
+
+=cut
projects / p5sagit/p5-mst-13.2.git / blobdiff