use vars qw($VERSION @ISA @EXPORT_OK);
use Net::Config;
-@ISA = qw(Exporter);
+@ISA = qw(Exporter);
@EXPORT_OK = qw(hostname hostdomain hostfqdn domainname);
-$VERSION = "2.19_01"; # $Id: //depot/libnet/Net/Domain.pm#21 $
+$VERSION = "2.20";
-my($host,$domain,$fqdn) = (undef,undef,undef);
+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`);
+ # 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;
}
- 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;
+ if (defined($host) && index($host, '.') > 0) {
+ $fqdn = $host;
+ ($host, $domain) = $fqdn =~ /^([^\.]+)\.(.*)$/;
}
- 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 = "";
- };
+ 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__'};
- # remove garbage
- $host =~ s/[\0\r\n]+//go;
- $host =~ s/(\A\.+|\.+\Z)//go;
- $host =~ s/\.\.+/\./go;
-
- $host;
+ # 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);
+ # we already know it
+ return $domain
+ if (defined $domain);
- local $SIG{'__DIE__'};
+ 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 ($_);
- return $domain = $NetConfig{'inet_domain'}
- if defined $NetConfig{'inet_domain'};
+ if (open(RES, "/etc/resolv.conf")) {
+ while (<RES>) {
+ $domain = $1
+ if (/\A\s*(?:domain|search)\s+(\S+)/);
+ }
+ close(RES);
+
+ return $domain
+ if (defined $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.
+ # just try hostname and system calls
- local *RES;
- local($_);
+ my $host = _hostname();
+ my (@hosts);
- if(open(RES,"/etc/resolv.conf")) {
- while(<RES>) {
- $domain = $1
- if(/\A\s*(?:domain|search)\s+(\S+)/);
- }
- close(RES);
+ @hosts = ($host, "localhost");
- return $domain
- if(defined $domain);
+ 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'};
}
- # 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);
- }
+ 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
+ # Attempt to locate FQDN
- foreach (grep {defined $_} @hosts) {
- my @info = gethostbyname($_);
+ foreach (grep { defined $_ } @hosts) {
+ my @info = gethostbyname($_);
- next unless @info;
+ next unless @info;
- # look at real name & aliases
- my $site;
- foreach $site ($info[0], split(/ /,$info[1])) {
- if(rindex($site,".") > 0) {
+ # look at real name & aliases
+ my $site;
+ foreach $site ($info[0], split(/ /, $info[1])) {
+ if (rindex($site, ".") > 0) {
- # Extract domain from FQDN
+ # Extract domain from FQDN
- ($domain = $site) =~ s/\A[^\.]+\.//;
- return $domain;
- }
- }
+ ($domain = $site) =~ s/\A[^\.]+\.//;
+ return $domain;
+ }
}
+ }
- # Look for environment variable
+ # Look for environment variable
- $domain ||= $ENV{LOCALDOMAIN} || $ENV{DOMAIN};
+ $domain ||= $ENV{LOCALDOMAIN} || $ENV{DOMAIN};
- if(defined $domain) {
- $domain =~ s/[\r\n\0]+//g;
- $domain =~ s/(\A\.+|\.+\Z)//g;
- $domain =~ s/\.\.+/\./g;
- }
+ if (defined $domain) {
+ $domain =~ s/[\r\n\0]+//g;
+ $domain =~ s/(\A\.+|\.+\Z)//g;
+ $domain =~ s/\.\.+/\./g;
+ }
- $domain;
+ $domain;
}
+
sub domainname {
- return $fqdn
- if(defined $fqdn);
+ return $fqdn
+ if (defined $fqdn);
- _hostname();
- _hostdomain();
+ _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
+ # 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 =~ /\./);
+ 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}$/;
+ # 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 = ();
+ my @host = defined $host ? split(/\./, $host) : ('localhost');
+ my @domain = defined $domain ? split(/\./, $domain) : ();
+ my @fqdn = ();
- # Determine from @host & @domain the FQDN
+ # Determine from @host & @domain the FQDN
- my @d = @domain;
+ 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;
+ 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;
+ if (@fqdn) {
+ $host = shift @fqdn;
+ until ((gethostbyname($host))[0]) {
+ $host .= "." . shift @fqdn;
}
-
- $fqdn;
+ $domain = join(".", @fqdn);
+ }
+ else {
+ undef $host;
+ undef $domain;
+ undef $fqdn;
+ }
+
+ $fqdn;
}
+
sub hostfqdn { domainname() }
+
sub hostname {
- domainname()
- unless(defined $host);
- return $host;
+ domainname()
+ unless (defined $host);
+ return $host;
}
+
sub hostdomain {
- domainname()
- unless(defined $domain);
- return $domain;
+ domainname()
+ unless (defined $domain);
+ return $domain;
}
-1; # Keep require happy
+1; # Keep require happy
__END__
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#21 $>
-
=cut
projects / p5sagit/p5-mst-13.2.git / blobdiff