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	13.7ms	38.4ms	Mail::SpamAssassin::Plugin::MIMEHeader::__ANON__[:160]
46	1	1	321µs	321µs	Mail::SpamAssassin::Plugin::MIMEHeader::CORE:match (opcode)
46	1	1	217µs	217µs	Mail::SpamAssassin::Plugin::MIMEHeader::CORE:subst (opcode)
1	1	1	72µs	80µs	Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@60
1	1	1	59µs	299µs	Mail::SpamAssassin::Plugin::MIMEHeader::new
1	1	1	47µs	198µs	Mail::SpamAssassin::Plugin::MIMEHeader::set_config
1	1	1	31µs	64µs	Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@61
1	1	1	30µs	200µs	Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@70
1	1	1	28µs	33µs	Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@62
1	1	1	24µs	189µs	Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@67
1	1	1	24µs	153µs	Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@68
1	1	1	22µs	96µs	Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@63
1	1	1	16µs	16µs	Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@66
1	1	1	13µs	13µ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	76µs	2	89µs	# spent 80µs (72+8) within Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@60 which was called: # once (72µs+8µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 60 use strict; # spent 80µs making 1 call to Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@60 # spent 8µs making 1 call to strict::import
61	2	79µs	2	97µs	# spent 64µs (31+33) within Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@61 which was called: # once (31µs+33µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 61 use warnings; # spent 64µs making 1 call to Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@61 # spent 33µs making 1 call to warnings::import
62	2	66µs	2	38µs	# spent 33µs (28+5) within Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@62 which was called: # once (28µs+5µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 62 use bytes; # spent 33µs making 1 call to Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@62 # spent 5µs making 1 call to bytes::import
63	2	69µs	2	169µs	# spent 96µs (22+73) within Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@63 which was called: # once (22µs+73µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 63 use re 'taint'; # spent 96µs making 1 call to Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@63 # spent 73µs making 1 call to re::import
64
65	2	62µs	1	13µs	# spent 13µs within Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@65 which was called: # once (13µs+0s) by Mail::SpamAssassin::PluginHandler::load_plugin at line 65 use Mail::SpamAssassin::Plugin; # spent 13µs making 1 call to Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@65
66	2	63µs	1	16µs	# spent 16µs within Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@66 which was called: # once (16µs+0s) by Mail::SpamAssassin::PluginHandler::load_plugin at line 66 use Mail::SpamAssassin::Conf; # spent 16µs making 1 call to Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@66
67	2	68µs	2	354µs	# spent 189µs (24+165) within Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@67 which was called: # once (24µs+165µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 67 use Mail::SpamAssassin::Logger; # spent 189µs making 1 call to Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@67 # spent 165µs making 1 call to Exporter::import
68	2	84µs	2	283µs	# spent 153µs (24+130) within Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@68 which was called: # once (24µs+130µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 68 use Mail::SpamAssassin::Util qw(untaint_var); # spent 153µs making 1 call to Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@68 # spent 130µs making 1 call to Exporter::import
69
70	2	1.41ms	2	369µs	# spent 200µs (30+170) within Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@70 which was called: # once (30µs+170µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 70 use vars qw(@ISA @TEMPORARY_METHODS); # spent 200µs making 1 call to Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@70 # spent 170µs making 1 call to vars::import
71	1	21µs			@ISA = qw(Mail::SpamAssassin::Plugin);
72
73	1	2µs			@TEMPORARY_METHODS = ();
74
75					# ---------------------------------------------------------------------------
76
77					# constructor
78					# spent 299µs (59+240) within Mail::SpamAssassin::Plugin::MIMEHeader::new which was called: # once (59µs+240µ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	20µs	1	42µs	my $self = $class->SUPER::new($samain); # spent 42µs making 1 call to Mail::SpamAssassin::Plugin::new
85	1	2µs			bless ($self, $class);
86
87	1	7µs	1	198µs	$self->set_config($samain->{conf}); # spent 198µs making 1 call to Mail::SpamAssassin::Plugin::MIMEHeader::set_config
88
89	1	9µs			return $self;
90					}
91
92					# ---------------------------------------------------------------------------
93
94					# spent 198µs (47+152) within Mail::SpamAssassin::Plugin::MIMEHeader::set_config which was called: # once (47µs+152µ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 38.4ms (13.7+24.7) within Mail::SpamAssassin::Plugin::MIMEHeader::__ANON__[/usr/local/lib/perl5/site_perl/Mail/SpamAssassin/Plugin/MIMEHeader.pm:160] which was called 46 times, avg 834µs/call: # 46 times (13.7ms+24.7ms) by Mail::SpamAssassin::Conf::Parser::parse at line 438 of Mail/SpamAssassin/Conf/Parser.pm, avg 834µs/call code => sub {
104	46	274µs			my ($self, $key, $value, $line) = @_;
105	46	273µs			local ($1,$2,$3,$4);
106	46	791µs	46	321µs	if ($value !~ /^(\S+)\s+(\S+)\s([\=\!]\~)\s(.+)$/) { # spent 321µs making 46 calls to Mail::SpamAssassin::Plugin::MIMEHeader::CORE:match, avg 7µs/call
107					return $Mail::SpamAssassin::Conf::INVALID_VALUE;
108					}
109
110					# provide stricter syntax for rule name!?
111	46	314µs	46	1.14ms	my $rulename = untaint_var($1); # spent 1.14ms making 46 calls to Mail::SpamAssassin::Util::untaint_var, avg 25µs/call
112	46	150µs			my $hdrname = $2;
113	46	173µs			my $negated = ($3 eq '!~') ? 1 : 0;
114	46	126µs			my $pattern = $4;
115
116	46	410µs	46	8.68ms	return unless $self->{parser}->is_delimited_regexp_valid($rulename, $pattern); # spent 8.68ms making 46 calls to Mail::SpamAssassin::Conf::Parser::is_delimited_regexp_valid, avg 189µs/call
117
118	46	424µ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	82µs			return $Mail::SpamAssassin::Conf::INVALID_VALUE unless $pattern;
120
121	46	642µ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	112µs			my $evalfn = "_mimeheader_eval_$rulename";
133	46	589µs	46	217µs	$evalfn =~ s/[^a-zA-Z0-9_]/_/gs; # spent 217µs making 46 calls to Mail::SpamAssassin::Plugin::MIMEHeader::CORE:subst, avg 5µ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	1.01ms			return if (defined &{'Mail::SpamAssassin::Plugin::MIMEHeader::'.$evalfn});
139
140	46	443µs	46	3.94ms	$self->{parser}->add_test($rulename, $evalfn."()", # spent 3.94ms making 46 calls to Mail::SpamAssassin::Conf::Parser::add_test, avg 86µs/call
141					$Mail::SpamAssassin::Conf::TYPE_BODY_EVALS);
142
143	46	157µ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.89ms			or do { # spent 16µs executing statements in 2 string evals (merged) # spent 13µs executing statements in string eval # spent 10µs executing statements in 2 string evals (merged) # spent 8µs executing statements in string eval # spent 7µs executing statements in string eval # spent 6µs executing statements in string eval # spent 6µs executing statements in string eval # spent 6µs executing statements in string eval # spent 6µ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 # 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	444µs	46	1.96ms	$pluginobj->register_eval_rule($evalfn); # spent 1.96ms making 46 calls to Mail::SpamAssassin::Plugin::register_eval_rule, avg 43µs/call
158
159	46	993µs			push @TEMPORARY_METHODS, "Mail::SpamAssassin::Plugin::MIMEHeader::${evalfn}";
160					}
161	1	22µs			});
162
163	1	15µs	1	152µs	$conf->{parser}->register_commands(\@cmds); # spent 152µ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	25µs			1;

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