contrib/perl5/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 { local $SIG{__DIE__}; $host = (gethostbyname('me'))[0] };
  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   elsif ($^O eq 'MSWin32') {
  64     ($host) = gethostbyname('localhost');
  65     chomp($host = `hostname 2> NUL`) unless defined $host;
  66     return $host;
  67   }
  68   else {  # Unix
  69
  70     # method 2 - syscall is preferred since it avoids tainting problems
  71     eval {
  72         local $SIG{__DIE__};
  73         {
  74             package main;
  75             require "syscall.ph";
  76         }
  77         $host = "\0" x 65; ## preload scalar
  78         syscall(&main::SYS_gethostname, $host, 65) == 0;
  79     }
  80
  81     # method 2a - syscall using systeminfo instead of gethostname
  82     #           -- needed on systems like Solaris
  83     || eval {
  84         local $SIG{__DIE__};
  85         {
  86             package main;
  87             require "sys/syscall.ph";
  88             require "sys/systeminfo.ph";
  89         }
  90         $host = "\0" x 65; ## preload scalar
  91         syscall(&main::SYS_systeminfo, &main::SI_HOSTNAME, $host, 65) != -1;
  92     }
  93
  94     # method 3 - trusty old hostname command
  95     || eval {
  96         $pathstack = $ENV{'PATH'};
  97         $ENV{'PATH'} = "/bin:/usr/bin";
  98         local $SIG{__DIE__};
  99         $host = `(hostname) 2>/dev/null`; # bsdish
 100         $ENV{'PATH'} = $pathstack;
 101     }
 102
 103     # method 4 - sysV uname command (may truncate)
 104     || eval {
 105         $pathstack = $ENV{'PATH'};
 106         $ENV{'PATH'} = "/bin:/usr/bin";
 107         local $SIG{__DIE__};
 108         $host = `uname -n 2>/dev/null`; ## sysVish
 109         $ENV{'PATH'} = $pathstack;
 110     }
 111
 112     # method 5 - Apollo pre-SR10
 113     || eval {
 114         local $SIG{__DIE__};
 115         ($host,$a,$b,$c,$d)=split(/[:\. ]/,`/com/host`,6);
 116     }
 117
 118     # bummer
 119     || Carp::croak "Cannot get host name of local machine";
 120
 121     # remove garbage
 122     $host =~ tr/\0\r\n//d;
 123     $host;
 124   }
 125 }
 126
 127 1;