home *** CD-ROM | disk | FTP | other *** search
/ PC World 2005 December (Special) / PCWorld_2005-12_Special_cd.bin / Bezpecnost / lsti / lsti.exe / framework-2.5.exe / Hostname.pm < prev    next >
Text File  |  2005-01-27  |  4KB  |  166 lines
  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.  
  166.