← Index
NYTProf Performance Profile   « line view »
For /usr/local/bin/sa-learn
  Run on Sun Nov 5 03:09:29 2017
Reported on Mon Nov 6 13:20:45 2017

Filename/usr/local/lib/perl5/site_perl/Mail/SpamAssassin/Util.pm
StatementsExecuted 683928 statements in 10.1s
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
7028313.77s6.05sMail::SpamAssassin::Util::::uri_list_canonicalizeMail::SpamAssassin::Util::uri_list_canonicalize
2140102611.44s1.44sMail::SpamAssassin::Util::::CORE:matchMail::SpamAssassin::Util::CORE:match (opcode)
4126518101.33s1.53sMail::SpamAssassin::Util::::untaint_varMail::SpamAssassin::Util::untaint_var (recurses: max depth 1, inclusive time 325ms)
10607661712ms712msMail::SpamAssassin::Util::::CORE:regcompMail::SpamAssassin::Util::CORE:regcomp (opcode)
86360341534ms534msMail::SpamAssassin::Util::::CORE:substMail::SpamAssassin::Util::CORE:subst (opcode)
30521413ms603msMail::SpamAssassin::Util::::qp_decodeMail::SpamAssassin::Util::qp_decode
321611368ms368msMail::SpamAssassin::Util::::first_available_moduleMail::SpamAssassin::Util::first_available_module
362653296ms515msMail::SpamAssassin::Util::::untaint_file_pathMail::SpamAssassin::Util::untaint_file_path
4179441184ms184msMail::SpamAssassin::Util::::CORE:substcontMail::SpamAssassin::Util::CORE:substcont (opcode)
70211146ms294msMail::SpamAssassin::Util::::parse_rfc822_dateMail::SpamAssassin::Util::parse_rfc822_date
196811137ms645msMail::SpamAssassin::Util::::decode_dns_question_entryMail::SpamAssassin::Util::decode_dns_question_entry
104731127ms196msMail::SpamAssassin::Util::::parse_content_typeMail::SpamAssassin::Util::parse_content_type
24811121ms162msMail::SpamAssassin::Util::::url_encodeMail::SpamAssassin::Util::url_encode
7021191.0ms462msMail::SpamAssassin::Util::::receive_dateMail::SpamAssassin::Util::receive_date
7141143.3ms54.8msMail::SpamAssassin::Util::::reverse_ip_addressMail::SpamAssassin::Util::reverse_ip_address
36722128.6ms28.6msMail::SpamAssassin::Util::::CORE:qrMail::SpamAssassin::Util::CORE:qr (opcode)
32171124.5ms24.7msMail::SpamAssassin::Util::::fq_hostnameMail::SpamAssassin::Util::fq_hostname
7021120.8ms315msMail::SpamAssassin::Util::::first_dateMail::SpamAssassin::Util::first_date
1632217.2ms187msMail::SpamAssassin::Util::::avoid_db_file_locking_bugMail::SpamAssassin::Util::avoid_db_file_locking_bug
1631116.0ms16.0msMail::SpamAssassin::Util::::CORE:globMail::SpamAssassin::Util::CORE:glob (opcode)
1115.08ms9.61msMail::SpamAssassin::Util::::BEGIN@71Mail::SpamAssassin::Util::BEGIN@71
70213.80ms63.9msMail::SpamAssassin::Util::::base64_decodeMail::SpamAssassin::Util::base64_decode
46113.66ms5.47msMail::SpamAssassin::Util::::regexp_remove_delimitersMail::SpamAssassin::Util::regexp_remove_delimiters
1113.29ms4.01msMail::SpamAssassin::Util::::BEGIN@73Mail::SpamAssassin::Util::BEGIN@73
16113.19ms3.19msMail::SpamAssassin::Util::::CORE:sysopenMail::SpamAssassin::Util::CORE:sysopen (opcode)
1113.09ms58.4msMail::SpamAssassin::Util::::BEGIN@76Mail::SpamAssassin::Util::BEGIN@76
1112.85ms4.07msMail::SpamAssassin::Util::::BEGIN@74Mail::SpamAssassin::Util::BEGIN@74
16112.52ms11.4msMail::SpamAssassin::Util::::secure_tmpfileMail::SpamAssassin::Util::secure_tmpfile
46111.83ms8.86msMail::SpamAssassin::Util::::make_qrMail::SpamAssassin::Util::make_qr
171211.78ms1.78msMail::SpamAssassin::Util::::CORE:statMail::SpamAssassin::Util::CORE:stat (opcode)
1111.73ms1.73msMail::SpamAssassin::Util::::CORE:gpwuidMail::SpamAssassin::Util::CORE:gpwuid (opcode)
1111.69ms2.38msMail::SpamAssassin::Util::::BEGIN@75Mail::SpamAssassin::Util::BEGIN@75
16111.61ms1.61msMail::SpamAssassin::Util::::CORE:open_dirMail::SpamAssassin::Util::CORE:open_dir (opcode)
1111.35ms1.96msMail::SpamAssassin::Util::::BEGIN@1750Mail::SpamAssassin::Util::BEGIN@1750
111866µs1.67msMail::SpamAssassin::Util::::BEGIN@84Mail::SpamAssassin::Util::BEGIN@84
222701µs1.71msMail::SpamAssassin::Util::::clean_path_in_taint_modeMail::SpamAssassin::Util::clean_path_in_taint_mode
1111252µs365µsMail::SpamAssassin::Util::::my_inet_atonMail::SpamAssassin::Util::my_inet_aton
1611211µs211µsMail::SpamAssassin::Util::::CORE:closedirMail::SpamAssassin::Util::CORE:closedir (opcode)
111166µs270µsMail::SpamAssassin::Util::::am_running_in_taint_modeMail::SpamAssassin::Util::am_running_in_taint_mode
111126µs1.88msMail::SpamAssassin::Util::::portable_getpwuidMail::SpamAssassin::Util::portable_getpwuid
11196µs96µsMail::SpamAssassin::Util::::CORE:ghbynameMail::SpamAssassin::Util::CORE:ghbyname (opcode)
161181µs81µsMail::SpamAssassin::Util::::CORE:binmodeMail::SpamAssassin::Util::CORE:binmode (opcode)
111179µs79µsMail::SpamAssassin::Util::::CORE:packMail::SpamAssassin::Util::CORE:pack (opcode)
54373µs103µsMail::SpamAssassin::Util::::am_running_on_windowsMail::SpamAssassin::Util::am_running_on_windows
11144µs97µsMail::SpamAssassin::Util::::hostnameMail::SpamAssassin::Util::hostname
11142µs48µsMail::SpamAssassin::Util::::BEGIN@43Mail::SpamAssassin::Util::BEGIN@43
11134µs148µsMail::SpamAssassin::Util::::BEGIN@85Mail::SpamAssassin::Util::BEGIN@85
111134µs34µsMail::SpamAssassin::Util::::CORE:unpackMail::SpamAssassin::Util::CORE:unpack (opcode)
11130µs30µsMail::SpamAssassin::Util::::BEGIN@52Mail::SpamAssassin::Util::BEGIN@52
11127µs1.47msMail::SpamAssassin::Util::::BEGIN@77Mail::SpamAssassin::Util::BEGIN@77
11126µs100µsMail::SpamAssassin::Util::::BEGIN@288Mail::SpamAssassin::Util::BEGIN@288
11123µs160µsMail::SpamAssassin::Util::::BEGIN@50Mail::SpamAssassin::Util::BEGIN@50
11123µs144µsMail::SpamAssassin::Util::::BEGIN@78Mail::SpamAssassin::Util::BEGIN@78
11120µs67µsMail::SpamAssassin::Util::::BEGIN@70Mail::SpamAssassin::Util::BEGIN@70
11119µs8.61msMail::SpamAssassin::Util::::BEGIN@79Mail::SpamAssassin::Util::BEGIN@79
11119µs23µsMail::SpamAssassin::Util::::BEGIN@88Mail::SpamAssassin::Util::BEGIN@88
11119µs25µsMail::SpamAssassin::Util::::BEGIN@45Mail::SpamAssassin::Util::BEGIN@45
11118µs40µsMail::SpamAssassin::Util::::BEGIN@44Mail::SpamAssassin::Util::BEGIN@44
11118µs184µsMail::SpamAssassin::Util::::BEGIN@55Mail::SpamAssassin::Util::BEGIN@55
11117µs63µsMail::SpamAssassin::Util::::BEGIN@46Mail::SpamAssassin::Util::BEGIN@46
11116µs16µsMail::SpamAssassin::Util::::BEGIN@68Mail::SpamAssassin::Util::BEGIN@68
11114µs14µsMail::SpamAssassin::Util::::BEGIN@72Mail::SpamAssassin::Util::BEGIN@72
71114µs14µsMail::SpamAssassin::Util::::CORE:ftdirMail::SpamAssassin::Util::CORE:ftdir (opcode)
11110µs10µsMail::SpamAssassin::Util::::BEGIN@53Mail::SpamAssassin::Util::BEGIN@53
0000s0sMail::SpamAssassin::Util::::__ANON__[:90]Mail::SpamAssassin::Util::__ANON__[:90]
0000s0sMail::SpamAssassin::Util::::__ANON__[:91]Mail::SpamAssassin::Util::__ANON__[:91]
0000s0sMail::SpamAssassin::Util::::__ANON__[:92]Mail::SpamAssassin::Util::__ANON__[:92]
0000s0sMail::SpamAssassin::Util::::__ANON__[:93]Mail::SpamAssassin::Util::__ANON__[:93]
0000s0sMail::SpamAssassin::Util::::_fake_getpwuidMail::SpamAssassin::Util::_fake_getpwuid
0000s0sMail::SpamAssassin::Util::::base64_encodeMail::SpamAssassin::Util::base64_encode
0000s0sMail::SpamAssassin::Util::::decode_ulong_to_ipMail::SpamAssassin::Util::decode_ulong_to_ip
0000s0sMail::SpamAssassin::Util::::exit_status_strMail::SpamAssassin::Util::exit_status_str
0000s0sMail::SpamAssassin::Util::::extract_ipv4_addr_from_stringMail::SpamAssassin::Util::extract_ipv4_addr_from_string
0000s0sMail::SpamAssassin::Util::::find_executable_in_env_pathMail::SpamAssassin::Util::find_executable_in_env_path
0000s0sMail::SpamAssassin::Util::::fisher_yates_shuffleMail::SpamAssassin::Util::fisher_yates_shuffle
0000s0sMail::SpamAssassin::Util::::force_dieMail::SpamAssassin::Util::force_die
0000s0sMail::SpamAssassin::Util::::get_my_localesMail::SpamAssassin::Util::get_my_locales
0000s0sMail::SpamAssassin::Util::::get_tag_value_for_scoreMail::SpamAssassin::Util::get_tag_value_for_score
0000s0sMail::SpamAssassin::Util::::helper_app_pipe_openMail::SpamAssassin::Util::helper_app_pipe_open
0000s0sMail::SpamAssassin::Util::::helper_app_pipe_open_unixMail::SpamAssassin::Util::helper_app_pipe_open_unix
0000s0sMail::SpamAssassin::Util::::helper_app_pipe_open_windowsMail::SpamAssassin::Util::helper_app_pipe_open_windows
0000s0sMail::SpamAssassin::Util::::ips_match_in_16_maskMail::SpamAssassin::Util::ips_match_in_16_mask
0000s0sMail::SpamAssassin::Util::::ips_match_in_24_maskMail::SpamAssassin::Util::ips_match_in_24_mask
0000s0sMail::SpamAssassin::Util::::local_tzMail::SpamAssassin::Util::local_tz
0000s0sMail::SpamAssassin::Util::::proc_status_okMail::SpamAssassin::Util::proc_status_ok
0000s0sMail::SpamAssassin::Util::::secure_tmpdirMail::SpamAssassin::Util::secure_tmpdir
0000s0sMail::SpamAssassin::Util::::setuid_to_euidMail::SpamAssassin::Util::setuid_to_euid
0000s0sMail::SpamAssassin::Util::::taint_varMail::SpamAssassin::Util::taint_var
0000s0sMail::SpamAssassin::Util::::time_to_rfc822_dateMail::SpamAssassin::Util::time_to_rfc822_date
0000s0sMail::SpamAssassin::Util::::trap_sigalrm_fullyMail::SpamAssassin::Util::trap_sigalrm_fully
0000s0sMail::SpamAssassin::Util::::untaint_hostnameMail::SpamAssassin::Util::untaint_hostname
0000s0sMail::SpamAssassin::Util::::uri_to_domainMail::SpamAssassin::Util::uri_to_domain
0000s0sMail::SpamAssassin::Util::::wrapMail::SpamAssassin::Util::wrap
Call graph for these subroutines as a Graphviz dot language file.
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
20Mail::SpamAssassin::Util - utility functions
21
22=head1 DESCRIPTION
23
24A general class for utility functions. Please use this for functions that
25stand alone, without requiring a $self object, Portability functions
26especially.
27
28NOTE: The functions in this module are to be considered private. Their API may
29change at any point, and it's expected that they'll only be used by other
30Mail::SpamAssassin modules. (TODO: we should probably revisit this if
31it's useful for plugin development.)
32
33NOTE: Utility functions should not be changing global variables such
34as $_, $1, $2, ... $/, etc. unless explicitly documented. If these
35variables are in use by these functions, they should be localized.
36
37=over 4
38
39=cut
40
41package Mail::SpamAssassin::Util;
42
43250µs255µs
# spent 48µs (42+7) within Mail::SpamAssassin::Util::BEGIN@43 which was called: # once (42µs+7µs) by Mail::SpamAssassin::Conf::BEGIN@85 at line 43
use strict;
# spent 48µs making 1 call to Mail::SpamAssassin::Util::BEGIN@43 # spent 7µs making 1 call to strict::import
44248µs261µs
# spent 40µs (18+21) within Mail::SpamAssassin::Util::BEGIN@44 which was called: # once (18µs+21µs) by Mail::SpamAssassin::Conf::BEGIN@85 at line 44
use warnings;
# spent 40µs making 1 call to Mail::SpamAssassin::Util::BEGIN@44 # spent 21µs making 1 call to warnings::import
45249µs232µs
# spent 25µs (19+7) within Mail::SpamAssassin::Util::BEGIN@45 which was called: # once (19µs+7µs) by Mail::SpamAssassin::Conf::BEGIN@85 at line 45
use bytes;
# spent 25µs making 1 call to Mail::SpamAssassin::Util::BEGIN@45 # spent 7µs making 1 call to bytes::import
46272µs2110µs
# spent 63µs (17+46) within Mail::SpamAssassin::Util::BEGIN@46 which was called: # once (17µs+46µs) by Mail::SpamAssassin::Conf::BEGIN@85 at line 46
use re 'taint';
# spent 63µs making 1 call to Mail::SpamAssassin::Util::BEGIN@46 # spent 46µs making 1 call to re::import
47
48124µsrequire 5.008001; # needs utf8::is_utf8()
49
50258µs2296µs
# spent 160µs (23+136) within Mail::SpamAssassin::Util::BEGIN@50 which was called: # once (23µs+136µs) by Mail::SpamAssassin::Conf::BEGIN@85 at line 50
use Mail::SpamAssassin::Logger;
# spent 160µs making 1 call to Mail::SpamAssassin::Util::BEGIN@50 # spent 136µs making 1 call to Exporter::import
51
52
# spent 30µs within Mail::SpamAssassin::Util::BEGIN@52 which was called: # once (30µs+0s) by Mail::SpamAssassin::Conf::BEGIN@85 at line 66
BEGIN {
53257µs110µ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
use Exporter ();
# spent 10µs making 1 call to Mail::SpamAssassin::Util::BEGIN@53
54
5512µs
# spent 184µs (18+166) within Mail::SpamAssassin::Util::BEGIN@55 which was called: # once (18µs+166µs) by Mail::SpamAssassin::Conf::BEGIN@85 at line 58
use vars qw (
56 @ISA @EXPORT @EXPORT_OK
57 $AM_TAINTED
581120µs2350µs );
# spent 184µs making 1 call to Mail::SpamAssassin::Util::BEGIN@55 # spent 166µs making 1 call to vars::import
59
60112µs @ISA = qw(Exporter);
6112µs @EXPORT = ();
62110µ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);
66142µs130µs}
# spent 30µs making 1 call to Mail::SpamAssassin::Util::BEGIN@52
67
68252µs116µs
# spent 16µs within Mail::SpamAssassin::Util::BEGIN@68 which was called: # once (16µs+0s) by Mail::SpamAssassin::Conf::BEGIN@85 at line 68
use Mail::SpamAssassin;
# spent 16µs making 1 call to Mail::SpamAssassin::Util::BEGIN@68
69
70261µs2114µs
# spent 67µs (20+47) within Mail::SpamAssassin::Util::BEGIN@70 which was called: # once (20µs+47µs) by Mail::SpamAssassin::Conf::BEGIN@85 at line 70
use Config;
# spent 67µs making 1 call to Mail::SpamAssassin::Util::BEGIN@70 # spent 47µs making 1 call to Config::import
712663µs29.70ms
# spent 9.61ms (5.08+4.53) within Mail::SpamAssassin::Util::BEGIN@71 which was called: # once (5.08ms+4.53ms) by Mail::SpamAssassin::Conf::BEGIN@85 at line 71
use IO::Handle;
# spent 9.61ms making 1 call to Mail::SpamAssassin::Util::BEGIN@71 # spent 86µs making 1 call to Exporter::import
72254µs114µs
# spent 14µs within Mail::SpamAssassin::Util::BEGIN@72 which was called: # once (14µs+0s) by Mail::SpamAssassin::Conf::BEGIN@85 at line 72
use File::Spec;
# spent 14µs making 1 call to Mail::SpamAssassin::Util::BEGIN@72
732530µs24.20ms
# spent 4.01ms (3.29+711µs) within Mail::SpamAssassin::Util::BEGIN@73 which was called: # once (3.29ms+711µs) by Mail::SpamAssassin::Conf::BEGIN@85 at line 73
use File::Basename;
# spent 4.01ms making 1 call to Mail::SpamAssassin::Util::BEGIN@73 # spent 191µs making 1 call to Exporter::import
742514µs24.21ms
# spent 4.07ms (2.85+1.22) within Mail::SpamAssassin::Util::BEGIN@74 which was called: # once (2.85ms+1.22ms) by Mail::SpamAssassin::Conf::BEGIN@85 at line 74
use Time::Local;
# spent 4.07ms making 1 call to Mail::SpamAssassin::Util::BEGIN@74 # spent 141µs making 1 call to Exporter::import
752491µs12.38ms
# spent 2.38ms (1.69+692µs) within Mail::SpamAssassin::Util::BEGIN@75 which was called: # once (1.69ms+692µs) by Mail::SpamAssassin::Conf::BEGIN@85 at line 75
use Sys::Hostname (); # don't import hostname() into this namespace!
# spent 2.38ms making 1 call to Mail::SpamAssassin::Util::BEGIN@75
763511µs358.8ms
# spent 58.4ms (3.09+55.3) within Mail::SpamAssassin::Util::BEGIN@76 which was called: # once (3.09ms+55.3ms) by Mail::SpamAssassin::Conf::BEGIN@85 at line 76
use NetAddr::IP 4.000;
# spent 58.4ms making 1 call to Mail::SpamAssassin::Util::BEGIN@76 # spent 312µs making 1 call to NetAddr::IP::import # spent 19µs making 1 call to UNIVERSAL::VERSION
77269µs22.91ms
# spent 1.47ms (27µs+1.44) within Mail::SpamAssassin::Util::BEGIN@77 which was called: # once (27µs+1.44ms) by Mail::SpamAssassin::Conf::BEGIN@85 at line 77
use Fcntl;
# spent 1.47ms making 1 call to Mail::SpamAssassin::Util::BEGIN@77 # spent 1.44ms making 1 call to Exporter::import
78269µs2264µs
# spent 144µs (23+120) within Mail::SpamAssassin::Util::BEGIN@78 which was called: # once (23µs+120µs) by Mail::SpamAssassin::Conf::BEGIN@85 at line 78
use Errno qw(ENOENT EACCES EEXIST);
# spent 144µs making 1 call to Mail::SpamAssassin::Util::BEGIN@78 # spent 120µs making 1 call to Exporter::import
7912µs
# spent 8.61ms (19µs+8.60) within Mail::SpamAssassin::Util::BEGIN@79 which was called: # once (19µs+8.60ms) by Mail::SpamAssassin::Conf::BEGIN@85 at line 80
use POSIX qw(:sys_wait_h WIFEXITED WIFSIGNALED WIFSTOPPED WEXITSTATUS
801122µs217.2ms WTERMSIG WSTOPSIG);
# spent 8.61ms making 1 call to Mail::SpamAssassin::Util::BEGIN@79 # spent 8.60ms making 1 call to POSIX::import
81
82###########################################################################
83
843515µs21.85ms
# spent 1.67ms (866µs+799µs) within Mail::SpamAssassin::Util::BEGIN@84 which was called: # once (866µs+799µs) by Mail::SpamAssassin::Conf::BEGIN@85 at line 84
use constant HAS_MIME_BASE64 => eval { require MIME::Base64; };
# spent 1.67ms making 1 call to Mail::SpamAssassin::Util::BEGIN@84 # spent 187µs making 1 call to constant::import
852281µs3262µs
# spent 148µs (34+114) within Mail::SpamAssassin::Util::BEGIN@85 which was called: # once (34µs+114µs) by Mail::SpamAssassin::Conf::BEGIN@85 at line 85
use constant RUNNING_ON_WINDOWS => ($^O =~ /^(?:mswin|dos|os2)/oi);
# spent 148µs making 1 call to Mail::SpamAssassin::Util::BEGIN@85 # spent 105µs making 1 call to constant::import # spent 9µ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 23µs (19+4) within Mail::SpamAssassin::Util::BEGIN@88 which was called: # once (19µs+4µs) by Mail::SpamAssassin::Conf::BEGIN@85 at line 95
BEGIN {
89112µs14µs if (RUNNING_ON_WINDOWS) {
# spent 4µ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 }
9511.88ms123µs}
# spent 23µ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.
10212µ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 ...
13225µs my $cleaned_taint_path = 0;
133
134
# spent 1.71ms (701µs+1.01) within Mail::SpamAssassin::Util::clean_path_in_taint_mode which was called 2 times, avg 853µs/call: # once (693µs+1.01ms) by Mail::SpamAssassin::new at line 438 of Mail/SpamAssassin.pm # once (8µs+0s) by Mail::SpamAssassin::Util::hostname at line 834
sub clean_path_in_taint_mode {
135215µs return if ($cleaned_taint_path++);
13617µs1270µs return unless am_running_in_taint_mode();
# spent 270µs making 1 call to Mail::SpamAssassin::Util::am_running_in_taint_mode
137
13816µs16µs dbg("util: taint mode: deleting unsafe environment variables, resetting PATH");
# spent 6µs making 1 call to Mail::SpamAssassin::Logger::dbg
139
14019µs16µ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
145121µs delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
146
147 # Go through and clean the PATH out
14812µs my @path;
149 my @stat;
150127µs171µs foreach my $dir (File::Spec->path()) {
# spent 71µs making 1 call to File::Spec::Unix::path
151814µs next unless $dir;
152
153 # untaint if at least 1 char and no NL (is the restriction intentional?)
154821µs local ($1);
1558139µs16228µs $dir = untaint_var($1) if $dir =~ /^(.+)$/;
# spent 186µs making 8 calls to Mail::SpamAssassin::Util::untaint_var, avg 23µs/call # spent 42µs making 8 calls to Mail::SpamAssassin::Util::CORE:match, avg 5µs/call
156 # then clean ( 'foo/./bar' -> 'foo/bar', etc. )
1578114µs852µs $dir = File::Spec->canonpath($dir);
# spent 52µs making 8 calls to File::Spec::Unix::canonpath, avg 7µs/call
158
1598331µs23306µs if (!File::Spec->file_name_is_absolute($dir)) {
# spent 174µs making 8 calls to Mail::SpamAssassin::Util::CORE:stat, avg 22µs/call # spent 118µs making 8 calls to File::Spec::Unix::file_name_is_absolute, avg 15µ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))) {
164117µs16µs dbg("util: PATH included '$dir', which is unusable, dropping: $!");
# spent 6µs making 1 call to Mail::SpamAssassin::Logger::dbg
16514µ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
179752µs745µs dbg("util: PATH included '$dir', keeping");
# spent 45µs making 7 calls to Mail::SpamAssassin::Logger::dbg, avg 6µs/call
180741µs push(@path, $dir);
181 }
182
183192µs110µs $ENV{'PATH'} = join($Config{'path_sep'}, @path);
# spent 10µs making 1 call to Config::FETCH
184118µs16µs dbg("util: final PATH set to: ".$ENV{'PATH'});
# spent 6µ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.
18913µs
# spent 270µs (166+104) within Mail::SpamAssassin::Util::am_running_in_taint_mode which was called: # once (166µs+104µs) by Mail::SpamAssassin::Util::clean_path_in_taint_mode at line 136
sub am_running_in_taint_mode {
19012µs return $AM_TAINTED if defined $AM_TAINTED;
191
19217µs if ($] >= 5.008) {
193 # perl 5.8 and above, ${^TAINT} is a syntax violation in 5.005
1941112µs $AM_TAINTED = eval q(no warnings q(syntax); ${^TAINT});
# spent 58µs executing statements in string eval
# includes 35µ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 }
21319µs19µs dbg("util: running in taint mode? %s", $AM_TAINTED ? "yes" : "no");
# spent 9µs making 1 call to Mail::SpamAssassin::Logger::dbg
214110µs return $AM_TAINTED;
215}
216
217###########################################################################
218
219
# spent 103µs (73+30) within Mail::SpamAssassin::Util::am_running_on_windows which was called 5 times, avg 21µs/call: # 2 times (24µs+11µs) by Mail::SpamAssassin::expand_name at line 2005 of Mail/SpamAssassin.pm, avg 18µs/call # once (16µs+7µs) by Mail::SpamAssassin::PerMsgStatus::is_dns_available at line 514 of Mail/SpamAssassin/Dns.pm # once (16µs+7µs) by main::RUNTIME at line 250 of /usr/local/bin/sa-learn # once (16µs+5µs) by Mail::SpamAssassin::create_locker at line 462 of Mail/SpamAssassin.pm
sub am_running_on_windows {
220573µs530µs return RUNNING_ON_WINDOWS;
# spent 30µs making 5 calls to constant::__ANON__[constant.pm:192], avg 6µ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 515ms (296+219) within Mail::SpamAssassin::Util::untaint_file_path which was called 3626 times, avg 142µs/call: # 3217 times (259ms+196ms) by Mail::SpamAssassin::Locker::UnixNFSSafe::safe_lock at line 71 of Mail/SpamAssassin/Locker/UnixNFSSafe.pm, avg 142µs/call # 163 times (11.5ms+10.5ms) by Mail::SpamAssassin::Util::avoid_db_file_locking_bug at line 1746, avg 135µs/call # 163 times (10.6ms+7.90ms) by Mail::SpamAssassin::Util::avoid_db_file_locking_bug at line 1751, avg 114µs/call # 67 times (13.4ms+3.56ms) by Mail::SpamAssassin::sed_path at line 2041 of Mail/SpamAssassin.pm, avg 253µs/call # 16 times (981µs+796µs) by Mail::SpamAssassin::Util::secure_tmpfile at line 1100, avg 111µs/call
sub untaint_file_path {
23436269.50ms my ($path) = @_;
235
23636267.72ms return unless defined($path);
23736269.99ms return '' if ($path eq '');
238
239362613.7ms local ($1);
240 # Barry Jaspan: allow ~ and spaces, good for Windows. Also return ''
241 # if input is '', as it is a safe path.
24236269.53ms my $chars = '-_A-Za-z0-9\xA0-\xFF\.\%\@\=\+\,\/\\\:';
2433626122ms725236.8ms my $re = qr/^\s*([$chars][${chars}~ ]*)$/o;
# spent 28.3ms making 3626 calls to Mail::SpamAssassin::Util::CORE:qr, avg 8µs/call # spent 8.51ms making 3626 calls to Mail::SpamAssassin::Util::CORE:regcomp, avg 2µs/call
244
2453626115ms725256.6ms if ($path =~ $re) {
# spent 28.5ms making 3626 calls to Mail::SpamAssassin::Util::CORE:match, avg 8µs/call # spent 28.1ms making 3626 calls to Mail::SpamAssassin::Util::CORE:regcomp, avg 8µs/call
246362611.9ms $path = $1;
247362673.4ms3626126ms return untaint_var($path);
# spent 126ms making 3626 calls to Mail::SpamAssassin::Util::untaint_var, avg 35µs/call
248 } else {
249 warn "util: refusing to untaint suspicious path: \"$path\"\n";
250 return $path;
251 }
252}
253
254sub 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 1.53s (1.33+198ms) within Mail::SpamAssassin::Util::untaint_var which was called 41265 times, avg 37µs/call: # 13368 times (357ms+39.9ms) by Mail::SpamAssassin::Conf::Parser::_meta_deps_recurse at line 999 of Mail/SpamAssassin/Conf/Parser.pm, avg 30µs/call # 9648 times (259ms+-259ms) by Mail::SpamAssassin::Util::untaint_var at line 297, avg 0s/call # 8956 times (268ms+67.0ms) by Mail::SpamAssassin::PerMsgStatus::_get_parsed_uri_list at line 2375 of Mail/SpamAssassin/PerMsgStatus.pm, avg 37µs/call # 3626 times (110ms+16.0ms) by Mail::SpamAssassin::Util::untaint_file_path at line 247, avg 35µs/call # 3216 times (254ms+325ms) by Mail::SpamAssassin::DBBasedAddrList::new_checker at line 57 of Mail/SpamAssassin/DBBasedAddrList.pm, avg 180µs/call # 1164 times (39.7ms+4.00ms) by Mail::SpamAssassin::Conf::Parser::handle_conditional at line 518 of Mail/SpamAssassin/Conf/Parser.pm, avg 38µs/call # 489 times (20.3ms+1.58ms) by Mail::SpamAssassin::Conf::Parser::handle_conditional at line 540 of Mail/SpamAssassin/Conf/Parser.pm, avg 45µs/call # 465 times (11.5ms+1.97ms) by Mail::SpamAssassin::Conf::Parser::is_meta_valid at line 1290 of Mail/SpamAssassin/Conf/Parser.pm, avg 29µs/call # 189 times (5.55ms+1.20ms) by Mail::SpamAssassin::HTML::parse at line 231 of Mail/SpamAssassin/HTML.pm, avg 36µs/call # 54 times (909µs+134µ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 19µs/call # 46 times (1.16ms+184µ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 29µs/call # 27 times (506µs+106µs) by Mail::SpamAssassin::Conf::load_plugin at line 4949 of Mail/SpamAssassin/Conf.pm, avg 23µs/call # 8 times (158µs+27µs) by Mail::SpamAssassin::Util::clean_path_in_taint_mode at line 155, avg 23µs/call # 4 times (94µs+15µs) by Mail::SpamAssassin::Conf::Parser::set_numeric_value at line 726 of Mail/SpamAssassin/Conf/Parser.pm, avg 27µs/call # 2 times (56µs+9µs) by Mail::SpamAssassin::DnsResolver::configured_nameservers at line 214 of Mail/SpamAssassin/DnsResolver.pm, avg 33µs/call # once (44µs+18µs) by Mail::SpamAssassin::Plugin::Bayes::learner_new at line 1652 of Mail/SpamAssassin/Plugin/Bayes.pm # once (31µs+6µ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 (27µs+5µs) by Mail::SpamAssassin::Plugin::TxRep::open_storages at line 1641 of Mail/SpamAssassin/Plugin/TxRep.pm
sub untaint_var {
286# my $arg = $_[0]; # avoid copying unnecessarily
28741265127ms if (!ref $_[0]) { # optimized by-far-the-most-common case
288213.9ms2173µs
# spent 100µs (26+74) within Mail::SpamAssassin::Util::BEGIN@288 which was called: # once (26µs+74µs) by Mail::SpamAssassin::Conf::BEGIN@85 at line 288
no re 'taint'; # override a "use re 'taint'" from outer scope
# spent 100µs making 1 call to Mail::SpamAssassin::Util::BEGIN@288 # spent 74µs making 1 call to re::unimport
2893804966.5ms return undef if !defined $_[0]; ## no critic (ProhibitExplicitReturnUndef) - See Bug 7120
29038022173ms local($1); # avoid Perl taint bug: tainted global $1 propagates taintedness
29138022603ms38022198ms $_[0] =~ /^(.*)\z/s;
# spent 198ms making 38022 calls to Mail::SpamAssassin::Util::CORE:match, avg 5µs/call
29238022532ms return $1;
293 } else {
294321610.2ms my $r = ref $_[0];
295321614.7ms if ($r eq 'ARRAY') {
29632166.67ms my $arg = $_[0];
2976432122ms96480s $_ = untaint_var($_) for @{$arg};
# spent 325ms making 9648 calls to Mail::SpamAssassin::Util::untaint_var, avg 34µs/call, recursion: max depth 1, sum of overlapping time 325ms
29832168.15ms 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 }
325321623.6ms return $_[0];
326}
327
328###########################################################################
329
330sub 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#
345sub 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#
373sub 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
388161µsmy %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
449116µsmy %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
45212µsmy $LOCALTZ;
453
454sub 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 294ms (146+149) within Mail::SpamAssassin::Util::parse_rfc822_date which was called 702 times, avg 420µs/call: # 702 times (146ms+149ms) by Mail::SpamAssassin::Util::first_date at line 1435, avg 420µs/call
sub parse_rfc822_date {
4677022.14ms my ($date) = @_;
46814048.92ms local ($_); local ($1,$2,$3,$4);
4697021.61ms my ($yyyy, $mmm, $dd, $hh, $mm, $ss, $mon, $tzoff);
470
471 # make it a bit easier to match
472210646.1ms140431.2ms $_ = " $date "; s/, */ /gs; s/\s+/ /gs;
# spent 31.2ms making 1404 calls to Mail::SpamAssassin::Util::CORE:subst, avg 22µs/call
473
474 # now match it in parts. Date part first:
47570219.0ms70212.2ms if (s/ (\d+) (Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec) (\d{4}) / /i) {
# spent 12.2ms making 702 calls to Mail::SpamAssassin::Util::CORE:subst, avg 17µs/call
47621068.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
4877022.88ms if (defined $yyyy) {
4887023.82ms 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
49870213.2ms7026.84ms if (s/ (\d?\d):(\d\d)(:(\d\d))? / /) {
# spent 6.84ms making 702 calls to Mail::SpamAssassin::Util::CORE:subst, avg 10µs/call
49921066.86ms $hh = $1; $mm = $2; $ss = $4 || 0;
500 }
501
502 # numeric timezones
50370214.2ms7027.52ms if (s/ ([-+]\d{4}) / /) {
# spent 7.52ms making 702 calls to Mail::SpamAssassin::Util::CORE:subst, avg 11µs/call
5047022.15ms $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"
5117021.45ms $tzoff ||= '-0000';
512
513 # months
5147023.89ms if (exists $MONTH{$mon}) {
5157022.13ms $mmm = $MONTH{$mon};
516 }
517
51842128.52ms $hh ||= 0; $mm ||= 0; $ss ||= 0; $dd ||= 0; $mmm ||= 0; $yyyy ||= 0;
519
520 # Fudge invalid times so that we get a usable date.
5217023.12ms 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
5267021.71ms if ($mm > 59) {
527 dbg("util: minute after supported range, forcing minute to 59: $date");
528 $mm = 59;
529 }
530
5317021.78ms if ($hh > 23) {
532 dbg("util: hour after supported range, forcing hour to 23: $date");
533 $hh = 23;
534 }
535
5367021.64ms my $max_dd = 31;
5377023.70ms if ($mmm == 4 || $mmm == 6 || $mmm == 9 || $mmm == 11) {
538159361µs $max_dd = 30;
539 }
540 elsif ($mmm == 2) {
541 $max_dd = (!($yyyy % 4) && (($yyyy % 100) || !($yyyy % 400))) ? 29 : 28;
542 }
5437021.76ms 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.
5557022.37ms 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
5647021.51ms my $time;
565 eval { # could croak
5667029.58ms70286.7ms $time = timegm($ss, $mm, $hh, $dd, $mmm-1, $yyyy);
# spent 86.7ms making 702 calls to Time::Local::timegm, avg 124µs/call
5677021.85ms 1;
5687023.47ms } 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
57470210.7ms7024.12ms if ($tzoff =~ /([-+])(\d\d)(\d\d)$/) # convert to seconds difference
# spent 4.12ms making 702 calls to Mail::SpamAssassin::Util::CORE:match, avg 6µs/call
575 {
5767023.81ms $tzoff = (($2 * 60) + $3) * 60;
5777023.74ms if ($1 eq '-') {
5787021.78ms $time += $tzoff;
579 } elsif ($time < $tzoff) { # careful with year 1970 and '+' time zones
580 $time = 0;
581 } else {
582 $time -= $tzoff;
583 }
584 }
585
58670211.9ms return $time;
587}
588
589sub 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
624sub 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 63.9ms (3.80+60.1) within Mail::SpamAssassin::Util::base64_decode which was called 70 times, avg 913µs/call: # 55 times (2.94ms+59.7ms) by Mail::SpamAssassin::Message::Node::decode at line 352 of Mail/SpamAssassin/Message/Node.pm, avg 1.14ms/call # 15 times (860µs+462µs) by Mail::SpamAssassin::Message::Node::__decode_header at line 769 of Mail/SpamAssassin/Message/Node.pm, avg 88µs/call
sub base64_decode {
68670279µs local $_ = shift;
68770141µs my $decoded_length = shift;
688
6897036.9ms7036.2ms s/\s+//g;
# spent 36.2ms making 70 calls to Mail::SpamAssassin::Util::CORE:subst, avg 517µs/call
690709.00ms708.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
694703.39ms702.86ms s/(=+)(?!=*$)/'A' x length($1)/ge;
# spent 2.86ms making 70 calls to Mail::SpamAssassin::Util::CORE:subst, avg 41µ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
69870154µ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
7057014.2ms7013.0ms return MIME::Base64::decode_base64($_);
# spent 13.0ms making 70 calls to MIME::Base64::decode_base64, avg 185µ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 603ms (413+190) within Mail::SpamAssassin::Util::qp_decode which was called 305 times, avg 1.98ms/call: # 202 times (408ms+188ms) by Mail::SpamAssassin::Message::Node::decode at line 339 of Mail/SpamAssassin/Message/Node.pm, avg 2.95ms/call # 103 times (5.16ms+2.14ms) by Mail::SpamAssassin::Message::Node::__decode_header at line 777 of Mail/SpamAssassin/Message/Node.pm, avg 71µs/call
sub qp_decode {
7303051.69ms local $_ = shift;
731
732 # RFC 2045: when decoding a Quoted-Printable body, any trailing
733 # white space on a line must be deleted
73430540.4ms30538.0ms s/[ \t]+(?=\r?\n)//gs;
# spent 38.0ms making 305 calls to Mail::SpamAssassin::Util::CORE:subst, avg 125µs/call
735
73630527.4ms30525.2ms s/=\r?\n//gs; # soft line breaks
# spent 25.2ms making 305 calls to Mail::SpamAssassin::Util::CORE:subst, avg 83µs/call
737
738 # RFC 2045 explicitly prohibits lowercase characters a-f in QP encoding
739 # do we really want to allow them???
74026203530ms26395127ms s/=([0-9a-fA-F]{2})/chr(hex($1))/ge;
# spent 125ms making 26090 calls to Mail::SpamAssassin::Util::CORE:substcont, avg 5µs/call # spent 1.80ms making 305 calls to Mail::SpamAssassin::Util::CORE:subst, avg 6µs/call
741
7423054.54ms return $_;
743}
744
745sub 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 1.88ms (126µs+1.76) within Mail::SpamAssassin::Util::portable_getpwuid which was called: # once (126µs+1.76ms) by Mail::SpamAssassin::new at line 441 of Mail/SpamAssassin.pm
sub portable_getpwuid {
76213µs if (defined &Mail::SpamAssassin::Util::_getpwuid_wrapper) {
763 return Mail::SpamAssassin::Util::_getpwuid_wrapper(@_);
764 }
765
76612µs my $sts;
76719µs14µs if (!RUNNING_ON_WINDOWS) {
# spent 4µs making 1 call to constant::__ANON__[constant.pm:192]
768177µs $sts = eval ' sub _getpwuid_wrapper { getpwuid($_[0]); }; 1 ';
# spent 1.76ms executing statements in string eval
# includes 27µ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 }
77312µ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 {
777121µs11.75ms return Mail::SpamAssassin::Util::_getpwuid_wrapper(@_);
# spent 1.75ms making 1 call to Mail::SpamAssassin::Util::_getpwuid_wrapper
778 }
779}
780
781sub _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#
802sub 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{
82512µ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 97µs (44+53) within Mail::SpamAssassin::Util::hostname which was called: # once (44µs+53µs) by Mail::SpamAssassin::Util::fq_hostname at line 845
sub hostname {
83012µ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.
83418µs18µs clean_path_in_taint_mode();
# spent 8µs making 1 call to Mail::SpamAssassin::Util::clean_path_in_taint_mode
835112µs141µs $hostname = Sys::Hostname::hostname();
# spent 41µs making 1 call to Sys::Hostname::hostname
836113µs14µs $hostname =~ s/[()]//gs; # bug 5929
# spent 4µs making 1 call to Mail::SpamAssassin::Util::CORE:subst
83719µ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 24.7ms (24.5+224µs) within Mail::SpamAssassin::Util::fq_hostname which was called 3217 times, avg 8µs/call: # 3217 times (24.5ms+224µs) by Mail::SpamAssassin::Locker::UnixNFSSafe::safe_lock at line 70 of Mail/SpamAssassin/Locker/UnixNFSSafe.pm, avg 8µs/call
sub fq_hostname {
843321749.7ms return $fq_hostname if defined($fq_hostname);
844
84518µs197µs $fq_hostname = hostname();
# spent 97µs making 1 call to Mail::SpamAssassin::Util::hostname
846113µs13µ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
8483189µs5121µ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 10µs/call # spent 6µs making 2 calls to Mail::SpamAssassin::Util::CORE:match, avg 3µs/call
849 );
85013µs $fq_hostname = $names[0] if (@names); # take the first FQDN, if any
851112µs13µs $fq_hostname =~ s/[()]//gs; # bug 5929
# spent 3µs making 1 call to Mail::SpamAssassin::Util::CORE:subst
852 }
853
854110µs return $fq_hostname;
855 }
856}
857
858###########################################################################
859
86013µssub 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
877sub 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 54.8ms (43.3+11.5) within Mail::SpamAssassin::Util::reverse_ip_address which was called 714 times, avg 77µs/call: # 714 times (43.3ms+11.5ms) by Mail::SpamAssassin::Message::Metadata::extract at line 97 of Mail/SpamAssassin/Message/Metadata.pm, avg 77µs/call
sub reverse_ip_address {
9027141.88ms my ($ip) = @_;
903
9047141.29ms my $revip;
9057146.38ms local($1,$2,$3,$4);
90671420.8ms7326.85ms if ($ip =~ /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})\z/) {
# spent 6.81ms making 726 calls to Mail::SpamAssassin::Util::CORE:match, avg 9µs/call # spent 38µs making 6 calls to UNIVERSAL::can, avg 6µs/call
9077086.77ms $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
914653µs677µs my $ip_obj = NetAddr::IP->new6($ip);
# spent 77µs making 6 calls to NetAddr::IP::Lite::new6, avg 13µs/call
915631µs if (defined $ip_obj) { # valid IPv6 address
916 # RFC 5782 section 2.4.
9176123µs12563µs $revip = lc $ip_obj->network->full6; # string in a canonical form
# spent 360µs making 6 calls to NetAddr::IP::Lite::network, avg 60µs/call # spent 202µs making 6 calls to NetAddr::IP::full6, avg 34µs/call
9186100µs640µs $revip =~ s/://g;
# spent 40µs making 6 calls to Mail::SpamAssassin::Util::CORE:subst, avg 7µs/call
9196112µs $revip = join('.', reverse split(//,$revip));
920 }
921 }
92271419.3ms return $revip;
923}
924
925###########################################################################
926
92711388µs22113µs
# spent 365µs (252+113) within Mail::SpamAssassin::Util::my_inet_aton which was called 11 times, avg 33µs/call: # 11 times (252µs+113µs) by Mail::SpamAssassin::Plugin::URIDNSBL::parse_and_canonicalize_subtest at line 530 of Mail/SpamAssassin/Plugin/URIDNSBL.pm, avg 33µs/call
sub my_inet_aton { unpack("N", pack("C4", split(/\./, $_[0]))) }
# spent 79µs making 11 calls to Mail::SpamAssassin::Util::CORE:pack, avg 7µs/call # spent 34µs making 11 calls to Mail::SpamAssassin::Util::CORE:unpack, avg 3µs/call
928
929###########################################################################
930
931
# spent 645ms (137+508) within Mail::SpamAssassin::Util::decode_dns_question_entry which was called 1968 times, avg 328µs/call: # 1968 times (137ms+508ms) by Mail::SpamAssassin::DnsResolver::_packet_id at line 640 of Mail/SpamAssassin/DnsResolver.pm, avg 328µs/call
sub decode_dns_question_entry {
932 # decodes a Net::DNS::Packet->question entry,
933 # returning a triple: class, type, label
934 #
93519683.91ms my $q = $_[0];
936196815.3ms1968294ms my $qname = $q->qname;
# spent 294ms making 1968 calls to Net::DNS::Question::qname, avg 149µ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
940196824.3ms19688.43ms utf8::encode($qname) if utf8::is_utf8($qname); # since Perl 5.8.1
# spent 8.43ms making 1968 calls to utf8::is_utf8, avg 4µs/call
941
94219686.29ms local $1;
943 # Net::DNS provides a query in encoded RFC 1035 zone file format, decode it!
944196844.2ms19687.89ms $qname =~ s{ \\ ( [0-9]{3} | [^0-9] ) }
# spent 7.89ms making 1968 calls to Mail::SpamAssassin::Util::CORE:subst, avg 4µs/call
945 { length($1)==1 ? $1 : $1 <= 255 ? chr($1) : "\\$1" }xgse;
946196856.6ms3936198ms return ($q->qclass, $q->qtype, $qname);
# spent 116ms making 1968 calls to Net::DNS::Question::qclass, avg 59µs/call # spent 82.2ms making 1968 calls to Net::DNS::Question::qtype, avg 42µs/call
947}
948
949###########################################################################
950
951
# spent 196ms (127+69.3) within Mail::SpamAssassin::Util::parse_content_type which was called 1047 times, avg 187µs/call: # 425 times (40.4ms+31.2ms) by Mail::SpamAssassin::Message::_parse_normal at line 1034 of Mail/SpamAssassin/Message.pm, avg 168µs/call # 388 times (65.0ms+25.3ms) by Mail::SpamAssassin::Message::_parse_multipart at line 922 of Mail/SpamAssassin/Message.pm, avg 233µs/call # 234 times (21.4ms+12.9ms) by Mail::SpamAssassin::Message::new at line 363 of Mail/SpamAssassin/Message.pm, avg 147µs/call
sub parse_content_type {
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 #
95810473.40ms 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 #
980104727.0ms104710.9ms my($boundary) = $ct =~ m!\bboundary\s*=\s*("[^"]+|[^\s";]+(?=[\s;]|$))!i;
# spent 10.9ms 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 #
98410472.72ms $boundary =~ tr/"//d if defined $boundary;
985
986 # Parse out the charset and name, if they exist.
987 #
988104721.7ms104713.7ms my($charset) = $ct =~ /\bcharset\s*=\s*["']?(.*?)["']?(?:;|$)/i;
# spent 13.7ms making 1047 calls to Mail::SpamAssassin::Util::CORE:match, avg 13µs/call
989104728.9ms104710.6ms my($name) = $ct =~ /\b(?:file)?name\s*=\s*["']?(.*?)["']?(?:;|$)/i;
# spent 10.6ms 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 #
999104718.8ms10473.08ms $ct =~ s/^\s+//; # strip leading whitespace
# spent 3.08ms making 1047 calls to Mail::SpamAssassin::Util::CORE:subst, avg 3µs/call
1000104716.2ms10479.36ms $ct =~ s/;.*$//s; # strip everything after first ';'
# spent 9.36ms making 1047 calls to Mail::SpamAssassin::Util::CORE:subst, avg 9µs/call
1001104717.9ms104710.9ms $ct =~ s@^([^/]+(?:/[^/\s]*)?).*$@$1@s; # only something/something ...
# spent 10.9ms making 1047 calls to Mail::SpamAssassin::Util::CORE:subst, avg 10µs/call
100210473.09ms $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.
1007104737.9ms186710.8ms if (!$ct ||
# spent 10.8ms making 1867 calls to Mail::SpamAssassin::Util::CORE:match, avg 6µs/call
1008 ($ct =~ /^text\b/ && $ct !~ /^text\/(?:x-vcard|calendar|html)$/))
1009 {
10104401.14ms $ct = "text/plain";
1011 }
1012
1013 # strip inappropriate chars (bug 5399: after the text/plain fixup)
101410475.39ms $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 #
1020104713.7ms return wantarray ? ($ct,$boundary,$charset,$name) : $ct;
1021}
1022
1023###########################################################################
1024
1025
# spent 162ms (121+40.8) within Mail::SpamAssassin::Util::url_encode which was called 248 times, avg 654µs/call: # 248 times (121ms+40.8ms) by Mail::SpamAssassin::Util::uri_list_canonicalize at line 1283, avg 654µs/call
sub url_encode {
1026248591µs my ($url) = @_;
10272483.51ms my (@characters) = split(/(\%[0-9a-fA-F]{2})/, $url);
1028248437µs my (@unencoded);
1029 my (@encoded);
1030
10312481.12ms foreach (@characters) {
1032 # escaped character set ...
1033264657.7ms264612.0ms if (/\%[0-9a-fA-F]{2}/) {
# spent 12.0ms making 2646 calls to Mail::SpamAssassin::Util::CORE:match, avg 5µ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
1038129022.6ms12904.71ms unless (/(20|7f|[0189a-fA-F][0-9a-fA-F])/i) {
# spent 4.71ms making 1290 calls to Mail::SpamAssassin::Util::CORE:match, avg 4µs/call
1039255653.5ms383421.1ms s/\%([2-7][0-9a-fA-F])/sprintf "%c", hex($1)/e;
# spent 15.6ms making 2556 calls to Mail::SpamAssassin::Util::CORE:substcont, avg 6µs/call # spent 5.43ms making 1278 calls to Mail::SpamAssassin::Util::CORE:subst, avg 4µs/call
104012783.72ms push(@unencoded, $_);
1041 }
1042 }
1043 # other stuff
1044 else {
1045 # no re "strict"; # since perl 5.21.8
1046 # 0x00-0x20, 0x7f-0xff, ", %, <, >
1047135615.1ms13563.06ms s/([\000-\040\177-\377\042\045\074\076])
# spent 3.06ms 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 }
1051248445µs if (wantarray) {
1052 return(join("", @characters), join("", @unencoded), join("", @encoded));
1053 }
1054 else {
105524811.2ms return join("", @characters);
1056 }
1057}
1058
1059###########################################################################
1060
1061=item $module = first_available_module (@module_list)
1062
1063Return the name of the first module that can be successfully loaded with
1064C<require> from the list. Returns C<undef> if none are available.
1065
1066This 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
1072Note that C<SDBM_File> is guaranteed to be present, since it comes
1073with Perl.
1074
1075=cut
1076
1077
# spent 368ms within Mail::SpamAssassin::Util::first_available_module which was called 3216 times, avg 114µs/call: # 3216 times (368ms+0s) by Mail::SpamAssassin::DBBasedAddrList::new_checker at line 58 of Mail/SpamAssassin/DBBasedAddrList.pm, avg 114µs/call
sub first_available_module {
1078321614.9ms my (@packages) = @_;
107932169.04ms foreach my $mod (@packages) {
10803216265ms if (eval 'require '.$mod.'; 1; ') {
# spent 43.3ms executing statements in 3216 string evals (merged)
1081321652.9ms return $mod;
1082 }
1083 }
1084 undef;
1085}
1086
1087###########################################################################
1088
1089=item my ($filepath, $filehandle) = secure_tmpfile();
1090
1091Generates a filename for a temporary file, opens it exclusively and
1092securely, and returns a filehandle to the open file (opened O_RDWR).
1093
1094If 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 11.4ms (2.52+8.86) within Mail::SpamAssassin::Util::secure_tmpfile which was called 16 times, avg 712µs/call: # 16 times (2.52ms+8.86ms) by Mail::SpamAssassin::Message::_parse_normal at line 1059 of Mail/SpamAssassin/Message.pm, avg 712µs/call
sub secure_tmpfile {
110016377µs322.87ms my $tmpdir = untaint_file_path($ENV{'TMPDIR'} || File::Spec->tmpdir());
# spent 1.78ms making 16 calls to Mail::SpamAssassin::Util::untaint_file_path, avg 111µs/call # spent 1.09ms making 16 calls to File::Spec::Unix::tmpdir, avg 68µs/call
1101
11021649µs defined $tmpdir && $tmpdir ne ''
1103 or die "util: cannot find a temporary directory, set TMP or TMPDIR in environment";
1104
1105161.92ms161.61ms opendir(my $dh, $tmpdir) or die "Could not open directory $tmpdir: $!";
# spent 1.61ms making 16 calls to Mail::SpamAssassin::Util::CORE:open_dir, avg 101µs/call
110616358µs16211µs closedir $dh or die "Error closing directory $tmpdir: $!";
# spent 211µs making 16 calls to Mail::SpamAssassin::Util::CORE:closedir, avg 13µs/call
1107
11081642µs my ($reportfile, $tmpfh);
11091682µ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
111216246µs my $suffix = join('', (0..9,'A'..'Z','a'..'z')[rand 62, rand 62, rand 62,
1113 rand 62, rand 62, rand 62]);
1114161.10ms641.14ms $reportfile = File::Spec->catfile($tmpdir,".spamassassin${$}${suffix}tmp");
# spent 768µs making 16 calls to File::Spec::Unix::catfile, avg 48µs/call # spent 242µs making 16 calls to File::Spec::Unix::catdir, avg 15µs/call # spent 130µ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
1118163.40ms163.19ms if (sysopen($tmpfh, $reportfile, O_RDWR|O_CREAT|O_EXCL, 0600)) {
# spent 3.19ms making 16 calls to Mail::SpamAssassin::Util::CORE:sysopen, avg 199µs/call
111916215µs1681µs binmode $tmpfh or die "cannot set $reportfile to binmode: $!";
# spent 81µs making 16 calls to Mail::SpamAssassin::Util::CORE:binmode, avg 5µs/call
11201662µ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
11401632µs if (!$tmpfh) {
1141 warn "util: secure_tmpfile failed to create a temporary file, giving up";
1142 return;
1143 }
1144
114516124µs16131µs dbg("util: secure_tmpfile created a temporary file %s", $reportfile);
# spent 131µs making 16 calls to Mail::SpamAssassin::Logger::dbg, avg 8µs/call
114616216µs return ($reportfile, $tmpfh);
1147}
1148
1149=item my ($dirpath) = secure_tmpdir();
1150
1151Generates a directory for temporary files. Creates it securely and
1152returns the path to the directory.
1153
1154If it cannot create a directory after 20 tries, it returns C<undef>.
1155
1156=cut
1157
1158# stolen from secure_tmpfile()
1159sub 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##
1210sub 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
124716µs*uri_list_canonify = \&uri_list_canonicalize; # compatibility alias
1248
# spent 6.05s (3.77+2.29) within Mail::SpamAssassin::Util::uri_list_canonicalize which was called 7028 times, avg 861µs/call: # 4211 times (2.24s+1.51s) by Mail::SpamAssassin::PerMsgStatus::get_uri_detail_list at line 2272 of Mail/SpamAssassin/PerMsgStatus.pm, avg 890µs/call # 1916 times (1.16s+580ms) by Mail::SpamAssassin::PerMsgStatus::_get_parsed_uri_list at line 2420 of Mail/SpamAssassin/PerMsgStatus.pm, avg 906µs/call # 901 times (374ms+197ms) by Mail::SpamAssassin::PerMsgStatus::get_uri_detail_list at line 2309 of Mail/SpamAssassin/PerMsgStatus.pm, avg 633µs/call
sub uri_list_canonicalize {
1249702850.8ms my($redirector_patterns, @uris) = @_;
1250
1251 # make sure we catch bad encoding tricks
1252702811.6ms my @nuris;
1253702826.1ms for my $uri (@uris) {
1254 # we're interested in http:// and so on, skip mailto: and
1255 # email addresses with no protocol
12567062163ms1390465.1ms next if $uri =~ /^mailto:/i || $uri =~ /^[^:]*\@/;
# spent 65.1ms making 13904 calls to Mail::SpamAssassin::Util::CORE:match, avg 5µs/call
1257
1258 # sometimes we catch URLs on multiple lines
1259664663.5ms664614.0ms $uri =~ s/\n//g;
# spent 14.0ms making 6646 calls to Mail::SpamAssassin::Util::CORE:subst, avg 2µs/call
1260
1261 # URLs won't have leading/trailing whitespace
12626646129ms664637.1ms $uri =~ s/^\s+//;
# spent 37.1ms making 6646 calls to Mail::SpamAssassin::Util::CORE:subst, avg 6µs/call
1263664662.7ms664616.4ms $uri =~ s/\s+$//;
# spent 16.4ms 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
1266664665.5ms664613.4ms $uri =~ s/\r//g;
# spent 13.4ms 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
1269664612.5ms 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.
1274664632.4ms $nuri =~ tr{\\}{/};
1275
1276 # http:www.foo.biz -> http://www.foo.biz
12776646300ms19774102ms $nuri =~ s{^(https?:)/{0,2}}{$1//}i;
# spent 59.0ms making 6646 calls to Mail::SpamAssassin::Util::CORE:subst, avg 9µs/call # spent 43.2ms 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)
1282664655.4ms664615.7ms if ($nuri =~ /%[0-9a-fA-F]{2}/) {
# spent 15.7ms making 6646 calls to Mail::SpamAssassin::Util::CORE:match, avg 2µs/call
12832482.01ms248162ms $nuri = Mail::SpamAssassin::Util::url_encode($nuri);
# spent 162ms making 248 calls to Mail::SpamAssassin::Util::url_encode, avg 654µs/call
1284 }
1285
1286 # www.foo.biz -> http://www.foo.biz
1287 # unschemed URIs: assume default of "http://" as most MUAs do
1288664678.2ms664626.8ms if ($nuri !~ /^[-_a-z0-9]+:/i) {
# spent 26.8ms making 6646 calls to Mail::SpamAssassin::Util::CORE:match, avg 4µs/call
128964773µs64148µs if ($nuri =~ /^ftp\./) {
# spent 148µs making 64 calls to Mail::SpamAssassin::Util::CORE:match, avg 2µs/call
1290 $nuri =~ s{^}{ftp://}g;
1291 }
1292 else {
129364990µs64463µs $nuri =~ s{^}{http://}g;
# spent 463µ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
1298664689.5ms666634.2ms $nuri =~ s{^(https?://[^/?]+)\?}{$1/?}i;
# spent 34.2ms making 6646 calls to Mail::SpamAssassin::Util::CORE:subst, avg 5µs/call # spent 58µ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)
1302664689.5ms664614.7ms $nuri =~ s/\&\#0*(3[3-9]|[4-9]\d|1[01]\d|12[0-6]);/sprintf "%c",$1/ge;
# spent 14.7ms making 6646 calls to Mail::SpamAssassin::Util::CORE:subst, avg 2µs/call
1303664653.0ms664614.6ms $nuri =~ s/\&\#x0*(2[1-9]|[3-6][a-fA-F0-9]|7[0-9a-eA-E]);/sprintf "%c",hex($1)/ge;
# spent 14.6ms 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
1306664614.0ms if ($nuri ne $uri) {
13073041.12ms push(@nuris, $nuri);
1308 }
1309
1310 # deal with wierd hostname parts, remove user/pass, etc.
13116646230ms6646148ms if ($nuri =~ m{^(https?://)([^/]+?)((?::\d*)?\/.*)?$}i) {
# spent 148ms making 6646 calls to Mail::SpamAssassin::Util::CORE:match, avg 22µs/call
1312661625.9ms my($proto, $host, $rest) = ($1,$2,$3);
1313
1314 # not required
1315661611.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).
13286616129ms661665.0ms if ($host =~ s{(?: \xE3\x80\x82 | \xEF\xBC\x8E | \xEF\xBD\xA1 |
# spent 65.0ms making 6616 calls to Mail::SpamAssassin::Util::CORE:subst, avg 10µ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...
1336661616.7ms if ($host =~ tr/\000-\040\200-\377//d) {
1337420µ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>
1344661688.8ms661614.9ms if ($rest =~ m{(https?:/{0,2}.+)$}i) {
# spent 14.9ms making 6616 calls to Mail::SpamAssassin::Util::CORE:match, avg 2µs/call
134534192µ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 {
13511316448.1ms foreach (@{$redirector_patterns}) {
1352987303.51s1974601.44s if ("$proto$host$rest" =~ $_) {
# spent 769ms making 98730 calls to Mail::SpamAssassin::Util::CORE:match, avg 8µs/call # spent 674ms making 98730 calls to Mail::SpamAssassin::Util::CORE:regcomp, avg 7µ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
1369661673.9ms661614.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.
1377661678.4ms661633.7ms if ($host =~ s/[^0-9A-Za-z]+$//) {
# spent 33.7ms making 6616 calls to Mail::SpamAssassin::Util::CORE:subst, avg 5µ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
13886616208ms1984849.6ms if ($host =~ /^
# spent 49.6ms 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
142014398111ms my %uris = map { $_ => 1 } @uris, @nuris;
1421
1422702874.7ms return keys %uris;
1423}
1424
1425sub decode_ulong_to_ip {
1426 return join(".", unpack("CCCC",pack("H*", sprintf "%08lx", $_[0])));
1427}
1428
1429###########################################################################
1430
1431
# spent 315ms (20.8+294) within Mail::SpamAssassin::Util::first_date which was called 702 times, avg 449µs/call: # 702 times (20.8ms+294ms) by Mail::SpamAssassin::Util::receive_date at line 1466, avg 449µs/call
sub first_date {
14327022.68ms my (@strings) = @_;
1433
14347021.88ms foreach my $string (@strings) {
14357027.22ms702294ms my $time = parse_rfc822_date($string);
# spent 294ms making 702 calls to Mail::SpamAssassin::Util::parse_rfc822_date, avg 420µs/call
14367027.93ms return $time if defined($time) && $time;
1437 }
1438 return;
1439}
1440
1441
# spent 462ms (91.0+372) within Mail::SpamAssassin::Util::receive_date which was called 702 times, avg 659µs/call: # 702 times (91.0ms+372ms) by Mail::SpamAssassin::Message::receive_date at line 699 of Mail/SpamAssassin/Message.pm, avg 659µs/call
sub receive_date {
14427022.30ms my ($header) = @_;
1443
14447021.67ms $header ||= '';
144570232.4ms70214.4ms $header =~ s/\n[ \t]+/ /gs; # fix continuation lines
# spent 14.4ms making 702 calls to Mail::SpamAssassin::Util::CORE:subst, avg 21µs/call
1446
144770247.9ms70225.0ms my @rcvd = ($header =~ /^Received:(.*)/img);
# spent 25.0ms making 702 calls to Mail::SpamAssassin::Util::CORE:match, avg 36µs/call
14487021.54ms my @local;
1449 my $time;
1450
14517023.11ms if (@rcvd) {
145270231.2ms140414.0ms if ($rcvd[0] =~ /qmail \d+ invoked by uid \d+/ ||
# spent 14.0ms making 1404 calls to Mail::SpamAssassin::Util::CORE:match, avg 10µs/call
1453 $rcvd[0] =~ /\bfrom (?:localhost\s|(?:\S+ ){1,2}\S*\b127\.0\.0\.1\b)/)
1454 {
1455 push @local, (shift @rcvd);
1456 }
14577028.27ms7022.71ms if (@rcvd && ($rcvd[0] =~ m/\bby localhost with \w+ \(fetchmail-[\d.]+/)) {
# spent 2.71ms making 702 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
14657021.52ms if (@rcvd) {
14667027.18ms702315ms $time = first_date(shift @rcvd);
# spent 315ms making 702 calls to Mail::SpamAssassin::Util::first_date, avg 449µs/call
146770220.9ms 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
1497sub 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
1519sub 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
1527sub 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
1537sub 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
1550sub 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
1661sub 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.47ms (3.66+1.81) within Mail::SpamAssassin::Util::regexp_remove_delimiters which was called 46 times, avg 119µs/call: # 46 times (3.66ms+1.81ms) by Mail::SpamAssassin::Util::make_qr at line 1717, avg 119µs/call
sub regexp_remove_delimiters {
168146116µs my ($re) = @_;
1682
16834681µs my $delim;
1684461.81ms184550µs if (!defined $re || $re eq '') {
# spent 550µ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#
16981444µs $delim = $1;
1699 } else { # /foo\/bar/ or !foo/bar!
170064567µs32199µs $re =~ s/^(\W)//; $delim = $1;
# spent 199µs making 32 calls to Mail::SpamAssassin::Util::CORE:subst, avg 6µs/call
1701 }
1702
1703461.96ms921.06ms $re =~ s/\Q${delim}\E([imsx]*)$// or warn "unbalanced re: $re";
# spent 662µs making 46 calls to Mail::SpamAssassin::Util::CORE:regcomp, avg 14µs/call # spent 400µs making 46 calls to Mail::SpamAssassin::Util::CORE:subst, avg 9µs/call
1704
170546150µs my $mods = $1;
170646157µs if ($mods) {
170733178µs $re = "(?".$mods.")".$re;
1708 }
1709
171046637µs return $re;
1711}
1712
1713# turn "/foobar/i" into qr/(?i)foobar/
1714
1715
# spent 8.86ms (1.83+7.03) within Mail::SpamAssassin::Util::make_qr which was called 46 times, avg 193µs/call: # 46 times (1.83ms+7.03ms) 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 193µs/call
sub make_qr {
171646152µs my ($re) = @_;
171746371µs465.47ms $re = regexp_remove_delimiters($re);
# spent 5.47ms making 46 calls to Mail::SpamAssassin::Util::regexp_remove_delimiters, avg 119µs/call
1718462.69ms921.56ms return qr/$re/;
# spent 1.21ms making 46 calls to Mail::SpamAssassin::Util::CORE:regcomp, avg 26µs/call # spent 356µs making 46 calls to Mail::SpamAssassin::Util::CORE:qr, avg 8µs/call
1719}
1720
1721###########################################################################
1722
1723sub 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 187ms (17.2+170) within Mail::SpamAssassin::Util::avoid_db_file_locking_bug which was called 163 times, avg 1.15ms/call: # 161 times (17.0ms+168ms) by Mail::SpamAssassin::DBBasedAddrList::new_checker at line 85 of Mail/SpamAssassin/DBBasedAddrList.pm, avg 1.15ms/call # 2 times (214µs+1.63ms) by Mail::SpamAssassin::BayesStore::DBM::tie_db_writable at line 295 of Mail/SpamAssassin/BayesStore/DBM.pm, avg 924µs/call
sub avoid_db_file_locking_bug {
1744163546µs my ($path) = @_;
1745
174616327.9ms1141138ms my $db_tmpfile = untaint_file_path(File::Spec->catfile(dirname($path),
# spent 53.9ms making 163 calls to File::Basename::dirname, avg 331µs/call # spent 36.4ms making 163 calls to File::Basename::basename, avg 224µs/call # spent 22.0ms making 163 calls to Mail::SpamAssassin::Util::untaint_file_path, avg 135µs/call # spent 21.6ms making 163 calls to File::Spec::Unix::catfile, avg 132µs/call # spent 2.61ms making 163 calls to File::Spec::Unix::catdir, avg 16µs/call # spent 1.31ms making 326 calls to File::Spec::Unix::canonpath, avg 4µs/call
1747 '__db.'.basename($path)));
1748
1749 # delete "__db.[DBNAME]" and "__db.[DBNAME].*"
175016521.0ms16418.0ms
# spent 1.96ms (1.35+613µs) within Mail::SpamAssassin::Util::BEGIN@1750 which was called: # once (1.35ms+613µs) by Mail::SpamAssassin::Conf::BEGIN@85 at line 1750
foreach my $tfile ($db_tmpfile, glob("$db_tmpfile.*")) {
# spent 16.0ms making 163 calls to Mail::SpamAssassin::Util::CORE:glob, avg 98µs/call # spent 1.96ms making 1 call to Mail::SpamAssassin::Util::BEGIN@1750
17511631.32ms16318.5ms my $file = untaint_file_path($tfile);
# spent 18.5ms making 163 calls to Mail::SpamAssassin::Util::untaint_file_path, avg 114µs/call
17521635.31ms1631.60ms my $stat_errn = stat($file) ? 0 : 0+$!;
# spent 1.60ms making 163 calls to Mail::SpamAssassin::Util::CORE:stat, avg 10µs/call
1753163589µ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
1762sub 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
1783sub 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
1806138µs1;
1807
1808=back
1809
1810=cut
 
# spent 81µs within Mail::SpamAssassin::Util::CORE:binmode which was called 16 times, avg 5µs/call: # 16 times (81µs+0s) by Mail::SpamAssassin::Util::secure_tmpfile at line 1119, avg 5µs/call
sub Mail::SpamAssassin::Util::CORE:binmode; # opcode
# spent 211µs within Mail::SpamAssassin::Util::CORE:closedir which was called 16 times, avg 13µs/call: # 16 times (211µs+0s) by Mail::SpamAssassin::Util::secure_tmpfile at line 1106, avg 13µs/call
sub Mail::SpamAssassin::Util::CORE:closedir; # opcode
# 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
sub Mail::SpamAssassin::Util::CORE:ftdir; # opcode
# 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
sub Mail::SpamAssassin::Util::CORE:ghbyname; # opcode
# spent 16.0ms within Mail::SpamAssassin::Util::CORE:glob which was called 163 times, avg 98µs/call: # 163 times (16.0ms+0s) by Mail::SpamAssassin::Util::avoid_db_file_locking_bug at line 1750, avg 98µs/call
sub Mail::SpamAssassin::Util::CORE:glob; # opcode
# spent 1.73ms within Mail::SpamAssassin::Util::CORE:gpwuid which was called: # once (1.73ms+0s) by Mail::SpamAssassin::Util::_getpwuid_wrapper at line 1 of (eval 32)[Mail/SpamAssassin/Util.pm:768]
sub Mail::SpamAssassin::Util::CORE:gpwuid; # opcode
# spent 1.44s within Mail::SpamAssassin::Util::CORE:match which was called 214010 times, avg 7µs/call: # 98730 times (769ms+0s) by Mail::SpamAssassin::Util::uri_list_canonicalize at line 1352, avg 8µs/call # 38022 times (198ms+0s) by Mail::SpamAssassin::Util::untaint_var at line 291, avg 5µs/call # 19848 times (49.6ms+0s) by Mail::SpamAssassin::Util::uri_list_canonicalize at line 1388, avg 2µs/call # 13904 times (65.1ms+0s) by Mail::SpamAssassin::Util::uri_list_canonicalize at line 1256, avg 5µs/call # 6646 times (148ms+0s) by Mail::SpamAssassin::Util::uri_list_canonicalize at line 1311, avg 22µs/call # 6646 times (26.8ms+0s) by Mail::SpamAssassin::Util::uri_list_canonicalize at line 1288, avg 4µs/call # 6646 times (15.7ms+0s) by Mail::SpamAssassin::Util::uri_list_canonicalize at line 1282, avg 2µs/call # 6616 times (14.9ms+0s) by Mail::SpamAssassin::Util::uri_list_canonicalize at line 1344, avg 2µs/call # 3626 times (28.5ms+0s) by Mail::SpamAssassin::Util::untaint_file_path at line 245, avg 8µs/call # 2646 times (12.0ms+0s) by Mail::SpamAssassin::Util::url_encode at line 1033, avg 5µs/call # 1867 times (10.8ms+0s) by Mail::SpamAssassin::Util::parse_content_type at line 1007, avg 6µs/call # 1404 times (14.0ms+0s) by Mail::SpamAssassin::Util::receive_date at line 1452, avg 10µs/call # 1290 times (4.71ms+0s) by Mail::SpamAssassin::Util::url_encode at line 1038, avg 4µs/call # 1047 times (13.7ms+0s) by Mail::SpamAssassin::Util::parse_content_type at line 988, avg 13µs/call # 1047 times (10.9ms+0s) by Mail::SpamAssassin::Util::parse_content_type at line 980, avg 10µs/call # 1047 times (10.6ms+0s) by Mail::SpamAssassin::Util::parse_content_type at line 989, avg 10µs/call # 726 times (6.81ms+0s) by Mail::SpamAssassin::Util::reverse_ip_address at line 906, avg 9µs/call # 702 times (25.0ms+0s) by Mail::SpamAssassin::Util::receive_date at line 1447, avg 36µs/call # 702 times (4.12ms+0s) by Mail::SpamAssassin::Util::parse_rfc822_date at line 574, avg 6µs/call # 702 times (2.71ms+0s) by Mail::SpamAssassin::Util::receive_date at line 1457, avg 4µs/call # 70 times (8.12ms+0s) by Mail::SpamAssassin::Util::base64_decode at line 690, avg 116µs/call # 64 times (148µs+0s) by Mail::SpamAssassin::Util::uri_list_canonicalize at line 1289, avg 2µs/call # 8 times (42µs+0s) by Mail::SpamAssassin::Util::clean_path_in_taint_mode at line 155, avg 5µs/call # 2 times (6µs+0s) by Mail::SpamAssassin::Util::fq_hostname at line 848, avg 3µs/call # once (9µs+0s) by Mail::SpamAssassin::Util::BEGIN@85 at line 85 # once (3µs+0s) by Mail::SpamAssassin::Util::fq_hostname at line 846
sub Mail::SpamAssassin::Util::CORE:match; # opcode
# spent 1.61ms within Mail::SpamAssassin::Util::CORE:open_dir which was called 16 times, avg 101µs/call: # 16 times (1.61ms+0s) by Mail::SpamAssassin::Util::secure_tmpfile at line 1105, avg 101µs/call
sub Mail::SpamAssassin::Util::CORE:open_dir; # opcode
# spent 79µs within Mail::SpamAssassin::Util::CORE:pack which was called 11 times, avg 7µs/call: # 11 times (79µs+0s) by Mail::SpamAssassin::Util::my_inet_aton at line 927, avg 7µs/call
sub Mail::SpamAssassin::Util::CORE:pack; # opcode
# spent 28.6ms within Mail::SpamAssassin::Util::CORE:qr which was called 3672 times, avg 8µs/call: # 3626 times (28.3ms+0s) by Mail::SpamAssassin::Util::untaint_file_path at line 243, avg 8µs/call # 46 times (356µs+0s) by Mail::SpamAssassin::Util::make_qr at line 1718, avg 8µs/call
sub Mail::SpamAssassin::Util::CORE:qr; # opcode
# spent 712ms within Mail::SpamAssassin::Util::CORE:regcomp which was called 106076 times, avg 7µs/call: # 98730 times (674ms+0s) by Mail::SpamAssassin::Util::uri_list_canonicalize at line 1352, avg 7µs/call # 3626 times (28.1ms+0s) by Mail::SpamAssassin::Util::untaint_file_path at line 245, avg 8µs/call # 3626 times (8.51ms+0s) by Mail::SpamAssassin::Util::untaint_file_path at line 243, avg 2µs/call # 46 times (1.21ms+0s) by Mail::SpamAssassin::Util::make_qr at line 1718, avg 26µs/call # 46 times (662µs+0s) by Mail::SpamAssassin::Util::regexp_remove_delimiters at line 1703, avg 14µs/call # 2 times (19µs+0s) by Mail::SpamAssassin::Util::fq_hostname at line 848, avg 10µs/call
sub Mail::SpamAssassin::Util::CORE:regcomp; # opcode
# spent 1.78ms within Mail::SpamAssassin::Util::CORE:stat which was called 171 times, avg 10µs/call: # 163 times (1.60ms+0s) by Mail::SpamAssassin::Util::avoid_db_file_locking_bug at line 1752, avg 10µs/call # 8 times (174µs+0s) by Mail::SpamAssassin::Util::clean_path_in_taint_mode at line 159, avg 22µs/call
sub Mail::SpamAssassin::Util::CORE:stat; # opcode
# spent 534ms within Mail::SpamAssassin::Util::CORE:subst which was called 86360 times, avg 6µs/call: # 6646 times (59.0ms+0s) by Mail::SpamAssassin::Util::uri_list_canonicalize at line 1277, avg 9µs/call # 6646 times (37.1ms+0s) by Mail::SpamAssassin::Util::uri_list_canonicalize at line 1262, avg 6µs/call # 6646 times (34.2ms+0s) by Mail::SpamAssassin::Util::uri_list_canonicalize at line 1298, avg 5µs/call # 6646 times (16.4ms+0s) by Mail::SpamAssassin::Util::uri_list_canonicalize at line 1263, avg 2µs/call # 6646 times (14.7ms+0s) by Mail::SpamAssassin::Util::uri_list_canonicalize at line 1302, avg 2µs/call # 6646 times (14.6ms+0s) by Mail::SpamAssassin::Util::uri_list_canonicalize at line 1303, avg 2µs/call # 6646 times (14.0ms+0s) by Mail::SpamAssassin::Util::uri_list_canonicalize at line 1259, avg 2µs/call # 6646 times (13.4ms+0s) by Mail::SpamAssassin::Util::uri_list_canonicalize at line 1266, avg 2µs/call # 6616 times (65.0ms+0s) by Mail::SpamAssassin::Util::uri_list_canonicalize at line 1328, avg 10µs/call # 6616 times (33.7ms+0s) by Mail::SpamAssassin::Util::uri_list_canonicalize at line 1377, avg 5µs/call # 6616 times (14.3ms+0s) by Mail::SpamAssassin::Util::uri_list_canonicalize at line 1369, avg 2µs/call # 1968 times (7.89ms+0s) by Mail::SpamAssassin::Util::decode_dns_question_entry at line 944, avg 4µs/call # 1404 times (31.2ms+0s) by Mail::SpamAssassin::Util::parse_rfc822_date at line 472, avg 22µs/call # 1356 times (3.06ms+0s) by Mail::SpamAssassin::Util::url_encode at line 1047, avg 2µs/call # 1278 times (5.43ms+0s) by Mail::SpamAssassin::Util::url_encode at line 1039, avg 4µs/call # 1047 times (10.9ms+0s) by Mail::SpamAssassin::Util::parse_content_type at line 1001, avg 10µs/call # 1047 times (9.36ms+0s) by Mail::SpamAssassin::Util::parse_content_type at line 1000, avg 9µs/call # 1047 times (3.08ms+0s) by Mail::SpamAssassin::Util::parse_content_type at line 999, avg 3µs/call # 702 times (14.4ms+0s) by Mail::SpamAssassin::Util::receive_date at line 1445, avg 21µs/call # 702 times (12.2ms+0s) by Mail::SpamAssassin::Util::parse_rfc822_date at line 475, avg 17µs/call # 702 times (7.52ms+0s) by Mail::SpamAssassin::Util::parse_rfc822_date at line 503, avg 11µs/call # 702 times (6.84ms+0s) by Mail::SpamAssassin::Util::parse_rfc822_date at line 498, avg 10µs/call # 305 times (38.0ms+0s) by Mail::SpamAssassin::Util::qp_decode at line 734, avg 125µs/call # 305 times (25.2ms+0s) by Mail::SpamAssassin::Util::qp_decode at line 736, avg 83µs/call # 305 times (1.80ms+0s) by Mail::SpamAssassin::Util::qp_decode at line 740, avg 6µs/call # 184 times (550µs+0s) by Mail::SpamAssassin::Util::regexp_remove_delimiters at line 1684, avg 3µs/call # 70 times (36.2ms+0s) by Mail::SpamAssassin::Util::base64_decode at line 689, avg 517µs/call # 70 times (2.86ms+0s) by Mail::SpamAssassin::Util::base64_decode at line 694, avg 41µs/call # 64 times (463µs+0s) by Mail::SpamAssassin::Util::uri_list_canonicalize at line 1293, avg 7µs/call # 46 times (400µs+0s) by Mail::SpamAssassin::Util::regexp_remove_delimiters at line 1703, avg 9µs/call # 32 times (199µs+0s) by Mail::SpamAssassin::Util::regexp_remove_delimiters at line 1700, avg 6µs/call # 6 times (40µ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
sub Mail::SpamAssassin::Util::CORE:subst; # opcode
# spent 184ms within Mail::SpamAssassin::Util::CORE:substcont which was called 41794 times, avg 4µs/call: # 26090 times (125ms+0s) by Mail::SpamAssassin::Util::qp_decode at line 740, avg 5µs/call # 13128 times (43.2ms+0s) by Mail::SpamAssassin::Util::uri_list_canonicalize at line 1277, avg 3µs/call # 2556 times (15.6ms+0s) by Mail::SpamAssassin::Util::url_encode at line 1039, avg 6µs/call # 20 times (58µs+0s) by Mail::SpamAssassin::Util::uri_list_canonicalize at line 1298, avg 3µs/call
sub Mail::SpamAssassin::Util::CORE:substcont; # opcode
# spent 3.19ms within Mail::SpamAssassin::Util::CORE:sysopen which was called 16 times, avg 199µs/call: # 16 times (3.19ms+0s) by Mail::SpamAssassin::Util::secure_tmpfile at line 1118, avg 199µs/call
sub Mail::SpamAssassin::Util::CORE:sysopen; # opcode
# spent 34µs within Mail::SpamAssassin::Util::CORE:unpack which was called 11 times, avg 3µs/call: # 11 times (34µs+0s) by Mail::SpamAssassin::Util::my_inet_aton at line 927, avg 3µs/call
sub Mail::SpamAssassin::Util::CORE:unpack; # opcode
Report produced by the NYTProf 6.04 Perl profiler, developed by Tim Bunce based on work by Adam Kaplan and Salvador Fandiño García.