Profile of Mail/SpamAssassin/Plugin/MIMEHeader.pm

Filename	/usr/local/lib/perl5/site_perl/Mail/SpamAssassin/Plugin/MIMEHeader.pm
Statements	Executed 953 statements in 15.4ms

Subroutines
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
46	1	1	21.0ms	45.4ms	Mail::SpamAssassin::Plugin::MIMEHeader::__ANON__[:160]
46	1	1	283µs	283µs	Mail::SpamAssassin::Plugin::MIMEHeader::CORE:match (opcode)
46	1	1	191µs	191µs	Mail::SpamAssassin::Plugin::MIMEHeader::CORE:subst (opcode)
1	1	1	65µs	73µs	Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@60
1	1	1	58µs	179µs	Mail::SpamAssassin::Plugin::MIMEHeader::set_config
1	1	1	51µs	275µs	Mail::SpamAssassin::Plugin::MIMEHeader::new
1	1	1	32µs	89µs	Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@63
1	1	1	30µs	44µs	Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@62
1	1	1	29µs	174µs	Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@70
1	1	1	25µs	156µs	Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@68
1	1	1	25µs	223µs	Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@67
1	1	1	25µs	60µs	Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@61
1	1	1	23µs	23µs	Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@66
1	1	1	18µs	18µs	Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@65
0	0	0	0s	0s	Mail::SpamAssassin::Plugin::MIMEHeader::eval_hook_called
0	0	0	0s	0s	Mail::SpamAssassin::Plugin::MIMEHeader::finish_tests

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
20					MIMEHeader - perform regexp tests against MIME headers
21
22					=head1 SYNOPSIS
23
24					loadplugin Mail::SpamAssassin::Plugin::MIMEHeader
25					mimeheader NAME_OF_RULE Content-Id =~ /foo/
26
27					=head1 DESCRIPTION
28
29					This plugin allows regexp rules to be written against MIME headers in the
30					message.
31
32					=head1 RULE DEFINITIONS AND PRIVILEGED SETTINGS
33
34					=over 4
35
36					=item mimeheader NAME_OF_RULE Header-Name =~ /pattern/modifiers
37
38					Specify a rule. C<NAME_OF_RULE> is the name of the rule to be used,
39					C<Header-Name> is the name of the MIME header to check, and
40					C</pattern/modifiers> is the Perl regular expression to match against this.
41
42					Note that in a message of multiple parts, each header will be checked
43					against the pattern separately. In other words, if multiple parts
44					have a 'Content-Type' header, each header's value will be tested
45					individually as a separate string.
46
47					Header names are considered case-insensitive.
48
49					The header values are normally cleaned up a little; for example, whitespace
50					around the newline character in "folded" headers will be replaced with a single
51					space. Append C<:raw> to the header name to retrieve the raw, undecoded value,
52					including pristine whitespace, instead.
53
54					=back
55
56					=cut
57
58					package Mail::SpamAssassin::Plugin::MIMEHeader;
59
60	2	73µs	2	80µs	# spent 73µs (65+8) within Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@60 which was called: # once (65µs+8µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 60 use strict; # spent 73µs making 1 call to Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@60 # spent 8µs making 1 call to strict::import
61	2	74µs	2	95µs	# spent 60µs (25+35) within Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@61 which was called: # once (25µs+35µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 61 use warnings; # spent 60µs making 1 call to Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@61 # spent 35µs making 1 call to warnings::import
62	2	82µs	2	58µs	# spent 44µs (30+14) within Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@62 which was called: # once (30µs+14µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 62 use bytes; # spent 44µs making 1 call to Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@62 # spent 14µs making 1 call to bytes::import
63	2	76µs	2	146µs	# spent 89µs (32+57) within Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@63 which was called: # once (32µs+57µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 63 use re 'taint'; # spent 89µs making 1 call to Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@63 # spent 58µs making 1 call to re::import
64
65	2	92µs	1	18µs	# spent 18µs within Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@65 which was called: # once (18µs+0s) by Mail::SpamAssassin::PluginHandler::load_plugin at line 65 use Mail::SpamAssassin::Plugin; # spent 18µs making 1 call to Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@65
66	2	70µs	1	23µs	# spent 23µs within Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@66 which was called: # once (23µs+0s) by Mail::SpamAssassin::PluginHandler::load_plugin at line 66 use Mail::SpamAssassin::Conf; # spent 23µs making 1 call to Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@66
67	2	76µs	2	420µs	# spent 223µs (25+198) within Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@67 which was called: # once (25µs+198µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 67 use Mail::SpamAssassin::Logger; # spent 223µs making 1 call to Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@67 # spent 198µs making 1 call to Exporter::import
68	2	91µs	2	286µs	# spent 156µs (25+130) within Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@68 which was called: # once (25µs+130µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 68 use Mail::SpamAssassin::Util qw(untaint_var); # spent 156µs making 1 call to Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@68 # spent 130µs making 1 call to Exporter::import
69
70	2	1.45ms	2	318µs	# spent 174µs (29+145) within Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@70 which was called: # once (29µs+145µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 70 use vars qw(@ISA @TEMPORARY_METHODS); # spent 174µs making 1 call to Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@70 # spent 145µs making 1 call to vars::import
71	1	18µs			@ISA = qw(Mail::SpamAssassin::Plugin);
72
73	1	2µs			@TEMPORARY_METHODS = ();
74
75					# ---------------------------------------------------------------------------
76
77					# constructor
78					# spent 275µs (51+224) within Mail::SpamAssassin::Plugin::MIMEHeader::new which was called: # once (51µs+224µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 1 of (eval 77)[Mail/SpamAssassin/PluginHandler.pm:129] sub new {
79	1	2µs			my $class = shift;
80	1	2µs			my $samain = shift;
81
82					# some boilerplate...
83	1	2µs			$class = ref($class) \|\| $class;
84	1	13µs	1	45µs	my $self = $class->SUPER::new($samain); # spent 45µs making 1 call to Mail::SpamAssassin::Plugin::new
85	1	2µs			bless ($self, $class);
86
87	1	15µs	1	179µs	$self->set_config($samain->{conf}); # spent 179µs making 1 call to Mail::SpamAssassin::Plugin::MIMEHeader::set_config
88
89	1	17µs			return $self;
90					}
91
92					# ---------------------------------------------------------------------------
93
94					# spent 179µs (58+121) within Mail::SpamAssassin::Plugin::MIMEHeader::set_config which was called: # once (58µs+121µs) by Mail::SpamAssassin::Plugin::MIMEHeader::new at line 87 sub set_config {
95	1	2µs			my($self, $conf) = @_;
96	1	2µs			my @cmds;
97
98	1	2µs			my $pluginobj = $self; # allow use inside the closure below
99
100					push (@cmds, {
101					setting => 'mimeheader',
102					is_priv => 1,
103					# spent 45.4ms (21.0+24.4) within Mail::SpamAssassin::Plugin::MIMEHeader::__ANON__[/usr/local/lib/perl5/site_perl/Mail/SpamAssassin/Plugin/MIMEHeader.pm:160] which was called 46 times, avg 986µs/call: # 46 times (21.0ms+24.4ms) by Mail::SpamAssassin::Conf::Parser::parse at line 438 of Mail/SpamAssassin/Conf/Parser.pm, avg 986µs/call code => sub {
104	46	267µs			my ($self, $key, $value, $line) = @_;
105	46	280µs			local ($1,$2,$3,$4);
106	46	701µs	46	283µs	if ($value !~ /^(\S+)\s+(\S+)\s([\=\!]\~)\s(.+)$/) { # spent 283µs making 46 calls to Mail::SpamAssassin::Plugin::MIMEHeader::CORE:match, avg 6µs/call
107					return $Mail::SpamAssassin::Conf::INVALID_VALUE;
108					}
109
110					# provide stricter syntax for rule name!?
111	46	325µs	46	1.08ms	my $rulename = untaint_var($1); # spent 1.08ms making 46 calls to Mail::SpamAssassin::Util::untaint_var, avg 23µs/call
112	46	144µs			my $hdrname = $2;
113	46	158µs			my $negated = ($3 eq '!~') ? 1 : 0;
114	46	130µs			my $pattern = $4;
115
116	46	438µs	46	8.59ms	return unless $self->{parser}->is_delimited_regexp_valid($rulename, $pattern); # spent 8.59ms making 46 calls to Mail::SpamAssassin::Conf::Parser::is_delimited_regexp_valid, avg 187µs/call
117
118	46	467µs	46	8.40ms	$pattern = Mail::SpamAssassin::Util::make_qr($pattern); # spent 8.40ms making 46 calls to Mail::SpamAssassin::Util::make_qr, avg 183µs/call
119	46	104µs			return $Mail::SpamAssassin::Conf::INVALID_VALUE unless $pattern;
120
121	46	682µs			$self->{mimeheader_tests}->{$rulename} = {
122					hdr => $hdrname,
123					negated => $negated,
124					if_unset => '', # TODO!
125					pattern => $pattern
126					};
127
128					# now here's a hack; generate a fake eval rule function to
129					# call this rule's _real_ code!
130					# TODO: we should have a more elegant way for new rule types to
131					# be defined
132	46	124µs			my $evalfn = "_mimeheader_eval_$rulename";
133	46	543µs	46	191µs	$evalfn =~ s/[^a-zA-Z0-9_]/_/gs; # spent 191µs making 46 calls to Mail::SpamAssassin::Plugin::MIMEHeader::CORE:subst, avg 4µs/call
134
135					# don't redefine the subroutine if it already exists!
136					# this causes lots of annoying warnings and such during things like
137					# "make test".
138	92	923µs			return if (defined &{'Mail::SpamAssassin::Plugin::MIMEHeader::'.$evalfn});
139
140	46	481µs	46	3.81ms	$self->{parser}->add_test($rulename, $evalfn."()", # spent 3.81ms making 46 calls to Mail::SpamAssassin::Conf::Parser::add_test, avg 83µs/call
141					$Mail::SpamAssassin::Conf::TYPE_BODY_EVALS);
142
143	46	199µs			my $evalcode = '
144					sub Mail::SpamAssassin::Plugin::MIMEHeader::'.$evalfn.' {
145					$_[0]->eval_hook_called($_[1], q{'.$rulename.'});
146					}
147					';
148
149					eval
150					$evalcode . '; 1'
151	46	5.73ms			or do { # spent 12µs executing statements in 2 string evals (merged) # spent 11µs executing statements in 2 string evals (merged) # spent 10µs executing statements in string eval # spent 9µs executing statements in string eval # spent 9µs executing statements in string eval # spent 9µs executing statements in string eval # spent 9µs executing statements in string eval # spent 9µs executing statements in string eval # spent 8µs executing statements in string eval # spent 8µs executing statements in string eval # spent 8µs executing statements in string eval # spent 8µs executing statements in string eval # spent 8µs executing statements in string eval # spent 8µs executing statements in string eval # spent 8µs executing statements in string eval # spent 8µs executing statements in string eval # spent 8µs executing statements in string eval # spent 8µs executing statements in string eval # spent 8µs executing statements in string eval # spent 8µs executing statements in string eval # spent 8µs executing statements in string eval # spent 8µs executing statements in string eval # spent 8µs executing statements in string eval # spent 8µs executing statements in string eval # spent 8µs executing statements in string eval # spent 8µs executing statements in string eval # spent 6µs executing statements in string eval # spent 5µs executing statements in string eval # spent 5µs executing statements in string eval # spent 5µs executing statements in string eval # spent 5µs executing statements in string eval # spent 5µs executing statements in string eval # spent 5µs executing statements in string eval # spent 5µs executing statements in string eval # spent 5µs executing statements in string eval # spent 5µs executing statements in string eval # spent 5µs executing statements in string eval # spent 5µs executing statements in string eval # spent 5µs executing statements in string eval # spent 5µs executing statements in string eval # spent 5µs executing statements in string eval # spent 5µs executing statements in string eval # spent 5µs executing statements in string eval # spent 5µs executing statements in string eval
152					my $eval_stat = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
153					warn "mimeheader: plugin error: $eval_stat\n";
154					return $Mail::SpamAssassin::Conf::INVALID_VALUE;
155					};
156
157	46	462µs	46	2.02ms	$pluginobj->register_eval_rule($evalfn); # spent 2.02ms making 46 calls to Mail::SpamAssassin::Plugin::register_eval_rule, avg 44µs/call
158
159	46	993µs			push @TEMPORARY_METHODS, "Mail::SpamAssassin::Plugin::MIMEHeader::${evalfn}";
160					}
161	1	21µs			});
162
163	1	18µs	1	121µs	$conf->{parser}->register_commands(\@cmds); # spent 121µs making 1 call to Mail::SpamAssassin::Conf::Parser::register_commands
164					}
165
166					# ---------------------------------------------------------------------------
167
168					sub eval_hook_called {
169					my ($pobj, $scanner, $rulename) = @_;
170
171					my $rule = $scanner->{conf}->{mimeheader_tests}->{$rulename};
172					my $hdr = $rule->{hdr};
173					my $negated = $rule->{negated};
174					my $if_unset = $rule->{if_unset};
175					my $pattern = $rule->{pattern};
176
177
178					my $getraw;
179					if ($hdr =~ s/:raw$//i) {
180					$getraw = 1;
181					} else {
182					$getraw = 0;
183					}
184
185					foreach my $p ($scanner->{msg}->find_parts(qr/./)) {
186					my $val;
187					if ($getraw) {
188					$val = $p->raw_header($hdr);
189					} else {
190					$val = $p->get_header($hdr);
191					}
192					$val \|\|= $if_unset;
193
194					if ($val =~ ${pattern}) {
195					return ($negated ? 0 : 1);
196					}
197					}
198
199					return ($negated ? 1 : 0);
200					}
201
202					# ---------------------------------------------------------------------------
203
204					sub finish_tests {
205					my ($self, $params) = @_;
206
207					foreach my $method (@TEMPORARY_METHODS) {
208					undef &{$method};
209					}
210					@TEMPORARY_METHODS = (); # clear for next time
211					}
212
213					# ---------------------------------------------------------------------------
214
215	1	13µs			1;

					# spent 283µs within Mail::SpamAssassin::Plugin::MIMEHeader::CORE:match which was called 46 times, avg 6µs/call: # 46 times (283µs+0s) by Mail::SpamAssassin::Plugin::MIMEHeader::__ANON__[/usr/local/lib/perl5/site_perl/Mail/SpamAssassin/Plugin/MIMEHeader.pm:160] at line 106, avg 6µs/call sub Mail::SpamAssassin::Plugin::MIMEHeader::CORE:match; # opcode
					# spent 191µs within Mail::SpamAssassin::Plugin::MIMEHeader::CORE:subst which was called 46 times, avg 4µs/call: # 46 times (191µs+0s) by Mail::SpamAssassin::Plugin::MIMEHeader::__ANON__[/usr/local/lib/perl5/site_perl/Mail/SpamAssassin/Plugin/MIMEHeader.pm:160] at line 133, avg 4µs/call sub Mail::SpamAssassin::Plugin::MIMEHeader::CORE:subst; # opcode