X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FNet%2FDomain.pm;h=b79ec8fa073fddd4570b95e8b3ced211da349a80;hb=446eaa427e017001f2d47e21b0ad20ce965cd808;hp=558b7f311107e5f0488bc8c5448a1ab640dfb652;hpb=7e1af8bca57f405a8444b575a870918a6d88fc5c;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/Net/Domain.pm b/lib/Net/Domain.pm index 558b7f3..b79ec8f 100644 --- a/lib/Net/Domain.pm +++ b/lib/Net/Domain.pm @@ -1,69 +1,22 @@ # Net::Domain.pm # -# Copyright (c) 1995 Graham Barr . All rights -# reserved. This program is free software; you can redistribute it and/or +# 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; -=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 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); @@ -71,42 +24,85 @@ 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; @@ -116,61 +112,94 @@ sub _hostname { 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() { + $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() { - $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; @@ -189,14 +218,26 @@ sub domainname { _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; @@ -243,3 +284,53 @@ sub hostdomain { } 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#19 $> + +=cut