lib/Sys/Hostname.pm

   1 package Sys::Hostname;
   2
   3 use Carp;
   4 use Config;
   5 require Exporter;
   6 @ISA = qw(Exporter);
   7 @EXPORT = qw(hostname);
   8
   9 =head1 NAME
  10
  11 Sys::Hostname - Try every conceivable way to get hostname
  12
  13 =head1 SYNOPSIS
  14
  15     use Sys::Hostname;
  16     $host = hostname;
  17
  18 =head1 DESCRIPTION
  19
  20 Attempts several methods of getting the system hostname and
  21 then caches the result.  It tries C<syscall(SYS_gethostname)>,
  22 C<`hostname`>, C<`uname -n`>, and the file F</com/host>.
  23 If all that fails it C<croak>s.
  24
  25 All nulls, returns, and newlines are removed from the result.
  26
  27 =head1 AUTHOR
  28
  29 David Sundstrom <sunds@asictest.sc.ti.com>
  30
  31 Texas Instruments
  32
  33 =cut
  34
  35 sub hostname {
  36
  37   # method 1 - we already know it
  38   return $host if defined $host;
  39
  40   if ($Config{'osname'} eq 'VMS') {
  41
  42     # method 2 - no sockets ==> return DECnet node name
  43     if (!$Config{'d_has_sockets'}) { 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     Carp::croak "Cannot get host name of local machine";
  60
  61   }
  62   else {  # Unix
  63
  64     # method 2 - syscall is preferred since it avoids tainting problems
  65     eval {
  66         {
  67             package main;
  68             require "syscall.ph";
  69         }
  70         $host = "\0" x 65; ## preload scalar
  71         syscall(&main::SYS_gethostname, $host, 65) == 0;
  72     }
  73
  74     # method 3 - trusty old hostname command
  75     || eval {
  76         $host = `(hostname) 2>/dev/null`; # bsdish
  77     }
  78
  79     # method 4 - sysV uname command (may truncate)
  80     || eval {
  81         $host = `uname -n 2>/dev/null`; ## sysVish
  82     }
  83
  84     # method 5 - Apollo pre-SR10
  85     || eval {
  86         ($host,$a,$b,$c,$d)=split(/[:\. ]/,`/com/host`,6);
  87     }
  88
  89     # bummer
  90     || Carp::croak "Cannot get host name of local machine";
  91
  92     # remove garbage
  93     $host =~ tr/\0\r\n//d;
  94     $host;
  95   }
  96 }
  97
  98 1;