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
CommitLineData
a0d0e21e 1package Sys::Hostname;
8990e307 2
a0d0e21e 3use Carp;
8990e307 4require Exporter;
a0d0e21e
LW
5@ISA = qw(Exporter);
6@EXPORT = qw(hostname);
8990e307 7
cb1a09d0
AD
8=head1 NAME
9
10Sys::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
19Attempts several methods of getting the system hostname and
20then caches the result. It tries C<syscall(SYS_gethostname)>,
21C<`hostname`>, C<`uname -n`>, and the file F</com/host>.
22If all that fails it C<croak>s.
23
24All nulls, returns, and newlines are removed from the result.
25
26=head1 AUTHOR
27
1fef88e7 28David Sundstrom E<lt>F<sunds@asictest.sc.ti.com>E<gt>
cb1a09d0
AD
29
30Texas Instruments
31
32=cut
8990e307
LW
33
34sub hostname {
a0d0e21e 35
567d72c2 36 # method 1 - we already know it
37 return $host if defined $host;
38
c5f45532 39 if ($^O eq 'VMS') {
567d72c2 40
41 # method 2 - no sockets ==> return DECnet node name
84902520 42 eval { local $SIG{__DIE__}; $host = (gethostbyname('me'))[0] };
c5f45532 43 if ($@) { return $host = $ENV{'SYS$NODE'}; }
567d72c2 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!
c5f45532 59 $host = '';
567d72c2 60 Carp::croak "Cannot get host name of local machine";
61
62 }
7bac28a0 63 elsif ($^O eq 'MSWin32') {
64 ($host) = gethostbyname('localhost');
65 chomp($host = `hostname 2> NUL`) unless defined $host;
66 return $host;
67 }
3a2f06e9
GS
68 elsif ($^O eq 'epoc') {
69 $host = 'localhost';
70 return $host;
71 }
567d72c2 72 else { # Unix
8990e307 73
6bb694c1 74 # method 2 - use POSIX.pm, prefer the standard library to system calls
8990e307 75 eval {
84902520 76 local $SIG{__DIE__};
6bb694c1
GS
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";
8990e307 84 $host = "\0" x 65; ## preload scalar
6bb694c1 85 syscall(&SYS_gethostname, $host, 65) == 0;
8990e307
LW
86 }
87
6bb694c1 88 # method 3a - syscall using systeminfo instead of gethostname
67693aa5
TB
89 # -- needed on systems like Solaris
90 || eval {
91 local $SIG{__DIE__};
6bb694c1
GS
92 require "sys/syscall.ph";
93 require "sys/systeminfo.ph";
67693aa5 94 $host = "\0" x 65; ## preload scalar
6bb694c1 95 syscall(&SYS_systeminfo, &SI_HOSTNAME, $host, 65) != -1;
67693aa5
TB
96 }
97
6bb694c1 98 # method 4 - trusty old hostname command
8990e307 99 || eval {
84902520 100 local $SIG{__DIE__};
b522bf06 101 local $SIG{CHLD};
a0d0e21e 102 $host = `(hostname) 2>/dev/null`; # bsdish
8990e307
LW
103 }
104
6bb694c1 105 # method 5 - sysV uname command (may truncate)
8990e307 106 || eval {
84902520 107 local $SIG{__DIE__};
85e6fe83 108 $host = `uname -n 2>/dev/null`; ## sysVish
8990e307
LW
109 }
110
6bb694c1 111 # method 6 - Apollo pre-SR10
8990e307 112 || eval {
84902520 113 local $SIG{__DIE__};
8990e307
LW
114 ($host,$a,$b,$c,$d)=split(/[:\. ]/,`/com/host`,6);
115 }
116
117 # bummer
a0d0e21e 118 || Carp::croak "Cannot get host name of local machine";
8990e307
LW
119
120 # remove garbage
121 $host =~ tr/\0\r\n//d;
122 $host;
567d72c2 123 }
8990e307
LW
124}
125
1261;