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 <sunds@asictest.sc.ti.com>
  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     # method 2 - syscall is preferred since it avoids tainting problems
  40     eval {
  41         {
  42             package main;
  43             require "syscall.ph";
  44         }
  45         $host = "\0" x 65; ## preload scalar
  46         syscall(&main::SYS_gethostname, $host, 65) == 0;
  47     }
  48
  49     # method 3 - trusty old hostname command
  50     || eval {
  51         $host = `(hostname) 2>/dev/null`; # bsdish
  52     }
  53
  54     # method 4 - sysV uname command (may truncate)
  55     || eval {
  56         $host = `uname -n 2>/dev/null`; ## sysVish
  57     }
  58
  59     # method 5 - Apollo pre-SR10
  60     || eval {
  61         ($host,$a,$b,$c,$d)=split(/[:\. ]/,`/com/host`,6);
  62     }
  63
  64     # bummer
  65     || Carp::croak "Cannot get host name of local machine";
  66
  67     # remove garbage
  68     $host =~ tr/\0\r\n//d;
  69     $host;
  70 }
  71
  72 1;