← Index
NYTProf Performance Profile   « line view »
For /usr/local/bin/sa-learn
  Run on Tue Nov 7 05:38:10 2017
Reported on Tue Nov 7 06:16:05 2017

Filename/usr/local/lib/perl5/site_perl/Mail/SpamAssassin/Plugin/FreeMail.pm
StatementsExecuted 12958 statements in 130ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
5011197.8ms115msMail::SpamAssassin::Plugin::FreeMail::::parse_configMail::SpamAssassin::Plugin::FreeMail::parse_config
51382114.0ms14.0msMail::SpamAssassin::Plugin::FreeMail::::CORE:matchMail::SpamAssassin::Plugin::FreeMail::CORE:match (opcode)
2214.07ms4.07msMail::SpamAssassin::Plugin::FreeMail::::CORE:regcompMail::SpamAssassin::Plugin::FreeMail::CORE:regcomp (opcode)
111814µs2.20msMail::SpamAssassin::Plugin::FreeMail::::finish_parsing_endMail::SpamAssassin::Plugin::FreeMail::finish_parsing_end
9331543µs543µsMail::SpamAssassin::Plugin::FreeMail::::CORE:substMail::SpamAssassin::Plugin::FreeMail::CORE:subst (opcode)
111177µs3.89msMail::SpamAssassin::Plugin::FreeMail::::newMail::SpamAssassin::Plugin::FreeMail::new
11154µs62µsMail::SpamAssassin::Plugin::FreeMail::::BEGIN@2Mail::SpamAssassin::Plugin::FreeMail::BEGIN@2
11145µs302µsMail::SpamAssassin::Plugin::FreeMail::::set_configMail::SpamAssassin::Plugin::FreeMail::set_config
44128µs28µsMail::SpamAssassin::Plugin::FreeMail::::CORE:qrMail::SpamAssassin::Plugin::FreeMail::CORE:qr (opcode)
11126µs33µsMail::SpamAssassin::Plugin::FreeMail::::dbgMail::SpamAssassin::Plugin::FreeMail::dbg
11122µs226µsMail::SpamAssassin::Plugin::FreeMail::::BEGIN@114Mail::SpamAssassin::Plugin::FreeMail::BEGIN@114
11120µs20µsMail::SpamAssassin::Plugin::FreeMail::::BEGIN@112Mail::SpamAssassin::Plugin::FreeMail::BEGIN@112
11119µs44µsMail::SpamAssassin::Plugin::FreeMail::::BEGIN@3Mail::SpamAssassin::Plugin::FreeMail::BEGIN@3
11115µs15µsMail::SpamAssassin::Plugin::FreeMail::::BEGIN@111Mail::SpamAssassin::Plugin::FreeMail::BEGIN@111
0000s0sMail::SpamAssassin::Plugin::FreeMail::::_got_hitMail::SpamAssassin::Plugin::FreeMail::_got_hit
0000s0sMail::SpamAssassin::Plugin::FreeMail::::_is_freemailMail::SpamAssassin::Plugin::FreeMail::_is_freemail
0000s0sMail::SpamAssassin::Plugin::FreeMail::::_parse_bodyMail::SpamAssassin::Plugin::FreeMail::_parse_body
0000s0sMail::SpamAssassin::Plugin::FreeMail::::check_freemail_bodyMail::SpamAssassin::Plugin::FreeMail::check_freemail_body
0000s0sMail::SpamAssassin::Plugin::FreeMail::::check_freemail_fromMail::SpamAssassin::Plugin::FreeMail::check_freemail_from
0000s0sMail::SpamAssassin::Plugin::FreeMail::::check_freemail_headerMail::SpamAssassin::Plugin::FreeMail::check_freemail_header
0000s0sMail::SpamAssassin::Plugin::FreeMail::::check_freemail_replytoMail::SpamAssassin::Plugin::FreeMail::check_freemail_replyto
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package Mail::SpamAssassin::Plugin::FreeMail;
2263µs271µs
# spent 62µs (54+9) within Mail::SpamAssassin::Plugin::FreeMail::BEGIN@2 which was called: # once (54µs+9µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 2
use strict;
# spent 62µs making 1 call to Mail::SpamAssassin::Plugin::FreeMail::BEGIN@2 # spent 9µs making 1 call to strict::import
32262µs268µs
# spent 44µs (19+25) within Mail::SpamAssassin::Plugin::FreeMail::BEGIN@3 which was called: # once (19µs+25µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 3
use warnings;
# spent 44µs making 1 call to Mail::SpamAssassin::Plugin::FreeMail::BEGIN@3 # spent 24µs making 1 call to warnings::import
412µsmy $VERSION = 2.002;
5
6### About:
7#
8# If From-address is freemail, and Reply-To or address found in mail body is
9# a different freemail address, return success. Good sign of Nigerian scams
10# etc. Test idea from Marc Perkel.
11#
12# Also separate functions to check various portions of message for freemails.
13#
14
15### Install:
16#
17# Please add loadplugin to init.pre (so it's loaded before cf files!):
18#
19# loadplugin Mail::SpamAssassin::Plugin::FreeMail FreeMail.pm
20#
21
22### Supported .cf clauses:
23#
24# freemail_domains domain ...
25#
26# List of domains to be used in checks.
27#
28# Regexp is not supported, but following wildcards work:
29#
30# ? for single character (does not match a dot)
31# * for multiple characters (does not match a dot)
32#
33# For example:
34# freemail_domains hotmail.com hotmail.co.?? yahoo.* yahoo.*.*
35#
36# freemail_whitelist email/domain ...
37#
38# Emails or domains listed here are ignored (pretend they arent
39# freemail). No wildcards!
40#
41# header FREEMAIL_REPLYTO eval:check_freemail_replyto(['option'])
42#
43# Checks/compares freemail addresses found from headers and body.
44#
45# Possible options:
46#
47# replyto From: or body address is different than Reply-To
48# (this is the default)
49# reply as above, but if no Reply-To header is found,
50# compares From: and body
51#
52# header FREEMAIL_FROM eval:check_freemail_from(['regex'])
53#
54# Checks all possible "from" headers to see if sender is freemail.
55# Uses SA all_from_addrs() function (includes 'Resent-From', 'From',
56# 'EnvelopeFrom' etc).
57#
58# Add optional regex to match the found email address(es). For example,
59# to see if user ends in digit: check_freemail_from('\d@')
60#
61# If you use multiple check_freemail_from rules with regexes, remember
62# that they might hit different emails from different heades. To match
63# a certain header only, use check_freemail_header.
64#
65# header FREEMAIL_HDRX eval:check_freemail_header('header' [, 'regex'])
66#
67# Searches defined header for freemail address. Optional regex to match
68# the found address (like in check_freemail_from).
69#
70# header FREEMAIL_BODY eval:check_freemail_body(['regex'])
71#
72# Searches body for freemail address. With optional regex to match.
73#
74
75### Changelog:
76#
77# 1.995 - public beta version, revamped whole code, moved default
78# domains to separate file: http://sa.hege.li/freemail_domains.cf
79# 1.996 - fix freemail_skip_bulk_envfrom
80# 1.997 - set freemail_skip_when_over_max to 1 by default
81# 1.998 - don't warn about missing freemail_domains when linting
82# 1.999 - default whitelist undisclosed-recipient@yahoo.com etc
83# 2.000 - some cleaning up
84# 2.001 - fix freemail_whitelist
85# 2.002 - _add_desc -> _got_hit, fix description email append bug
86#
87
88### Blah:
89#
90# Author: Henrik Krohns <sa@hege.li>
91# Copyright 2009 Henrik Krohns
92#
93# <@LICENSE>
94# Licensed to the Apache Software Foundation (ASF) under one or more
95# contributor license agreements. See the NOTICE file distributed with
96# this work for additional information regarding copyright ownership.
97# The ASF licenses this file to you under the Apache License, Version 2.0
98# (the "License"); you may not use this file except in compliance with
99# the License. You may obtain a copy of the License at:
100#
101# http://www.apache.org/licenses/LICENSE-2.0
102#
103# Unless required by applicable law or agreed to in writing, software
104# distributed under the License is distributed on an "AS IS" BASIS,
105# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
106# See the License for the specific language governing permissions and
107# limitations under the License.
108# </@LICENSE>
109#
110
111262µs115µs
# spent 15µs within Mail::SpamAssassin::Plugin::FreeMail::BEGIN@111 which was called: # once (15µs+0s) by Mail::SpamAssassin::PluginHandler::load_plugin at line 111
use Mail::SpamAssassin::Plugin;
# spent 15µs making 1 call to Mail::SpamAssassin::Plugin::FreeMail::BEGIN@111
112272µs120µs
# spent 20µs within Mail::SpamAssassin::Plugin::FreeMail::BEGIN@112 which was called: # once (20µs+0s) by Mail::SpamAssassin::PluginHandler::load_plugin at line 112
use Mail::SpamAssassin::PerMsgStatus;
# spent 20µs making 1 call to Mail::SpamAssassin::Plugin::FreeMail::BEGIN@112
113
11425.91ms2431µs
# spent 226µs (22+204) within Mail::SpamAssassin::Plugin::FreeMail::BEGIN@114 which was called: # once (22µs+204µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 114
use vars qw(@ISA $email_whitelist $skip_replyto_envfrom);
# spent 226µs making 1 call to Mail::SpamAssassin::Plugin::FreeMail::BEGIN@114 # spent 204µs making 1 call to vars::import
115119µs@ISA = qw(Mail::SpamAssassin::Plugin);
116
117# default email whitelist
118127µs111µs$email_whitelist = qr/
# spent 11µs making 1 call to Mail::SpamAssassin::Plugin::FreeMail::CORE:qr
119 ^(?:
120 abuse|support|sales|info|helpdesk|contact|kontakt
121 | (?:post|host|domain)master
122 | undisclosed.* # yahoo.com etc(?)
123 | request-[a-f0-9]{16} # live.com
124 | bounced?- # yahoo.com etc
125 | [a-f0-9]{8}(?:\.[a-f0-9]{8}|-[a-f0-9]{4}-[a-f0-9]{4}-[a-f0-9]{4}-[a-f0-9]{12}) # gmail msgids?
126 | .+=.+=.+ # gmail forward
127 )\@
128/xi;
129
130# skip replyto check when envelope sender is
131# allow <> for now
132{ # no re "strict"; # since perl 5.21.8: Ranges of ASCII printables...
133216µs14µs $skip_replyto_envfrom = qr/
# spent 4µs making 1 call to Mail::SpamAssassin::Plugin::FreeMail::CORE:qr
134 (?:
135 ^(?:post|host|domain)master
136 | ^double-bounce
137 | ^(?:sentto|owner|return|(?:gr)?bounced?)-.+
138 | -(?:request|bounces?|admin|owner)
139 | \b(?:do[._-t]?)?no[._-t]?repl(?:y|ies)
140 | .+=.+
141 )\@
142/xi;
143}
144
145119µs17µs
# spent 33µs (26+7) within Mail::SpamAssassin::Plugin::FreeMail::dbg which was called: # once (26µs+7µs) by Mail::SpamAssassin::Plugin::FreeMail::finish_parsing_end at line 275
sub dbg { Mail::SpamAssassin::Plugin::dbg ("FreeMail: @_"); }
# spent 7µs making 1 call to Mail::SpamAssassin::Logger::dbg
146
147
# spent 3.89ms (177µs+3.71) within Mail::SpamAssassin::Plugin::FreeMail::new which was called: # once (177µs+3.71ms) by Mail::SpamAssassin::PluginHandler::load_plugin at line 1 of (eval 111)[Mail/SpamAssassin/PluginHandler.pm:129]
sub new {
14816µs my ($class, $mailsa) = @_;
149
15012µs $class = ref($class) || $class;
151110µs123µs my $self = $class->SUPER::new($mailsa);
# spent 23µs making 1 call to Mail::SpamAssassin::Plugin::new
15212µs bless ($self, $class);
153
154117µs $self->{freemail_available} = 1;
15518µs1302µs $self->set_config($mailsa->{conf});
# spent 302µs making 1 call to Mail::SpamAssassin::Plugin::FreeMail::set_config
156115µs136µs $self->register_eval_rule("check_freemail_replyto");
# spent 36µs making 1 call to Mail::SpamAssassin::Plugin::register_eval_rule
15716µs129µs $self->register_eval_rule("check_freemail_from");
# spent 29µs making 1 call to Mail::SpamAssassin::Plugin::register_eval_rule
15816µs127µs $self->register_eval_rule("check_freemail_header");
# spent 27µs making 1 call to Mail::SpamAssassin::Plugin::register_eval_rule
15916µs127µs $self->register_eval_rule("check_freemail_body");
# spent 27µs making 1 call to Mail::SpamAssassin::Plugin::register_eval_rule
160
161 # Need to init the regex here, utilizing registryboundaries->valid_tlds_re
162 # Some regexp tips courtesy of http://www.regular-expressions.info/email.html
163 # full email regex v0.02
16413.30ms23.27ms $self->{email_regex} = qr/
# spent 3.26ms making 1 call to Mail::SpamAssassin::Plugin::FreeMail::CORE:regcomp # spent 5µs making 1 call to Mail::SpamAssassin::Plugin::FreeMail::CORE:qr
165 (?=.{0,64}\@) # limit userpart to 64 chars (and speed up searching?)
166 (?<![a-z0-9!#\$%&'*+\/=?^_`{|}~-]) # start boundary
167 ( # capture email
168 [a-z0-9!#\$%&'*+\/=?^_`{|}~-]+ # no dot in beginning
169 (?:\.[a-z0-9!#\$%&'*+\/=?^_`{|}~-]+)* # no consecutive dots, no ending dot
170 \@
171 (?:[a-z0-9](?:[a-z0-9-]{0,59}[a-z0-9])?\.){1,4} # max 4x61 char parts (should be enough?)
172 $self->{main}->{registryboundaries}->{valid_tlds_re} # ends with valid tld
173 )
174 (?!(?:[a-z0-9-]|\.[a-z0-9])) # make sure domain ends here
175 /xi;
176
177115µs return $self;
178}
179
180
# spent 302µs (45+256) within Mail::SpamAssassin::Plugin::FreeMail::set_config which was called: # once (45µs+256µs) by Mail::SpamAssassin::Plugin::FreeMail::new at line 155
sub set_config {
18112µs my ($self, $conf) = @_;
18212µs my @cmds;
18315µs push(@cmds, {
184 setting => 'freemail_max_body_emails',
185 default => 5,
186 type => $Mail::SpamAssassin::Conf::CONF_TYPE_NUMERIC,
187 }
188 );
18913µs push(@cmds, {
190 setting => 'freemail_max_body_freemails',
191 default => 3,
192 type => $Mail::SpamAssassin::Conf::CONF_TYPE_NUMERIC,
193 }
194 );
19515µs push(@cmds, {
196 setting => 'freemail_skip_when_over_max',
197 default => 1,
198 type => $Mail::SpamAssassin::Conf::CONF_TYPE_NUMERIC,
199 }
200 );
20113µs push(@cmds, {
202 setting => 'freemail_skip_bulk_envfrom',
203 default => 1,
204 type => $Mail::SpamAssassin::Conf::CONF_TYPE_NUMERIC,
205 }
206 );
20716µs push(@cmds, {
208 setting => 'freemail_add_describe_email',
209 default => 1,
210 type => $Mail::SpamAssassin::Conf::CONF_TYPE_NUMERIC,
211 }
212 );
213121µs1256µs $conf->{parser}->register_commands(\@cmds);
# spent 256µs making 1 call to Mail::SpamAssassin::Conf::Parser::register_commands
214}
215
216
# spent 115ms (97.8+17.1) within Mail::SpamAssassin::Plugin::FreeMail::parse_config which was called 501 times, avg 229µs/call: # 501 times (97.8ms+17.1ms) by Mail::SpamAssassin::PluginHandler::callback at line 204 of Mail/SpamAssassin/PluginHandler.pm, avg 229µs/call
sub parse_config {
217501843µs my ($self, $opts) = @_;
218
2195011.07ms if ($opts->{key} eq "freemail_domains") {
2205016.50ms foreach my $temp (split(/\s+/, $opts->{value})) {
221256940.6ms25698.10ms if ($temp =~ /^[a-z0-9.*?-]+$/i) {
# spent 8.10ms making 2569 calls to Mail::SpamAssassin::Plugin::FreeMail::CORE:match, avg 3µs/call
22225697.13ms my $value = lc($temp);
223256923.9ms25695.88ms if ($value =~ /[*?]/) { # separate wildcard list
# spent 5.88ms making 2569 calls to Mail::SpamAssassin::Plugin::FreeMail::CORE:match, avg 2µs/call
22431317µs $self->{freemail_temp_wc}{$value} = 1;
225 }
226 else {
227253825.5ms $self->{freemail_domains}{$value} = 1;
228 }
229 }
230 else {
231 warn("invalid freemail_domains: $temp");
232 }
233 }
2345013.06ms5013.12ms $self->inhibit_further_callbacks();
# spent 3.12ms making 501 calls to Mail::SpamAssassin::Plugin::inhibit_further_callbacks, avg 6µs/call
2355018.63ms return 1;
236 }
237
238 if ($opts->{key} eq "freemail_whitelist") {
239 foreach my $temp (split(/\s+/, $opts->{value})) {
240 my $value = lc($temp);
241 if ($value =~ /\w[.@]\w/) {
242 $self->{freemail_whitelist}{$value} = 1;
243 }
244 else {
245 warn("invalid freemail_whitelist: $temp");
246 }
247 }
248 $self->inhibit_further_callbacks();
249 return 1;
250 }
251
252 return 0;
253}
254
255
# spent 2.20ms (814µs+1.39) within Mail::SpamAssassin::Plugin::FreeMail::finish_parsing_end which was called: # once (814µs+1.39ms) by Mail::SpamAssassin::PluginHandler::callback at line 204 of Mail/SpamAssassin/PluginHandler.pm
sub finish_parsing_end {
25612µs my ($self, $opts) = @_;
257
25812µs my $wcount = 0;
259111µs if (defined $self->{freemail_temp_wc}) {
26012µs my @domains;
261239µs foreach my $value (keys %{$self->{freemail_temp_wc}}) {
26231528µs31352µs $value =~ s/\./\\./g;
# spent 352µs making 31 calls to Mail::SpamAssassin::Plugin::FreeMail::CORE:subst, avg 11µs/call
26331226µs3166µs $value =~ s/\?/./g;
# spent 66µs making 31 calls to Mail::SpamAssassin::Plugin::FreeMail::CORE:subst, avg 2µs/call
26431299µs31125µs $value =~ s/\*/[^.]*/g;
# spent 125µs making 31 calls to Mail::SpamAssassin::Plugin::FreeMail::CORE:subst, avg 4µs/call
26531136µs push(@domains, $value);
266 }
26718µs my $doms = join('|', @domains);
2681838µs2812µs $self->{freemail_domains_re} = qr/\@(?:${doms})$/;
# spent 804µs making 1 call to Mail::SpamAssassin::Plugin::FreeMail::CORE:regcomp # spent 8µs making 1 call to Mail::SpamAssassin::Plugin::FreeMail::CORE:qr
26912µs $wcount = scalar @domains;
270234µs undef %{$self->{freemail_temp_wc}};
271 }
272
27327µs my $count = scalar keys %{$self->{freemail_domains}};
27415µs if ($count + $wcount) {
275117µs133µs dbg("loaded freemail_domains entries: $count normal, $wcount wildcard");
# spent 33µs making 1 call to Mail::SpamAssassin::Plugin::FreeMail::dbg
276 }
277 else {
278 if ($self->{main}->{lint_rules} ||1) {
279 dbg("no freemail_domains entries defined, disabling plugin");
280 }
281 else {
282 warn("no freemail_domains entries defined, disabling plugin");
283 }
284 $self->{freemail_available} = 0;
285 }
286
28719µs return 0;
288}
289
290sub _is_freemail {
291 my ($self, $email) = @_;
292
293 return 0 if $email eq '';
294
295 if (defined $self->{freemail_whitelist}{$email}) {
296 dbg("whitelisted email: $email");
297 return 0;
298 }
299
300 my $domain = $email;
301 $domain =~ s/.*\@//;
302
303 if (defined $self->{freemail_whitelist}{$domain}) {
304 dbg("whitelisted domain: $domain");
305 return 0;
306 }
307 if ($email =~ $email_whitelist) {
308 dbg("whitelisted email, default: $email");
309 return 0;
310 }
311 if (defined $self->{freemail_domains}{$domain}
312 or ( defined $self->{freemail_domains_re}
313 and $email =~ $self->{freemail_domains_re} )) {
314 return 1;
315 }
316
317 return 0;
318}
319
320sub _parse_body {
321 my ($self, $pms) = @_;
322
323 # Parse body
324 if (not defined $pms->{freemail_cache}{body}) {
325 %{$pms->{freemail_cache}{body}} = ();
326 my %seen;
327 my @body_emails;
328 # get all <a href="mailto:", since they don't show up on stripped_body
329 my $parsed = $pms->get_uri_detail_list();
330 while (my($uri, $info) = each %{$parsed}) {
331 if (defined $info->{types}->{a} and not defined $info->{types}->{parsed}) {
332 if ($uri =~ /^(?:(?i)mailto):$self->{email_regex}/) {
333 my $email = lc($1);
334 push(@body_emails, $email) unless defined $seen{$email};
335 $seen{$email} = 1;
336 last if scalar @body_emails >= 20; # sanity
337 }
338 }
339 }
340 # scan stripped normalized body
341 # have to do this way since get_uri_detail_list doesn't know what mails are inside <>
342 my $body = $pms->get_decoded_stripped_body_text_array();
343 BODY: foreach (@$body) {
344 # strip urls with possible emails inside
345 s#<?https?://\S{0,255}(?:\@|%40)\S{0,255}# #gi;
346 # strip emails contained in <>, not mailto:
347 # also strip ones followed by quote-like "wrote:" (but not fax: and tel: etc)
348 s#<?(?<!mailto:)$self->{email_regex}(?:>|\s{1,10}(?!(?:fa(?:x|csi)|tel|phone|e?-?mail))[a-z]{2,11}:)# #gi;
349 while (/$self->{email_regex}/g) {
350 my $email = lc($1);
351 push(@body_emails, $email) unless defined $seen{$email};
352 $seen{$email} = 1;
353 last BODY if scalar @body_emails >= 40; # sanity
354 }
355 }
356 my $count_all = 0;
357 my $count_fm = 0;
358 foreach my $email (@body_emails) {
359 if (++$count_all == $pms->{main}->{conf}->{freemail_max_body_emails}) {
360 if ($pms->{main}->{conf}->{freemail_skip_when_over_max}) {
361 $pms->{freemail_skip_body} = 1;
362 dbg("too many unique emails found from body");
363 return 0;
364 }
365 }
366 next unless $self->_is_freemail($email);
367 if (++$count_fm == $pms->{main}->{conf}->{freemail_max_body_freemails}) {
368 if ($pms->{main}->{conf}->{freemail_skip_when_over_max}) {
369 $pms->{freemail_skip_body} = 1;
370 dbg("too many unique freemails found from body");
371 return 0;
372 }
373 }
374 $pms->{freemail_cache}{body}{$email} = 1;
375 }
376 dbg("all body freemails: ".join(', ', keys %{$pms->{freemail_cache}{body}}))
377 if scalar keys %{$pms->{freemail_cache}{body}};
378 }
379
380 if (defined $pms->{freemail_skip_body}) {
381 dbg("[cached] body email limit exceeded, skipping");
382 return 0;
383 }
384
385 return 1;
386}
387
388sub _got_hit {
389 my ($self, $pms, $email, $desc) = @_;
390
391 my $rulename = $pms->get_current_eval_rule_name();
392
393 if (defined $pms->{conf}->{descriptions}->{$rulename}) {
394 $desc = $pms->{conf}->{descriptions}->{$rulename};
395 }
396
397 if ($pms->{main}->{conf}->{freemail_add_describe_email}) {
398 $email =~ s/\@/[at]/g;
399 $pms->got_hit($rulename, "", description => $desc." ($email)", ruletype => 'eval');
400 }
401 else {
402 $pms->got_hit($rulename, "", description => $desc, ruletype => 'eval');
403 }
404}
405
406sub check_freemail_header {
407 my ($self, $pms, $header, $regex) = @_;
408
409 return 0 unless $self->{freemail_available};
410
411 my $rulename = $pms->get_current_eval_rule_name();
412 dbg("RULE ($rulename) check_freemail_header".(defined $regex ? " regex:$regex" : ""));
413
414 unless (defined $header) {
415 warn("check_freemail_header needs argument");
416 return 0;
417 }
418
419 my $re;
420 if (defined $regex) {
421 $re = eval { qr/$regex/; };
422 if ($@) {
423 warn("invalid regex: $@");
424 return 0;
425 }
426 }
427
428 my $email = lc($pms->get(index($header,':') >= 0 ? $header : $header.":addr"));
429
430 if ($email eq '') {
431 dbg("header $header not found from mail");
432 return 0;
433 }
434 dbg("address from header $header: $email");
435
436 if ($self->_is_freemail($email)) {
437 if (defined $re) {
438 return 0 unless $email =~ $re;
439 dbg("HIT! $email is freemail and matches regex");
440 }
441 else {
442 dbg("HIT! $email is freemail");
443 }
444 $self->_got_hit($pms, $email, "Header $header is freemail");
445 return 0;
446 }
447
448 return 0;
449}
450
451sub check_freemail_body {
452 my ($self, $pms, $regex) = @_;
453
454 return 0 unless $self->{freemail_available};
455
456 my $rulename = $pms->get_current_eval_rule_name();
457 dbg("RULE ($rulename) check_freemail_body".(defined $regex ? " regex:$regex" : ""));
458
459 return 0 unless $self->_parse_body($pms);
460
461 my $re;
462 if (defined $regex) {
463 $re = eval { qr/$regex/; };
464 if ($@) {
465 warn("invalid regex: $@");
466 return 0;
467 }
468 }
469
470 if (defined $re) {
471 foreach my $email (keys %{$pms->{freemail_cache}{body}}) {
472 if ($email =~ $re) {
473 dbg("HIT! email from body is freemail and matches regex: $email");
474 $self->_got_hit($pms, $email, "Email from body is freemail");
475 return 0;
476 }
477 }
478 }
479 elsif (scalar keys %{$pms->{freemail_cache}{body}}) {
480 my $emails = join(', ', keys %{$pms->{freemail_cache}{body}});
481 dbg("HIT! body has freemails: $emails");
482 $self->_got_hit($pms, $emails, "Body contains freemails");
483 return 0;
484 }
485
486 return 0;
487}
488
489sub check_freemail_from {
490 my ($self, $pms, $regex) = @_;
491
492 return 0 unless $self->{freemail_available};
493
494 my $rulename = $pms->get_current_eval_rule_name();
495 dbg("RULE ($rulename) check_freemail_from".(defined $regex ? " regex:$regex" : ""));
496
497 my $re;
498 if (defined $regex) {
499 $re = eval { qr/$regex/; };
500 if ($@ or not defined $re) {
501 warn("invalid regex: $@");
502 return 0;
503 }
504 }
505
506 my %from_addrs = map { lc($_) => 1 } ($pms->all_from_addrs());
507 delete $from_addrs{''}; # no empty ones thx
508
509 unless (scalar keys %from_addrs) {
510 dbg("no from-addresses found to check");
511 return 0;
512 }
513
514 dbg("all from-addresses: ".join(', ', keys %from_addrs));
515
516 foreach my $email (keys %from_addrs) {
517 next unless $self->_is_freemail($email);
518 if (defined $re) {
519 next unless $email =~ $re;
520 dbg("HIT! $email is freemail and matches regex");
521 }
522 else {
523 dbg("HIT! $email is freemail");
524 }
525 $self->_got_hit($pms, $email, "Sender address is freemail");
526 return 0;
527 }
528
529 return 0;
530}
531
532sub check_freemail_replyto {
533 my ($self, $pms, $what) = @_;
534
535 return 0 unless $self->{freemail_available};
536
537 my $rulename = $pms->get_current_eval_rule_name();
538 dbg("RULE ($rulename) check_freemail_replyto");
539
540 if (defined $what) {
541 if ($what ne 'replyto' and $what ne 'reply') {
542 warn("invalid check_freemail_replyto option: $what");
543 return 0;
544 }
545 }
546 else {
547 $what = 'replyto';
548 }
549
550 # Skip mailing-list etc looking requests, mostly FPs from them
551 if ($pms->{main}->{conf}->{freemail_skip_bulk_envfrom}) {
552 my $envfrom = lc($pms->get("EnvelopeFrom"));
553 if ($envfrom =~ $skip_replyto_envfrom) {
554 dbg("envelope sender looks bulk, skipping check: $envfrom");
555 return 0;
556 }
557 }
558
559 my $from = lc($pms->get("From:addr"));
560 my $replyto = lc($pms->get("Reply-To:addr"));
561 my $from_is_fm = $self->_is_freemail($from);
562 my $replyto_is_fm = $self->_is_freemail($replyto);
563
564 dbg("From address: $from") if $from ne '';
565 dbg("Reply-To address: $replyto") if $replyto ne '';
566
567 if ($from_is_fm and $replyto_is_fm and ($from ne $replyto)) {
568 dbg("HIT! From and Reply-To are different freemails");
569 $self->_got_hit($pms, "$from, $replyto", "From and Reply-To are different freemails");
570 return 0;
571 }
572
573 if ($what eq 'replyto') {
574 if (!$replyto_is_fm) {
575 dbg("Reply-To is not freemail, skipping check");
576 return 0;
577 }
578 }
579 elsif ($what eq 'reply') {
580 if ($replyto ne '' and !$replyto_is_fm) {
581 dbg("Reply-To defined and is not freemail, skipping check");
582 return 0;
583 }
584 elsif (!$from_is_fm) {
585 dbg("No Reply-To and From is not freemail, skipping check");
586 return 0;
587 }
588 }
589 my $reply = $replyto_is_fm ? $replyto : $from;
590
591 return 0 unless $self->_parse_body($pms);
592
593 # Compare body to headers
594 if (scalar keys %{$pms->{freemail_cache}{body}}) {
595 my $check = $what eq 'replyto' ? $replyto : $reply;
596 dbg("comparing $check to body freemails");
597 foreach my $email (keys %{$pms->{freemail_cache}{body}}) {
598 if ($email ne $check) {
599 dbg("HIT! $check and $email are different freemails");
600 $self->_got_hit($pms, "$check, $email", "Different freemails in reply header and body");
601 return 0;
602 }
603 }
604 }
605
606 return 0;
607}
608
609118µs1;
 
# spent 14.0ms within Mail::SpamAssassin::Plugin::FreeMail::CORE:match which was called 5138 times, avg 3µs/call: # 2569 times (8.10ms+0s) by Mail::SpamAssassin::Plugin::FreeMail::parse_config at line 221, avg 3µs/call # 2569 times (5.88ms+0s) by Mail::SpamAssassin::Plugin::FreeMail::parse_config at line 223, avg 2µs/call
sub Mail::SpamAssassin::Plugin::FreeMail::CORE:match; # opcode
# spent 28µs within Mail::SpamAssassin::Plugin::FreeMail::CORE:qr which was called 4 times, avg 7µs/call: # once (11µs+0s) by Mail::SpamAssassin::PluginHandler::load_plugin at line 118 # once (8µs+0s) by Mail::SpamAssassin::Plugin::FreeMail::finish_parsing_end at line 268 # once (5µs+0s) by Mail::SpamAssassin::Plugin::FreeMail::new at line 164 # once (4µs+0s) by Mail::SpamAssassin::PluginHandler::load_plugin at line 133
sub Mail::SpamAssassin::Plugin::FreeMail::CORE:qr; # opcode
# spent 4.07ms within Mail::SpamAssassin::Plugin::FreeMail::CORE:regcomp which was called 2 times, avg 2.03ms/call: # once (3.26ms+0s) by Mail::SpamAssassin::Plugin::FreeMail::new at line 164 # once (804µs+0s) by Mail::SpamAssassin::Plugin::FreeMail::finish_parsing_end at line 268
sub Mail::SpamAssassin::Plugin::FreeMail::CORE:regcomp; # opcode
# spent 543µs within Mail::SpamAssassin::Plugin::FreeMail::CORE:subst which was called 93 times, avg 6µs/call: # 31 times (352µs+0s) by Mail::SpamAssassin::Plugin::FreeMail::finish_parsing_end at line 262, avg 11µs/call # 31 times (125µs+0s) by Mail::SpamAssassin::Plugin::FreeMail::finish_parsing_end at line 264, avg 4µs/call # 31 times (66µs+0s) by Mail::SpamAssassin::Plugin::FreeMail::finish_parsing_end at line 263, avg 2µs/call
sub Mail::SpamAssassin::Plugin::FreeMail::CORE:subst; # 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.