lib/Sys/Hostname.pm

   1 package Sys::Hostname;
   2
   3 use Carp;
   4 require Exporter;
   5 @ISA = qw(Exporter);
   6 @EXPORT = qw(hostname);
   7
   8 =head1 NAME
   9
  10 Sys::Hostname - Try every conceivable way to get hostname
  11
  12 =head1 SYNOPSIS
  13
  14     use Sys::Hostname;
  15     $host = hostname;
  16
  17 =head1 DESCRIPTION
  18
  19 Attempts several methods of getting the system hostname and
  20 then caches the result.  It tries C<syscall(SYS_gethostname)>,
  21 C<`hostname`>, C<`uname -n`>, and the file F</com/host>.
  22 If all that fails it C<croak>s.
  23
  24 All nulls, returns, and newlines are removed from the result.
  25
  26 =head1 AUTHOR
  27
  28 David Sundstrom E<lt>F<sunds@asictest.sc.ti.com>E<gt>
  29
  30 Texas Instruments
  31
  32 =cut
  33
  34 sub hostname {
  35
  36   # method 1 - we already know it
  37   return $host if defined $host;
  38
  39   if ($^O eq 'VMS') {
  40
  41     # method 2 - no sockets ==> return DECnet node name
  42     eval {my($test) = gethostbyname('me')}; # returns 'me' on most systems
  43     if ($@) { return $host = $ENV{'SYS$NODE'}; }
  44
  45     # method 3 - has someone else done the job already?  It's common for the
  46     #    TCP/IP stack to advertise the hostname via a logical name.  (Are
  47     #    there any other logicals which TCP/IP stacks use for the host name?)
  48     $host = $ENV{'ARPANET_HOST_NAME'}  || $ENV{'INTERNET_HOST_NAME'} ||
  49             $ENV{'MULTINET_HOST_NAME'} || $ENV{'UCX$INET_HOST'}      ||
  50             $ENV{'TCPWARE_DOMAINNAME'} || $ENV{'NEWS_ADDRESS'};
  51     return $host if $host;
  52
  53     # method 4 - does hostname happen to work?
  54     my($rslt) = `hostname`;
  55     if ($rslt !~ /IVVERB/) { ($host) = $rslt =~ /^(\S+)/; }
  56     return $host if $host;
  57
  58     # rats!
  59     $host = '';
  60     Carp::croak "Cannot get host name of local machine";
  61
  62   }
  63   else {  # Unix
  64
  65     # method 2 - syscall is preferred since it avoids tainting problems
  66     eval {
  67         {
  68             package main;
  69             require "syscall.ph";
  70         }
  71         $host = "\0" x 65; ## preload scalar
  72         syscall(&main::SYS_gethostname, $host, 65) == 0;
  73     }
  74
  75     # method 3 - trusty old hostname command
  76     || eval {
  77         $host = `(hostname) 2>/dev/null`; # bsdish
  78     }
  79
  80     # method 4 - sysV uname command (may truncate)
  81     || eval {
  82         $host = `uname -n 2>/dev/null`; ## sysVish
  83     }
  84
  85     # method 5 - Apollo pre-SR10
  86     || eval {
  87         ($host,$a,$b,$c,$d)=split(/[:\. ]/,`/com/host`,6);
  88     }
  89
  90     # bummer
  91     || Carp::croak "Cannot get host name of local machine";
  92
  93     # remove garbage
  94     $host =~ tr/\0\r\n//d;
  95     $host;
  96   }
  97 }
  98
  99 1;