Filename | /usr/local/lib/perl5/5.32/mach/Sys/Hostname.pm |
Statements | Executed 4 statements in 59µs |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 34µs | 54µs | hostname | Sys::Hostname::
1 | 1 | 1 | 20µs | 20µs | ghname (xsub) | Sys::Hostname::
0 | 0 | 0 | 0s | 0s | BEGIN@14 | Sys::Hostname::
0 | 0 | 0 | 0s | 0s | BEGIN@18 | Sys::Hostname::
0 | 0 | 0 | 0s | 0s | BEGIN@3 | Sys::Hostname::
0 | 0 | 0 | 0s | 0s | BEGIN@5 | Sys::Hostname::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Sys::Hostname; | ||||
2 | |||||
3 | use strict; | ||||
4 | |||||
5 | use Carp; | ||||
6 | |||||
7 | require Exporter; | ||||
8 | |||||
9 | our @ISA = qw/ Exporter /; | ||||
10 | our @EXPORT = qw/ hostname /; | ||||
11 | |||||
12 | our $VERSION; | ||||
13 | |||||
14 | use warnings (); | ||||
15 | |||||
16 | our $host; | ||||
17 | |||||
18 | BEGIN { | ||||
19 | $VERSION = '1.23'; | ||||
20 | { | ||||
21 | local $SIG{__DIE__}; | ||||
22 | eval { | ||||
23 | require XSLoader; | ||||
24 | XSLoader::load(); | ||||
25 | }; | ||||
26 | warn $@ if $@; | ||||
27 | } | ||||
28 | } | ||||
29 | |||||
30 | |||||
31 | # spent 54µs (34+20) within Sys::Hostname::hostname which was called:
# once (34µs+20µs) by File::NFSLock::new at line 110 of File/NFSLock.pm | ||||
32 | 1 | 900ns | @_ and croak("hostname() does not accepts arguments (it used to silently discard any provided)"); | ||
33 | |||||
34 | # method 1 - we already know it | ||||
35 | 1 | 900ns | return $host if defined $host; | ||
36 | |||||
37 | # method 1' - try to ask the system | ||||
38 | 1 | 38µs | 1 | 20µs | $host = ghname() if defined &ghname; # spent 20µs making 1 call to Sys::Hostname::ghname |
39 | 1 | 18µs | return $host if defined $host; | ||
40 | |||||
41 | if ($^O eq 'VMS') { | ||||
42 | |||||
43 | # method 2 - no sockets ==> return DECnet node name | ||||
44 | eval { local $SIG{__DIE__}; $host = (gethostbyname('me'))[0] }; | ||||
45 | if ($@) { return $host = $ENV{'SYS$NODE'}; } | ||||
46 | |||||
47 | # method 3 - has someone else done the job already? It's common for the | ||||
48 | # TCP/IP stack to advertise the hostname via a logical name. (Are | ||||
49 | # there any other logicals which TCP/IP stacks use for the host name?) | ||||
50 | $host = $ENV{'ARPANET_HOST_NAME'} || $ENV{'INTERNET_HOST_NAME'} || | ||||
51 | $ENV{'MULTINET_HOST_NAME'} || $ENV{'UCX$INET_HOST'} || | ||||
52 | $ENV{'TCPWARE_DOMAINNAME'} || $ENV{'NEWS_ADDRESS'}; | ||||
53 | return $host if $host; | ||||
54 | |||||
55 | # method 4 - does hostname happen to work? | ||||
56 | my($rslt) = `hostname`; | ||||
57 | if ($rslt !~ /IVVERB/) { ($host) = $rslt =~ /^(\S+)/; } | ||||
58 | return $host if $host; | ||||
59 | |||||
60 | # rats! | ||||
61 | $host = ''; | ||||
62 | croak "Cannot get host name of local machine"; | ||||
63 | |||||
64 | } | ||||
65 | elsif ($^O eq 'MSWin32') { | ||||
66 | ($host) = gethostbyname('localhost'); | ||||
67 | chomp($host = `hostname 2> NUL`) unless defined $host; | ||||
68 | return $host; | ||||
69 | } | ||||
70 | else { # Unix | ||||
71 | # is anyone going to make it here? | ||||
72 | |||||
73 | local $ENV{PATH} = '/usr/bin:/bin:/usr/sbin:/sbin'; # Paranoia. | ||||
74 | |||||
75 | # method 2 - syscall is preferred since it avoids tainting problems | ||||
76 | # XXX: is it such a good idea to return hostname untainted? | ||||
77 | eval { | ||||
78 | local $SIG{__DIE__}; | ||||
79 | require "syscall.ph"; | ||||
80 | $host = "\0" x 65; ## preload scalar | ||||
81 | syscall(&SYS_gethostname, $host, 65) == 0; | ||||
82 | } | ||||
83 | |||||
84 | # method 2a - syscall using systeminfo instead of gethostname | ||||
85 | # -- needed on systems like Solaris | ||||
86 | || eval { | ||||
87 | local $SIG{__DIE__}; | ||||
88 | require "sys/syscall.ph"; | ||||
89 | require "sys/systeminfo.ph"; | ||||
90 | $host = "\0" x 65; ## preload scalar | ||||
91 | syscall(&SYS_systeminfo, &SI_HOSTNAME, $host, 65) != -1; | ||||
92 | } | ||||
93 | |||||
94 | # method 3 - trusty old hostname command | ||||
95 | || eval { | ||||
96 | local $SIG{__DIE__}; | ||||
97 | local $SIG{CHLD}; | ||||
98 | $host = `(hostname) 2>/dev/null`; # BSDish | ||||
99 | } | ||||
100 | |||||
101 | # method 4 - use POSIX::uname(), which strictly can't be expected to be | ||||
102 | # correct | ||||
103 | || eval { | ||||
104 | local $SIG{__DIE__}; | ||||
105 | require POSIX; | ||||
106 | $host = (POSIX::uname())[1]; | ||||
107 | } | ||||
108 | |||||
109 | # method 5 - sysV uname command (may truncate) | ||||
110 | || eval { | ||||
111 | local $SIG{__DIE__}; | ||||
112 | $host = `uname -n 2>/dev/null`; ## sysVish | ||||
113 | } | ||||
114 | |||||
115 | # bummer | ||||
116 | || croak "Cannot get host name of local machine"; | ||||
117 | |||||
118 | # remove garbage | ||||
119 | $host =~ tr/\0\r\n//d; | ||||
120 | $host; | ||||
121 | } | ||||
122 | } | ||||
123 | |||||
124 | 1; | ||||
125 | |||||
126 | __END__ | ||||
# spent 20µs within Sys::Hostname::ghname which was called:
# once (20µs+0s) by Sys::Hostname::hostname at line 38 |