Filename | /usr/local/lib/perl5/site_perl/Mail/SpamAssassin/Util.pm |
Statements | Executed 534752 statements in 7.93s |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
7028 | 3 | 1 | 3.70s | 5.60s | uri_list_canonicalize | Mail::SpamAssassin::Util::
196560 | 26 | 1 | 1.08s | 1.08s | CORE:match (opcode) | Mail::SpamAssassin::Util::
24870 | 18 | 10 | 622ms | 736ms | untaint_var (recurses: max depth 1, inclusive time 112µs) | Mail::SpamAssassin::Util::
99006 | 6 | 1 | 566ms | 566ms | CORE:regcomp (opcode) | Mail::SpamAssassin::Util::
85478 | 34 | 1 | 472ms | 472ms | CORE:subst (opcode) | Mail::SpamAssassin::Util::
305 | 2 | 1 | 452ms | 648ms | qp_decode | Mail::SpamAssassin::Util::
41794 | 4 | 1 | 191ms | 191ms | CORE:substcont (opcode) | Mail::SpamAssassin::Util::
555 | 1 | 1 | 138ms | 255ms | parse_rfc822_date | Mail::SpamAssassin::Util::
1968 | 1 | 1 | 124ms | 533ms | decode_dns_question_entry | Mail::SpamAssassin::Util::
248 | 1 | 1 | 115ms | 151ms | url_encode | Mail::SpamAssassin::Util::
1047 | 3 | 1 | 113ms | 178ms | parse_content_type | Mail::SpamAssassin::Util::
555 | 1 | 1 | 50.6ms | 362ms | receive_date | Mail::SpamAssassin::Util::
714 | 1 | 1 | 33.9ms | 44.4ms | reverse_ip_address | Mail::SpamAssassin::Util::
555 | 1 | 1 | 16.7ms | 271ms | first_date | Mail::SpamAssassin::Util::
70 | 2 | 1 | 16.1ms | 75.6ms | base64_decode | Mail::SpamAssassin::Util::
5 | 4 | 3 | 8.23ms | 8.27ms | am_running_on_windows | Mail::SpamAssassin::Util::
91 | 5 | 3 | 5.73ms | 10.6ms | untaint_file_path | Mail::SpamAssassin::Util::
1 | 1 | 1 | 5.45ms | 10.8ms | BEGIN@71 | Mail::SpamAssassin::Util::
16 | 1 | 1 | 3.87ms | 3.87ms | CORE:sysopen (opcode) | Mail::SpamAssassin::Util::
1 | 1 | 1 | 3.25ms | 4.04ms | BEGIN@73 | Mail::SpamAssassin::Util::
46 | 1 | 1 | 3.24ms | 5.07ms | regexp_remove_delimiters | Mail::SpamAssassin::Util::
1 | 1 | 1 | 3.22ms | 69.1ms | BEGIN@76 | Mail::SpamAssassin::Util::
16 | 1 | 1 | 2.74ms | 12.3ms | secure_tmpfile | Mail::SpamAssassin::Util::
1 | 1 | 1 | 2.68ms | 4.15ms | BEGIN@74 | Mail::SpamAssassin::Util::
1 | 1 | 1 | 2.51ms | 2.51ms | CORE:gpwuid (opcode) | Mail::SpamAssassin::Util::
46 | 1 | 1 | 1.63ms | 8.40ms | make_qr | Mail::SpamAssassin::Util::
1 | 1 | 1 | 1.58ms | 2.25ms | BEGIN@75 | Mail::SpamAssassin::Util::
1 | 1 | 1 | 1.34ms | 2.00ms | BEGIN@1750 | Mail::SpamAssassin::Util::
16 | 1 | 1 | 1.25ms | 1.25ms | CORE:open_dir (opcode) | Mail::SpamAssassin::Util::
137 | 2 | 1 | 1.21ms | 1.21ms | CORE:qr (opcode) | Mail::SpamAssassin::Util::
2 | 2 | 2 | 937µs | 2.21ms | clean_path_in_taint_mode | Mail::SpamAssassin::Util::
1 | 1 | 1 | 849µs | 1.75ms | BEGIN@84 | Mail::SpamAssassin::Util::
3 | 2 | 2 | 341µs | 2.74ms | avoid_db_file_locking_bug | Mail::SpamAssassin::Util::
11 | 1 | 1 | 270µs | 405µs | my_inet_aton | Mail::SpamAssassin::Util::
16 | 1 | 1 | 260µs | 260µs | CORE:closedir (opcode) | Mail::SpamAssassin::Util::
3 | 1 | 1 | 255µs | 255µs | CORE:glob (opcode) | Mail::SpamAssassin::Util::
11 | 2 | 1 | 214µs | 214µs | CORE:stat (opcode) | Mail::SpamAssassin::Util::
1 | 1 | 1 | 172µs | 283µs | am_running_in_taint_mode | Mail::SpamAssassin::Util::
1 | 1 | 1 | 137µs | 2.71ms | portable_getpwuid | Mail::SpamAssassin::Util::
2 | 1 | 1 | 119µs | 340µs | fq_hostname | Mail::SpamAssassin::Util::
1 | 1 | 1 | 96µs | 96µs | CORE:ghbyname (opcode) | Mail::SpamAssassin::Util::
16 | 1 | 1 | 86µs | 86µs | CORE:binmode (opcode) | Mail::SpamAssassin::Util::
1 | 1 | 1 | 75µs | 75µs | first_available_module | Mail::SpamAssassin::Util::
11 | 1 | 1 | 73µs | 73µs | CORE:unpack (opcode) | Mail::SpamAssassin::Util::
1 | 1 | 1 | 66µs | 81µs | BEGIN@43 | Mail::SpamAssassin::Util::
11 | 1 | 1 | 62µs | 62µs | CORE:pack (opcode) | Mail::SpamAssassin::Util::
1 | 1 | 1 | 45µs | 237µs | BEGIN@85 | Mail::SpamAssassin::Util::
1 | 1 | 1 | 41µs | 220µs | BEGIN@78 | Mail::SpamAssassin::Util::
1 | 1 | 1 | 41µs | 41µs | BEGIN@52 | Mail::SpamAssassin::Util::
1 | 1 | 1 | 38µs | 94µs | hostname | Mail::SpamAssassin::Util::
1 | 1 | 1 | 35µs | 264µs | BEGIN@55 | Mail::SpamAssassin::Util::
1 | 1 | 1 | 34µs | 39µs | BEGIN@45 | Mail::SpamAssassin::Util::
1 | 1 | 1 | 29µs | 101µs | BEGIN@288 | Mail::SpamAssassin::Util::
1 | 1 | 1 | 29µs | 240µs | BEGIN@50 | Mail::SpamAssassin::Util::
1 | 1 | 1 | 29µs | 82µs | BEGIN@70 | Mail::SpamAssassin::Util::
1 | 1 | 1 | 27µs | 2.47ms | BEGIN@77 | Mail::SpamAssassin::Util::
1 | 1 | 1 | 24µs | 32µs | BEGIN@88 | Mail::SpamAssassin::Util::
1 | 1 | 1 | 24µs | 94µs | BEGIN@46 | Mail::SpamAssassin::Util::
1 | 1 | 1 | 23µs | 52µs | BEGIN@44 | Mail::SpamAssassin::Util::
1 | 1 | 1 | 23µs | 13.0ms | BEGIN@79 | Mail::SpamAssassin::Util::
1 | 1 | 1 | 17µs | 17µs | BEGIN@72 | Mail::SpamAssassin::Util::
1 | 1 | 1 | 15µs | 15µs | BEGIN@68 | Mail::SpamAssassin::Util::
7 | 1 | 1 | 14µs | 14µs | CORE:ftdir (opcode) | Mail::SpamAssassin::Util::
1 | 1 | 1 | 10µs | 10µs | BEGIN@53 | Mail::SpamAssassin::Util::
0 | 0 | 0 | 0s | 0s | __ANON__[:90] | Mail::SpamAssassin::Util::
0 | 0 | 0 | 0s | 0s | __ANON__[:91] | Mail::SpamAssassin::Util::
0 | 0 | 0 | 0s | 0s | __ANON__[:92] | Mail::SpamAssassin::Util::
0 | 0 | 0 | 0s | 0s | __ANON__[:93] | Mail::SpamAssassin::Util::
0 | 0 | 0 | 0s | 0s | _fake_getpwuid | Mail::SpamAssassin::Util::
0 | 0 | 0 | 0s | 0s | base64_encode | Mail::SpamAssassin::Util::
0 | 0 | 0 | 0s | 0s | decode_ulong_to_ip | Mail::SpamAssassin::Util::
0 | 0 | 0 | 0s | 0s | exit_status_str | Mail::SpamAssassin::Util::
0 | 0 | 0 | 0s | 0s | extract_ipv4_addr_from_string | Mail::SpamAssassin::Util::
0 | 0 | 0 | 0s | 0s | find_executable_in_env_path | Mail::SpamAssassin::Util::
0 | 0 | 0 | 0s | 0s | fisher_yates_shuffle | Mail::SpamAssassin::Util::
0 | 0 | 0 | 0s | 0s | force_die | Mail::SpamAssassin::Util::
0 | 0 | 0 | 0s | 0s | get_my_locales | Mail::SpamAssassin::Util::
0 | 0 | 0 | 0s | 0s | get_tag_value_for_score | Mail::SpamAssassin::Util::
0 | 0 | 0 | 0s | 0s | helper_app_pipe_open | Mail::SpamAssassin::Util::
0 | 0 | 0 | 0s | 0s | helper_app_pipe_open_unix | Mail::SpamAssassin::Util::
0 | 0 | 0 | 0s | 0s | helper_app_pipe_open_windows | Mail::SpamAssassin::Util::
0 | 0 | 0 | 0s | 0s | ips_match_in_16_mask | Mail::SpamAssassin::Util::
0 | 0 | 0 | 0s | 0s | ips_match_in_24_mask | Mail::SpamAssassin::Util::
0 | 0 | 0 | 0s | 0s | local_tz | Mail::SpamAssassin::Util::
0 | 0 | 0 | 0s | 0s | proc_status_ok | Mail::SpamAssassin::Util::
0 | 0 | 0 | 0s | 0s | secure_tmpdir | Mail::SpamAssassin::Util::
0 | 0 | 0 | 0s | 0s | setuid_to_euid | Mail::SpamAssassin::Util::
0 | 0 | 0 | 0s | 0s | taint_var | Mail::SpamAssassin::Util::
0 | 0 | 0 | 0s | 0s | time_to_rfc822_date | Mail::SpamAssassin::Util::
0 | 0 | 0 | 0s | 0s | trap_sigalrm_fully | Mail::SpamAssassin::Util::
0 | 0 | 0 | 0s | 0s | untaint_hostname | Mail::SpamAssassin::Util::
0 | 0 | 0 | 0s | 0s | uri_to_domain | Mail::SpamAssassin::Util::
0 | 0 | 0 | 0s | 0s | wrap | Mail::SpamAssassin::Util::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | # <@LICENSE> | ||||
2 | # Licensed to the Apache Software Foundation (ASF) under one or more | ||||
3 | # contributor license agreements. See the NOTICE file distributed with | ||||
4 | # this work for additional information regarding copyright ownership. | ||||
5 | # The ASF licenses this file to you under the Apache License, Version 2.0 | ||||
6 | # (the "License"); you may not use this file except in compliance with | ||||
7 | # the License. You may obtain a copy of the License at: | ||||
8 | # | ||||
9 | # http://www.apache.org/licenses/LICENSE-2.0 | ||||
10 | # | ||||
11 | # Unless required by applicable law or agreed to in writing, software | ||||
12 | # distributed under the License is distributed on an "AS IS" BASIS, | ||||
13 | # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. | ||||
14 | # See the License for the specific language governing permissions and | ||||
15 | # limitations under the License. | ||||
16 | # </@LICENSE> | ||||
17 | |||||
18 | =head1 NAME | ||||
19 | |||||
20 | Mail::SpamAssassin::Util - utility functions | ||||
21 | |||||
22 | =head1 DESCRIPTION | ||||
23 | |||||
24 | A general class for utility functions. Please use this for functions that | ||||
25 | stand alone, without requiring a $self object, Portability functions | ||||
26 | especially. | ||||
27 | |||||
28 | NOTE: The functions in this module are to be considered private. Their API may | ||||
29 | change at any point, and it's expected that they'll only be used by other | ||||
30 | Mail::SpamAssassin modules. (TODO: we should probably revisit this if | ||||
31 | it's useful for plugin development.) | ||||
32 | |||||
33 | NOTE: Utility functions should not be changing global variables such | ||||
34 | as $_, $1, $2, ... $/, etc. unless explicitly documented. If these | ||||
35 | variables are in use by these functions, they should be localized. | ||||
36 | |||||
37 | =over 4 | ||||
38 | |||||
39 | =cut | ||||
40 | |||||
41 | package Mail::SpamAssassin::Util; | ||||
42 | |||||
43 | 2 | 75µs | 2 | 97µs | # spent 81µs (66+16) within Mail::SpamAssassin::Util::BEGIN@43 which was called:
# once (66µs+16µs) by Mail::SpamAssassin::Conf::BEGIN@85 at line 43 # spent 81µs making 1 call to Mail::SpamAssassin::Util::BEGIN@43
# spent 16µs making 1 call to strict::import |
44 | 2 | 64µs | 2 | 81µs | # spent 52µs (23+29) within Mail::SpamAssassin::Util::BEGIN@44 which was called:
# once (23µs+29µs) by Mail::SpamAssassin::Conf::BEGIN@85 at line 44 # spent 52µs making 1 call to Mail::SpamAssassin::Util::BEGIN@44
# spent 29µs making 1 call to warnings::import |
45 | 2 | 59µs | 2 | 44µs | # spent 39µs (34+5) within Mail::SpamAssassin::Util::BEGIN@45 which was called:
# once (34µs+5µs) by Mail::SpamAssassin::Conf::BEGIN@85 at line 45 # spent 39µs making 1 call to Mail::SpamAssassin::Util::BEGIN@45
# spent 5µs making 1 call to bytes::import |
46 | 2 | 106µs | 2 | 165µs | # spent 94µs (24+70) within Mail::SpamAssassin::Util::BEGIN@46 which was called:
# once (24µs+70µs) by Mail::SpamAssassin::Conf::BEGIN@85 at line 46 # spent 94µs making 1 call to Mail::SpamAssassin::Util::BEGIN@46
# spent 70µs making 1 call to re::import |
47 | |||||
48 | 1 | 24µs | require 5.008001; # needs utf8::is_utf8() | ||
49 | |||||
50 | 2 | 61µs | 2 | 452µs | # spent 240µs (29+212) within Mail::SpamAssassin::Util::BEGIN@50 which was called:
# once (29µs+212µs) by Mail::SpamAssassin::Conf::BEGIN@85 at line 50 # spent 240µs making 1 call to Mail::SpamAssassin::Util::BEGIN@50
# spent 212µs making 1 call to Exporter::import |
51 | |||||
52 | # spent 41µs within Mail::SpamAssassin::Util::BEGIN@52 which was called:
# once (41µs+0s) by Mail::SpamAssassin::Conf::BEGIN@85 at line 66 | ||||
53 | 2 | 113µs | 1 | 10µs | # spent 10µs within Mail::SpamAssassin::Util::BEGIN@53 which was called:
# once (10µs+0s) by Mail::SpamAssassin::Conf::BEGIN@85 at line 53 # spent 10µs making 1 call to Mail::SpamAssassin::Util::BEGIN@53 |
54 | |||||
55 | 1 | 2µs | # spent 264µs (35+229) within Mail::SpamAssassin::Util::BEGIN@55 which was called:
# once (35µs+229µs) by Mail::SpamAssassin::Conf::BEGIN@85 at line 58 | ||
56 | @ISA @EXPORT @EXPORT_OK | ||||
57 | $AM_TAINTED | ||||
58 | 1 | 184µs | 2 | 492µs | ); # spent 264µs making 1 call to Mail::SpamAssassin::Util::BEGIN@55
# spent 229µs making 1 call to vars::import |
59 | |||||
60 | 1 | 13µs | @ISA = qw(Exporter); | ||
61 | 1 | 2µs | @EXPORT = (); | ||
62 | 1 | 20µs | @EXPORT_OK = qw(&local_tz &base64_decode &untaint_var &untaint_file_path | ||
63 | &exit_status_str &proc_status_ok &am_running_on_windows | ||||
64 | &reverse_ip_address &decode_dns_question_entry | ||||
65 | &secure_tmpfile &secure_tmpdir &uri_list_canonicalize); | ||||
66 | 1 | 54µs | 1 | 41µs | } # spent 41µs making 1 call to Mail::SpamAssassin::Util::BEGIN@52 |
67 | |||||
68 | 2 | 76µs | 1 | 15µs | # spent 15µs within Mail::SpamAssassin::Util::BEGIN@68 which was called:
# once (15µs+0s) by Mail::SpamAssassin::Conf::BEGIN@85 at line 68 # spent 15µs making 1 call to Mail::SpamAssassin::Util::BEGIN@68 |
69 | |||||
70 | 2 | 82µs | 2 | 135µs | # spent 82µs (29+53) within Mail::SpamAssassin::Util::BEGIN@70 which was called:
# once (29µs+53µs) by Mail::SpamAssassin::Conf::BEGIN@85 at line 70 # spent 82µs making 1 call to Mail::SpamAssassin::Util::BEGIN@70
# spent 53µs making 1 call to Config::import |
71 | 2 | 686µs | 2 | 10.8ms | # spent 10.8ms (5.45+5.31) within Mail::SpamAssassin::Util::BEGIN@71 which was called:
# once (5.45ms+5.31ms) by Mail::SpamAssassin::Conf::BEGIN@85 at line 71 # spent 10.8ms making 1 call to Mail::SpamAssassin::Util::BEGIN@71
# spent 90µs making 1 call to Exporter::import |
72 | 2 | 60µs | 1 | 17µs | # spent 17µs within Mail::SpamAssassin::Util::BEGIN@72 which was called:
# once (17µs+0s) by Mail::SpamAssassin::Conf::BEGIN@85 at line 72 # spent 17µs making 1 call to Mail::SpamAssassin::Util::BEGIN@72 |
73 | 2 | 481µs | 2 | 4.25ms | # spent 4.04ms (3.25+789µs) within Mail::SpamAssassin::Util::BEGIN@73 which was called:
# once (3.25ms+789µs) by Mail::SpamAssassin::Conf::BEGIN@85 at line 73 # spent 4.04ms making 1 call to Mail::SpamAssassin::Util::BEGIN@73
# spent 212µs making 1 call to Exporter::import |
74 | 2 | 360µs | 2 | 4.33ms | # spent 4.15ms (2.68+1.48) within Mail::SpamAssassin::Util::BEGIN@74 which was called:
# once (2.68ms+1.48ms) by Mail::SpamAssassin::Conf::BEGIN@85 at line 74 # spent 4.15ms making 1 call to Mail::SpamAssassin::Util::BEGIN@74
# spent 180µs making 1 call to Exporter::import |
75 | 2 | 323µs | 1 | 2.25ms | # spent 2.25ms (1.58+678µs) within Mail::SpamAssassin::Util::BEGIN@75 which was called:
# once (1.58ms+678µs) by Mail::SpamAssassin::Conf::BEGIN@85 at line 75 # spent 2.25ms making 1 call to Mail::SpamAssassin::Util::BEGIN@75 |
76 | 3 | 380µs | 3 | 69.5ms | # spent 69.1ms (3.22+65.9) within Mail::SpamAssassin::Util::BEGIN@76 which was called:
# once (3.22ms+65.9ms) by Mail::SpamAssassin::Conf::BEGIN@85 at line 76 # spent 69.1ms making 1 call to Mail::SpamAssassin::Util::BEGIN@76
# spent 434µs making 1 call to NetAddr::IP::import
# spent 19µs making 1 call to UNIVERSAL::VERSION |
77 | 2 | 73µs | 2 | 4.92ms | # spent 2.47ms (27µs+2.45) within Mail::SpamAssassin::Util::BEGIN@77 which was called:
# once (27µs+2.45ms) by Mail::SpamAssassin::Conf::BEGIN@85 at line 77 # spent 2.47ms making 1 call to Mail::SpamAssassin::Util::BEGIN@77
# spent 2.45ms making 1 call to Exporter::import |
78 | 2 | 86µs | 2 | 398µs | # spent 220µs (41+178) within Mail::SpamAssassin::Util::BEGIN@78 which was called:
# once (41µs+178µs) by Mail::SpamAssassin::Conf::BEGIN@85 at line 78 # spent 220µs making 1 call to Mail::SpamAssassin::Util::BEGIN@78
# spent 178µs making 1 call to Exporter::import |
79 | 1 | 2µs | # spent 13.0ms (23µs+13.0) within Mail::SpamAssassin::Util::BEGIN@79 which was called:
# once (23µs+13.0ms) by Mail::SpamAssassin::Conf::BEGIN@85 at line 80 | ||
80 | 1 | 119µs | 2 | 26.0ms | WTERMSIG WSTOPSIG); # spent 13.0ms making 1 call to Mail::SpamAssassin::Util::BEGIN@79
# spent 13.0ms making 1 call to POSIX::import |
81 | |||||
82 | ########################################################################### | ||||
83 | |||||
84 | 3 | 478µs | 2 | 1.93ms | # spent 1.75ms (849µs+900µs) within Mail::SpamAssassin::Util::BEGIN@84 which was called:
# once (849µs+900µs) by Mail::SpamAssassin::Conf::BEGIN@85 at line 84 # spent 1.75ms making 1 call to Mail::SpamAssassin::Util::BEGIN@84
# spent 184µs making 1 call to constant::import |
85 | 2 | 306µs | 3 | 430µs | # spent 237µs (45+192) within Mail::SpamAssassin::Util::BEGIN@85 which was called:
# once (45µs+192µs) by Mail::SpamAssassin::Conf::BEGIN@85 at line 85 # spent 237µs making 1 call to Mail::SpamAssassin::Util::BEGIN@85
# spent 172µs making 1 call to constant::import
# spent 20µs making 1 call to Mail::SpamAssassin::Util::CORE:match |
86 | |||||
87 | # These are not implemented on windows (see bug 6798 and 6470) | ||||
88 | # spent 32µs (24+8) within Mail::SpamAssassin::Util::BEGIN@88 which was called:
# once (24µs+8µs) by Mail::SpamAssassin::Conf::BEGIN@85 at line 95 | ||||
89 | 1 | 15µs | 1 | 8µs | if (RUNNING_ON_WINDOWS) { # spent 8µs making 1 call to constant::__ANON__[constant.pm:192] |
90 | *WIFEXITED = sub { not $_[0] & 127 }; | ||||
91 | *WEXITSTATUS = sub { $_[0] >> 8 }; | ||||
92 | *WIFSIGNALED = sub { ($_[0] & 127) && ($_[0] & 127 != 127) }; | ||||
93 | *WTERMSIG = sub { $_[0] & 127 }; | ||||
94 | } | ||||
95 | 1 | 2.02ms | 1 | 32µs | } # spent 32µs making 1 call to Mail::SpamAssassin::Util::BEGIN@88 |
96 | |||||
97 | ########################################################################### | ||||
98 | |||||
99 | # find an executable in the current $PATH (or whatever for that platform) | ||||
100 | { | ||||
101 | # Show the PATH we're going to explore only once. | ||||
102 | 1 | 2µs | my $displayed_path = 0; | ||
103 | |||||
104 | sub find_executable_in_env_path { | ||||
105 | my ($filename) = @_; | ||||
106 | |||||
107 | clean_path_in_taint_mode(); | ||||
108 | if ( !$displayed_path++ ) { | ||||
109 | dbg("util: current PATH is: ".join($Config{'path_sep'},File::Spec->path())); | ||||
110 | } | ||||
111 | foreach my $path (File::Spec->path()) { | ||||
112 | my $fname = File::Spec->catfile ($path, $filename); | ||||
113 | if ( -f $fname ) { | ||||
114 | if (-x $fname) { | ||||
115 | dbg("util: executable for $filename was found at $fname"); | ||||
116 | return $fname; | ||||
117 | } | ||||
118 | else { | ||||
119 | dbg("util: $filename was found at $fname, but isn't executable"); | ||||
120 | } | ||||
121 | } | ||||
122 | } | ||||
123 | return; | ||||
124 | } | ||||
125 | } | ||||
126 | |||||
127 | ########################################################################### | ||||
128 | |||||
129 | # taint mode: delete more unsafe vars for exec, as per perlsec | ||||
130 | { | ||||
131 | # We only need to clean the environment once, it stays clean ... | ||||
132 | 2 | 5µs | my $cleaned_taint_path = 0; | ||
133 | |||||
134 | # spent 2.21ms (937µs+1.27) within Mail::SpamAssassin::Util::clean_path_in_taint_mode which was called 2 times, avg 1.11ms/call:
# once (930µs+1.27ms) by Mail::SpamAssassin::new at line 438 of Mail/SpamAssassin.pm
# once (8µs+0s) by Mail::SpamAssassin::Util::hostname at line 834 | ||||
135 | 2 | 13µs | return if ($cleaned_taint_path++); | ||
136 | 1 | 7µs | 1 | 283µs | return unless am_running_in_taint_mode(); # spent 283µs making 1 call to Mail::SpamAssassin::Util::am_running_in_taint_mode |
137 | |||||
138 | 1 | 6µs | 1 | 6µs | dbg("util: taint mode: deleting unsafe environment variables, resetting PATH"); # spent 6µs making 1 call to Mail::SpamAssassin::Logger::dbg |
139 | |||||
140 | 1 | 9µs | 1 | 6µs | if (RUNNING_ON_WINDOWS) { # spent 6µs making 1 call to constant::__ANON__[constant.pm:192] |
141 | dbg("util: running on Win32, skipping PATH cleaning"); | ||||
142 | return; | ||||
143 | } | ||||
144 | |||||
145 | 1 | 21µs | delete @ENV{qw(IFS CDPATH ENV BASH_ENV)}; | ||
146 | |||||
147 | # Go through and clean the PATH out | ||||
148 | 1 | 2µs | my @path; | ||
149 | my @stat; | ||||
150 | 1 | 28µs | 1 | 67µs | foreach my $dir (File::Spec->path()) { # spent 67µs making 1 call to File::Spec::Unix::path |
151 | 8 | 14µs | next unless $dir; | ||
152 | |||||
153 | # untaint if at least 1 char and no NL (is the restriction intentional?) | ||||
154 | 8 | 40µs | local ($1); | ||
155 | 8 | 208µs | 16 | 384µs | $dir = untaint_var($1) if $dir =~ /^(.+)$/; # spent 288µs making 8 calls to Mail::SpamAssassin::Util::untaint_var, avg 36µs/call
# spent 96µs making 8 calls to Mail::SpamAssassin::Util::CORE:match, avg 12µs/call |
156 | # then clean ( 'foo/./bar' -> 'foo/bar', etc. ) | ||||
157 | 8 | 154µs | 8 | 44µs | $dir = File::Spec->canonpath($dir); # spent 44µs making 8 calls to File::Spec::Unix::canonpath, avg 6µs/call |
158 | |||||
159 | 8 | 357µs | 23 | 411µs | if (!File::Spec->file_name_is_absolute($dir)) { # spent 221µs making 8 calls to File::Spec::Unix::file_name_is_absolute, avg 28µs/call
# spent 176µs making 8 calls to Mail::SpamAssassin::Util::CORE:stat, avg 22µs/call
# spent 14µs making 7 calls to Mail::SpamAssassin::Util::CORE:ftdir, avg 2µs/call |
160 | dbg("util: PATH included '$dir', which is not absolute, dropping"); | ||||
161 | next; | ||||
162 | } | ||||
163 | elsif (!(@stat=stat($dir))) { | ||||
164 | 1 | 18µs | 1 | 6µs | dbg("util: PATH included '$dir', which is unusable, dropping: $!"); # spent 6µs making 1 call to Mail::SpamAssassin::Logger::dbg |
165 | 1 | 4µs | next; | ||
166 | } | ||||
167 | elsif (!-d _) { | ||||
168 | dbg("util: PATH included '$dir', which isn't a directory, dropping"); | ||||
169 | next; | ||||
170 | } | ||||
171 | elsif (($stat[2]&2) != 0) { | ||||
172 | # World-Writable directories are considered insecure. | ||||
173 | # We could be more paranoid and check all of the parent directories as well, | ||||
174 | # but it's good for now. | ||||
175 | dbg("util: PATH included '$dir', which is world writable, dropping"); | ||||
176 | next; | ||||
177 | } | ||||
178 | |||||
179 | 7 | 60µs | 7 | 50µs | dbg("util: PATH included '$dir', keeping"); # spent 50µs making 7 calls to Mail::SpamAssassin::Logger::dbg, avg 7µs/call |
180 | 7 | 88µs | push(@path, $dir); | ||
181 | } | ||||
182 | |||||
183 | 1 | 81µs | 1 | 11µs | $ENV{'PATH'} = join($Config{'path_sep'}, @path); # spent 11µs making 1 call to Config::FETCH |
184 | 1 | 19µs | 1 | 7µs | dbg("util: final PATH set to: ".$ENV{'PATH'}); # spent 7µs making 1 call to Mail::SpamAssassin::Logger::dbg |
185 | } | ||||
186 | } | ||||
187 | |||||
188 | # taint mode: are we running in taint mode? 1 for yes, 0 for no. | ||||
189 | 1 | 5µs | # spent 283µs (172+111) within Mail::SpamAssassin::Util::am_running_in_taint_mode which was called:
# once (172µs+111µs) by Mail::SpamAssassin::Util::clean_path_in_taint_mode at line 136 | ||
190 | 1 | 2µs | return $AM_TAINTED if defined $AM_TAINTED; | ||
191 | |||||
192 | 1 | 7µs | if ($] >= 5.008) { | ||
193 | # perl 5.8 and above, ${^TAINT} is a syntax violation in 5.005 | ||||
194 | 1 | 117µs | $AM_TAINTED = eval q(no warnings q(syntax); ${^TAINT}); # spent 62µs executing statements in string eval # includes 37µs spent executing 1 call to 1 sub defined therein. | ||
195 | } | ||||
196 | else { | ||||
197 | # older versions | ||||
198 | my $blank; | ||||
199 | for my $d ((File::Spec->curdir, File::Spec->rootdir, File::Spec->tmpdir)) { | ||||
200 | opendir(TAINT, $d) || next; | ||||
201 | $blank = readdir(TAINT); | ||||
202 | closedir(TAINT) or die "error closing directory $d: $!"; | ||||
203 | last; | ||||
204 | } | ||||
205 | if (!(defined $blank && $blank)) { | ||||
206 | # these are sometimes untainted, so this is less preferable than readdir | ||||
207 | $blank = join('', values %ENV, $0, @ARGV); | ||||
208 | } | ||||
209 | $blank = substr($blank, 0, 0); | ||||
210 | # seriously mind-bending perl | ||||
211 | $AM_TAINTED = not eval { eval "1 || $blank" || 1 }; | ||||
212 | } | ||||
213 | 1 | 9µs | 1 | 10µs | dbg("util: running in taint mode? %s", $AM_TAINTED ? "yes" : "no"); # spent 10µs making 1 call to Mail::SpamAssassin::Logger::dbg |
214 | 1 | 9µs | return $AM_TAINTED; | ||
215 | } | ||||
216 | |||||
217 | ########################################################################### | ||||
218 | |||||
219 | # spent 8.27ms (8.23+43µs) within Mail::SpamAssassin::Util::am_running_on_windows which was called 5 times, avg 1.65ms/call:
# 2 times (33µs+21µs) by Mail::SpamAssassin::expand_name at line 2005 of Mail/SpamAssassin.pm, avg 27µs/call
# once (8.16ms+7µs) by Mail::SpamAssassin::PerMsgStatus::is_dns_available at line 514 of Mail/SpamAssassin/Dns.pm
# once (19µs+7µs) by Mail::SpamAssassin::create_locker at line 462 of Mail/SpamAssassin.pm
# once (15µs+7µs) by main::RUNTIME at line 250 of /usr/local/bin/sa-learn | ||||
220 | 5 | 91µs | 5 | 43µs | return RUNNING_ON_WINDOWS; # spent 43µs making 5 calls to constant::__ANON__[constant.pm:192], avg 9µs/call |
221 | } | ||||
222 | |||||
223 | ########################################################################### | ||||
224 | |||||
225 | # untaint a path to a file, e.g. "/home/jm/.spamassassin/foo", | ||||
226 | # "C:\Program Files\SpamAssassin\tmp\foo", "/home/��t/etc". | ||||
227 | # | ||||
228 | # TODO: this does *not* handle locales well. We cannot use "use locale" | ||||
229 | # and \w, since that will not detaint the data. So instead just allow the | ||||
230 | # high-bit chars from ISO-8859-1, none of which have special metachar | ||||
231 | # meanings (as far as I know). | ||||
232 | # | ||||
233 | # spent 10.6ms (5.73+4.84) within Mail::SpamAssassin::Util::untaint_file_path which was called 91 times, avg 116µs/call:
# 67 times (4.16ms+3.53ms) by Mail::SpamAssassin::sed_path at line 2041 of Mail/SpamAssassin.pm, avg 115µs/call
# 16 times (1.07ms+868µs) by Mail::SpamAssassin::Util::secure_tmpfile at line 1100, avg 121µs/call
# 3 times (228µs+175µs) by Mail::SpamAssassin::Util::avoid_db_file_locking_bug at line 1746, avg 134µs/call
# 3 times (162µs+150µs) by Mail::SpamAssassin::Util::avoid_db_file_locking_bug at line 1751, avg 104µs/call
# 2 times (108µs+111µs) by Mail::SpamAssassin::Locker::UnixNFSSafe::safe_lock at line 71 of Mail/SpamAssassin/Locker/UnixNFSSafe.pm, avg 110µs/call | ||||
234 | 91 | 250µs | my ($path) = @_; | ||
235 | |||||
236 | 91 | 184µs | return unless defined($path); | ||
237 | 91 | 287µs | return '' if ($path eq ''); | ||
238 | |||||
239 | 91 | 364µs | local ($1); | ||
240 | # Barry Jaspan: allow ~ and spaces, good for Windows. Also return '' | ||||
241 | # if input is '', as it is a safe path. | ||||
242 | 91 | 274µs | my $chars = '-_A-Za-z0-9\xA0-\xFF\.\%\@\=\+\,\/\\\:'; | ||
243 | 91 | 2.41ms | 182 | 1.05ms | my $re = qr/^\s*([$chars][${chars}~ ]*)$/o; # spent 715µs making 91 calls to Mail::SpamAssassin::Util::CORE:qr, avg 8µs/call
# spent 338µs making 91 calls to Mail::SpamAssassin::Util::CORE:regcomp, avg 4µs/call |
244 | |||||
245 | 91 | 2.21ms | 182 | 1.17ms | if ($path =~ $re) { # spent 639µs making 91 calls to Mail::SpamAssassin::Util::CORE:regcomp, avg 7µs/call
# spent 526µs making 91 calls to Mail::SpamAssassin::Util::CORE:match, avg 6µs/call |
246 | 91 | 294µs | $path = $1; | ||
247 | 91 | 1.53ms | 91 | 2.62ms | return untaint_var($path); # spent 2.62ms making 91 calls to Mail::SpamAssassin::Util::untaint_var, avg 29µs/call |
248 | } else { | ||||
249 | warn "util: refusing to untaint suspicious path: \"$path\"\n"; | ||||
250 | return $path; | ||||
251 | } | ||||
252 | } | ||||
253 | |||||
254 | sub untaint_hostname { | ||||
255 | my ($host) = @_; | ||||
256 | |||||
257 | return unless defined($host); | ||||
258 | return '' if ($host eq ''); | ||||
259 | |||||
260 | # from RFC 1035, but allowing domains starting with numbers: | ||||
261 | # $label = q/[A-Za-z\d](?:[A-Za-z\d-]{0,61}[A-Za-z\d])?/; | ||||
262 | # $domain = qq<$label(?:\.$label)*>; | ||||
263 | # length($host) <= 255 && $host =~ /^($domain)$/ | ||||
264 | # expanded (no variables in the re) because of a tainting bug in Perl 5.8.0 | ||||
265 | if (length($host) <= 255 && $host =~ /^[a-z\d](?:[a-z\d-]{0,61}[a-z\d])?(?:\.[a-z\d](?:[a-z\d-]{0,61}[a-z\d])?)*$/i) { | ||||
266 | return untaint_var($host); | ||||
267 | } | ||||
268 | else { | ||||
269 | warn "util: cannot untaint hostname: \"$host\"\n"; | ||||
270 | return $host; | ||||
271 | } | ||||
272 | } | ||||
273 | |||||
274 | # This sub takes a scalar or a reference to an array, hash, scalar or another | ||||
275 | # reference and recursively untaints all its values (and keys if it's a | ||||
276 | # reference to a hash). It should be used with caution as blindly untainting | ||||
277 | # values subverts the purpose of working in taint mode. It will return the | ||||
278 | # untainted value if requested but to avoid unnecessary copying, the return | ||||
279 | # value should be ignored when working on lists. | ||||
280 | # Bad: | ||||
281 | # %ENV = untaint_var(\%ENV); | ||||
282 | # Better: | ||||
283 | # untaint_var(\%ENV); | ||||
284 | # | ||||
285 | # spent 736ms (622+115) within Mail::SpamAssassin::Util::untaint_var which was called 24870 times, avg 30µs/call:
# 13368 times (297ms+38.2ms) by Mail::SpamAssassin::Conf::Parser::_meta_deps_recurse at line 999 of Mail/SpamAssassin/Conf/Parser.pm, avg 25µs/call
# 8956 times (270ms+67.0ms) by Mail::SpamAssassin::PerMsgStatus::_get_parsed_uri_list at line 2375 of Mail/SpamAssassin/PerMsgStatus.pm, avg 38µs/call
# 1164 times (23.7ms+3.90ms) by Mail::SpamAssassin::Conf::Parser::handle_conditional at line 518 of Mail/SpamAssassin/Conf/Parser.pm, avg 24µs/call
# 489 times (9.42ms+1.54ms) by Mail::SpamAssassin::Conf::Parser::handle_conditional at line 540 of Mail/SpamAssassin/Conf/Parser.pm, avg 22µs/call
# 465 times (10.9ms+1.88ms) by Mail::SpamAssassin::Conf::Parser::is_meta_valid at line 1290 of Mail/SpamAssassin/Conf/Parser.pm, avg 27µs/call
# 189 times (5.53ms+1.18ms) by Mail::SpamAssassin::HTML::parse at line 231 of Mail/SpamAssassin/HTML.pm, avg 36µs/call
# 91 times (2.23ms+396µs) by Mail::SpamAssassin::Util::untaint_file_path at line 247, avg 29µs/call
# 54 times (1.06ms+162µs) by Mail::SpamAssassin::Conf::__ANON__[/usr/local/lib/perl5/site_perl/Mail/SpamAssassin/Conf.pm:4145] at line 4143 of Mail/SpamAssassin/Conf.pm, avg 23µs/call
# 46 times (933µs+143µs) by Mail::SpamAssassin::Plugin::MIMEHeader::__ANON__[/usr/local/lib/perl5/site_perl/Mail/SpamAssassin/Plugin/MIMEHeader.pm:160] at line 111 of Mail/SpamAssassin/Plugin/MIMEHeader.pm, avg 23µs/call
# 27 times (697µs+119µs) by Mail::SpamAssassin::Conf::load_plugin at line 4949 of Mail/SpamAssassin/Conf.pm, avg 30µs/call
# 8 times (260µs+28µs) by Mail::SpamAssassin::Util::clean_path_in_taint_mode at line 155, avg 36µs/call
# 4 times (129µs+15µs) by Mail::SpamAssassin::Conf::Parser::set_numeric_value at line 726 of Mail/SpamAssassin/Conf/Parser.pm, avg 36µs/call
# 3 times (96µs+-96µs) by Mail::SpamAssassin::Util::untaint_var at line 297, avg 0s/call
# 2 times (63µs+11µs) by Mail::SpamAssassin::DnsResolver::configured_nameservers at line 214 of Mail/SpamAssassin/DnsResolver.pm, avg 37µs/call
# once (79µs+112µs) by Mail::SpamAssassin::DBBasedAddrList::new_checker at line 57 of Mail/SpamAssassin/DBBasedAddrList.pm
# once (33µs+11µs) by Mail::SpamAssassin::Plugin::Bayes::learner_new at line 1652 of Mail/SpamAssassin/Plugin/Bayes.pm
# once (30µs+3µs) by Mail::SpamAssassin::Conf::__ANON__[/usr/local/lib/perl5/site_perl/Mail/SpamAssassin/Conf.pm:3858] at line 3857 of Mail/SpamAssassin/Conf.pm
# once (25µs+4µs) by Mail::SpamAssassin::Plugin::TxRep::open_storages at line 1577 of Mail/SpamAssassin/Plugin/TxRep.pm | ||||
286 | # my $arg = $_[0]; # avoid copying unnecessarily | ||||
287 | 24870 | 75.5ms | if (!ref $_[0]) { # optimized by-far-the-most-common case | ||
288 | 2 | 15.0ms | 2 | 173µs | # spent 101µs (29+72) within Mail::SpamAssassin::Util::BEGIN@288 which was called:
# once (29µs+72µs) by Mail::SpamAssassin::Conf::BEGIN@85 at line 288 # spent 101µs making 1 call to Mail::SpamAssassin::Util::BEGIN@288
# spent 72µs making 1 call to re::unimport |
289 | 24869 | 41.8ms | return undef if !defined $_[0]; ## no critic (ProhibitExplicitReturnUndef) - See Bug 7120 | ||
290 | 24842 | 82.4ms | local($1); # avoid Perl taint bug: tainted global $1 propagates taintedness | ||
291 | 24842 | 331ms | 24842 | 115ms | $_[0] =~ /^(.*)\z/s; # spent 115ms making 24842 calls to Mail::SpamAssassin::Util::CORE:match, avg 5µs/call |
292 | 24842 | 331ms | return $1; | ||
293 | } else { | ||||
294 | 1 | 3µs | my $r = ref $_[0]; | ||
295 | 1 | 4µs | if ($r eq 'ARRAY') { | ||
296 | 1 | 2µs | my $arg = $_[0]; | ||
297 | 2 | 51µs | 3 | 0s | $_ = untaint_var($_) for @{$arg}; # spent 112µs making 3 calls to Mail::SpamAssassin::Util::untaint_var, avg 37µs/call, recursion: max depth 1, sum of overlapping time 112µs |
298 | 1 | 2µs | return @{$arg} if wantarray; | ||
299 | } | ||||
300 | elsif ($r eq 'HASH') { | ||||
301 | my $arg = $_[0]; | ||||
302 | if ($arg == \%ENV) { # purge undefs from %ENV, untaint the rest | ||||
303 | while (my($k, $v) = each %{$arg}) { | ||||
304 | # It is safe to delete the item most recently returned by each() | ||||
305 | if (!defined $v) { delete ${$arg}{$k}; next } | ||||
306 | ${$arg}{untaint_var($k)} = untaint_var($v); | ||||
307 | } | ||||
308 | } else { | ||||
309 | # hash keys are never tainted, | ||||
310 | # although old version of perl had some quirks there | ||||
311 | while (my($k, $v) = each %{$arg}) { | ||||
312 | ${$arg}{untaint_var($k)} = untaint_var($v); | ||||
313 | } | ||||
314 | } | ||||
315 | return %{$arg} if wantarray; | ||||
316 | } | ||||
317 | elsif ($r eq 'SCALAR' || $r eq 'REF') { | ||||
318 | my $arg = $_[0]; | ||||
319 | ${$arg} = untaint_var(${$arg}); | ||||
320 | } | ||||
321 | else { | ||||
322 | warn "util: can't untaint a $r !\n"; | ||||
323 | } | ||||
324 | } | ||||
325 | 1 | 8µs | return $_[0]; | ||
326 | } | ||||
327 | |||||
328 | ########################################################################### | ||||
329 | |||||
330 | sub taint_var { | ||||
331 | my ($v) = @_; | ||||
332 | return $v unless defined $v; # can't taint "undef" | ||||
333 | |||||
334 | # $^X is apparently "always tainted". | ||||
335 | # Concatenating an empty tainted string taints the result. | ||||
336 | return $v . substr($^X, 0, 0); | ||||
337 | } | ||||
338 | |||||
339 | ########################################################################### | ||||
340 | |||||
341 | # map process termination status number to an informative string, and | ||||
342 | # append optional mesage (dual-valued errno or a string or a number), | ||||
343 | # returning the resulting string | ||||
344 | # | ||||
345 | sub exit_status_str { | ||||
346 | my($stat,$errno) = @_; | ||||
347 | my $str; | ||||
348 | if (!defined($stat)) { | ||||
349 | $str = '(no status)'; | ||||
350 | } elsif (WIFEXITED($stat)) { | ||||
351 | $str = sprintf("exit %d", WEXITSTATUS($stat)); | ||||
352 | } elsif (WIFSTOPPED($stat)) { | ||||
353 | $str = sprintf("stopped, signal %d", WSTOPSIG($stat)); | ||||
354 | } else { | ||||
355 | my $sig = WTERMSIG($stat); | ||||
356 | $str = sprintf("%s, signal %d (%04x)", | ||||
357 | $sig == 1 ? 'HANGUP' : $sig == 2 ? 'interrupted' : | ||||
358 | $sig == 6 ? 'ABORTED' : $sig == 9 ? 'KILLED' : | ||||
359 | $sig == 15 ? 'TERMINATED' : 'DIED', | ||||
360 | $sig, $stat); | ||||
361 | } | ||||
362 | if (defined $errno) { # deal with dual-valued and plain variables | ||||
363 | $str .= ', '.$errno if (0+$errno) != 0 || ($errno ne '' && $errno ne '0'); | ||||
364 | } | ||||
365 | return $str; | ||||
366 | } | ||||
367 | |||||
368 | ########################################################################### | ||||
369 | |||||
370 | # check errno to be 0 and a process exit status to be in the list of success | ||||
371 | # status codes, returning true if both are ok, and false otherwise | ||||
372 | # | ||||
373 | sub proc_status_ok { | ||||
374 | my($exit_status,$errno,@success) = @_; | ||||
375 | my $ok = 0; | ||||
376 | if ((!defined $errno || $errno == 0) && WIFEXITED($exit_status)) { | ||||
377 | my $j = WEXITSTATUS($exit_status); | ||||
378 | if (!@success) { $ok = $j==0 } # empty list implies only status 0 is good | ||||
379 | elsif (grep {$_ == $j} @success) { $ok = 1 } | ||||
380 | } | ||||
381 | return $ok; | ||||
382 | } | ||||
383 | |||||
384 | ########################################################################### | ||||
385 | |||||
386 | # timezone mappings: in case of conflicts, use RFC 2822, then most | ||||
387 | # common and least conflicting mapping | ||||
388 | 1 | 58µs | my %TZ = ( | ||
389 | # standard | ||||
390 | 'UT' => '+0000', | ||||
391 | 'UTC' => '+0000', | ||||
392 | # US and Canada | ||||
393 | 'NDT' => '-0230', | ||||
394 | 'AST' => '-0400', | ||||
395 | 'ADT' => '-0300', | ||||
396 | 'NST' => '-0330', | ||||
397 | 'EST' => '-0500', | ||||
398 | 'EDT' => '-0400', | ||||
399 | 'CST' => '-0600', | ||||
400 | 'CDT' => '-0500', | ||||
401 | 'MST' => '-0700', | ||||
402 | 'MDT' => '-0600', | ||||
403 | 'PST' => '-0800', | ||||
404 | 'PDT' => '-0700', | ||||
405 | 'HST' => '-1000', | ||||
406 | 'AKST' => '-0900', | ||||
407 | 'AKDT' => '-0800', | ||||
408 | 'HADT' => '-0900', | ||||
409 | 'HAST' => '-1000', | ||||
410 | # Europe | ||||
411 | 'GMT' => '+0000', | ||||
412 | 'BST' => '+0100', | ||||
413 | 'IST' => '+0100', | ||||
414 | 'WET' => '+0000', | ||||
415 | 'WEST' => '+0100', | ||||
416 | 'CET' => '+0100', | ||||
417 | 'CEST' => '+0200', | ||||
418 | 'EET' => '+0200', | ||||
419 | 'EEST' => '+0300', | ||||
420 | 'MSK' => '+0300', | ||||
421 | 'MSD' => '+0400', | ||||
422 | 'MET' => '+0100', | ||||
423 | 'MEZ' => '+0100', | ||||
424 | 'MEST' => '+0200', | ||||
425 | 'MESZ' => '+0200', | ||||
426 | # South America | ||||
427 | 'BRST' => '-0200', | ||||
428 | 'BRT' => '-0300', | ||||
429 | # Australia | ||||
430 | 'AEST' => '+1000', | ||||
431 | 'AEDT' => '+1100', | ||||
432 | 'ACST' => '+0930', | ||||
433 | 'ACDT' => '+1030', | ||||
434 | 'AWST' => '+0800', | ||||
435 | # New Zealand | ||||
436 | 'NZST' => '+1200', | ||||
437 | 'NZDT' => '+1300', | ||||
438 | # Asia | ||||
439 | 'JST' => '+0900', | ||||
440 | 'KST' => '+0900', | ||||
441 | 'HKT' => '+0800', | ||||
442 | 'SGT' => '+0800', | ||||
443 | 'PHT' => '+0800', | ||||
444 | # Middle East | ||||
445 | 'IDT' => '+0300', | ||||
446 | ); | ||||
447 | |||||
448 | # month mappings | ||||
449 | 1 | 15µs | my %MONTH = (jan => 1, feb => 2, mar => 3, apr => 4, may => 5, jun => 6, | ||
450 | jul => 7, aug => 8, sep => 9, oct => 10, nov => 11, dec => 12); | ||||
451 | |||||
452 | 1 | 2µs | my $LOCALTZ; | ||
453 | |||||
454 | sub local_tz { | ||||
455 | return $LOCALTZ if defined($LOCALTZ); | ||||
456 | |||||
457 | # standard method for determining local timezone | ||||
458 | my $time = time; | ||||
459 | my @g = gmtime($time); | ||||
460 | my @t = localtime($time); | ||||
461 | my $z = $t[1]-$g[1]+($t[2]-$g[2])*60+($t[7]-$g[7])*1440+($t[5]-$g[5])*525600; | ||||
462 | $LOCALTZ = sprintf("%+.2d%.2d", $z/60, $z%60); | ||||
463 | return $LOCALTZ; | ||||
464 | } | ||||
465 | |||||
466 | # spent 255ms (138+117) within Mail::SpamAssassin::Util::parse_rfc822_date which was called 555 times, avg 459µs/call:
# 555 times (138ms+117ms) by Mail::SpamAssassin::Util::first_date at line 1435, avg 459µs/call | ||||
467 | 555 | 1.62ms | my ($date) = @_; | ||
468 | 1110 | 6.43ms | local ($_); local ($1,$2,$3,$4); | ||
469 | 555 | 1.31ms | my ($yyyy, $mmm, $dd, $hh, $mm, $ss, $mon, $tzoff); | ||
470 | |||||
471 | # make it a bit easier to match | ||||
472 | 1665 | 36.5ms | 1110 | 23.3ms | $_ = " $date "; s/, */ /gs; s/\s+/ /gs; # spent 23.3ms making 1110 calls to Mail::SpamAssassin::Util::CORE:subst, avg 21µs/call |
473 | |||||
474 | # now match it in parts. Date part first: | ||||
475 | 555 | 14.7ms | 555 | 9.36ms | if (s/ (\d+) (Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec) (\d{4}) / /i) { # spent 9.36ms making 555 calls to Mail::SpamAssassin::Util::CORE:subst, avg 17µs/call |
476 | 1665 | 6.71ms | $dd = $1; $mon = lc($2); $yyyy = $3; | ||
477 | } elsif (s/ (Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec) +(\d+) \d+:\d+:\d+ (\d{4}) / /i) { | ||||
478 | $dd = $2; $mon = lc($1); $yyyy = $3; | ||||
479 | } elsif (s/ (\d+) (Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec) (\d{2,3}) / /i) { | ||||
480 | $dd = $1; $mon = lc($2); $yyyy = $3; | ||||
481 | } else { | ||||
482 | dbg("util: time cannot be parsed: $date"); | ||||
483 | return; | ||||
484 | } | ||||
485 | |||||
486 | # handle two and three digit dates as specified by RFC 2822 | ||||
487 | 555 | 2.21ms | if (defined $yyyy) { | ||
488 | 555 | 2.96ms | if (length($yyyy) == 2 && $yyyy < 50) { | ||
489 | $yyyy += 2000; | ||||
490 | } | ||||
491 | elsif (length($yyyy) != 4) { | ||||
492 | # three digit years and two digit years with values between 50 and 99 | ||||
493 | $yyyy += 1900; | ||||
494 | } | ||||
495 | } | ||||
496 | |||||
497 | # hh:mm:ss | ||||
498 | 555 | 10.7ms | 555 | 5.54ms | if (s/ (\d?\d):(\d\d)(:(\d\d))? / /) { # spent 5.54ms making 555 calls to Mail::SpamAssassin::Util::CORE:subst, avg 10µs/call |
499 | 1665 | 5.43ms | $hh = $1; $mm = $2; $ss = $4 || 0; | ||
500 | } | ||||
501 | |||||
502 | # numeric timezones | ||||
503 | 555 | 34.9ms | 555 | 5.92ms | if (s/ ([-+]\d{4}) / /) { # spent 5.92ms making 555 calls to Mail::SpamAssassin::Util::CORE:subst, avg 11µs/call |
504 | 555 | 1.81ms | $tzoff = $1; | ||
505 | } | ||||
506 | # common timezones | ||||
507 | elsif (s/\b([A-Z]{2,4}(?:-DST)?)\b/ / && exists $TZ{$1}) { | ||||
508 | $tzoff = $TZ{$1}; | ||||
509 | } | ||||
510 | # all other timezones are considered equivalent to "-0000" | ||||
511 | 555 | 1.13ms | $tzoff ||= '-0000'; | ||
512 | |||||
513 | # months | ||||
514 | 555 | 2.86ms | if (exists $MONTH{$mon}) { | ||
515 | 555 | 1.62ms | $mmm = $MONTH{$mon}; | ||
516 | } | ||||
517 | |||||
518 | 3330 | 6.63ms | $hh ||= 0; $mm ||= 0; $ss ||= 0; $dd ||= 0; $mmm ||= 0; $yyyy ||= 0; | ||
519 | |||||
520 | # Fudge invalid times so that we get a usable date. | ||||
521 | 555 | 2.53ms | if ($ss > 59) { # rfc2822 does recognize leap seconds, not handled here | ||
522 | dbg("util: second after supported range, forcing second to 59: $date"); | ||||
523 | $ss = 59; | ||||
524 | } | ||||
525 | |||||
526 | 555 | 1.28ms | if ($mm > 59) { | ||
527 | dbg("util: minute after supported range, forcing minute to 59: $date"); | ||||
528 | $mm = 59; | ||||
529 | } | ||||
530 | |||||
531 | 555 | 1.30ms | if ($hh > 23) { | ||
532 | dbg("util: hour after supported range, forcing hour to 23: $date"); | ||||
533 | $hh = 23; | ||||
534 | } | ||||
535 | |||||
536 | 555 | 1.23ms | my $max_dd = 31; | ||
537 | 555 | 2.79ms | if ($mmm == 4 || $mmm == 6 || $mmm == 9 || $mmm == 11) { | ||
538 | 126 | 269µs | $max_dd = 30; | ||
539 | } | ||||
540 | elsif ($mmm == 2) { | ||||
541 | $max_dd = (!($yyyy % 4) && (($yyyy % 100) || !($yyyy % 400))) ? 29 : 28; | ||||
542 | } | ||||
543 | 555 | 1.32ms | if ($dd > $max_dd) { | ||
544 | dbg("util: day is too high, incrementing date to next valid date: $date"); | ||||
545 | $dd = 1; | ||||
546 | $mmm++; | ||||
547 | if ($mmm > 12) { | ||||
548 | $mmm = 1; | ||||
549 | $yyyy++; | ||||
550 | } | ||||
551 | } | ||||
552 | |||||
553 | # Time::Local (v1.10 at least, also 1.17) throws warnings when dates cause | ||||
554 | # a signed 32-bit integer overflow. So force a min/max for year. | ||||
555 | 555 | 1.82ms | if ($yyyy > 2037) { | ||
556 | dbg("util: year after supported range, forcing year to 2037: $date"); | ||||
557 | $yyyy = 2037; | ||||
558 | } | ||||
559 | elsif ($yyyy < 1970) { | ||||
560 | dbg("util: year before supported range, forcing year to 1970: $date"); | ||||
561 | $yyyy = 1970; | ||||
562 | } | ||||
563 | |||||
564 | 555 | 1.13ms | my $time; | ||
565 | eval { # could croak | ||||
566 | 555 | 7.29ms | 555 | 69.4ms | $time = timegm($ss, $mm, $hh, $dd, $mmm-1, $yyyy); # spent 69.4ms making 555 calls to Time::Local::timegm, avg 125µs/call |
567 | 555 | 1.37ms | 1; | ||
568 | 555 | 2.65ms | } or do { | ||
569 | my $eval_stat = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat; | ||||
570 | dbg("util: time cannot be parsed: $date, $yyyy-$mmm-$dd $hh:$mm:$ss, $eval_stat"); | ||||
571 | return; | ||||
572 | }; | ||||
573 | |||||
574 | 555 | 8.74ms | 555 | 3.38ms | if ($tzoff =~ /([-+])(\d\d)(\d\d)$/) # convert to seconds difference # spent 3.38ms making 555 calls to Mail::SpamAssassin::Util::CORE:match, avg 6µs/call |
575 | { | ||||
576 | 555 | 2.81ms | $tzoff = (($2 * 60) + $3) * 60; | ||
577 | 555 | 2.88ms | if ($1 eq '-') { | ||
578 | 555 | 1.35ms | $time += $tzoff; | ||
579 | } elsif ($time < $tzoff) { # careful with year 1970 and '+' time zones | ||||
580 | $time = 0; | ||||
581 | } else { | ||||
582 | $time -= $tzoff; | ||||
583 | } | ||||
584 | } | ||||
585 | |||||
586 | 555 | 9.78ms | return $time; | ||
587 | } | ||||
588 | |||||
589 | sub time_to_rfc822_date { | ||||
590 | my($time) = @_; | ||||
591 | |||||
592 | my @days = qw/Sun Mon Tue Wed Thu Fri Sat/; | ||||
593 | my @months = qw/Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec/; | ||||
594 | my @localtime = localtime($time || time); | ||||
595 | $localtime[5]+=1900; | ||||
596 | |||||
597 | sprintf("%s, %02d %s %4d %02d:%02d:%02d %s", $days[$localtime[6]], $localtime[3], | ||||
598 | $months[$localtime[4]], @localtime[5,2,1,0], local_tz()); | ||||
599 | } | ||||
600 | |||||
601 | ########################################################################### | ||||
602 | |||||
603 | # This used to be a wrapper for Text::Wrap. Now we do basically the same | ||||
604 | # function as Text::Wrap::wrap(). See bug 5056 and 2165 for more information | ||||
605 | # about why things aren't using that function anymore. | ||||
606 | # | ||||
607 | # It accepts values for almost all options which can be set | ||||
608 | # in Text::Wrap. All parameters are optional (leaving away the first one | ||||
609 | # probably doesn't make too much sense though), either a missing or a false | ||||
610 | # value will fall back to the default. | ||||
611 | # | ||||
612 | # The parameters are: | ||||
613 | # 1st: The string to wrap. Only one string is allowed. | ||||
614 | # (default: "") | ||||
615 | # 2nd: The prefix to be put in front of all lines except the first one. | ||||
616 | # (default: "") | ||||
617 | # 3rd: The prefix for the first line. (default: "") | ||||
618 | # 4th: The number of columns available (no line will be longer than this | ||||
619 | # unless overflow is set below). (default: 77) | ||||
620 | # 5th: Enable or disable overflow mode. (default: 0) | ||||
621 | # 6th: The sequence/expression to wrap at. (default: '\s'); | ||||
622 | # 7th: The string to join the lines again. (default: "\n") | ||||
623 | |||||
624 | sub wrap { | ||||
625 | my $string = shift || ''; | ||||
626 | my $prefix = shift || ''; | ||||
627 | my $first = shift || ''; | ||||
628 | my $length = shift || 77; | ||||
629 | my $overflow = shift || 0; | ||||
630 | my $break = shift || qr/\s/; | ||||
631 | my $sep = "\n"; | ||||
632 | |||||
633 | # go ahead and break apart the string, keeping the break chars | ||||
634 | my @arr = split(/($break)/, $string); | ||||
635 | |||||
636 | # tack the first prefix line at the start | ||||
637 | splice @arr, 0, 0, $first if $first; | ||||
638 | |||||
639 | # go ahead and make up the lines in the array | ||||
640 | my $pos = 0; | ||||
641 | my $pos_mod = 0; | ||||
642 | while ($#arr > $pos) { | ||||
643 | my $len = length $arr[$pos]; | ||||
644 | |||||
645 | # if we don't want to have lines > $length (overflow==0), we | ||||
646 | # need to verify what will happen with the next line. if we don't | ||||
647 | # care if a single line goes longer, don't care about the next | ||||
648 | # line. | ||||
649 | # we also want this to be true for the first entry on the line | ||||
650 | if ($pos_mod != 0 && $overflow == 0) { | ||||
651 | $len += length $arr[$pos+1]; | ||||
652 | } | ||||
653 | |||||
654 | if ($len <= $length) { | ||||
655 | # if the length determined above is within bounds, go ahead and | ||||
656 | # merge the next line with the current one | ||||
657 | $arr[$pos] .= splice @arr, $pos+1, 1; | ||||
658 | $pos_mod = 1; | ||||
659 | } | ||||
660 | else { | ||||
661 | # ok, the current line is the right length, but there's more text! | ||||
662 | # prep the current line and then go onto the next one | ||||
663 | |||||
664 | # strip any trailing whitespace from the next line that's ready | ||||
665 | $arr[$pos] =~ s/\s+$//; | ||||
666 | |||||
667 | # go to the next line and reset pos_mod | ||||
668 | $pos++; | ||||
669 | $pos_mod = 0; | ||||
670 | |||||
671 | # put the appropriate prefix at the front of the line | ||||
672 | splice @arr, $pos, 0, $prefix; | ||||
673 | } | ||||
674 | } | ||||
675 | |||||
676 | # go ahead and return the wrapped text, with the separator in between | ||||
677 | return join($sep, @arr); | ||||
678 | } | ||||
679 | |||||
680 | ########################################################################### | ||||
681 | |||||
682 | # Some base64 decoders will remove intermediate "=" characters, others | ||||
683 | # will stop decoding on the first "=" character, this one translates "=" | ||||
684 | # characters to null. | ||||
685 | # spent 75.6ms (16.1+59.5) within Mail::SpamAssassin::Util::base64_decode which was called 70 times, avg 1.08ms/call:
# 55 times (15.3ms+59.1ms) by Mail::SpamAssassin::Message::Node::decode at line 352 of Mail/SpamAssassin/Message/Node.pm, avg 1.35ms/call
# 15 times (826µs+421µs) by Mail::SpamAssassin::Message::Node::__decode_header at line 769 of Mail/SpamAssassin/Message/Node.pm, avg 83µs/call | ||||
686 | 70 | 272µs | local $_ = shift; | ||
687 | 70 | 141µs | my $decoded_length = shift; | ||
688 | |||||
689 | 70 | 37.2ms | 70 | 36.5ms | s/\s+//g; # spent 36.5ms making 70 calls to Mail::SpamAssassin::Util::CORE:subst, avg 522µs/call |
690 | 70 | 8.97ms | 70 | 8.12ms | if (HAS_MIME_BASE64 && (length($_) % 4 == 0) && # spent 8.12ms making 70 calls to Mail::SpamAssassin::Util::CORE:match, avg 116µs/call |
691 | m|^(?:[A-Za-z0-9+/=]{2,}={0,2})$|s) | ||||
692 | { | ||||
693 | # only use MIME::Base64 when the XS and Perl are both correct and quiet | ||||
694 | 70 | 3.25ms | 70 | 2.74ms | s/(=+)(?!=*$)/'A' x length($1)/ge; # spent 2.74ms making 70 calls to Mail::SpamAssassin::Util::CORE:subst, avg 39µs/call |
695 | |||||
696 | # If only a certain number of bytes are requested, truncate the encoded | ||||
697 | # version down to the appropriate size and return the requested bytes | ||||
698 | 70 | 144µs | if (defined $decoded_length) { | ||
699 | $_ = substr $_, 0, 4 * (int($decoded_length/3) + 1); | ||||
700 | my $decoded = MIME::Base64::decode_base64($_); | ||||
701 | return substr $decoded, 0, $decoded_length; | ||||
702 | } | ||||
703 | |||||
704 | # otherwise, just decode the whole thing and return it | ||||
705 | 70 | 25.8ms | 70 | 12.2ms | return MIME::Base64::decode_base64($_); # spent 12.2ms making 70 calls to MIME::Base64::decode_base64, avg 174µs/call |
706 | } | ||||
707 | tr{A-Za-z0-9+/=}{}cd; # remove non-base64 characters | ||||
708 | s/=+$//; # remove terminating padding | ||||
709 | tr{A-Za-z0-9+/=}{ -_`}; # translate to uuencode | ||||
710 | s/.$// if (length($_) % 4 == 1); # unpack cannot cope with extra byte | ||||
711 | |||||
712 | my $length; | ||||
713 | my $out = ''; | ||||
714 | while ($_) { | ||||
715 | $length = (length >= 84) ? 84 : length; | ||||
716 | $out .= unpack("u", chr(32 + $length * 3/4) . substr($_, 0, $length, '')); | ||||
717 | last if (defined $decoded_length && length $out >= $decoded_length); | ||||
718 | } | ||||
719 | |||||
720 | # If only a certain number of bytes are requested, truncate the encoded | ||||
721 | # version down to the appropriate size and return the requested bytes | ||||
722 | if (defined $decoded_length) { | ||||
723 | return substr $out, 0, $decoded_length; | ||||
724 | } | ||||
725 | |||||
726 | return $out; | ||||
727 | } | ||||
728 | |||||
729 | # spent 648ms (452+196) within Mail::SpamAssassin::Util::qp_decode which was called 305 times, avg 2.13ms/call:
# 202 times (448ms+195ms) by Mail::SpamAssassin::Message::Node::decode at line 339 of Mail/SpamAssassin/Message/Node.pm, avg 3.18ms/call
# 103 times (4.42ms+1.53ms) by Mail::SpamAssassin::Message::Node::__decode_header at line 777 of Mail/SpamAssassin/Message/Node.pm, avg 58µs/call | ||||
730 | 305 | 1.30ms | local $_ = shift; | ||
731 | |||||
732 | # RFC 2045: when decoding a Quoted-Printable body, any trailing | ||||
733 | # white space on a line must be deleted | ||||
734 | 305 | 40.2ms | 305 | 37.2ms | s/[ \t]+(?=\r?\n)//gs; # spent 37.2ms making 305 calls to Mail::SpamAssassin::Util::CORE:subst, avg 122µs/call |
735 | |||||
736 | 305 | 27.1ms | 305 | 25.0ms | s/=\r?\n//gs; # soft line breaks # spent 25.0ms making 305 calls to Mail::SpamAssassin::Util::CORE:subst, avg 82µs/call |
737 | |||||
738 | # RFC 2045 explicitly prohibits lowercase characters a-f in QP encoding | ||||
739 | # do we really want to allow them??? | ||||
740 | 26203 | 576ms | 26395 | 134ms | s/=([0-9a-fA-F]{2})/chr(hex($1))/ge; # spent 132ms making 26090 calls to Mail::SpamAssassin::Util::CORE:substcont, avg 5µs/call
# spent 2.02ms making 305 calls to Mail::SpamAssassin::Util::CORE:subst, avg 7µs/call |
741 | |||||
742 | 305 | 4.31ms | return $_; | ||
743 | } | ||||
744 | |||||
745 | sub base64_encode { | ||||
746 | local $_ = shift; | ||||
747 | |||||
748 | if (HAS_MIME_BASE64) { | ||||
749 | return MIME::Base64::encode_base64($_); | ||||
750 | } | ||||
751 | |||||
752 | $_ = pack("u57", $_); | ||||
753 | s/^.//mg; | ||||
754 | tr| -_`|A-Za-z0-9+/A|; # -> #`# <- kluge against vim syntax issues | ||||
755 | s/(A+)$/'=' x length $1/e; | ||||
756 | return $_; | ||||
757 | } | ||||
758 | |||||
759 | ########################################################################### | ||||
760 | |||||
761 | # spent 2.71ms (137µs+2.58) within Mail::SpamAssassin::Util::portable_getpwuid which was called:
# once (137µs+2.58ms) by Mail::SpamAssassin::new at line 441 of Mail/SpamAssassin.pm | ||||
762 | 1 | 3µs | if (defined &Mail::SpamAssassin::Util::_getpwuid_wrapper) { | ||
763 | return Mail::SpamAssassin::Util::_getpwuid_wrapper(@_); | ||||
764 | } | ||||
765 | |||||
766 | 1 | 2µs | my $sts; | ||
767 | 1 | 8µs | 1 | 4µs | if (!RUNNING_ON_WINDOWS) { # spent 4µs making 1 call to constant::__ANON__[constant.pm:192] |
768 | 1 | 74µs | $sts = eval ' sub _getpwuid_wrapper { getpwuid($_[0]); }; 1 '; # spent 2.59ms executing statements in string eval # includes 58µs spent executing 1 call to 1 sub defined therein. | ||
769 | } else { | ||||
770 | dbg("util: defining getpwuid() wrapper using 'unknown' as username"); | ||||
771 | $sts = eval ' sub _getpwuid_wrapper { _fake_getpwuid($_[0]); }; 1 '; | ||||
772 | } | ||||
773 | 1 | 2µs | if (!$sts) { | ||
774 | my $eval_stat = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat; | ||||
775 | warn "util: failed to define getpwuid() wrapper: $eval_stat\n"; | ||||
776 | } else { | ||||
777 | 1 | 29µs | 1 | 2.57ms | return Mail::SpamAssassin::Util::_getpwuid_wrapper(@_); # spent 2.57ms making 1 call to Mail::SpamAssassin::Util::_getpwuid_wrapper |
778 | } | ||||
779 | } | ||||
780 | |||||
781 | sub _fake_getpwuid { | ||||
782 | return ( | ||||
783 | 'unknown', # name, | ||||
784 | 'x', # passwd, | ||||
785 | $_[0], # uid, | ||||
786 | 0, # gid, | ||||
787 | '', # quota, | ||||
788 | '', # comment, | ||||
789 | '', # gcos, | ||||
790 | '/', # dir, | ||||
791 | '', # shell, | ||||
792 | '', # expire | ||||
793 | ); | ||||
794 | } | ||||
795 | |||||
796 | ########################################################################### | ||||
797 | |||||
798 | # Given a string, extract an IPv4 address from it. Required, since | ||||
799 | # we currently have no way to portably unmarshal an IPv4 address from | ||||
800 | # an IPv6 one without kludging elsewhere. | ||||
801 | # | ||||
802 | sub extract_ipv4_addr_from_string { | ||||
803 | my ($str) = @_; | ||||
804 | |||||
805 | return unless defined($str); | ||||
806 | |||||
807 | if ($str =~ /\b( | ||||
808 | (?:1\d\d|2[0-4]\d|25[0-5]|\d\d|\d)\. | ||||
809 | (?:1\d\d|2[0-4]\d|25[0-5]|\d\d|\d)\. | ||||
810 | (?:1\d\d|2[0-4]\d|25[0-5]|\d\d|\d)\. | ||||
811 | (?:1\d\d|2[0-4]\d|25[0-5]|\d\d|\d) | ||||
812 | )\b/ix) | ||||
813 | { | ||||
814 | if (defined $1) { return $1; } | ||||
815 | } | ||||
816 | |||||
817 | # ignore native IPv6 addresses; | ||||
818 | # TODO, eventually, once IPv6 spam starts to appear ;) | ||||
819 | return; | ||||
820 | } | ||||
821 | |||||
822 | ########################################################################### | ||||
823 | |||||
824 | { | ||||
825 | 1 | 4µs | my($hostname, $fq_hostname); | ||
826 | |||||
827 | # get the current host's unqalified domain name (better: return whatever | ||||
828 | # Sys::Hostname thinks our hostname is, might also be a full qualified one) | ||||
829 | # spent 94µs (38+56) within Mail::SpamAssassin::Util::hostname which was called:
# once (38µs+56µs) by Mail::SpamAssassin::Util::fq_hostname at line 845 | ||||
830 | 1 | 2µs | return $hostname if defined($hostname); | ||
831 | |||||
832 | # Sys::Hostname isn't taint safe and might fall back to `hostname`. So we've | ||||
833 | # got to clean PATH before we may call it. | ||||
834 | 1 | 8µs | 1 | 8µs | clean_path_in_taint_mode(); # spent 8µs making 1 call to Mail::SpamAssassin::Util::clean_path_in_taint_mode |
835 | 1 | 8µs | 1 | 44µs | $hostname = Sys::Hostname::hostname(); # spent 44µs making 1 call to Sys::Hostname::hostname |
836 | 1 | 12µs | 1 | 4µs | $hostname =~ s/[()]//gs; # bug 5929 # spent 4µs making 1 call to Mail::SpamAssassin::Util::CORE:subst |
837 | 1 | 8µs | return $hostname; | ||
838 | } | ||||
839 | |||||
840 | # get the current host's fully-qualified domain name, if possible. If | ||||
841 | # not possible, return the unqualified hostname. | ||||
842 | # spent 340µs (119+221) within Mail::SpamAssassin::Util::fq_hostname which was called 2 times, avg 170µs/call:
# 2 times (119µs+221µs) by Mail::SpamAssassin::Locker::UnixNFSSafe::safe_lock at line 70 of Mail/SpamAssassin/Locker/UnixNFSSafe.pm, avg 170µs/call | ||||
843 | 2 | 11µs | return $fq_hostname if defined($fq_hostname); | ||
844 | |||||
845 | 1 | 8µs | 1 | 94µs | $fq_hostname = hostname(); # spent 94µs making 1 call to Mail::SpamAssassin::Util::hostname |
846 | 1 | 13µs | 1 | 3µs | if ($fq_hostname !~ /\./) { # hostname doesn't contain a dot, so it can't be a FQDN # spent 3µs making 1 call to Mail::SpamAssassin::Util::CORE:match |
847 | my @names = grep(/^\Q${fq_hostname}.\E/o, # grep only FQDNs | ||||
848 | 3 | 190µs | 5 | 121µs | map { split } (gethostbyname($fq_hostname))[0 .. 1] # from all aliases # spent 96µs making 1 call to Mail::SpamAssassin::Util::CORE:ghbyname
# spent 19µs making 2 calls to Mail::SpamAssassin::Util::CORE:regcomp, avg 9µs/call
# spent 6µs making 2 calls to Mail::SpamAssassin::Util::CORE:match, avg 3µs/call |
849 | ); | ||||
850 | 1 | 3µs | $fq_hostname = $names[0] if (@names); # take the first FQDN, if any | ||
851 | 1 | 12µs | 1 | 3µs | $fq_hostname =~ s/[()]//gs; # bug 5929 # spent 3µs making 1 call to Mail::SpamAssassin::Util::CORE:subst |
852 | } | ||||
853 | |||||
854 | 1 | 10µs | return $fq_hostname; | ||
855 | } | ||||
856 | } | ||||
857 | |||||
858 | ########################################################################### | ||||
859 | |||||
860 | 1 | 3µs | sub ips_match_in_16_mask { | ||
861 | my ($ipset1, $ipset2) = @_; | ||||
862 | my ($b1, $b2); | ||||
863 | |||||
864 | foreach my $ip1 (@{$ipset1}) { | ||||
865 | foreach my $ip2 (@{$ipset2}) { | ||||
866 | next unless defined $ip1; | ||||
867 | next unless defined $ip2; | ||||
868 | next unless ($ip1 =~ /^(\d+\.\d+\.)/); $b1 = $1; | ||||
869 | next unless ($ip2 =~ /^(\d+\.\d+\.)/); $b2 = $1; | ||||
870 | if ($b1 eq $b2) { return 1; } | ||||
871 | } | ||||
872 | } | ||||
873 | |||||
874 | return 0; | ||||
875 | } | ||||
876 | |||||
877 | sub ips_match_in_24_mask { | ||||
878 | my ($ipset1, $ipset2) = @_; | ||||
879 | my ($b1, $b2); | ||||
880 | |||||
881 | foreach my $ip1 (@{$ipset1}) { | ||||
882 | foreach my $ip2 (@{$ipset2}) { | ||||
883 | next unless defined $ip1; | ||||
884 | next unless defined $ip2; | ||||
885 | next unless ($ip1 =~ /^(\d+\.\d+\.\d+\.)/); $b1 = $1; | ||||
886 | next unless ($ip2 =~ /^(\d+\.\d+\.\d+\.)/); $b2 = $1; | ||||
887 | if ($b1 eq $b2) { return 1; } | ||||
888 | } | ||||
889 | } | ||||
890 | |||||
891 | return 0; | ||||
892 | } | ||||
893 | |||||
894 | ########################################################################### | ||||
895 | |||||
896 | # Given a quad-dotted IPv4 address or an IPv6 address, reverses the order | ||||
897 | # of its bytes (IPv4) or nibbles (IPv6), joins them with dots, producing | ||||
898 | # a string suitable for reverse DNS lookups. Returns undef in case of a | ||||
899 | # syntactically invalid IP address. | ||||
900 | # | ||||
901 | # spent 44.4ms (33.9+10.5) within Mail::SpamAssassin::Util::reverse_ip_address which was called 714 times, avg 62µs/call:
# 714 times (33.9ms+10.5ms) by Mail::SpamAssassin::Message::Metadata::extract at line 97 of Mail/SpamAssassin/Message/Metadata.pm, avg 62µs/call | ||||
902 | 714 | 1.85ms | my ($ip) = @_; | ||
903 | |||||
904 | 714 | 1.22ms | my $revip; | ||
905 | 714 | 5.37ms | local($1,$2,$3,$4); | ||
906 | 714 | 13.0ms | 732 | 5.82ms | if ($ip =~ /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})\z/) { # spent 5.79ms making 726 calls to Mail::SpamAssassin::Util::CORE:match, avg 8µs/call
# spent 37µs making 6 calls to UNIVERSAL::can, avg 6µs/call |
907 | 708 | 6.65ms | $revip = "$4.$3.$2.$1"; | ||
908 | } elsif ($ip !~ /:/ || $ip !~ /^[0-9a-fA-F:.]{2,}\z/) { # triage | ||||
909 | # obviously unrecognized syntax | ||||
910 | } elsif (!NetAddr::IP->can('full6')) { # since NetAddr::IP 4.010 | ||||
911 | info("util: version of NetAddr::IP is too old, IPv6 not supported"); | ||||
912 | } else { | ||||
913 | # looks like an IPv6 address, let NetAddr::IP check the details | ||||
914 | 6 | 54µs | 6 | 77µs | my $ip_obj = NetAddr::IP->new6($ip); # spent 77µs making 6 calls to NetAddr::IP::Lite::new6, avg 13µs/call |
915 | 6 | 35µs | if (defined $ip_obj) { # valid IPv6 address | ||
916 | # RFC 5782 section 2.4. | ||||
917 | 6 | 120µs | 12 | 585µs | $revip = lc $ip_obj->network->full6; # string in a canonical form # spent 354µs making 6 calls to NetAddr::IP::Lite::network, avg 59µs/call
# spent 232µs making 6 calls to NetAddr::IP::full6, avg 39µs/call |
918 | 6 | 123µs | 6 | 41µs | $revip =~ s/://g; # spent 41µs making 6 calls to Mail::SpamAssassin::Util::CORE:subst, avg 7µs/call |
919 | 6 | 116µs | $revip = join('.', reverse split(//,$revip)); | ||
920 | } | ||||
921 | } | ||||
922 | 714 | 11.4ms | return $revip; | ||
923 | } | ||||
924 | |||||
925 | ########################################################################### | ||||
926 | |||||
927 | 11 | 439µs | 22 | 136µs | # spent 405µs (270+136) within Mail::SpamAssassin::Util::my_inet_aton which was called 11 times, avg 37µs/call:
# 11 times (270µs+136µs) by Mail::SpamAssassin::Plugin::URIDNSBL::parse_and_canonicalize_subtest at line 530 of Mail/SpamAssassin/Plugin/URIDNSBL.pm, avg 37µs/call # spent 73µs making 11 calls to Mail::SpamAssassin::Util::CORE:unpack, avg 7µs/call
# spent 62µs making 11 calls to Mail::SpamAssassin::Util::CORE:pack, avg 6µs/call |
928 | |||||
929 | ########################################################################### | ||||
930 | |||||
931 | # spent 533ms (124+408) within Mail::SpamAssassin::Util::decode_dns_question_entry which was called 1968 times, avg 271µs/call:
# 1968 times (124ms+408ms) by Mail::SpamAssassin::DnsResolver::_packet_id at line 640 of Mail/SpamAssassin/DnsResolver.pm, avg 271µs/call | ||||
932 | # decodes a Net::DNS::Packet->question entry, | ||||
933 | # returning a triple: class, type, label | ||||
934 | # | ||||
935 | 1968 | 3.91ms | my $q = $_[0]; | ||
936 | 1968 | 15.5ms | 1968 | 227ms | my $qname = $q->qname; # spent 227ms making 1968 calls to Net::DNS::Question::qname, avg 115µs/call |
937 | |||||
938 | # Bug 6959, Net::DNS flags a domain name in a query section as utf8, while | ||||
939 | # still keeping it "RFC 1035 zone file format"-encoded, silly and harmful | ||||
940 | 1968 | 24.4ms | 1968 | 7.72ms | utf8::encode($qname) if utf8::is_utf8($qname); # since Perl 5.8.1 # spent 7.72ms making 1968 calls to utf8::is_utf8, avg 4µs/call |
941 | |||||
942 | 1968 | 6.14ms | local $1; | ||
943 | # Net::DNS provides a query in encoded RFC 1035 zone file format, decode it! | ||||
944 | 1968 | 22.1ms | 1968 | 7.09ms | $qname =~ s{ \\ ( [0-9]{3} | [^0-9] ) } # spent 7.09ms making 1968 calls to Mail::SpamAssassin::Util::CORE:subst, avg 4µs/call |
945 | { length($1)==1 ? $1 : $1 <= 255 ? chr($1) : "\\$1" }xgse; | ||||
946 | 1968 | 44.4ms | 3936 | 167ms | return ($q->qclass, $q->qtype, $qname); # spent 84.0ms making 1968 calls to Net::DNS::Question::qtype, avg 43µs/call
# spent 82.6ms making 1968 calls to Net::DNS::Question::qclass, avg 42µs/call |
947 | } | ||||
948 | |||||
949 | ########################################################################### | ||||
950 | |||||
951 | # spent 178ms (113+65.2) within Mail::SpamAssassin::Util::parse_content_type which was called 1047 times, avg 170µs/call:
# 425 times (42.3ms+28.6ms) by Mail::SpamAssassin::Message::_parse_normal at line 1034 of Mail/SpamAssassin/Message.pm, avg 167µs/call
# 388 times (40.5ms+24.1ms) by Mail::SpamAssassin::Message::_parse_multipart at line 922 of Mail/SpamAssassin/Message.pm, avg 166µs/call
# 234 times (29.9ms+12.5ms) by Mail::SpamAssassin::Message::new at line 363 of Mail/SpamAssassin/Message.pm, avg 181µs/call | ||||
952 | # This routine is typically called by passing a | ||||
953 | # get_header("content-type") which passes all content-type headers | ||||
954 | # (array context). If there are multiple Content-type headers (invalid, | ||||
955 | # but it happens), MUAs seem to take the last one and so that's what we | ||||
956 | # should do here. | ||||
957 | # | ||||
958 | 1047 | 3.32ms | my $ct = $_[-1] || 'text/plain; charset=us-ascii'; | ||
959 | |||||
960 | # This could be made a bit more rigid ... | ||||
961 | # the actual ABNF, BTW (RFC 1521, section 7.2.1): | ||||
962 | # boundary := 0*69<bchars> bcharsnospace | ||||
963 | # bchars := bcharsnospace / " " | ||||
964 | # bcharsnospace := DIGIT / ALPHA / "'" / "(" / ")" / "+" /"_" | ||||
965 | # / "," / "-" / "." / "/" / ":" / "=" / "?" | ||||
966 | # | ||||
967 | # The boundary may be surrounded by double quotes. | ||||
968 | # "the boundary parameter, which consists of 1 to 70 characters from | ||||
969 | # a set of characters known to be very robust through email gateways, | ||||
970 | # and NOT ending with white space. (If a boundary appears to end with | ||||
971 | # white space, the white space must be presumed to have been added by | ||||
972 | # a gateway, and must be deleted.)" | ||||
973 | # | ||||
974 | # In practice: | ||||
975 | # - MUAs accept whitespace before and after the "=" character | ||||
976 | # - only an opening double quote seems to be needed | ||||
977 | # - non-quoted boundaries should be followed by space, ";", or end of line | ||||
978 | # - blank boundaries seem to not work | ||||
979 | # | ||||
980 | 1047 | 19.2ms | 1047 | 10.5ms | my($boundary) = $ct =~ m!\bboundary\s*=\s*("[^"]+|[^\s";]+(?=[\s;]|$))!i; # spent 10.5ms making 1047 calls to Mail::SpamAssassin::Util::CORE:match, avg 10µs/call |
981 | |||||
982 | # remove double-quotes in boundary (should only be at start and end) | ||||
983 | # | ||||
984 | 1047 | 2.68ms | $boundary =~ tr/"//d if defined $boundary; | ||
985 | |||||
986 | # Parse out the charset and name, if they exist. | ||||
987 | # | ||||
988 | 1047 | 30.4ms | 1047 | 13.6ms | my($charset) = $ct =~ /\bcharset\s*=\s*["']?(.*?)["']?(?:;|$)/i; # spent 13.6ms making 1047 calls to Mail::SpamAssassin::Util::CORE:match, avg 13µs/call |
989 | 1047 | 19.1ms | 1047 | 10.4ms | my($name) = $ct =~ /\b(?:file)?name\s*=\s*["']?(.*?)["']?(?:;|$)/i; # spent 10.4ms making 1047 calls to Mail::SpamAssassin::Util::CORE:match, avg 10µs/call |
990 | |||||
991 | # Get the actual MIME type out ... | ||||
992 | # Note: the header content may not be whitespace unfolded, so make sure the | ||||
993 | # REs do /s when appropriate. | ||||
994 | # correct: | ||||
995 | # Content-type: text/plain; charset=us-ascii | ||||
996 | # missing a semi-colon, CT shouldn't have whitespace anyway: | ||||
997 | # Content-type: text/plain charset=us-ascii | ||||
998 | # | ||||
999 | 1047 | 18.5ms | 1047 | 2.99ms | $ct =~ s/^\s+//; # strip leading whitespace # spent 2.99ms making 1047 calls to Mail::SpamAssassin::Util::CORE:subst, avg 3µs/call |
1000 | 1047 | 15.4ms | 1047 | 8.17ms | $ct =~ s/;.*$//s; # strip everything after first ';' # spent 8.17ms making 1047 calls to Mail::SpamAssassin::Util::CORE:subst, avg 8µs/call |
1001 | 1047 | 25.4ms | 1047 | 9.90ms | $ct =~ s@^([^/]+(?:/[^/\s]*)?).*$@$1@s; # only something/something ... # spent 9.90ms making 1047 calls to Mail::SpamAssassin::Util::CORE:subst, avg 9µs/call |
1002 | 1047 | 3.18ms | $ct = lc $ct; | ||
1003 | |||||
1004 | # bug 4298: If at this point we don't have a content-type, assume text/plain; | ||||
1005 | # also, bug 5399: if the content-type *starts* with "text", and isn't in a | ||||
1006 | # list of known bad/non-plain formats, do likewise. | ||||
1007 | 1047 | 22.6ms | 1867 | 9.68ms | if (!$ct || # spent 9.68ms making 1867 calls to Mail::SpamAssassin::Util::CORE:match, avg 5µs/call |
1008 | ($ct =~ /^text\b/ && $ct !~ /^text\/(?:x-vcard|calendar|html)$/)) | ||||
1009 | { | ||||
1010 | 440 | 1.12ms | $ct = "text/plain"; | ||
1011 | } | ||||
1012 | |||||
1013 | # strip inappropriate chars (bug 5399: after the text/plain fixup) | ||||
1014 | 1047 | 4.89ms | $ct =~ tr/\000-\040\177-\377\042\050\051\054\072-\077\100\133-\135//d; | ||
1015 | |||||
1016 | # Now that the header has been parsed, return the requested information. | ||||
1017 | # In scalar context, just the MIME type, in array context the | ||||
1018 | # four important data parts (type, boundary, charset, and filename). | ||||
1019 | # | ||||
1020 | 1047 | 22.1ms | return wantarray ? ($ct,$boundary,$charset,$name) : $ct; | ||
1021 | } | ||||
1022 | |||||
1023 | ########################################################################### | ||||
1024 | |||||
1025 | # spent 151ms (115+36.5) within Mail::SpamAssassin::Util::url_encode which was called 248 times, avg 610µs/call:
# 248 times (115ms+36.5ms) by Mail::SpamAssassin::Util::uri_list_canonicalize at line 1283, avg 610µs/call | ||||
1026 | 248 | 531µs | my ($url) = @_; | ||
1027 | 248 | 3.37ms | my (@characters) = split(/(\%[0-9a-fA-F]{2})/, $url); | ||
1028 | 248 | 430µs | my (@unencoded); | ||
1029 | my (@encoded); | ||||
1030 | |||||
1031 | 248 | 1.04ms | foreach (@characters) { | ||
1032 | # escaped character set ... | ||||
1033 | 2646 | 42.6ms | 2646 | 10.1ms | if (/\%[0-9a-fA-F]{2}/) { # spent 10.1ms making 2646 calls to Mail::SpamAssassin::Util::CORE:match, avg 4µs/call |
1034 | # IF it is in the range of 0x00-0x20 or 0x7f-0xff | ||||
1035 | # or it is one of "<", ">", """, "#", "%", | ||||
1036 | # ";", "/", "?", ":", "@", "=" or "&" | ||||
1037 | # THEN preserve its encoding | ||||
1038 | 1290 | 14.8ms | 1290 | 4.53ms | unless (/(20|7f|[0189a-fA-F][0-9a-fA-F])/i) { # spent 4.53ms making 1290 calls to Mail::SpamAssassin::Util::CORE:match, avg 4µs/call |
1039 | 2556 | 61.8ms | 3834 | 19.0ms | s/\%([2-7][0-9a-fA-F])/sprintf "%c", hex($1)/e; # spent 13.8ms making 2556 calls to Mail::SpamAssassin::Util::CORE:substcont, avg 5µs/call
# spent 5.17ms making 1278 calls to Mail::SpamAssassin::Util::CORE:subst, avg 4µs/call |
1040 | 1278 | 3.68ms | push(@unencoded, $_); | ||
1041 | } | ||||
1042 | } | ||||
1043 | # other stuff | ||||
1044 | else { | ||||
1045 | # no re "strict"; # since perl 5.21.8 | ||||
1046 | # 0x00-0x20, 0x7f-0xff, ", %, <, > | ||||
1047 | 1356 | 19.6ms | 1356 | 2.86ms | s/([\000-\040\177-\377\042\045\074\076]) # spent 2.86ms making 1356 calls to Mail::SpamAssassin::Util::CORE:subst, avg 2µs/call |
1048 | /push(@encoded, $1) && sprintf "%%%02x", unpack("C",$1)/egx; | ||||
1049 | } | ||||
1050 | } | ||||
1051 | 248 | 429µs | if (wantarray) { | ||
1052 | return(join("", @characters), join("", @unencoded), join("", @encoded)); | ||||
1053 | } | ||||
1054 | else { | ||||
1055 | 248 | 3.54ms | return join("", @characters); | ||
1056 | } | ||||
1057 | } | ||||
1058 | |||||
1059 | ########################################################################### | ||||
1060 | |||||
1061 | =item $module = first_available_module (@module_list) | ||||
1062 | |||||
1063 | Return the name of the first module that can be successfully loaded with | ||||
1064 | C<require> from the list. Returns C<undef> if none are available. | ||||
1065 | |||||
1066 | This is used instead of C<AnyDBM_File> as follows: | ||||
1067 | |||||
1068 | my $module = Mail::SpamAssassin::Util::first_available_module | ||||
1069 | (qw(DB_File GDBM_File NDBM_File SDBM_File)); | ||||
1070 | tie %hash, $module, $path, [... args]; | ||||
1071 | |||||
1072 | Note that C<SDBM_File> is guaranteed to be present, since it comes | ||||
1073 | with Perl. | ||||
1074 | |||||
1075 | =cut | ||||
1076 | |||||
1077 | # spent 75µs within Mail::SpamAssassin::Util::first_available_module which was called:
# once (75µs+0s) by Mail::SpamAssassin::DBBasedAddrList::new_checker at line 58 of Mail/SpamAssassin/DBBasedAddrList.pm | ||||
1078 | 1 | 4µs | my (@packages) = @_; | ||
1079 | 1 | 3µs | foreach my $mod (@packages) { | ||
1080 | 1 | 44µs | if (eval 'require '.$mod.'; 1; ') { # spent 8µs executing statements in string eval | ||
1081 | 1 | 16µs | return $mod; | ||
1082 | } | ||||
1083 | } | ||||
1084 | undef; | ||||
1085 | } | ||||
1086 | |||||
1087 | ########################################################################### | ||||
1088 | |||||
1089 | =item my ($filepath, $filehandle) = secure_tmpfile(); | ||||
1090 | |||||
1091 | Generates a filename for a temporary file, opens it exclusively and | ||||
1092 | securely, and returns a filehandle to the open file (opened O_RDWR). | ||||
1093 | |||||
1094 | If it cannot open a file after 20 tries, it returns C<undef>. | ||||
1095 | |||||
1096 | =cut | ||||
1097 | |||||
1098 | # thanks to http://www2.picante.com:81/~gtaylor/autobuse/ for this code | ||||
1099 | # spent 12.3ms (2.74+9.56) within Mail::SpamAssassin::Util::secure_tmpfile which was called 16 times, avg 768µs/call:
# 16 times (2.74ms+9.56ms) by Mail::SpamAssassin::Message::_parse_normal at line 1059 of Mail/SpamAssassin/Message.pm, avg 768µs/call | ||||
1100 | 16 | 396µs | 32 | 3.10ms | my $tmpdir = untaint_file_path($ENV{'TMPDIR'} || File::Spec->tmpdir()); # spent 1.94ms making 16 calls to Mail::SpamAssassin::Util::untaint_file_path, avg 121µs/call
# spent 1.16ms making 16 calls to File::Spec::Unix::tmpdir, avg 73µs/call |
1101 | |||||
1102 | 16 | 52µs | defined $tmpdir && $tmpdir ne '' | ||
1103 | or die "util: cannot find a temporary directory, set TMP or TMPDIR in environment"; | ||||
1104 | |||||
1105 | 16 | 1.60ms | 16 | 1.25ms | opendir(my $dh, $tmpdir) or die "Could not open directory $tmpdir: $!"; # spent 1.25ms making 16 calls to Mail::SpamAssassin::Util::CORE:open_dir, avg 78µs/call |
1106 | 16 | 413µs | 16 | 260µs | closedir $dh or die "Error closing directory $tmpdir: $!"; # spent 260µs making 16 calls to Mail::SpamAssassin::Util::CORE:closedir, avg 16µs/call |
1107 | |||||
1108 | 16 | 35µs | my ($reportfile, $tmpfh); | ||
1109 | 16 | 83µs | for (my $retries = 20; $retries > 0; $retries--) { | ||
1110 | # we do not rely on the obscurity of this name for security, | ||||
1111 | # we use a average-quality PRG since this is all we need | ||||
1112 | 16 | 253µs | my $suffix = join('', (0..9,'A'..'Z','a'..'z')[rand 62, rand 62, rand 62, | ||
1113 | rand 62, rand 62, rand 62]); | ||||
1114 | 16 | 1.21ms | 64 | 1.21ms | $reportfile = File::Spec->catfile($tmpdir,".spamassassin${$}${suffix}tmp"); # spent 833µs making 16 calls to File::Spec::Unix::catfile, avg 52µs/call
# spent 246µs making 16 calls to File::Spec::Unix::catdir, avg 15µs/call
# spent 134µs making 32 calls to File::Spec::Unix::canonpath, avg 4µs/call |
1115 | |||||
1116 | # instead, we require O_EXCL|O_CREAT to guarantee us proper | ||||
1117 | # ownership of our file, read the open(2) man page | ||||
1118 | 16 | 4.12ms | 16 | 3.87ms | if (sysopen($tmpfh, $reportfile, O_RDWR|O_CREAT|O_EXCL, 0600)) { # spent 3.87ms making 16 calls to Mail::SpamAssassin::Util::CORE:sysopen, avg 242µs/call |
1119 | 16 | 240µs | 16 | 86µs | binmode $tmpfh or die "cannot set $reportfile to binmode: $!"; # spent 86µs making 16 calls to Mail::SpamAssassin::Util::CORE:binmode, avg 5µs/call |
1120 | 16 | 71µs | last; | ||
1121 | } | ||||
1122 | my $errno = $!; | ||||
1123 | |||||
1124 | # ensure the file handle is not semi-open in some way | ||||
1125 | if ($tmpfh) { | ||||
1126 | if (! close $tmpfh) { | ||||
1127 | info("error closing $reportfile: $!"); | ||||
1128 | undef $tmpfh; | ||||
1129 | } | ||||
1130 | } | ||||
1131 | |||||
1132 | # it is acceptable if $tmpfh already exists, try another | ||||
1133 | next if $errno == EEXIST; | ||||
1134 | |||||
1135 | # error, maybe "out of quota", "too many open files", "Permission denied" | ||||
1136 | # (bug 4017); makes no sense retrying | ||||
1137 | die "util: failed to create a temporary file '$reportfile': $errno"; | ||||
1138 | } | ||||
1139 | |||||
1140 | 16 | 34µs | if (!$tmpfh) { | ||
1141 | warn "util: secure_tmpfile failed to create a temporary file, giving up"; | ||||
1142 | return; | ||||
1143 | } | ||||
1144 | |||||
1145 | 16 | 156µs | 16 | 161µs | dbg("util: secure_tmpfile created a temporary file %s", $reportfile); # spent 161µs making 16 calls to Mail::SpamAssassin::Logger::dbg, avg 10µs/call |
1146 | 16 | 255µs | return ($reportfile, $tmpfh); | ||
1147 | } | ||||
1148 | |||||
1149 | =item my ($dirpath) = secure_tmpdir(); | ||||
1150 | |||||
1151 | Generates a directory for temporary files. Creates it securely and | ||||
1152 | returns the path to the directory. | ||||
1153 | |||||
1154 | If it cannot create a directory after 20 tries, it returns C<undef>. | ||||
1155 | |||||
1156 | =cut | ||||
1157 | |||||
1158 | # stolen from secure_tmpfile() | ||||
1159 | sub secure_tmpdir { | ||||
1160 | my $tmpdir = untaint_file_path(File::Spec->tmpdir()); | ||||
1161 | |||||
1162 | if (!$tmpdir) { | ||||
1163 | # Note: we would prefer to keep this fatal, as not being able to | ||||
1164 | # find a writable tmpdir is a big deal for the calling code too. | ||||
1165 | # That would be quite a psychotic case, also. | ||||
1166 | warn "util: cannot find a temporary directory, set TMP or TMPDIR in environment"; | ||||
1167 | return; | ||||
1168 | } | ||||
1169 | |||||
1170 | my ($reportpath, $tmppath); | ||||
1171 | my $umask = umask 077; | ||||
1172 | |||||
1173 | for (my $retries = 20; $retries > 0; $retries--) { | ||||
1174 | # we do not rely on the obscurity of this name for security, | ||||
1175 | # we use a average-quality PRG since this is all we need | ||||
1176 | my $suffix = join('', (0..9,'A'..'Z','a'..'z')[rand 62, rand 62, rand 62, | ||||
1177 | rand 62, rand 62, rand 62]); | ||||
1178 | $reportpath = File::Spec->catfile($tmpdir,".spamassassin${$}${suffix}tmp"); | ||||
1179 | |||||
1180 | # instead, we require O_EXCL|O_CREAT to guarantee us proper | ||||
1181 | # ownership of our file, read the open(2) man page | ||||
1182 | if (mkdir $reportpath, 0700) { | ||||
1183 | $tmppath = $reportpath; | ||||
1184 | last; | ||||
1185 | } | ||||
1186 | |||||
1187 | if ($!{EEXIST}) { | ||||
1188 | # it is acceptable if $reportpath already exists, try another | ||||
1189 | next; | ||||
1190 | } | ||||
1191 | |||||
1192 | # error, maybe "out of quota" or "too many open files" (bug 4017) | ||||
1193 | warn "util: secure_tmpdir failed to create file '$reportpath': $!\n"; | ||||
1194 | } | ||||
1195 | |||||
1196 | umask $umask; | ||||
1197 | |||||
1198 | warn "util: secure_tmpdir failed to create a directory, giving up" if (!$tmppath); | ||||
1199 | |||||
1200 | return $tmppath; | ||||
1201 | } | ||||
1202 | |||||
1203 | |||||
1204 | ########################################################################### | ||||
1205 | |||||
1206 | ## | ||||
1207 | ## DEPRECATED FUNCTION, only left for third party plugins as fallback. | ||||
1208 | ## Replaced with Mail::SpamAssassin::RegistryBoundaries::uri_to_domain. | ||||
1209 | ## | ||||
1210 | sub uri_to_domain { | ||||
1211 | my ($uri) = @_; | ||||
1212 | |||||
1213 | # Javascript is not going to help us, so return. | ||||
1214 | return if ($uri =~ /^javascript:/i); | ||||
1215 | |||||
1216 | $uri =~ s{\#.*$}{}gs; # drop fragment | ||||
1217 | $uri =~ s{^[a-z]+:/{0,2}}{}gsi; # drop the protocol | ||||
1218 | $uri =~ s{^[^/]*\@}{}gs; # username/passwd | ||||
1219 | |||||
1220 | # strip path and CGI params. note: bug 4213 shows that "&" should | ||||
1221 | # *not* be likewise stripped here -- it's permitted in hostnames by | ||||
1222 | # some common MUAs! | ||||
1223 | $uri =~ s{[/?].*$}{}gs; | ||||
1224 | |||||
1225 | $uri =~ s{:\d*$}{}gs; # port, bug 4191: sometimes the # is missing | ||||
1226 | |||||
1227 | # skip undecoded URIs if the encoded bits shouldn't be. | ||||
1228 | # we'll see the decoded version as well. see url_encode() | ||||
1229 | return if $uri =~ /\%(?:2[1-9a-fA-F]|[3-6][0-9a-fA-F]|7[0-9a-eA-E])/; | ||||
1230 | |||||
1231 | my $host = $uri; # unstripped/full domain name | ||||
1232 | |||||
1233 | # keep IPs intact | ||||
1234 | if ($uri !~ /^\d+\.\d+\.\d+\.\d+$/) { | ||||
1235 | # get rid of hostname part of domain, understanding delegation | ||||
1236 | $uri = Mail::SpamAssassin::Util::RegistrarBoundaries::trim_domain($uri); | ||||
1237 | |||||
1238 | # ignore invalid domains | ||||
1239 | return unless | ||||
1240 | (Mail::SpamAssassin::Util::RegistrarBoundaries::is_domain_valid($uri)); | ||||
1241 | } | ||||
1242 | |||||
1243 | # $uri is now the domain only, optionally return unstripped host name | ||||
1244 | return !wantarray ? lc $uri : (lc $uri, lc $host); | ||||
1245 | } | ||||
1246 | |||||
1247 | 1 | 8µs | *uri_list_canonify = \&uri_list_canonicalize; # compatibility alias | ||
1248 | # spent 5.60s (3.70+1.90) within Mail::SpamAssassin::Util::uri_list_canonicalize which was called 7028 times, avg 797µs/call:
# 4211 times (2.08s+1.22s) by Mail::SpamAssassin::PerMsgStatus::get_uri_detail_list at line 2272 of Mail/SpamAssassin/PerMsgStatus.pm, avg 783µs/call
# 1916 times (1.27s+505ms) by Mail::SpamAssassin::PerMsgStatus::_get_parsed_uri_list at line 2420 of Mail/SpamAssassin/PerMsgStatus.pm, avg 927µs/call
# 901 times (356ms+175ms) by Mail::SpamAssassin::PerMsgStatus::get_uri_detail_list at line 2309 of Mail/SpamAssassin/PerMsgStatus.pm, avg 590µs/call | ||||
1249 | 7028 | 40.4ms | my($redirector_patterns, @uris) = @_; | ||
1250 | |||||
1251 | # make sure we catch bad encoding tricks | ||||
1252 | 7028 | 11.5ms | my @nuris; | ||
1253 | 7028 | 26.0ms | for my $uri (@uris) { | ||
1254 | # we're interested in http:// and so on, skip mailto: and | ||||
1255 | # email addresses with no protocol | ||||
1256 | 7062 | 162ms | 13904 | 47.7ms | next if $uri =~ /^mailto:/i || $uri =~ /^[^:]*\@/; # spent 47.7ms making 13904 calls to Mail::SpamAssassin::Util::CORE:match, avg 3µs/call |
1257 | |||||
1258 | # sometimes we catch URLs on multiple lines | ||||
1259 | 6646 | 54.6ms | 6646 | 14.1ms | $uri =~ s/\n//g; # spent 14.1ms making 6646 calls to Mail::SpamAssassin::Util::CORE:subst, avg 2µs/call |
1260 | |||||
1261 | # URLs won't have leading/trailing whitespace | ||||
1262 | 6646 | 74.8ms | 6646 | 16.9ms | $uri =~ s/^\s+//; # spent 16.9ms making 6646 calls to Mail::SpamAssassin::Util::CORE:subst, avg 3µs/call |
1263 | 6646 | 83.4ms | 6646 | 16.5ms | $uri =~ s/\s+$//; # spent 16.5ms making 6646 calls to Mail::SpamAssassin::Util::CORE:subst, avg 2µs/call |
1264 | |||||
1265 | # CRs just confuse things down below, so trash them now | ||||
1266 | 6646 | 81.2ms | 6646 | 13.3ms | $uri =~ s/\r//g; # spent 13.3ms making 6646 calls to Mail::SpamAssassin::Util::CORE:subst, avg 2µs/call |
1267 | |||||
1268 | # Make a copy so we don't trash the original in the array | ||||
1269 | 6646 | 12.1ms | my $nuri = $uri; | ||
1270 | |||||
1271 | # bug 4390: certain MUAs treat back slashes as front slashes. | ||||
1272 | # since backslashes are supposed to be encoded in a URI, swap non-encoded | ||||
1273 | # ones with front slashes. | ||||
1274 | 6646 | 34.9ms | $nuri =~ tr{\\}{/}; | ||
1275 | |||||
1276 | # http:www.foo.biz -> http://www.foo.biz | ||||
1277 | 6646 | 291ms | 19774 | 92.2ms | $nuri =~ s{^(https?:)/{0,2}}{$1//}i; # spent 46.7ms making 6646 calls to Mail::SpamAssassin::Util::CORE:subst, avg 7µs/call
# spent 45.5ms making 13128 calls to Mail::SpamAssassin::Util::CORE:substcont, avg 3µs/call |
1278 | |||||
1279 | # *always* make a dup with all %-encoding decoded, since | ||||
1280 | # important parts of the URL may be encoded (such as the | ||||
1281 | # scheme). (bug 4213) | ||||
1282 | 6646 | 57.5ms | 6646 | 16.1ms | if ($nuri =~ /%[0-9a-fA-F]{2}/) { # spent 16.1ms making 6646 calls to Mail::SpamAssassin::Util::CORE:match, avg 2µs/call |
1283 | 248 | 1.92ms | 248 | 151ms | $nuri = Mail::SpamAssassin::Util::url_encode($nuri); # spent 151ms making 248 calls to Mail::SpamAssassin::Util::url_encode, avg 610µs/call |
1284 | } | ||||
1285 | |||||
1286 | # www.foo.biz -> http://www.foo.biz | ||||
1287 | # unschemed URIs: assume default of "http://" as most MUAs do | ||||
1288 | 6646 | 73.6ms | 6646 | 32.4ms | if ($nuri !~ /^[-_a-z0-9]+:/i) { # spent 32.4ms making 6646 calls to Mail::SpamAssassin::Util::CORE:match, avg 5µs/call |
1289 | 64 | 675µs | 64 | 138µs | if ($nuri =~ /^ftp\./) { # spent 138µs making 64 calls to Mail::SpamAssassin::Util::CORE:match, avg 2µs/call |
1290 | $nuri =~ s{^}{ftp://}g; | ||||
1291 | } | ||||
1292 | else { | ||||
1293 | 64 | 919µs | 64 | 446µs | $nuri =~ s{^}{http://}g; # spent 446µs making 64 calls to Mail::SpamAssassin::Util::CORE:subst, avg 7µs/call |
1294 | } | ||||
1295 | } | ||||
1296 | |||||
1297 | # http://www.foo.biz?id=3 -> http://www.foo.biz/?id=3 | ||||
1298 | 6646 | 76.2ms | 6666 | 34.5ms | $nuri =~ s{^(https?://[^/?]+)\?}{$1/?}i; # spent 34.4ms making 6646 calls to Mail::SpamAssassin::Util::CORE:subst, avg 5µs/call
# spent 54µs making 20 calls to Mail::SpamAssassin::Util::CORE:substcont, avg 3µs/call |
1299 | |||||
1300 | # deal with encoding of chars, this is just the set of printable | ||||
1301 | # chars minus ' ' (that is, dec 33-126, hex 21-7e) | ||||
1302 | 6646 | 75.4ms | 6646 | 14.4ms | $nuri =~ s/\&\#0*(3[3-9]|[4-9]\d|1[01]\d|12[0-6]);/sprintf "%c",$1/ge; # spent 14.4ms making 6646 calls to Mail::SpamAssassin::Util::CORE:subst, avg 2µs/call |
1303 | 6646 | 83.1ms | 6646 | 14.5ms | $nuri =~ s/\&\#x0*(2[1-9]|[3-6][a-fA-F0-9]|7[0-9a-eA-E]);/sprintf "%c",hex($1)/ge; # spent 14.5ms making 6646 calls to Mail::SpamAssassin::Util::CORE:subst, avg 2µs/call |
1304 | |||||
1305 | # put the new URI on the new list if it's different | ||||
1306 | 6646 | 14.7ms | if ($nuri ne $uri) { | ||
1307 | 304 | 1.74ms | push(@nuris, $nuri); | ||
1308 | } | ||||
1309 | |||||
1310 | # deal with wierd hostname parts, remove user/pass, etc. | ||||
1311 | 6646 | 212ms | 6646 | 134ms | if ($nuri =~ m{^(https?://)([^/]+?)((?::\d*)?\/.*)?$}i) { # spent 134ms making 6646 calls to Mail::SpamAssassin::Util::CORE:match, avg 20µs/call |
1312 | 6616 | 26.7ms | my($proto, $host, $rest) = ($1,$2,$3); | ||
1313 | |||||
1314 | # not required | ||||
1315 | 6616 | 11.5ms | $rest ||= ''; | ||
1316 | |||||
1317 | # Bug 6751: | ||||
1318 | # RFC 3490 (IDNA): Whenever dots are used as label separators, the | ||||
1319 | # following characters MUST be recognized as dots: U+002E (full stop), | ||||
1320 | # U+3002 (ideographic full stop), U+FF0E (fullwidth full stop), | ||||
1321 | # U+FF61 (halfwidth ideographic full stop). | ||||
1322 | # RFC 5895: [...] the IDEOGRAPHIC FULL STOP character (U+3002) | ||||
1323 | # can be mapped to the FULL STOP before label separation occurs. | ||||
1324 | # [...] Only the IDEOGRAPHIC FULL STOP character (U+3002) is added in | ||||
1325 | # this mapping because the authors have not fully investigated [...] | ||||
1326 | # Adding also 'SMALL FULL STOP' (U+FE52) as seen in the wild. | ||||
1327 | # Parhaps also the 'ONE DOT LEADER' (U+2024). | ||||
1328 | 6616 | 107ms | 6616 | 46.8ms | if ($host =~ s{(?: \xE3\x80\x82 | \xEF\xBC\x8E | \xEF\xBD\xA1 | # spent 46.8ms making 6616 calls to Mail::SpamAssassin::Util::CORE:subst, avg 7µs/call |
1329 | \xEF\xB9\x92 | \xE2\x80\xA4 )}{.}xgs) { | ||||
1330 | push(@nuris, join ('', $proto, $host, $rest)); | ||||
1331 | } | ||||
1332 | |||||
1333 | # bug 4146: deal with non-US ASCII 7-bit chars in the host portion | ||||
1334 | # of the URI according to RFC 1738 that's invalid, and the tested | ||||
1335 | # browsers (Firefox, IE) remove them before usage... | ||||
1336 | 6616 | 20.3ms | if ($host =~ tr/\000-\040\200-\377//d) { | ||
1337 | 4 | 15µs | push(@nuris, join ('', $proto, $host, $rest)); | ||
1338 | } | ||||
1339 | |||||
1340 | # deal with http redirectors. strip off one level of redirector | ||||
1341 | # and add back to the array. the foreach loop will go over those | ||||
1342 | # and deal appropriately. | ||||
1343 | # bug 3308: redirectors like yahoo only need one '/' ... <grrr> | ||||
1344 | 6616 | 80.1ms | 6616 | 14.7ms | if ($rest =~ m{(https?:/{0,2}.+)$}i) { # spent 14.7ms making 6616 calls to Mail::SpamAssassin::Util::CORE:match, avg 2µs/call |
1345 | 34 | 164µs | push(@uris, $1); | ||
1346 | } | ||||
1347 | |||||
1348 | # resort to redirector pattern matching if the generic https? check | ||||
1349 | # doesn't result in a match -- bug 4176 | ||||
1350 | else { | ||||
1351 | 13164 | 54.8ms | foreach (@{$redirector_patterns}) { | ||
1352 | 98730 | 3.12s | 197460 | 1.13s | if ("$proto$host$rest" =~ $_) { # spent 568ms making 98730 calls to Mail::SpamAssassin::Util::CORE:match, avg 6µs/call
# spent 563ms making 98730 calls to Mail::SpamAssassin::Util::CORE:regcomp, avg 6µs/call |
1353 | next unless defined $1; | ||||
1354 | dbg("uri: parsed uri pattern: $_"); | ||||
1355 | dbg("uri: parsed uri found: $1 in redirector: $proto$host$rest"); | ||||
1356 | push (@uris, $1); | ||||
1357 | last; | ||||
1358 | } | ||||
1359 | } | ||||
1360 | } | ||||
1361 | |||||
1362 | ######################## | ||||
1363 | ## TVD: known issue, if host has multiple combinations of the following, | ||||
1364 | ## all permutations will be put onto @nuris. shouldn't be an issue. | ||||
1365 | |||||
1366 | # Get rid of cruft that could cause confusion for rules... | ||||
1367 | |||||
1368 | # remove "www.fakehostname.com@" username part | ||||
1369 | 6616 | 90.4ms | 6616 | 14.3ms | if ($host =~ s/^[^\@]+\@//gs) { # spent 14.3ms making 6616 calls to Mail::SpamAssassin::Util::CORE:subst, avg 2µs/call |
1370 | push(@nuris, join ('', $proto, $host, $rest)); | ||||
1371 | } | ||||
1372 | |||||
1373 | # bug 3186: If in a sentence, we might pick up odd characters ... | ||||
1374 | # ie: "visit http://example.biz." or "visit http://example.biz!!!" | ||||
1375 | # the host portion should end in some form of alpha-numeric, strip off | ||||
1376 | # the rest. | ||||
1377 | 6616 | 110ms | 6616 | 44.0ms | if ($host =~ s/[^0-9A-Za-z]+$//) { # spent 44.0ms making 6616 calls to Mail::SpamAssassin::Util::CORE:subst, avg 7µs/call |
1378 | push(@nuris, join ('', $proto, $host, $rest)); | ||||
1379 | } | ||||
1380 | |||||
1381 | ######################## | ||||
1382 | |||||
1383 | # deal with hosts which are IPs | ||||
1384 | # also handle things like: | ||||
1385 | # http://89.0x00000000000000000000068.0000000000000000000000160.0x00000000000011 | ||||
1386 | # both hex (0x) and oct (0+) encoded octets, etc. | ||||
1387 | |||||
1388 | 6616 | 203ms | 19848 | 48.8ms | if ($host =~ /^ # spent 48.8ms making 19848 calls to Mail::SpamAssassin::Util::CORE:match, avg 2µs/call |
1389 | ((?:0x[0-9a-f]+|\d+)\.) | ||||
1390 | ((?:0x[0-9a-f]+|\d+)\.) | ||||
1391 | ((?:0x[0-9a-f]+|\d+)\.) | ||||
1392 | (0x[0-9a-f]+|\d+) | ||||
1393 | $/ix) | ||||
1394 | { | ||||
1395 | my @chunk = ($1,$2,$3,$4); | ||||
1396 | foreach my $octet (@chunk) { | ||||
1397 | $octet =~ s/^0x([0-9a-f]+)/sprintf "%d",hex($1)/gei; | ||||
1398 | $octet =~ s/^0+([1-3][0-7]{0,2}|[4-7][0-7]?)\b/sprintf "%d",oct($1)/ge; | ||||
1399 | $octet =~ s/^0+//; | ||||
1400 | } | ||||
1401 | push(@nuris, join ('', $proto, @chunk, $rest)); | ||||
1402 | } | ||||
1403 | |||||
1404 | # "http://0x7f000001/" | ||||
1405 | elsif ($host =~ /^0x[0-9a-f]+$/i) { | ||||
1406 | # only take last 4 octets | ||||
1407 | $host =~ s/^0x[0-9a-f]*?([0-9a-f]{1,8})$/sprintf "%d",hex($1)/gei; | ||||
1408 | push(@nuris, join ('', $proto, decode_ulong_to_ip($host), $rest)); | ||||
1409 | } | ||||
1410 | |||||
1411 | # "http://1113343453/" | ||||
1412 | elsif ($host =~ /^[0-9]+$/) { | ||||
1413 | push(@nuris, join ('', $proto, decode_ulong_to_ip($host), $rest)); | ||||
1414 | } | ||||
1415 | |||||
1416 | } | ||||
1417 | } | ||||
1418 | |||||
1419 | # remove duplicates, merge nuris and uris | ||||
1420 | 14398 | 108ms | my %uris = map { $_ => 1 } @uris, @nuris; | ||
1421 | |||||
1422 | 7028 | 80.9ms | return keys %uris; | ||
1423 | } | ||||
1424 | |||||
1425 | sub decode_ulong_to_ip { | ||||
1426 | return join(".", unpack("CCCC",pack("H*", sprintf "%08lx", $_[0]))); | ||||
1427 | } | ||||
1428 | |||||
1429 | ########################################################################### | ||||
1430 | |||||
1431 | # spent 271ms (16.7+255) within Mail::SpamAssassin::Util::first_date which was called 555 times, avg 489µs/call:
# 555 times (16.7ms+255ms) by Mail::SpamAssassin::Util::receive_date at line 1466, avg 489µs/call | ||||
1432 | 555 | 2.24ms | my (@strings) = @_; | ||
1433 | |||||
1434 | 555 | 1.47ms | foreach my $string (@strings) { | ||
1435 | 555 | 5.45ms | 555 | 255ms | my $time = parse_rfc822_date($string); # spent 255ms making 555 calls to Mail::SpamAssassin::Util::parse_rfc822_date, avg 459µs/call |
1436 | 555 | 6.57ms | return $time if defined($time) && $time; | ||
1437 | } | ||||
1438 | return; | ||||
1439 | } | ||||
1440 | |||||
1441 | # spent 362ms (50.6+312) within Mail::SpamAssassin::Util::receive_date which was called 555 times, avg 653µs/call:
# 555 times (50.6ms+312ms) by Mail::SpamAssassin::Message::receive_date at line 699 of Mail/SpamAssassin/Message.pm, avg 653µs/call | ||||
1442 | 555 | 1.87ms | my ($header) = @_; | ||
1443 | |||||
1444 | 555 | 1.33ms | $header ||= ''; | ||
1445 | 555 | 17.7ms | 555 | 10.3ms | $header =~ s/\n[ \t]+/ /gs; # fix continuation lines # spent 10.3ms making 555 calls to Mail::SpamAssassin::Util::CORE:subst, avg 19µs/call |
1446 | |||||
1447 | 555 | 28.5ms | 555 | 17.6ms | my @rcvd = ($header =~ /^Received:(.*)/img); # spent 17.6ms making 555 calls to Mail::SpamAssassin::Util::CORE:match, avg 32µs/call |
1448 | 555 | 1.20ms | my @local; | ||
1449 | my $time; | ||||
1450 | |||||
1451 | 555 | 2.38ms | if (@rcvd) { | ||
1452 | 555 | 16.9ms | 1110 | 10.3ms | if ($rcvd[0] =~ /qmail \d+ invoked by uid \d+/ || # spent 10.3ms making 1110 calls to Mail::SpamAssassin::Util::CORE:match, avg 9µs/call |
1453 | $rcvd[0] =~ /\bfrom (?:localhost\s|(?:\S+ ){1,2}\S*\b127\.0\.0\.1\b)/) | ||||
1454 | { | ||||
1455 | push @local, (shift @rcvd); | ||||
1456 | } | ||||
1457 | 555 | 6.74ms | 555 | 2.17ms | if (@rcvd && ($rcvd[0] =~ m/\bby localhost with \w+ \(fetchmail-[\d.]+/)) { # spent 2.17ms making 555 calls to Mail::SpamAssassin::Util::CORE:match, avg 4µs/call |
1458 | push @local, (shift @rcvd); | ||||
1459 | } | ||||
1460 | elsif (@local) { | ||||
1461 | unshift @rcvd, (shift @local); | ||||
1462 | } | ||||
1463 | } | ||||
1464 | |||||
1465 | 555 | 1.26ms | if (@rcvd) { | ||
1466 | 555 | 5.55ms | 555 | 271ms | $time = first_date(shift @rcvd); # spent 271ms making 555 calls to Mail::SpamAssassin::Util::first_date, avg 489µs/call |
1467 | 555 | 20.7ms | return $time if defined($time); | ||
1468 | } | ||||
1469 | if (@local) { | ||||
1470 | $time = first_date(@local); | ||||
1471 | return $time if defined($time); | ||||
1472 | } | ||||
1473 | if ($header =~ /^(?:From|X-From-Line:)\s+(.+)$/im) { | ||||
1474 | my $string = $1; | ||||
1475 | $string .= " ".local_tz() unless $string =~ /(?:[-+]\d{4}|\b[A-Z]{2,4}\b)/; | ||||
1476 | $time = first_date($string); | ||||
1477 | return $time if defined($time); | ||||
1478 | } | ||||
1479 | if (@rcvd) { | ||||
1480 | $time = first_date(@rcvd); | ||||
1481 | return $time if defined($time); | ||||
1482 | } | ||||
1483 | if ($header =~ /^Resent-Date:\s*(.+)$/im) { | ||||
1484 | $time = first_date($1); | ||||
1485 | return $time if defined($time); | ||||
1486 | } | ||||
1487 | if ($header =~ /^Date:\s*(.+)$/im) { | ||||
1488 | $time = first_date($1); | ||||
1489 | return $time if defined($time); | ||||
1490 | } | ||||
1491 | |||||
1492 | return time; | ||||
1493 | } | ||||
1494 | |||||
1495 | ########################################################################### | ||||
1496 | |||||
1497 | sub setuid_to_euid { | ||||
1498 | return if (RUNNING_ON_WINDOWS); | ||||
1499 | |||||
1500 | # remember the target uid, the first number is the important one | ||||
1501 | my $touid = $>; | ||||
1502 | |||||
1503 | if ($< != $touid) { | ||||
1504 | dbg("util: changing real uid from $< to match effective uid $touid"); | ||||
1505 | # bug 3586: kludges needed to work around platform dependent behavior assigning to $< | ||||
1506 | # The POSIX functions deal with that so just use it here | ||||
1507 | POSIX::setuid($touid); | ||||
1508 | $< = $touid; $> = $touid; # bug 5574 | ||||
1509 | |||||
1510 | # Check that we have now accomplished the setuid: catch bug 3586 if it comes back | ||||
1511 | if ($< != $touid) { | ||||
1512 | # keep this fatal: it's a serious security problem if it fails | ||||
1513 | die "util: setuid $< to $touid failed!"; | ||||
1514 | } | ||||
1515 | } | ||||
1516 | } | ||||
1517 | |||||
1518 | # helper app command-line open | ||||
1519 | sub helper_app_pipe_open { | ||||
1520 | if (RUNNING_ON_WINDOWS) { | ||||
1521 | return helper_app_pipe_open_windows (@_); | ||||
1522 | } else { | ||||
1523 | return helper_app_pipe_open_unix (@_); | ||||
1524 | } | ||||
1525 | } | ||||
1526 | |||||
1527 | sub helper_app_pipe_open_windows { | ||||
1528 | my ($fh, $stdinfile, $duperr2out, @cmdline) = @_; | ||||
1529 | |||||
1530 | # use a traditional open(FOO, "cmd |") | ||||
1531 | my $cmd = join(' ', @cmdline); | ||||
1532 | if ($stdinfile) { $cmd .= qq/ < "$stdinfile"/; } | ||||
1533 | if ($duperr2out) { $cmd .= " 2>&1"; } | ||||
1534 | return open ($fh, $cmd.'|'); | ||||
1535 | } | ||||
1536 | |||||
1537 | sub force_die { | ||||
1538 | my ($msg) = @_; | ||||
1539 | |||||
1540 | # note use of eval { } scope in logging -- paranoia to ensure that a broken | ||||
1541 | # $SIG{__WARN__} implementation will not interfere with the flow of control | ||||
1542 | # here, where we *have* to die. | ||||
1543 | eval { warn $msg }; # hmm, STDERR may no longer be open | ||||
1544 | eval { dbg("util: force_die: $msg") }; | ||||
1545 | |||||
1546 | POSIX::_exit(6); # avoid END and destructor processing | ||||
1547 | kill('KILL',$$); # still kicking? die! | ||||
1548 | } | ||||
1549 | |||||
1550 | sub helper_app_pipe_open_unix { | ||||
1551 | my ($fh, $stdinfile, $duperr2out, @cmdline) = @_; | ||||
1552 | |||||
1553 | my $pid; | ||||
1554 | # do a fork-open, so we can setuid() back | ||||
1555 | eval { | ||||
1556 | $pid = open ($fh, '-|'); 1; | ||||
1557 | } or do { | ||||
1558 | my $eval_stat = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat; | ||||
1559 | die "util: cannot fork: $eval_stat"; | ||||
1560 | }; | ||||
1561 | if (!defined $pid) { | ||||
1562 | # acceptable to die() here, calling code catches it | ||||
1563 | die "util: cannot open a pipe to a forked process: $!"; | ||||
1564 | } | ||||
1565 | |||||
1566 | if ($pid != 0) { | ||||
1567 | return $pid; # parent process; return the child pid | ||||
1568 | } | ||||
1569 | |||||
1570 | # else, child process. | ||||
1571 | |||||
1572 | # from now on, we cannot die(), it could create a cloned process | ||||
1573 | # use force_die() instead (bug 4370, cmt 2) | ||||
1574 | eval { | ||||
1575 | # go setuid... | ||||
1576 | setuid_to_euid(); | ||||
1577 | dbg("util: setuid: ruid=$< euid=$>"); | ||||
1578 | |||||
1579 | # now set up the fds. due to some wierdness, we may have to ensure that | ||||
1580 | # we *really* close the correct fd number, since some other code may have | ||||
1581 | # redirected the meaning of STDOUT/STDIN/STDERR it seems... (bug 3649). | ||||
1582 | # use POSIX::close() for that. it's safe to call close() and POSIX::close() | ||||
1583 | # on the same fd; the latter is a no-op in that case. | ||||
1584 | |||||
1585 | if (!$stdinfile) { # < $tmpfile | ||||
1586 | # ensure we have *some* kind of fd 0. | ||||
1587 | $stdinfile = "/dev/null"; | ||||
1588 | } | ||||
1589 | |||||
1590 | my $f = fileno(STDIN); | ||||
1591 | close STDIN or die "error closing STDIN: $!"; | ||||
1592 | |||||
1593 | # sanity: was that the *real* STDIN? if not, close that one too ;) | ||||
1594 | if ($f != 0) { | ||||
1595 | POSIX::close(0); | ||||
1596 | } | ||||
1597 | |||||
1598 | open (STDIN, "<$stdinfile") or die "cannot open $stdinfile: $!"; | ||||
1599 | |||||
1600 | # this should be impossible; if we just closed fd 0, UNIX | ||||
1601 | # fd behaviour dictates that the next fd opened (the new STDIN) | ||||
1602 | # will be the lowest unused fd number, which should be 0. | ||||
1603 | # so die with a useful error if this somehow isn't the case. | ||||
1604 | if (fileno(STDIN) != 0) { | ||||
1605 | die "oops: fileno(STDIN) [".fileno(STDIN)."] != 0"; | ||||
1606 | } | ||||
1607 | |||||
1608 | # Ensure STDOUT is open. As we just created a pipe to ensure this, it has | ||||
1609 | # to be open to that pipe, and if it isn't, something's seriously screwy. | ||||
1610 | # Update: actually, this fails! see bug 3649 comment 37. For some reason, | ||||
1611 | # fileno(STDOUT) can be 0; possibly because open("-|") didn't change the fh | ||||
1612 | # named STDOUT, instead changing fileno(1) directly. So this is now | ||||
1613 | # commented. | ||||
1614 | # if (fileno(STDOUT) != 1) { | ||||
1615 | # die "setuid: oops: fileno(STDOUT) [".fileno(STDOUT)."] != 1"; | ||||
1616 | # } | ||||
1617 | |||||
1618 | STDOUT->autoflush(1); | ||||
1619 | |||||
1620 | if ($duperr2out) { # 2>&1 | ||||
1621 | my $f = fileno(STDERR); | ||||
1622 | close STDERR or die "error closing STDERR: $!"; | ||||
1623 | |||||
1624 | # sanity: was that the *real* STDERR? if not, close that one too ;) | ||||
1625 | if ($f != 2) { | ||||
1626 | POSIX::close(2); | ||||
1627 | } | ||||
1628 | |||||
1629 | open (STDERR, ">&STDOUT") or die "dup STDOUT failed: $!"; | ||||
1630 | STDERR->autoflush(1); # make sure not to lose diagnostics if exec fails | ||||
1631 | |||||
1632 | # STDERR must be fd 2 to be useful to subprocesses! (bug 3649) | ||||
1633 | if (fileno(STDERR) != 2) { | ||||
1634 | die "oops: fileno(STDERR) [".fileno(STDERR)."] != 2"; | ||||
1635 | } | ||||
1636 | } | ||||
1637 | |||||
1638 | exec @cmdline; | ||||
1639 | die "exec failed: $!"; | ||||
1640 | }; | ||||
1641 | my $eval_stat = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat; | ||||
1642 | |||||
1643 | # bug 4370: we really have to exit here; break any eval traps | ||||
1644 | force_die(sprintf('util: failed to spawn a process "%s": %s', | ||||
1645 | join(", ",@cmdline), $eval_stat)); | ||||
1646 | die; # must be a die() otherwise -w will complain | ||||
1647 | } | ||||
1648 | |||||
1649 | ########################################################################### | ||||
1650 | |||||
1651 | # As "perldoc perlvar" notes, in perl 5.8.0, the concept of "safe" signal | ||||
1652 | # handling was added, which means that signals cannot interrupt a running OP. | ||||
1653 | # unfortunately, a regexp match is a single OP, so a psychotic m// can | ||||
1654 | # effectively "hang" the interpreter as a result, and a $SIG{ALRM} handler | ||||
1655 | # will never get called. | ||||
1656 | # | ||||
1657 | # However, by using "unsafe" signals, we can still interrupt that -- and | ||||
1658 | # POSIX::sigaction can create an unsafe handler on 5.8.x. So this function | ||||
1659 | # provides a portable way to do that. | ||||
1660 | |||||
1661 | sub trap_sigalrm_fully { | ||||
1662 | my ($handler) = @_; | ||||
1663 | if ($] < 5.008 || am_running_on_windows()) { | ||||
1664 | # signals are always unsafe on perl older than 5.008, just use %SIG | ||||
1665 | # Bug 6359, no POSIX::SIGALRM on Windows, just use %SIG | ||||
1666 | $SIG{ALRM} = $handler; | ||||
1667 | } else { | ||||
1668 | # may be using "safe" signals with %SIG; use POSIX to avoid it | ||||
1669 | POSIX::sigaction POSIX::SIGALRM(), new POSIX::SigAction $handler; | ||||
1670 | } | ||||
1671 | } | ||||
1672 | |||||
1673 | ########################################################################### | ||||
1674 | |||||
1675 | # Removes any normal perl-style regexp delimiters at | ||||
1676 | # the start and end, and modifiers at the end (if present). | ||||
1677 | # If modifiers are found, they are inserted into the pattern using | ||||
1678 | # the /(?i)/ idiom. | ||||
1679 | |||||
1680 | # spent 5.07ms (3.24+1.83) within Mail::SpamAssassin::Util::regexp_remove_delimiters which was called 46 times, avg 110µs/call:
# 46 times (3.24ms+1.83ms) by Mail::SpamAssassin::Util::make_qr at line 1717, avg 110µs/call | ||||
1681 | 46 | 112µs | my ($re) = @_; | ||
1682 | |||||
1683 | 46 | 102µs | my $delim; | ||
1684 | 46 | 1.60ms | 184 | 543µs | if (!defined $re || $re eq '') { # spent 543µs making 184 calls to Mail::SpamAssassin::Util::CORE:subst, avg 3µs/call |
1685 | warn "cannot remove delimiters from null regexp"; | ||||
1686 | return; # invalid | ||||
1687 | } | ||||
1688 | elsif ($re =~ s/^m\{//) { # m{foo/bar} | ||||
1689 | $delim = '}'; | ||||
1690 | } | ||||
1691 | elsif ($re =~ s/^m\(//) { # m(foo/bar) | ||||
1692 | $delim = ')'; | ||||
1693 | } | ||||
1694 | elsif ($re =~ s/^m<//) { # m<foo/bar> | ||||
1695 | $delim = '>'; | ||||
1696 | } | ||||
1697 | elsif ($re =~ s/^m(\W)//) { # m#foo/bar# | ||||
1698 | 14 | 42µs | $delim = $1; | ||
1699 | } else { # /foo\/bar/ or !foo/bar! | ||||
1700 | 64 | 547µs | 32 | 218µs | $re =~ s/^(\W)//; $delim = $1; # spent 218µs making 32 calls to Mail::SpamAssassin::Util::CORE:subst, avg 7µs/call |
1701 | } | ||||
1702 | |||||
1703 | 46 | 1.84ms | 92 | 1.07ms | $re =~ s/\Q${delim}\E([imsx]*)$// or warn "unbalanced re: $re"; # spent 668µs making 46 calls to Mail::SpamAssassin::Util::CORE:regcomp, avg 15µs/call
# spent 405µs making 46 calls to Mail::SpamAssassin::Util::CORE:subst, avg 9µs/call |
1704 | |||||
1705 | 46 | 128µs | my $mods = $1; | ||
1706 | 46 | 150µs | if ($mods) { | ||
1707 | 33 | 188µs | $re = "(?".$mods.")".$re; | ||
1708 | } | ||||
1709 | |||||
1710 | 46 | 525µs | return $re; | ||
1711 | } | ||||
1712 | |||||
1713 | # turn "/foobar/i" into qr/(?i)foobar/ | ||||
1714 | |||||
1715 | # spent 8.40ms (1.63+6.77) within Mail::SpamAssassin::Util::make_qr which was called 46 times, avg 183µs/call:
# 46 times (1.63ms+6.77ms) by Mail::SpamAssassin::Plugin::MIMEHeader::__ANON__[/usr/local/lib/perl5/site_perl/Mail/SpamAssassin/Plugin/MIMEHeader.pm:160] at line 118 of Mail/SpamAssassin/Plugin/MIMEHeader.pm, avg 183µs/call | ||||
1716 | 46 | 145µs | my ($re) = @_; | ||
1717 | 46 | 376µs | 46 | 5.07ms | $re = regexp_remove_delimiters($re); # spent 5.07ms making 46 calls to Mail::SpamAssassin::Util::regexp_remove_delimiters, avg 110µs/call |
1718 | 46 | 2.67ms | 92 | 1.70ms | return qr/$re/; # spent 1.20ms making 46 calls to Mail::SpamAssassin::Util::CORE:regcomp, avg 26µs/call
# spent 492µs making 46 calls to Mail::SpamAssassin::Util::CORE:qr, avg 11µs/call |
1719 | } | ||||
1720 | |||||
1721 | ########################################################################### | ||||
1722 | |||||
1723 | sub get_my_locales { | ||||
1724 | my ($ok_locales) = @_; | ||||
1725 | |||||
1726 | my @locales = split(' ', $ok_locales); | ||||
1727 | my $lang = $ENV{'LC_ALL'}; | ||||
1728 | $lang ||= $ENV{'LANGUAGE'}; | ||||
1729 | $lang ||= $ENV{'LC_MESSAGES'}; | ||||
1730 | $lang ||= $ENV{'LANG'}; | ||||
1731 | push (@locales, $lang) if defined($lang); | ||||
1732 | return @locales; | ||||
1733 | } | ||||
1734 | |||||
1735 | ########################################################################### | ||||
1736 | |||||
1737 | # bug 5612: work around for bugs in Berkeley db 4.2 | ||||
1738 | # | ||||
1739 | # on 4.2 having the __db.[DBNAME] file will cause an loop that will never finish | ||||
1740 | # on 4.3+ the loop will timeout after 301 open attempts, but we will still | ||||
1741 | # be unable to open the database. This workaround solves both problems. | ||||
1742 | # | ||||
1743 | # spent 2.74ms (341µs+2.40) within Mail::SpamAssassin::Util::avoid_db_file_locking_bug which was called 3 times, avg 913µs/call:
# 2 times (183µs+1.44ms) by Mail::SpamAssassin::BayesStore::DBM::tie_db_writable at line 295 of Mail/SpamAssassin/BayesStore/DBM.pm, avg 812µs/call
# once (158µs+958µs) by Mail::SpamAssassin::DBBasedAddrList::new_checker at line 85 of Mail/SpamAssassin/DBBasedAddrList.pm | ||||
1744 | 3 | 8µs | my ($path) = @_; | ||
1745 | |||||
1746 | 3 | 294µs | 21 | 1.88ms | my $db_tmpfile = untaint_file_path(File::Spec->catfile(dirname($path), # spent 686µs making 3 calls to File::Basename::dirname, avg 229µs/call
# spent 539µs making 3 calls to File::Basename::basename, avg 180µs/call
# spent 403µs making 3 calls to Mail::SpamAssassin::Util::untaint_file_path, avg 134µs/call
# spent 164µs making 3 calls to File::Spec::Unix::catfile, avg 55µs/call
# spent 62µs making 3 calls to File::Spec::Unix::catdir, avg 21µs/call
# spent 21µs making 6 calls to File::Spec::Unix::canonpath, avg 4µs/call |
1747 | '__db.'.basename($path))); | ||||
1748 | |||||
1749 | # delete "__db.[DBNAME]" and "__db.[DBNAME].*" | ||||
1750 | 5 | 1.31ms | 4 | 2.26ms | # spent 2.00ms (1.34+661µs) within Mail::SpamAssassin::Util::BEGIN@1750 which was called:
# once (1.34ms+661µs) by Mail::SpamAssassin::Conf::BEGIN@85 at line 1750 # spent 2.00ms making 1 call to Mail::SpamAssassin::Util::BEGIN@1750
# spent 255µs making 3 calls to Mail::SpamAssassin::Util::CORE:glob, avg 85µs/call |
1751 | 3 | 23µs | 3 | 312µs | my $file = untaint_file_path($tfile); # spent 312µs making 3 calls to Mail::SpamAssassin::Util::untaint_file_path, avg 104µs/call |
1752 | 3 | 92µs | 3 | 38µs | my $stat_errn = stat($file) ? 0 : 0+$!; # spent 38µs making 3 calls to Mail::SpamAssassin::Util::CORE:stat, avg 13µs/call |
1753 | 3 | 10µs | next if $stat_errn == ENOENT; | ||
1754 | |||||
1755 | dbg("util: Berkeley DB bug work-around: cleaning tmp file $file"); | ||||
1756 | unlink($file) or warn "cannot remove Berkeley DB tmp file $file: $!\n"; | ||||
1757 | } | ||||
1758 | } | ||||
1759 | |||||
1760 | ########################################################################### | ||||
1761 | |||||
1762 | sub fisher_yates_shuffle { | ||||
1763 | my ($deck) = @_; | ||||
1764 | for (my $i = $#{$deck}; $i > 0; $i--) { | ||||
1765 | my $j = int rand($i+1); | ||||
1766 | @$deck[$i,$j] = @$deck[$j,$i]; | ||||
1767 | } | ||||
1768 | } | ||||
1769 | |||||
1770 | ########################################################################### | ||||
1771 | |||||
1772 | |||||
1773 | ########################################################################### | ||||
1774 | |||||
1775 | # bugs 6419 and 2607 relate to returning a score 1/10th lower than the | ||||
1776 | # required score if the rounded to the 10th version of the score is equal | ||||
1777 | # to the required score | ||||
1778 | # | ||||
1779 | # moved from PerMessageStatus.pm to here and modified to allow for a | ||||
1780 | # non-class version of the routine to be called from PerMessageStatus | ||||
1781 | # and from spamd | ||||
1782 | |||||
1783 | sub get_tag_value_for_score { | ||||
1784 | my ($score, $rscore, $is_spam) = @_; | ||||
1785 | |||||
1786 | #BASED ON _get_tag_value_for_score from PerMsgStatus.pm | ||||
1787 | |||||
1788 | $score = sprintf("%2.1f", $score); | ||||
1789 | $rscore = sprintf("%2.1f", $rscore); | ||||
1790 | |||||
1791 | # if the email is spam, return the accurate score | ||||
1792 | # if the email is NOT spam and the score is less than the required score, | ||||
1793 | # then return the accurate score | ||||
1794 | |||||
1795 | return $score if $is_spam or $score < $rscore; | ||||
1796 | |||||
1797 | # if the email is NOT spam and $score = $rscore, return the $rscore - 0.1 | ||||
1798 | # effectively flooring the value to the closest tenth | ||||
1799 | |||||
1800 | return $rscore - 0.1; | ||||
1801 | } | ||||
1802 | |||||
1803 | ########################################################################### | ||||
1804 | |||||
1805 | |||||
1806 | 1 | 47µs | 1; | ||
1807 | |||||
1808 | =back | ||||
1809 | |||||
1810 | =cut | ||||
# spent 86µs within Mail::SpamAssassin::Util::CORE:binmode which was called 16 times, avg 5µs/call:
# 16 times (86µs+0s) by Mail::SpamAssassin::Util::secure_tmpfile at line 1119, avg 5µs/call | |||||
# spent 260µs within Mail::SpamAssassin::Util::CORE:closedir which was called 16 times, avg 16µs/call:
# 16 times (260µs+0s) by Mail::SpamAssassin::Util::secure_tmpfile at line 1106, avg 16µs/call | |||||
# spent 14µs within Mail::SpamAssassin::Util::CORE:ftdir which was called 7 times, avg 2µs/call:
# 7 times (14µs+0s) by Mail::SpamAssassin::Util::clean_path_in_taint_mode at line 159, avg 2µs/call | |||||
# spent 96µs within Mail::SpamAssassin::Util::CORE:ghbyname which was called:
# once (96µs+0s) by Mail::SpamAssassin::Util::fq_hostname at line 848 | |||||
# spent 255µs within Mail::SpamAssassin::Util::CORE:glob which was called 3 times, avg 85µs/call:
# 3 times (255µs+0s) by Mail::SpamAssassin::Util::avoid_db_file_locking_bug at line 1750, avg 85µs/call | |||||
# spent 2.51ms within Mail::SpamAssassin::Util::CORE:gpwuid which was called:
# once (2.51ms+0s) by Mail::SpamAssassin::Util::_getpwuid_wrapper at line 1 of (eval 32)[Mail/SpamAssassin/Util.pm:768] | |||||
# spent 1.08s within Mail::SpamAssassin::Util::CORE:match which was called 196560 times, avg 6µs/call:
# 98730 times (568ms+0s) by Mail::SpamAssassin::Util::uri_list_canonicalize at line 1352, avg 6µs/call
# 24842 times (115ms+0s) by Mail::SpamAssassin::Util::untaint_var at line 291, avg 5µs/call
# 19848 times (48.8ms+0s) by Mail::SpamAssassin::Util::uri_list_canonicalize at line 1388, avg 2µs/call
# 13904 times (47.7ms+0s) by Mail::SpamAssassin::Util::uri_list_canonicalize at line 1256, avg 3µs/call
# 6646 times (134ms+0s) by Mail::SpamAssassin::Util::uri_list_canonicalize at line 1311, avg 20µs/call
# 6646 times (32.4ms+0s) by Mail::SpamAssassin::Util::uri_list_canonicalize at line 1288, avg 5µs/call
# 6646 times (16.1ms+0s) by Mail::SpamAssassin::Util::uri_list_canonicalize at line 1282, avg 2µs/call
# 6616 times (14.7ms+0s) by Mail::SpamAssassin::Util::uri_list_canonicalize at line 1344, avg 2µs/call
# 2646 times (10.1ms+0s) by Mail::SpamAssassin::Util::url_encode at line 1033, avg 4µs/call
# 1867 times (9.68ms+0s) by Mail::SpamAssassin::Util::parse_content_type at line 1007, avg 5µs/call
# 1290 times (4.53ms+0s) by Mail::SpamAssassin::Util::url_encode at line 1038, avg 4µs/call
# 1110 times (10.3ms+0s) by Mail::SpamAssassin::Util::receive_date at line 1452, avg 9µs/call
# 1047 times (13.6ms+0s) by Mail::SpamAssassin::Util::parse_content_type at line 988, avg 13µs/call
# 1047 times (10.5ms+0s) by Mail::SpamAssassin::Util::parse_content_type at line 980, avg 10µs/call
# 1047 times (10.4ms+0s) by Mail::SpamAssassin::Util::parse_content_type at line 989, avg 10µs/call
# 726 times (5.79ms+0s) by Mail::SpamAssassin::Util::reverse_ip_address at line 906, avg 8µs/call
# 555 times (17.6ms+0s) by Mail::SpamAssassin::Util::receive_date at line 1447, avg 32µs/call
# 555 times (3.38ms+0s) by Mail::SpamAssassin::Util::parse_rfc822_date at line 574, avg 6µs/call
# 555 times (2.17ms+0s) by Mail::SpamAssassin::Util::receive_date at line 1457, avg 4µs/call
# 91 times (526µs+0s) by Mail::SpamAssassin::Util::untaint_file_path at line 245, avg 6µs/call
# 70 times (8.12ms+0s) by Mail::SpamAssassin::Util::base64_decode at line 690, avg 116µs/call
# 64 times (138µs+0s) by Mail::SpamAssassin::Util::uri_list_canonicalize at line 1289, avg 2µs/call
# 8 times (96µs+0s) by Mail::SpamAssassin::Util::clean_path_in_taint_mode at line 155, avg 12µs/call
# 2 times (6µs+0s) by Mail::SpamAssassin::Util::fq_hostname at line 848, avg 3µs/call
# once (20µs+0s) by Mail::SpamAssassin::Util::BEGIN@85 at line 85
# once (3µs+0s) by Mail::SpamAssassin::Util::fq_hostname at line 846 | |||||
# spent 1.25ms within Mail::SpamAssassin::Util::CORE:open_dir which was called 16 times, avg 78µs/call:
# 16 times (1.25ms+0s) by Mail::SpamAssassin::Util::secure_tmpfile at line 1105, avg 78µs/call | |||||
# spent 62µs within Mail::SpamAssassin::Util::CORE:pack which was called 11 times, avg 6µs/call:
# 11 times (62µs+0s) by Mail::SpamAssassin::Util::my_inet_aton at line 927, avg 6µs/call | |||||
sub Mail::SpamAssassin::Util::CORE:qr; # opcode | |||||
# spent 566ms within Mail::SpamAssassin::Util::CORE:regcomp which was called 99006 times, avg 6µs/call:
# 98730 times (563ms+0s) by Mail::SpamAssassin::Util::uri_list_canonicalize at line 1352, avg 6µs/call
# 91 times (639µs+0s) by Mail::SpamAssassin::Util::untaint_file_path at line 245, avg 7µs/call
# 91 times (338µs+0s) by Mail::SpamAssassin::Util::untaint_file_path at line 243, avg 4µs/call
# 46 times (1.20ms+0s) by Mail::SpamAssassin::Util::make_qr at line 1718, avg 26µs/call
# 46 times (668µs+0s) by Mail::SpamAssassin::Util::regexp_remove_delimiters at line 1703, avg 15µs/call
# 2 times (19µs+0s) by Mail::SpamAssassin::Util::fq_hostname at line 848, avg 9µs/call | |||||
# spent 214µs within Mail::SpamAssassin::Util::CORE:stat which was called 11 times, avg 19µs/call:
# 8 times (176µs+0s) by Mail::SpamAssassin::Util::clean_path_in_taint_mode at line 159, avg 22µs/call
# 3 times (38µs+0s) by Mail::SpamAssassin::Util::avoid_db_file_locking_bug at line 1752, avg 13µs/call | |||||
# spent 472ms within Mail::SpamAssassin::Util::CORE:subst which was called 85478 times, avg 6µs/call:
# 6646 times (46.7ms+0s) by Mail::SpamAssassin::Util::uri_list_canonicalize at line 1277, avg 7µs/call
# 6646 times (34.4ms+0s) by Mail::SpamAssassin::Util::uri_list_canonicalize at line 1298, avg 5µs/call
# 6646 times (16.9ms+0s) by Mail::SpamAssassin::Util::uri_list_canonicalize at line 1262, avg 3µs/call
# 6646 times (16.5ms+0s) by Mail::SpamAssassin::Util::uri_list_canonicalize at line 1263, avg 2µs/call
# 6646 times (14.5ms+0s) by Mail::SpamAssassin::Util::uri_list_canonicalize at line 1303, avg 2µs/call
# 6646 times (14.4ms+0s) by Mail::SpamAssassin::Util::uri_list_canonicalize at line 1302, avg 2µs/call
# 6646 times (14.1ms+0s) by Mail::SpamAssassin::Util::uri_list_canonicalize at line 1259, avg 2µs/call
# 6646 times (13.3ms+0s) by Mail::SpamAssassin::Util::uri_list_canonicalize at line 1266, avg 2µs/call
# 6616 times (46.8ms+0s) by Mail::SpamAssassin::Util::uri_list_canonicalize at line 1328, avg 7µs/call
# 6616 times (44.0ms+0s) by Mail::SpamAssassin::Util::uri_list_canonicalize at line 1377, avg 7µs/call
# 6616 times (14.3ms+0s) by Mail::SpamAssassin::Util::uri_list_canonicalize at line 1369, avg 2µs/call
# 1968 times (7.09ms+0s) by Mail::SpamAssassin::Util::decode_dns_question_entry at line 944, avg 4µs/call
# 1356 times (2.86ms+0s) by Mail::SpamAssassin::Util::url_encode at line 1047, avg 2µs/call
# 1278 times (5.17ms+0s) by Mail::SpamAssassin::Util::url_encode at line 1039, avg 4µs/call
# 1110 times (23.3ms+0s) by Mail::SpamAssassin::Util::parse_rfc822_date at line 472, avg 21µs/call
# 1047 times (9.90ms+0s) by Mail::SpamAssassin::Util::parse_content_type at line 1001, avg 9µs/call
# 1047 times (8.17ms+0s) by Mail::SpamAssassin::Util::parse_content_type at line 1000, avg 8µs/call
# 1047 times (2.99ms+0s) by Mail::SpamAssassin::Util::parse_content_type at line 999, avg 3µs/call
# 555 times (10.3ms+0s) by Mail::SpamAssassin::Util::receive_date at line 1445, avg 19µs/call
# 555 times (9.36ms+0s) by Mail::SpamAssassin::Util::parse_rfc822_date at line 475, avg 17µs/call
# 555 times (5.92ms+0s) by Mail::SpamAssassin::Util::parse_rfc822_date at line 503, avg 11µs/call
# 555 times (5.54ms+0s) by Mail::SpamAssassin::Util::parse_rfc822_date at line 498, avg 10µs/call
# 305 times (37.2ms+0s) by Mail::SpamAssassin::Util::qp_decode at line 734, avg 122µs/call
# 305 times (25.0ms+0s) by Mail::SpamAssassin::Util::qp_decode at line 736, avg 82µs/call
# 305 times (2.02ms+0s) by Mail::SpamAssassin::Util::qp_decode at line 740, avg 7µs/call
# 184 times (543µs+0s) by Mail::SpamAssassin::Util::regexp_remove_delimiters at line 1684, avg 3µs/call
# 70 times (36.5ms+0s) by Mail::SpamAssassin::Util::base64_decode at line 689, avg 522µs/call
# 70 times (2.74ms+0s) by Mail::SpamAssassin::Util::base64_decode at line 694, avg 39µs/call
# 64 times (446µs+0s) by Mail::SpamAssassin::Util::uri_list_canonicalize at line 1293, avg 7µs/call
# 46 times (405µs+0s) by Mail::SpamAssassin::Util::regexp_remove_delimiters at line 1703, avg 9µs/call
# 32 times (218µs+0s) by Mail::SpamAssassin::Util::regexp_remove_delimiters at line 1700, avg 7µs/call
# 6 times (41µs+0s) by Mail::SpamAssassin::Util::reverse_ip_address at line 918, avg 7µs/call
# once (4µs+0s) by Mail::SpamAssassin::Util::hostname at line 836
# once (3µs+0s) by Mail::SpamAssassin::Util::fq_hostname at line 851 | |||||
# spent 191ms within Mail::SpamAssassin::Util::CORE:substcont which was called 41794 times, avg 5µs/call:
# 26090 times (132ms+0s) by Mail::SpamAssassin::Util::qp_decode at line 740, avg 5µs/call
# 13128 times (45.5ms+0s) by Mail::SpamAssassin::Util::uri_list_canonicalize at line 1277, avg 3µs/call
# 2556 times (13.8ms+0s) by Mail::SpamAssassin::Util::url_encode at line 1039, avg 5µs/call
# 20 times (54µs+0s) by Mail::SpamAssassin::Util::uri_list_canonicalize at line 1298, avg 3µs/call | |||||
# spent 3.87ms within Mail::SpamAssassin::Util::CORE:sysopen which was called 16 times, avg 242µs/call:
# 16 times (3.87ms+0s) by Mail::SpamAssassin::Util::secure_tmpfile at line 1118, avg 242µs/call | |||||
# spent 73µs within Mail::SpamAssassin::Util::CORE:unpack which was called 11 times, avg 7µs/call:
# 11 times (73µs+0s) by Mail::SpamAssassin::Util::my_inet_aton at line 927, avg 7µs/call |