Filename | /usr/local/lib/perl5/5.24/Net/Config.pm |
Statements | Executed 51 statements in 5.14ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 2.73ms | 2.73ms | CORE:gpwuid (opcode) | Net::Config::
1 | 1 | 1 | 49µs | 49µs | BEGIN@13 | Net::Config::
13 | 1 | 1 | 48µs | 48µs | CORE:match (opcode) | Net::Config::
2 | 2 | 1 | 39µs | 39µs | CORE:ftfile (opcode) | Net::Config::
1 | 1 | 1 | 32µs | 188µs | BEGIN@19 | Net::Config::
1 | 1 | 1 | 24µs | 33µs | BEGIN@15 | Net::Config::
1 | 1 | 1 | 24µs | 24µs | CORE:subst (opcode) | Net::Config::
1 | 1 | 1 | 22µs | 53µs | BEGIN@16 | Net::Config::
1 | 1 | 1 | 22µs | 148µs | BEGIN@18 | Net::Config::
0 | 0 | 0 | 0s | 0s | requires_firewall | Net::Config::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | # Net::Config.pm | ||||
2 | # | ||||
3 | # Versions up to 1.11 Copyright (c) 2000 Graham Barr <gbarr@pobox.com>. | ||||
4 | # All rights reserved. | ||||
5 | # Changes in Version 1.11_01 onwards Copyright (C) 2013-2014 Steve Hay. All | ||||
6 | # rights reserved. | ||||
7 | # This module is free software; you can redistribute it and/or modify it under | ||||
8 | # the same terms as Perl itself, i.e. under the terms of either the GNU General | ||||
9 | # Public License or the Artistic License, as specified in the F<LICENCE> file. | ||||
10 | |||||
11 | package Net::Config; | ||||
12 | |||||
13 | 2 | 114µs | 1 | 49µs | # spent 49µs within Net::Config::BEGIN@13 which was called:
# once (49µs+0s) by Net::SMTP::BEGIN@21 at line 13 # spent 49µs making 1 call to Net::Config::BEGIN@13 |
14 | |||||
15 | 2 | 73µs | 2 | 41µs | # spent 33µs (24+9) within Net::Config::BEGIN@15 which was called:
# once (24µs+9µs) by Net::SMTP::BEGIN@21 at line 15 # spent 33µs making 1 call to Net::Config::BEGIN@15
# spent 9µs making 1 call to strict::import |
16 | 2 | 84µs | 2 | 84µs | # spent 53µs (22+31) within Net::Config::BEGIN@16 which was called:
# once (22µs+31µs) by Net::SMTP::BEGIN@21 at line 16 # spent 53µs making 1 call to Net::Config::BEGIN@16
# spent 31µs making 1 call to warnings::import |
17 | |||||
18 | 2 | 72µs | 2 | 275µs | # spent 148µs (22+127) within Net::Config::BEGIN@18 which was called:
# once (22µs+127µs) by Net::SMTP::BEGIN@21 at line 18 # spent 148µs making 1 call to Net::Config::BEGIN@18
# spent 127µs making 1 call to Exporter::import |
19 | 2 | 1.31ms | 2 | 344µs | # spent 188µs (32+156) within Net::Config::BEGIN@19 which was called:
# once (32µs+156µs) by Net::SMTP::BEGIN@21 at line 19 # spent 188µs making 1 call to Net::Config::BEGIN@19
# spent 156µs making 1 call to Exporter::import |
20 | |||||
21 | 1 | 3µs | our @EXPORT = qw(%NetConfig); | ||
22 | 1 | 21µs | our @ISA = qw(Net::LocalCfg Exporter); | ||
23 | 1 | 2µs | our $VERSION = "3.08_01"; | ||
24 | |||||
25 | our($CONFIGURE, $LIBNET_CFG); | ||||
26 | |||||
27 | 1 | 2µs | eval { | ||
28 | 1 | 4µs | local @INC = @INC; | ||
29 | 1 | 2µs | pop @INC if $INC[-1] eq '.'; | ||
30 | 1 | 8µs | local $SIG{__DIE__}; | ||
31 | 1 | 154µs | require Net::LocalCfg; | ||
32 | }; | ||||
33 | |||||
34 | 1 | 22µs | our %NetConfig = ( | ||
35 | nntp_hosts => [], | ||||
36 | snpp_hosts => [], | ||||
37 | pop3_hosts => [], | ||||
38 | smtp_hosts => [], | ||||
39 | ph_hosts => [], | ||||
40 | daytime_hosts => [], | ||||
41 | time_hosts => [], | ||||
42 | inet_domain => undef, | ||||
43 | ftp_firewall => undef, | ||||
44 | ftp_ext_passive => 1, | ||||
45 | ftp_int_passive => 1, | ||||
46 | test_hosts => 1, | ||||
47 | test_exist => 1, | ||||
48 | ); | ||||
49 | |||||
50 | # | ||||
51 | # Try to get as much configuration info as possible from InternetConfig | ||||
52 | # | ||||
53 | { | ||||
54 | ## no critic (BuiltinFunctions::ProhibitStringyEval) | ||||
55 | 2 | 7µs | $^O eq 'MacOS' and eval <<TRY_INTERNET_CONFIG; | ||
56 | use Mac::InternetConfig; | ||||
57 | |||||
58 | { | ||||
59 | my %nc = ( | ||||
60 | nntp_hosts => [ \$InternetConfig{ kICNNTPHost() } ], | ||||
61 | pop3_hosts => [ \$InternetConfig{ kICMailAccount() } =~ /\@(.*)/ ], | ||||
62 | smtp_hosts => [ \$InternetConfig{ kICSMTPHost() } ], | ||||
63 | ftp_testhost => \$InternetConfig{ kICFTPHost() } ? \$InternetConfig{ kICFTPHost()} : undef, | ||||
64 | ph_hosts => [ \$InternetConfig{ kICPhHost() } ], | ||||
65 | ftp_ext_passive => \$InternetConfig{"646F676F\xA5UsePassiveMode"} || 0, | ||||
66 | ftp_int_passive => \$InternetConfig{"646F676F\xA5UsePassiveMode"} || 0, | ||||
67 | socks_hosts => | ||||
68 | \$InternetConfig{ kICUseSocks() } ? [ \$InternetConfig{ kICSocksHost() } ] : [], | ||||
69 | ftp_firewall => | ||||
70 | \$InternetConfig{ kICUseFTPProxy() } ? [ \$InternetConfig{ kICFTPProxyHost() } ] : [], | ||||
71 | ); | ||||
72 | \@NetConfig{keys %nc} = values %nc; | ||||
73 | } | ||||
74 | TRY_INTERNET_CONFIG | ||||
75 | } | ||||
76 | |||||
77 | 1 | 2µs | my $file = __FILE__; | ||
78 | 1 | 1µs | my $ref; | ||
79 | 1 | 40µs | 1 | 24µs | $file =~ s/Config.pm/libnet.cfg/; # spent 24µs making 1 call to Net::Config::CORE:subst |
80 | 1 | 36µs | 1 | 24µs | if (-f $file) { # spent 24µs making 1 call to Net::Config::CORE:ftfile |
81 | $ref = eval { local $SIG{__DIE__}; do $file }; | ||||
82 | if (ref($ref) eq 'HASH') { | ||||
83 | %NetConfig = (%NetConfig, %{$ref}); | ||||
84 | $LIBNET_CFG = $file; | ||||
85 | } | ||||
86 | } | ||||
87 | 1 | 6µs | if ($< == $> and !$CONFIGURE) { | ||
88 | 3 | 2.79ms | 1 | 2.73ms | my $home = eval { local $SIG{__DIE__}; (getpwuid($>))[7] } || $ENV{HOME}; # spent 2.73ms making 1 call to Net::Config::CORE:gpwuid |
89 | 1 | 4µs | $home ||= $ENV{HOMEDRIVE} . ($ENV{HOMEPATH} || '') if defined $ENV{HOMEDRIVE}; | ||
90 | 1 | 4µs | if (defined $home) { | ||
91 | 1 | 3µs | $file = $home . "/.libnetrc"; | ||
92 | 1 | 24µs | 1 | 15µs | $ref = eval { local $SIG{__DIE__}; do $file } if -f $file; # spent 15µs making 1 call to Net::Config::CORE:ftfile |
93 | 1 | 3µs | %NetConfig = (%NetConfig, %{$ref}) | ||
94 | if ref($ref) eq 'HASH'; | ||||
95 | } | ||||
96 | } | ||||
97 | 1 | 2µs | my ($k, $v); | ||
98 | 1 | 10µs | while (($k, $v) = each %NetConfig) { | ||
99 | 13 | 240µs | 13 | 48µs | $NetConfig{$k} = [$v] # spent 48µs making 13 calls to Net::Config::CORE:match, avg 4µs/call |
100 | if ($k =~ /_hosts$/ and $k ne "test_hosts" and defined($v) and !ref($v)); | ||||
101 | } | ||||
102 | |||||
103 | # Take a hostname and determine if it is inside the firewall | ||||
104 | |||||
105 | |||||
106 | sub requires_firewall { | ||||
107 | shift; # ignore package | ||||
108 | my $host = shift; | ||||
109 | |||||
110 | return 0 unless defined $NetConfig{'ftp_firewall'}; | ||||
111 | |||||
112 | $host = inet_aton($host) or return -1; | ||||
113 | $host = inet_ntoa($host); | ||||
114 | |||||
115 | if (exists $NetConfig{'local_netmask'}) { | ||||
116 | my $quad = unpack("N", pack("C*", split(/\./, $host))); | ||||
117 | my $list = $NetConfig{'local_netmask'}; | ||||
118 | $list = [$list] unless ref($list); | ||||
119 | foreach (@$list) { | ||||
120 | my ($net, $bits) = (m#^(\d+\.\d+\.\d+\.\d+)/(\d+)$#) or next; | ||||
121 | my $mask = ~0 << (32 - $bits); | ||||
122 | my $addr = unpack("N", pack("C*", split(/\./, $net))); | ||||
123 | |||||
124 | return 0 if (($addr & $mask) == ($quad & $mask)); | ||||
125 | } | ||||
126 | return 1; | ||||
127 | } | ||||
128 | |||||
129 | return 0; | ||||
130 | } | ||||
131 | |||||
132 | 1 | 6µs | *is_external = \&requires_firewall; | ||
133 | |||||
134 | 1 | 92µs | 1; | ||
135 | |||||
136 | __END__ | ||||
sub Net::Config::CORE:ftfile; # opcode | |||||
# spent 2.73ms within Net::Config::CORE:gpwuid which was called:
# once (2.73ms+0s) by Net::SMTP::BEGIN@21 at line 88 | |||||
# spent 48µs within Net::Config::CORE:match which was called 13 times, avg 4µs/call:
# 13 times (48µs+0s) by Net::SMTP::BEGIN@21 at line 99, avg 4µs/call | |||||
# spent 24µs within Net::Config::CORE:subst which was called:
# once (24µs+0s) by Net::SMTP::BEGIN@21 at line 79 |