diff -r 6d08f4a05d93 -r 3145852acc89 releasing/cbrtools/perl/Net/Domain.pm
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/releasing/cbrtools/perl/Net/Domain.pm	Fri Jun 25 18:37:20 2010 +0800
@@ -0,0 +1,342 @@
+# Net::Domain.pm
+#
+# 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;
+
+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 = "2.19"; # $Id: //depot/libnet/Net/Domain.pm#21 $
+
+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`);
+    }
+    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__'};
+
+	# 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);
+
+    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($_);
+
+    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 (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);
+    	}
+    }
+
+    # Attempt to locate FQDN
+
+    foreach (grep {defined $_} @hosts) {
+    	my @info = gethostbyname($_);
+
+    	next unless @info;
+
+    	# look at real name & aliases
+    	my $site;
+    	foreach $site ($info[0], split(/ /,$info[1])) {
+    	    if(rindex($site,".") > 0) {
+
+    	    	# Extract domain from FQDN
+
+     	    	($domain = $site) =~ s/\A[^\.]+\.//;
+     	        return $domain;
+    	    }
+    	}
+    }
+
+    # Look for environment variable
+
+    $domain ||= $ENV{LOCALDOMAIN} || $ENV{DOMAIN};
+
+    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
+
+    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;
+    	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;
+    }
+
+    $fqdn;
+}
+
+sub hostfqdn { domainname() }
+
+sub hostname {
+    domainname()
+    	unless(defined $host);
+    return $host;
+}
+
+sub hostdomain {
+    domainname()
+    	unless(defined $domain);
+    return $domain;
+}
+
+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#21 $>
+
+=cut