[Summary view] [Print] [Text view]

   1  package Sys::Hostname;
   2  
   3  use strict;
   4  
   5  use Carp;
   6  
   7  require Exporter;
   8  require AutoLoader;
   9  
  10  our @ISA     = qw/ Exporter AutoLoader /;
  11  our @EXPORT  = qw/ hostname /;
  12  
  13  our $VERSION;
  14  
  15  our $host;
  16  
  17  BEGIN {
  18      $VERSION = '1.11';
  19      {
  20      local $SIG{__DIE__};
  21      eval {
  22          require XSLoader;
  23          XSLoader::load('Sys::Hostname', $VERSION);
  24      };
  25      warn $@ if $@;
  26      }
  27  }
  28  
  29  
  30  sub hostname {
  31  
  32    # method 1 - we already know it
  33    return $host if defined $host;
  34  
  35    # method 1' - try to ask the system
  36    $host = ghname() if defined &ghname;
  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      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    elsif ($^O eq 'epoc') {
  69      $host = 'localhost';
  70      return $host;
  71    }
  72    else {  # Unix
  73      # is anyone going to make it here?
  74  
  75      local $ENV{PATH} = '/usr/bin:/bin:/usr/sbin:/sbin'; # Paranoia.
  76  
  77      # method 2 - syscall is preferred since it avoids tainting problems
  78      # XXX: is it such a good idea to return hostname untainted?
  79      eval {
  80      local $SIG{__DIE__};
  81      require "syscall.ph";
  82      $host = "\0" x 65; ## preload scalar
  83      syscall(&SYS_gethostname, $host, 65) == 0;
  84      }
  85  
  86      # method 2a - syscall using systeminfo instead of gethostname
  87      #           -- needed on systems like Solaris
  88      || eval {
  89      local $SIG{__DIE__};
  90      require "sys/syscall.ph";
  91      require "sys/systeminfo.ph";
  92      $host = "\0" x 65; ## preload scalar
  93      syscall(&SYS_systeminfo, &SI_HOSTNAME, $host, 65) != -1;
  94      }
  95  
  96      # method 3 - trusty old hostname command
  97      || eval {
  98      local $SIG{__DIE__};
  99      local $SIG{CHLD};
 100      $host = `(hostname) 2>/dev/null`; # bsdish
 101      }
 102  
 103      # method 4 - use POSIX::uname(), which strictly can't be expected to be
 104      # correct
 105      || eval {
 106      local $SIG{__DIE__};
 107      require POSIX;
 108      $host = (POSIX::uname())[1];
 109      }
 110  
 111      # method 5 - sysV uname command (may truncate)
 112      || eval {
 113      local $SIG{__DIE__};
 114      $host = `uname -n 2>/dev/null`; ## sysVish
 115      }
 116  
 117      # method 6 - Apollo pre-SR10
 118      || eval {
 119      local $SIG{__DIE__};
 120          my($a,$b,$c,$d);
 121      ($host,$a,$b,$c,$d)=split(/[:\. ]/,`/com/host`,6);
 122      }
 123  
 124      # bummer
 125      || croak "Cannot get host name of local machine";  
 126  
 127      # remove garbage 
 128      $host =~ tr/\0\r\n//d;
 129      $host;
 130    }
 131  }
 132  
 133  1;
 134  
 135  __END__
 136  
 137  =head1 NAME
 138  
 139  Sys::Hostname - Try every conceivable way to get hostname
 140  
 141  =head1 SYNOPSIS
 142  
 143      use Sys::Hostname;
 144      $host = hostname;
 145  
 146  =head1 DESCRIPTION
 147  
 148  Attempts several methods of getting the system hostname and
 149  then caches the result.  It tries the first available of the C
 150  library's gethostname(), C<`$Config{aphostname}`>, uname(2),
 151  C<syscall(SYS_gethostname)>, C<`hostname`>, C<`uname -n`>,
 152  and the file F</com/host>.  If all that fails it C<croak>s.
 153  
 154  All NULs, returns, and newlines are removed from the result.
 155  
 156  =head1 AUTHOR
 157  
 158  David Sundstrom E<lt>F<sunds@asictest.sc.ti.com>E<gt>
 159  
 160  Texas Instruments
 161  
 162  XS code added by Greg Bacon E<lt>F<gbacon@cs.uah.edu>E<gt>
 163  
 164  =cut
 165