This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
prefer POSIX::uname() rather than syscalls, which require attempting
[perl5.git] / 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   elsif ($^O eq 'epoc') {
69     $host = 'localhost';
70     return $host;
71   }
72   else {  # Unix
73
74     # method 2 - use POSIX.pm, prefer the standard library to system calls
75     eval {
76         local $SIG{__DIE__};
77         require POSIX;
78         $host = (POSIX::uname())[1];
79     }
80     # method 3 - otherwise syscall is preferred since it avoids tainting problems
81     || eval {
82         local $SIG{__DIE__};
83         require "syscall.ph";
84         $host = "\0" x 65; ## preload scalar
85         syscall(&SYS_gethostname, $host, 65) == 0;
86     }
87
88     # method 3a - syscall using systeminfo instead of gethostname
89     #           -- needed on systems like Solaris
90     || eval {
91         local $SIG{__DIE__};
92         require "sys/syscall.ph";
93         require "sys/systeminfo.ph";
94         $host = "\0" x 65; ## preload scalar
95         syscall(&SYS_systeminfo, &SI_HOSTNAME, $host, 65) != -1;
96     }
97
98     # method 4 - trusty old hostname command
99     || eval {
100         local $SIG{__DIE__};
101         local $SIG{CHLD};
102         $host = `(hostname) 2>/dev/null`; # bsdish
103     }
104
105     # method 5 - sysV uname command (may truncate)
106     || eval {
107         local $SIG{__DIE__};
108         $host = `uname -n 2>/dev/null`; ## sysVish
109     }
110
111     # method 6 - Apollo pre-SR10
112     || eval {
113         local $SIG{__DIE__};
114         ($host,$a,$b,$c,$d)=split(/[:\. ]/,`/com/host`,6);
115     }
116
117     # bummer
118     || Carp::croak "Cannot get host name of local machine";  
119
120     # remove garbage 
121     $host =~ tr/\0\r\n//d;
122     $host;
123   }
124 }
125
126 1;