Profile of Mail/SpamAssassin/Plugin/URIDetail.pm

Filename	/usr/local/lib/perl5/site_perl/Mail/SpamAssassin/Plugin/URIDetail.pm
Statements	Executed 31 statements in 3.04ms

Subroutines
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
1	1	1	82µs	307µs	Mail::SpamAssassin::Plugin::URIDetail::new
1	1	1	53µs	160µs	Mail::SpamAssassin::Plugin::URIDetail::set_config
1	1	1	46µs	46µs	Mail::SpamAssassin::Plugin::URIDetail::BEGIN@69
1	1	1	40µs	44µs	Mail::SpamAssassin::Plugin::URIDetail::BEGIN@75
1	1	1	35µs	43µs	Mail::SpamAssassin::Plugin::URIDetail::BEGIN@73
1	1	1	34µs	68µs	Mail::SpamAssassin::Plugin::URIDetail::BEGIN@74
1	1	1	33µs	98µs	Mail::SpamAssassin::Plugin::URIDetail::BEGIN@76
1	1	1	31µs	129µs	Mail::SpamAssassin::Plugin::URIDetail::BEGIN@78
1	1	1	28µs	225µs	Mail::SpamAssassin::Plugin::URIDetail::BEGIN@70
1	1	1	27µs	153µs	Mail::SpamAssassin::Plugin::URIDetail::BEGIN@71
0	0	0	0s	0s	Mail::SpamAssassin::Plugin::URIDetail::__ANON__[:147]
0	0	0	0s	0s	Mail::SpamAssassin::Plugin::URIDetail::check_uri_detail
0	0	0	0s	0s	Mail::SpamAssassin::Plugin::URIDetail::make_qr

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					# TODO: where are the tests?
19
20					=head1 NAME
21
22					URIDetail - test URIs using detailed URI information
23
24					=head1 SYNOPSIS
25
26					This plugin creates a new rule test type, known as "uri_detail". These
27					rules apply to all URIs found in the message.
28
29					loadplugin Mail::SpamAssassin::Plugin::URIDetail
30
31					=head1 RULE DEFINITIONS AND PRIVILEGED SETTINGS
32
33					The format for defining a rule is as follows:
34
35					uri_detail SYMBOLIC_TEST_NAME key1 =~ /value1/ key2 !~ /value2/ ...
36
37					Supported keys are:
38
39					C<raw> is the raw URI prior to any cleaning
40					(e.g. "http://spamassassin.apache%2Eorg/").
41
42					C<type> is the tag(s) which referenced the raw_uri. I<parsed> is a
43					faked type which specifies that the raw_uri was parsed from the
44					rendered text.
45
46					C<cleaned> is a list including the raw URI and various cleaned
47					versions of the raw URI (http://spamassassin.apache%2Eorg/,
48					http://spamassassin.apache.org/).
49
50					C<text> is the anchor text(s) (text between <a> and </a>) that
51					linked to the raw URI.
52
53					C<domain> is the domain(s) found in the cleaned URIs.
54
55					Example rule for matching a URI where the raw URI matches "%2Ebar",
56					the domain "bar.com" is found, and the type is "a" (an anchor tag).
57
58					uri_detail TEST1 raw =~ /%2Ebar/ domain =~ /^bar\.com$/ type =~ /^a$/
59
60					Example rule to look for suspicious "https" links:
61
62					uri_detail FAKE_HTTPS text =~ /\bhttps:/ cleaned !~ /\bhttps:/
63
64					Regular expressions should be delimited by slashes.
65
66					=cut
67
68					package Mail::SpamAssassin::Plugin::URIDetail;
69	2	76µs	1	46µs	# spent 46µs within Mail::SpamAssassin::Plugin::URIDetail::BEGIN@69 which was called: # once (46µs+0s) by Mail::SpamAssassin::PluginHandler::load_plugin at line 69 use Mail::SpamAssassin::Plugin; # spent 46µs making 1 call to Mail::SpamAssassin::Plugin::URIDetail::BEGIN@69
70	2	88µs	2	422µs	# spent 225µs (28+197) within Mail::SpamAssassin::Plugin::URIDetail::BEGIN@70 which was called: # once (28µs+197µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 70 use Mail::SpamAssassin::Logger; # spent 225µs making 1 call to Mail::SpamAssassin::Plugin::URIDetail::BEGIN@70 # spent 197µs making 1 call to Exporter::import
71	2	72µs	2	280µs	# spent 153µs (27+126) within Mail::SpamAssassin::Plugin::URIDetail::BEGIN@71 which was called: # once (27µs+126µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 71 use Mail::SpamAssassin::Util qw(untaint_var); # spent 153µs making 1 call to Mail::SpamAssassin::Plugin::URIDetail::BEGIN@71 # spent 126µs making 1 call to Exporter::import
72
73	2	58µs	2	51µs	# spent 43µs (35+8) within Mail::SpamAssassin::Plugin::URIDetail::BEGIN@73 which was called: # once (35µs+8µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 73 use strict; # spent 43µs making 1 call to Mail::SpamAssassin::Plugin::URIDetail::BEGIN@73 # spent 8µs making 1 call to strict::import
74	2	84µs	2	102µs	# spent 68µs (34+34) within Mail::SpamAssassin::Plugin::URIDetail::BEGIN@74 which was called: # once (34µs+34µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 74 use warnings; # spent 68µs making 1 call to Mail::SpamAssassin::Plugin::URIDetail::BEGIN@74 # spent 34µs making 1 call to warnings::import
75	2	88µs	2	49µs	# spent 44µs (40+5) within Mail::SpamAssassin::Plugin::URIDetail::BEGIN@75 which was called: # once (40µs+5µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 75 use bytes; # spent 44µs making 1 call to Mail::SpamAssassin::Plugin::URIDetail::BEGIN@75 # spent 5µs making 1 call to bytes::import
76	2	78µs	2	162µs	# spent 98µs (33+65) within Mail::SpamAssassin::Plugin::URIDetail::BEGIN@76 which was called: # once (33µs+65µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 76 use re 'taint'; # spent 98µs making 1 call to Mail::SpamAssassin::Plugin::URIDetail::BEGIN@76 # spent 65µs making 1 call to re::import
77
78	2	2.36ms	2	228µs	# spent 129µs (31+98) within Mail::SpamAssassin::Plugin::URIDetail::BEGIN@78 which was called: # once (31µs+98µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 78 use vars qw(@ISA); # spent 129µs making 1 call to Mail::SpamAssassin::Plugin::URIDetail::BEGIN@78 # spent 98µs making 1 call to vars::import
79	1	13µs			@ISA = qw(Mail::SpamAssassin::Plugin);
80
81					# constructor
82					# spent 307µs (82+225) within Mail::SpamAssassin::Plugin::URIDetail::new which was called: # once (82µs+225µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 1 of (eval 87)[Mail/SpamAssassin/PluginHandler.pm:129] sub new {
83	1	2µs			my $class = shift;
84	1	2µs			my $mailsaobject = shift;
85
86					# some boilerplate...
87	1	2µs			$class = ref($class) \|\| $class;
88	1	20µs	1	29µs	my $self = $class->SUPER::new($mailsaobject); # spent 29µs making 1 call to Mail::SpamAssassin::Plugin::new
89	1	2µs			bless ($self, $class);
90
91	1	19µs	1	36µs	$self->register_eval_rule("check_uri_detail"); # spent 36µs making 1 call to Mail::SpamAssassin::Plugin::register_eval_rule
92
93	1	7µs	1	160µs	$self->set_config($mailsaobject->{conf}); # spent 160µs making 1 call to Mail::SpamAssassin::Plugin::URIDetail::set_config
94
95	1	16µs			return $self;
96					}
97
98					# spent 160µs (53+107) within Mail::SpamAssassin::Plugin::URIDetail::set_config which was called: # once (53µs+107µs) by Mail::SpamAssassin::Plugin::URIDetail::new at line 93 sub set_config {
99	1	2µs			my ($self, $conf) = @_;
100	1	2µs			my @cmds;
101
102	1	2µs			my $pluginobj = $self; # allow use inside the closure below
103
104					push (@cmds, {
105					setting => 'uri_detail',
106					is_priv => 1,
107					code => sub {
108					my ($self, $key, $value, $line) = @_;
109
110					if ($value !~ /^(\S+)\s+(.+)$/) {
111					return $Mail::SpamAssassin::Conf::INVALID_VALUE;
112					}
113					my $name = $1;
114					my $def = $2;
115					my $added_criteria = 0;
116
117					# if this matches a regex, it strips slashes
118					while ($def =~ m{\b(\w+)\b\s([\=\!]\~)\s((?:/.?/\|m(\W).?\4)[imsx]*)(?=\s\|$)}g) {
119					my $target = $1;
120					my $op = $2;
121					my $pattern = $3;
122
123					if ($target !~ /^(?:raw\|type\|cleaned\|text\|domain)$/) {
124					return $Mail::SpamAssassin::Conf::INVALID_VALUE;
125					}
126					if ($conf->{parser}->is_delimited_regexp_valid($name, $pattern)) {
127					$pattern = $pluginobj->make_qr($pattern);
128					}
129					else {
130					return $Mail::SpamAssassin::Conf::INVALID_VALUE;
131					}
132
133					dbg("config: uri_detail adding ($target $op /$pattern/) to $name");
134					$conf->{parser}->{conf}->{uri_detail}->{$name}->{$target} =
135					[$op, $pattern];
136					$added_criteria = 1;
137					}
138
139					if ($added_criteria) {
140					dbg("config: uri_detail added $name\n");
141					$conf->{parser}->add_test($name, 'check_uri_detail()', $Mail::SpamAssassin::Conf::TYPE_BODY_EVALS);
142					}
143					else {
144					warn "config: failed to add invalid rule $name";
145					return $Mail::SpamAssassin::Conf::INVALID_VALUE;
146					}
147					}
148	1	23µs			});
149
150	1	18µs	1	106µs	$conf->{parser}->register_commands(\@cmds); # spent 106µs making 1 call to Mail::SpamAssassin::Conf::Parser::register_commands
151					}
152
153					sub check_uri_detail {
154					my ($self, $permsg) = @_;
155
156					my %uri_detail = %{ $permsg->get_uri_detail_list() };
157
158					while (my ($raw, $info) = each %uri_detail) {
159					my $test = $permsg->{current_rule_name};
160
161					dbg("uri: running $test\n");
162
163					my $rule = $permsg->{conf}->{uri_detail}->{$test};
164
165					if (exists $rule->{raw}) {
166					my($op,$patt) = @{$rule->{raw}};
167					if ( ($op eq '=~' && $raw =~ /$patt/) \|\|
168					($op eq '!~' && $raw !~ /$patt/) ) {
169					dbg("uri: raw matched: '%s' %s /%s/", $raw,$op,$patt);
170					} else {
171					next;
172					}
173					}
174
175					if (exists $rule->{type}) {
176					next unless $info->{types};
177					my($op,$patt) = @{$rule->{type}};
178					my $match;
179					for my $text (keys %{ $info->{types} }) {
180					if ( ($op eq '=~' && $text =~ /$patt/) \|\|
181					($op eq '!~' && $text !~ /$patt/) ) { $match = $text; last }
182					}
183					next unless defined $match;
184					dbg("uri: type matched: '%s' %s /%s/", $match,$op,$patt);
185					}
186
187					if (exists $rule->{cleaned}) {
188					next unless $info->{cleaned};
189					my($op,$patt) = @{$rule->{cleaned}};
190					my $match;
191					for my $text (@{ $info->{cleaned} }) {
192					if ( ($op eq '=~' && $text =~ /$patt/) \|\|
193					($op eq '!~' && $text !~ /$patt/) ) { $match = $text; last }
194					}
195					next unless defined $match;
196					dbg("uri: cleaned matched: '%s' %s /%s/", $match,$op,$patt);
197					}
198
199					if (exists $rule->{text}) {
200					next unless $info->{anchor_text};
201					my($op,$patt) = @{$rule->{text}};
202					my $match;
203					for my $text (@{ $info->{anchor_text} }) {
204					if ( ($op eq '=~' && $text =~ /$patt/) \|\|
205					($op eq '!~' && $text !~ /$patt/) ) { $match = $text; last }
206					}
207					next unless defined $match;
208					dbg("uri: text matched: '%s' %s /%s/", $match,$op,$patt);
209					}
210
211					if (exists $rule->{domain}) {
212					next unless $info->{domains};
213					my($op,$patt) = @{$rule->{domain}};
214					my $match;
215					for my $text (keys %{ $info->{domains} }) {
216					if ( ($op eq '=~' && $text =~ /$patt/) \|\|
217					($op eq '!~' && $text !~ /$patt/) ) { $match = $text; last }
218					}
219					next unless defined $match;
220					dbg("uri: domain matched: '%s' %s /%s/", $match,$op,$patt);
221					}
222
223					if (would_log('dbg', 'rules') > 1) {
224					dbg("uri: criteria for $test met");
225					}
226
227					$permsg->got_hit($test);
228
229					# reset hash
230					keys %uri_detail;
231
232					return 0;
233					}
234
235					return 0;
236					}
237
238					# ---------------------------------------------------------------------------
239
240					# turn "/foobar/i" into qr/(?i)foobar/
241					sub make_qr {
242					my ($self, $pattern) = @_;
243
244					my $re_delim;
245					if ($pattern =~ s/^m(\W)//) { # m!foo/bar!
246					$re_delim = $1;
247					} else { # /foo\/bar/ or !foo/bar!
248					$pattern =~ s/^(\W)//; $re_delim = $1;
249					}
250					if (!$re_delim) {
251					return;
252					}
253
254					$pattern =~ s/${re_delim}([imsx]*)$//;
255
256					my $mods = $1;
257					if ($mods) { $pattern = "(?".$mods.")".$pattern; }
258
259					return qr/$pattern/;
260					}
261
262					# ---------------------------------------------------------------------------
263
264	1	8µs			1;