← 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:49 2017

Filename/usr/local/lib/perl5/site_perl/Mail/SpamAssassin/Plugin/MIMEHeader.pm
StatementsExecuted 953 statements in 16.0ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
461114.8ms41.1msMail::SpamAssassin::Plugin::MIMEHeader::::__ANON__[:160]Mail::SpamAssassin::Plugin::MIMEHeader::__ANON__[:160]
4611340µs340µsMail::SpamAssassin::Plugin::MIMEHeader::::CORE:matchMail::SpamAssassin::Plugin::MIMEHeader::CORE:match (opcode)
4611203µs203µsMail::SpamAssassin::Plugin::MIMEHeader::::CORE:substMail::SpamAssassin::Plugin::MIMEHeader::CORE:subst (opcode)
11143µs184µsMail::SpamAssassin::Plugin::MIMEHeader::::newMail::SpamAssassin::Plugin::MIMEHeader::new
11143µs53µsMail::SpamAssassin::Plugin::MIMEHeader::::BEGIN@60Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@60
11135µs122µsMail::SpamAssassin::Plugin::MIMEHeader::::set_configMail::SpamAssassin::Plugin::MIMEHeader::set_config
11124µs110µsMail::SpamAssassin::Plugin::MIMEHeader::::BEGIN@68Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@68
11122µs174µsMail::SpamAssassin::Plugin::MIMEHeader::::BEGIN@67Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@67
11120µs26µsMail::SpamAssassin::Plugin::MIMEHeader::::BEGIN@62Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@62
11120µs117µsMail::SpamAssassin::Plugin::MIMEHeader::::BEGIN@70Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@70
11120µs45µsMail::SpamAssassin::Plugin::MIMEHeader::::BEGIN@61Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@61
11120µs75µsMail::SpamAssassin::Plugin::MIMEHeader::::BEGIN@63Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@63
11116µs16µsMail::SpamAssassin::Plugin::MIMEHeader::::BEGIN@66Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@66
11112µs12µsMail::SpamAssassin::Plugin::MIMEHeader::::BEGIN@65Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@65
0000s0sMail::SpamAssassin::Plugin::MIMEHeader::::eval_hook_calledMail::SpamAssassin::Plugin::MIMEHeader::eval_hook_called
0000s0sMail::SpamAssassin::Plugin::MIMEHeader::::finish_testsMail::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
20MIMEHeader - 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
29This plugin allows regexp rules to be written against MIME headers in the
30message.
31
32=head1 RULE DEFINITIONS AND PRIVILEGED SETTINGS
33
34=over 4
35
36=item mimeheader NAME_OF_RULE Header-Name =~ /pattern/modifiers
37
38Specify a rule. C<NAME_OF_RULE> is the name of the rule to be used,
39C<Header-Name> is the name of the MIME header to check, and
40C</pattern/modifiers> is the Perl regular expression to match against this.
41
42Note that in a message of multiple parts, each header will be checked
43against the pattern separately. In other words, if multiple parts
44have a 'Content-Type' header, each header's value will be tested
45individually as a separate string.
46
47Header names are considered case-insensitive.
48
49The header values are normally cleaned up a little; for example, whitespace
50around the newline character in "folded" headers will be replaced with a single
51space. Append C<:raw> to the header name to retrieve the raw, undecoded value,
52including pristine whitespace, instead.
53
54=back
55
56=cut
57
58package Mail::SpamAssassin::Plugin::MIMEHeader;
59
60260µs262µs
# spent 53µs (43+10) within Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@60 which was called: # once (43µs+10µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 60
use strict;
# spent 53µs making 1 call to Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@60 # spent 10µs making 1 call to strict::import
61262µs269µs
# spent 45µs (20+25) within Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@61 which was called: # once (20µs+25µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 61
use warnings;
# spent 45µs making 1 call to Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@61 # spent 25µs making 1 call to warnings::import
62255µs231µs
# spent 26µs (20+5) within Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@62 which was called: # once (20µs+5µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 62
use bytes;
# spent 26µs making 1 call to Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@62 # spent 5µs making 1 call to bytes::import
63255µs2130µs
# spent 75µs (20+55) within Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@63 which was called: # once (20µs+55µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 63
use re 'taint';
# spent 75µs making 1 call to Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@63 # spent 55µs making 1 call to re::import
64
65249µs112µs
# spent 12µs within Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@65 which was called: # once (12µs+0s) by Mail::SpamAssassin::PluginHandler::load_plugin at line 65
use Mail::SpamAssassin::Plugin;
66254µs116µ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;
67261µs2327µs
# spent 174µs (22+152) within Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@67 which was called: # once (22µs+152µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 67
use Mail::SpamAssassin::Logger;
# spent 174µs making 1 call to Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@67 # spent 152µs making 1 call to Exporter::import
68264µs2195µs
# spent 110µs (24+86) within Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@68 which was called: # once (24µs+86µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 68
use Mail::SpamAssassin::Util qw(untaint_var);
# spent 110µs making 1 call to Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@68 # spent 86µs making 1 call to Exporter::import
69
7021.37ms2213µs
# spent 117µs (20+96) within Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@70 which was called: # once (20µs+96µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 70
use vars qw(@ISA @TEMPORARY_METHODS);
# spent 117µs making 1 call to Mail::SpamAssassin::Plugin::MIMEHeader::BEGIN@70 # spent 96µs making 1 call to vars::import
71113µs@ISA = qw(Mail::SpamAssassin::Plugin);
72
7312µs@TEMPORARY_METHODS = ();
74
75# ---------------------------------------------------------------------------
76
77# constructor
78
# spent 184µs (43+141) within Mail::SpamAssassin::Plugin::MIMEHeader::new which was called: # once (43µs+141µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 1 of (eval 77)[Mail/SpamAssassin/PluginHandler.pm:129]
sub new {
7912µs my $class = shift;
8012µs my $samain = shift;
81
82 # some boilerplate...
8312µs $class = ref($class) || $class;
84110µs119µs my $self = $class->SUPER::new($samain);
# spent 19µs making 1 call to Mail::SpamAssassin::Plugin::new
8512µs bless ($self, $class);
86
8717µs1122µs $self->set_config($samain->{conf});
88
8918µs return $self;
90}
91
92# ---------------------------------------------------------------------------
93
94
# spent 122µs (35+87) within Mail::SpamAssassin::Plugin::MIMEHeader::set_config which was called: # once (35µs+87µs) by Mail::SpamAssassin::Plugin::MIMEHeader::new at line 87
sub set_config {
9512µs my($self, $conf) = @_;
9612µs my @cmds;
97
9812µs my $pluginobj = $self; # allow use inside the closure below
99
100 push (@cmds, {
101 setting => 'mimeheader',
102 is_priv => 1,
103
# spent 41.1ms (14.8+26.3) within Mail::SpamAssassin::Plugin::MIMEHeader::__ANON__[/usr/local/lib/perl5/site_perl/Mail/SpamAssassin/Plugin/MIMEHeader.pm:160] which was called 46 times, avg 893µs/call: # 46 times (14.8ms+26.3ms) by Mail::SpamAssassin::Conf::Parser::parse at line 438 of Mail/SpamAssassin/Conf/Parser.pm, avg 893µs/call
code => sub {
10446302µs my ($self, $key, $value, $line) = @_;
10546300µs local ($1,$2,$3,$4);
10646885µs46340µs if ($value !~ /^(\S+)\s+(\S+)\s*([\=\!]\~)\s*(.+)$/) {
# spent 340µ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!?
11146350µs461.35ms my $rulename = untaint_var($1);
# spent 1.35ms making 46 calls to Mail::SpamAssassin::Util::untaint_var, avg 29µs/call
11246153µs my $hdrname = $2;
11346177µs my $negated = ($3 eq '!~') ? 1 : 0;
11446166µs my $pattern = $4;
115
11646393µs469.64ms return unless $self->{parser}->is_delimited_regexp_valid($rulename, $pattern);
# spent 9.64ms making 46 calls to Mail::SpamAssassin::Conf::Parser::is_delimited_regexp_valid, avg 210µs/call
117
11846443µs468.86ms $pattern = Mail::SpamAssassin::Util::make_qr($pattern);
# spent 8.86ms making 46 calls to Mail::SpamAssassin::Util::make_qr, avg 193µs/call
11946106µs return $Mail::SpamAssassin::Conf::INVALID_VALUE unless $pattern;
120
12146616µ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
13246136µs my $evalfn = "_mimeheader_eval_$rulename";
13346660µs46203µs $evalfn =~ s/[^a-zA-Z0-9_]/_/gs;
# spent 203µ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".
13892965µs return if (defined &{'Mail::SpamAssassin::Plugin::MIMEHeader::'.$evalfn});
139
14046474µs463.89ms $self->{parser}->add_test($rulename, $evalfn."()",
# spent 3.89ms making 46 calls to Mail::SpamAssassin::Conf::Parser::add_test, avg 85µs/call
141 $Mail::SpamAssassin::Conf::TYPE_BODY_EVALS);
142
14346198µ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'
151466.20ms or do {
# spent 26µs executing statements in string eval # spent 11µ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 10µs executing statements in string eval # spent 7µs executing statements in string eval # spent 7µs executing statements in string eval # spent 7µ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 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 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
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
15746496µs462.03ms $pluginobj->register_eval_rule($evalfn);
# spent 2.03ms making 46 calls to Mail::SpamAssassin::Plugin::register_eval_rule, avg 44µs/call
158
159461.06ms push @TEMPORARY_METHODS, "Mail::SpamAssassin::Plugin::MIMEHeader::${evalfn}";
160 }
161113µs });
162
163116µs187µs $conf->{parser}->register_commands(\@cmds);
164}
165
166# ---------------------------------------------------------------------------
167
168sub 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
204sub 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
215110µs1;
 
# spent 340µs within Mail::SpamAssassin::Plugin::MIMEHeader::CORE:match which was called 46 times, avg 7µs/call: # 46 times (340µ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 203µs within Mail::SpamAssassin::Plugin::MIMEHeader::CORE:subst which was called 46 times, avg 4µs/call: # 46 times (203µ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