← Index
NYTProf Performance Profile   « line view »
For /usr/local/bin/sa-learn
  Run on Sun Nov 5 02:36:06 2017
Reported on Sun Nov 5 02:56:22 2017

Filename/usr/local/lib/perl5/site_perl/Mail/SpamAssassin/Plugin/RelayEval.pm
StatementsExecuted 35 statements in 4.90ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
111191µs512µsMail::SpamAssassin::Plugin::RelayEval::::newMail::SpamAssassin::Plugin::RelayEval::new
11198µs655µsMail::SpamAssassin::Plugin::RelayEval::::BEGIN@22Mail::SpamAssassin::Plugin::RelayEval::BEGIN@22
11143µs43µsMail::SpamAssassin::Plugin::RelayEval::::BEGIN@20Mail::SpamAssassin::Plugin::RelayEval::BEGIN@20
11129µs35µsMail::SpamAssassin::Plugin::RelayEval::::BEGIN@26Mail::SpamAssassin::Plugin::RelayEval::BEGIN@26
11127µs100µsMail::SpamAssassin::Plugin::RelayEval::::BEGIN@29Mail::SpamAssassin::Plugin::RelayEval::BEGIN@29
11126µs91µsMail::SpamAssassin::Plugin::RelayEval::::BEGIN@27Mail::SpamAssassin::Plugin::RelayEval::BEGIN@27
11123µs238µsMail::SpamAssassin::Plugin::RelayEval::::BEGIN@21Mail::SpamAssassin::Plugin::RelayEval::BEGIN@21
11122µs34µsMail::SpamAssassin::Plugin::RelayEval::::BEGIN@24Mail::SpamAssassin::Plugin::RelayEval::BEGIN@24
11122µs55µsMail::SpamAssassin::Plugin::RelayEval::::BEGIN@25Mail::SpamAssassin::Plugin::RelayEval::BEGIN@25
0000s0sMail::SpamAssassin::Plugin::RelayEval::::_check_for_forged_receivedMail::SpamAssassin::Plugin::RelayEval::_check_for_forged_received
0000s0sMail::SpamAssassin::Plugin::RelayEval::::_check_received_helosMail::SpamAssassin::Plugin::RelayEval::_check_received_helos
0000s0sMail::SpamAssassin::Plugin::RelayEval::::_helo_forgery_whitelistedMail::SpamAssassin::Plugin::RelayEval::_helo_forgery_whitelisted
0000s0sMail::SpamAssassin::Plugin::RelayEval::::check_all_trustedMail::SpamAssassin::Plugin::RelayEval::check_all_trusted
0000s0sMail::SpamAssassin::Plugin::RelayEval::::check_for_forged_received_ip_heloMail::SpamAssassin::Plugin::RelayEval::check_for_forged_received_ip_helo
0000s0sMail::SpamAssassin::Plugin::RelayEval::::check_for_forged_received_trailMail::SpamAssassin::Plugin::RelayEval::check_for_forged_received_trail
0000s0sMail::SpamAssassin::Plugin::RelayEval::::check_for_from_domain_in_received_headersMail::SpamAssassin::Plugin::RelayEval::check_for_from_domain_in_received_headers
0000s0sMail::SpamAssassin::Plugin::RelayEval::::check_for_illegal_ipMail::SpamAssassin::Plugin::RelayEval::check_for_illegal_ip
0000s0sMail::SpamAssassin::Plugin::RelayEval::::check_for_no_rdns_dotcom_heloMail::SpamAssassin::Plugin::RelayEval::check_for_no_rdns_dotcom_helo
0000s0sMail::SpamAssassin::Plugin::RelayEval::::check_for_numeric_heloMail::SpamAssassin::Plugin::RelayEval::check_for_numeric_helo
0000s0sMail::SpamAssassin::Plugin::RelayEval::::check_for_sender_no_reverseMail::SpamAssassin::Plugin::RelayEval::check_for_sender_no_reverse
0000s0sMail::SpamAssassin::Plugin::RelayEval::::check_no_relaysMail::SpamAssassin::Plugin::RelayEval::check_no_relays
0000s0sMail::SpamAssassin::Plugin::RelayEval::::check_relays_unparseableMail::SpamAssassin::Plugin::RelayEval::check_relays_unparseable
0000s0sMail::SpamAssassin::Plugin::RelayEval::::dbg2Mail::SpamAssassin::Plugin::RelayEval::dbg2
0000s0sMail::SpamAssassin::Plugin::RelayEval::::helo_ip_mismatchMail::SpamAssassin::Plugin::RelayEval::helo_ip_mismatch
0000s0sMail::SpamAssassin::Plugin::RelayEval::::hostname_to_domainMail::SpamAssassin::Plugin::RelayEval::hostname_to_domain
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
18package Mail::SpamAssassin::Plugin::RelayEval;
19
20271µs143µs
# spent 43µs within Mail::SpamAssassin::Plugin::RelayEval::BEGIN@20 which was called: # once (43µs+0s) by Mail::SpamAssassin::PluginHandler::load_plugin at line 20
use Mail::SpamAssassin::Plugin;
21288µs2452µs
# spent 238µs (23+214) within Mail::SpamAssassin::Plugin::RelayEval::BEGIN@21 which was called: # once (23µs+214µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 21
use Mail::SpamAssassin::Logger;
# spent 238µs making 1 call to Mail::SpamAssassin::Plugin::RelayEval::BEGIN@21 # spent 214µs making 1 call to Exporter::import
22270µs21.21ms
# spent 655µs (98+558) within Mail::SpamAssassin::Plugin::RelayEval::BEGIN@22 which was called: # once (98µs+558µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 22
use Mail::SpamAssassin::Constants qw(:ip);
# spent 655µs making 1 call to Mail::SpamAssassin::Plugin::RelayEval::BEGIN@22 # spent 558µs making 1 call to Exporter::import
23
24269µs245µs
# spent 34µs (22+11) within Mail::SpamAssassin::Plugin::RelayEval::BEGIN@24 which was called: # once (22µs+11µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 24
use strict;
# spent 34µs making 1 call to Mail::SpamAssassin::Plugin::RelayEval::BEGIN@24 # spent 11µs making 1 call to strict::import
25273µs288µs
# spent 55µs (22+33) within Mail::SpamAssassin::Plugin::RelayEval::BEGIN@25 which was called: # once (22µs+33µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 25
use warnings;
# spent 55µs making 1 call to Mail::SpamAssassin::Plugin::RelayEval::BEGIN@25 # spent 33µs making 1 call to warnings::import
26265µs242µs
# spent 35µs (29+7) within Mail::SpamAssassin::Plugin::RelayEval::BEGIN@26 which was called: # once (29µs+7µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 26
use bytes;
# spent 35µs making 1 call to Mail::SpamAssassin::Plugin::RelayEval::BEGIN@26 # spent 7µs making 1 call to bytes::import
27290µs2155µs
# spent 91µs (26+64) within Mail::SpamAssassin::Plugin::RelayEval::BEGIN@27 which was called: # once (26µs+64µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 27
use re 'taint';
# spent 91µs making 1 call to Mail::SpamAssassin::Plugin::RelayEval::BEGIN@27 # spent 64µs making 1 call to re::import
28
2924.24ms2174µs
# spent 100µs (27+74) within Mail::SpamAssassin::Plugin::RelayEval::BEGIN@29 which was called: # once (27µs+74µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 29
use vars qw(@ISA);
# spent 100µs making 1 call to Mail::SpamAssassin::Plugin::RelayEval::BEGIN@29 # spent 74µs making 1 call to vars::import
30114µs@ISA = qw(Mail::SpamAssassin::Plugin);
31
32# constructor: register the eval rule
33
# spent 512µs (191+321) within Mail::SpamAssassin::Plugin::RelayEval::new which was called: # once (191µs+321µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 1 of (eval 101)[Mail/SpamAssassin/PluginHandler.pm:129]
sub new {
3412µs my $class = shift;
3514µs my $mailsaobject = shift;
36
37 # some boilerplate...
3812µs $class = ref($class) || $class;
39111µs122µs my $self = $class->SUPER::new($mailsaobject);
# spent 22µs making 1 call to Mail::SpamAssassin::Plugin::new
4012µs bless ($self, $class);
41
42 # the important bit!
43111µs133µs $self->register_eval_rule("check_for_numeric_helo");
# spent 33µs making 1 call to Mail::SpamAssassin::Plugin::register_eval_rule
4416µs128µs $self->register_eval_rule("check_for_illegal_ip");
# spent 28µs making 1 call to Mail::SpamAssassin::Plugin::register_eval_rule
4516µs129µs $self->register_eval_rule("check_all_trusted");
# spent 29µs making 1 call to Mail::SpamAssassin::Plugin::register_eval_rule
4616µs131µs $self->register_eval_rule("check_no_relays");
# spent 31µs making 1 call to Mail::SpamAssassin::Plugin::register_eval_rule
4716µs118µs $self->register_eval_rule("check_relays_unparseable");
# spent 18µs making 1 call to Mail::SpamAssassin::Plugin::register_eval_rule
4816µs128µs $self->register_eval_rule("check_for_sender_no_reverse");
# spent 28µs making 1 call to Mail::SpamAssassin::Plugin::register_eval_rule
4916µs128µs $self->register_eval_rule("check_for_from_domain_in_received_headers");
# spent 28µs making 1 call to Mail::SpamAssassin::Plugin::register_eval_rule
5016µs126µs $self->register_eval_rule("check_for_forged_received_trail");
# spent 26µs making 1 call to Mail::SpamAssassin::Plugin::register_eval_rule
5116µs128µs $self->register_eval_rule("check_for_forged_received_ip_helo");
# spent 28µs making 1 call to Mail::SpamAssassin::Plugin::register_eval_rule
5216µs126µs $self->register_eval_rule("helo_ip_mismatch");
# spent 26µs making 1 call to Mail::SpamAssassin::Plugin::register_eval_rule
5316µs124µs $self->register_eval_rule("check_for_no_rdns_dotcom_helo");
# spent 24µs making 1 call to Mail::SpamAssassin::Plugin::register_eval_rule
54
55117µs return $self;
56}
57
58# tvd: why isn't this just RegistrarBoundaries ?
59sub hostname_to_domain {
60 my ($hostname) = @_;
61
62 if ($hostname !~ /[a-zA-Z]/) { return $hostname; } # IP address
63
64 my @parts = split(/\./, $hostname);
65 if (@parts > 1 && $parts[-1] =~ /(?:\S{3,}|ie|fr|de)/) {
66 return join('.', @parts[-2..-1]);
67 }
68 elsif (@parts > 2) {
69 return join('.', @parts[-3..-1]);
70 }
71 else {
72 return $hostname;
73 }
74}
75
76sub _helo_forgery_whitelisted {
77 my ($helo, $rdns) = @_;
78 if ($helo eq 'msn.com' && $rdns eq 'hotmail.com') { return 1; }
79 0;
80}
81
82sub check_for_numeric_helo {
83 my ($self, $pms) = @_;
84
85 my $rcvd = $pms->{relays_untrusted_str};
86
87 if ($rcvd) {
88 my $IP_ADDRESS = IPV4_ADDRESS;
89 my $IP_PRIVATE = IP_PRIVATE;
90 local $1;
91 # no re "strict"; # since perl 5.21.8: Ranges of ASCII printables...
92 if ($rcvd =~ /\bhelo=($IP_ADDRESS)(?=[\000-\040,;\[()<>]|\z)/i # Bug 5878
93 && $1 !~ /$IP_PRIVATE/) {
94 return 1;
95 }
96 }
97 return 0;
98}
99
100sub check_for_illegal_ip {
101 my ($self, $pms) = @_;
102 # Bug 6295, no longer in use, kept for compatibility with old rules
103 dbg('eval: the "check_for_illegal_ip" eval rule no longer available, '.
104 'please update your rules');
105 return 0;
106}
107
108# note using IPv4 addresses for now due to empty strings matching IP_ADDRESS
109# due to bug in pure IPv6 address regular expression
110sub helo_ip_mismatch {
111 my ($self, $pms) = @_;
112 my $IP_ADDRESS = IPV4_ADDRESS;
113 my $IP_PRIVATE = IP_PRIVATE;
114
115 for my $relay (@{$pms->{relays_untrusted}}) {
116 # is HELO usable?
117 next unless ($relay->{helo} =~ m/^$IP_ADDRESS$/ &&
118 $relay->{helo} !~ /$IP_PRIVATE/);
119 # compare HELO with IP
120 return 1 if ($relay->{ip} =~ m/^$IP_ADDRESS$/ &&
121 $relay->{ip} !~ m/$IP_PRIVATE/ &&
122 $relay->{helo} ne $relay->{ip} &&
123 # different IP is okay if in same /24
124 $relay->{helo} =~ /^(\d+\.\d+\.\d+\.)/ &&
125 index($relay->{ip}, $1) != 0);
126 }
127
128 0;
129}
130
131###########################################################################
132
133sub check_all_trusted {
134 my ($self, $pms) = @_;
135 return $pms->{num_relays_trusted}
136 && !$pms->{num_relays_untrusted}
137 && !$pms->{num_relays_unparseable};
138}
139
140sub check_no_relays {
141 my ($self, $pms) = @_;
142 return !$pms->{num_relays_trusted}
143 && !$pms->{num_relays_untrusted}
144 && !$pms->{num_relays_unparseable};
145}
146
147sub check_relays_unparseable {
148 my ($self, $pms) = @_;
149 return $pms->{num_relays_unparseable};
150}
151
152# Check if the apparent sender (in the last received header) had
153# no reverse lookup for it's IP
154#
155# Look for headers like:
156#
157# Received: from mx1.eudoramail.com ([204.32.147.84])
158sub check_for_sender_no_reverse {
159 my ($self, $pms) = @_;
160
161 # Sender received header is the last in the sequence
162 my $srcvd = $pms->{relays_untrusted}->
163 [$pms->{num_relays_untrusted} - 1];
164
165 return 0 unless (defined $srcvd);
166
167 # Ignore if the from host is domainless (has no dot)
168 return 0 unless ($srcvd->{rdns} =~ /\./);
169
170 # Ignore if the from host is from a private IP range
171 return 0 if ($srcvd->{ip_private});
172
173 return 1;
174} # check_for_sender_no_reverse()
175
176#Received: from dragnet.sjc.ebay.com (dragnet.sjc.ebay.com [10.6.21.14])
177# by bashir.ebay.com (8.10.2/8.10.2) with SMTP id g29JpwB10940
178# for <rod@begbie.com>; Sat, 9 Mar 2002 11:51:58 -0800
179
180sub check_for_from_domain_in_received_headers {
181 my ($self, $pms, $domain, $desired) = @_;
182
183 if (exists $pms->{from_domain_in_received}) {
184 if (exists $pms->{from_domain_in_received}->{$domain}) {
185 if ($desired eq 'true') {
186 # See use of '0e0' below for why we force int() here:
187 return int($pms->{from_domain_in_received}->{$domain});
188 }
189 else {
190 # And why we deliberately do NOT use integers here:
191 return !$pms->{from_domain_in_received}->{$domain};
192 }
193 }
194 } else {
195 $pms->{from_domain_in_received} = {};
196 }
197
198 my $from = $pms->get('From:addr');
199 if ($from !~ /\b\Q$domain\E/i) {
200 # '0e0' is Perl idiom for "true but zero":
201 $pms->{from_domain_in_received}->{$domain} = '0e0';
202 return 0;
203 }
204
205 my $rcvd = $pms->{relays_trusted_str}."\n".$pms->{relays_untrusted_str};
206
207 if ($rcvd =~ / rdns=\S*\b${domain} [^\]]*by=\S*\b${domain} /) {
208 $pms->{from_domain_in_received}->{$domain} = 1;
209 return ($desired eq 'true');
210 }
211
212 $pms->{from_domain_in_received}->{$domain} = 0;
213 return ($desired ne 'true');
214}
215
216sub check_for_no_rdns_dotcom_helo {
217 my ($self, $pms) = @_;
218 if (!exists $pms->{no_rdns_dotcom_helo}) { $self->_check_received_helos($pms); }
219 return $pms->{no_rdns_dotcom_helo};
220}
221
222# Bug 1133
223
224# Some spammers will, through HELO, tell the server that their machine
225# name *is* the relay; don't know why. An example:
226
227# from mail1.mailwizards.com (m448-mp1.cvx1-b.col.dial.ntli.net
228# [213.107.233.192])
229# by mail1.mailwizards.com
230
231# When this occurs for real, the from name and HELO name will be the
232# same, unless the "helo" name is localhost, or the from and by hostsnames
233# themselves are localhost
234sub _check_received_helos {
235 my ($self, $pms) = @_;
236
237 for (my $i = 0; $i < $pms->{num_relays_untrusted}; $i++) {
238 my $rcvd = $pms->{relays_untrusted}->[$i];
239
240 # Ignore where IP is in private IP space
241 next if ($rcvd->{ip_private});
242
243 my $from_host = $rcvd->{rdns};
244 my $helo_host = $rcvd->{helo};
245 my $by_host = $rcvd->{by};
246 my $no_rdns = $rcvd->{no_reverse_dns};
247
248 next unless defined($helo_host);
249
250 # Check for a faked dotcom HELO, e.g.
251 # Received: from mx02.hotmail.com (www.sucasita.com.mx [148.223.251.99])...
252 # this can be a stronger spamsign than the normal case, since the
253 # big dotcoms don't screw up their rDNS normally ;), so less FPs.
254 # Since spammers like sending out their mails from the dotcoms (esp.
255 # hotmail and AOL) this will catch those forgeries.
256 #
257 # allow stuff before the dot-com for both from-name and HELO-name,
258 # so HELO="outgoing.aol.com" and from="mx34853495.mx.aol.com" works OK.
259 #
260 $pms->{no_rdns_dotcom_helo} = 0;
261 if ($helo_host =~ /(?:\.|^)(lycos\.com|lycos\.co\.uk|hotmail\.com
262 |localhost\.com|excite\.com|caramail\.com
263 |cs\.com|aol\.com|msn\.com|yahoo\.com|drizzle\.com)$/ix)
264 {
265 my $dom = $1;
266
267 # ok, let's catch the case where there's *no* reverse DNS there either
268 if ($no_rdns) {
269 dbg2("eval: Received: no rDNS for dotcom HELO: from=$from_host HELO=$helo_host");
270 $pms->{no_rdns_dotcom_helo} = 1;
271 }
272 }
273 }
274} # _check_received_helos()
275
276# FORGED_RCVD_TRAIL
277sub check_for_forged_received_trail {
278 my ($self, $pms) = @_;
279 $self->_check_for_forged_received($pms) unless exists $pms->{mismatch_from};
280 return ($pms->{mismatch_from} > 1);
281}
282
283# FORGED_RCVD_IP_HELO
284sub check_for_forged_received_ip_helo {
285 my ($self, $pms) = @_;
286 $self->_check_for_forged_received($pms) unless exists $pms->{mismatch_ip_helo};
287 return ($pms->{mismatch_ip_helo} > 0);
288}
289
290sub _check_for_forged_received {
291 my ($self, $pms) = @_;
292
293 $pms->{mismatch_from} = 0;
294 $pms->{mismatch_ip_helo} = 0;
295
296 my $IP_PRIVATE = IP_PRIVATE;
297
298 my @fromip = map { $_->{ip} } @{$pms->{relays_untrusted}};
299 # just pick up domains for these
300 my @by = map {
301 hostname_to_domain ($_->{lc_by});
302 } @{$pms->{relays_untrusted}};
303 my @from = map {
304 hostname_to_domain ($_->{lc_rdns});
305 } @{$pms->{relays_untrusted}};
306 my @helo = map {
307 hostname_to_domain ($_->{lc_helo});
308 } @{$pms->{relays_untrusted}};
309
310 for (my $i = 0; $i < $pms->{num_relays_untrusted}; $i++) {
311 next if (!defined $by[$i] || $by[$i] !~ /^\w+(?:[\w.-]+\.)+\w+$/);
312
313 if (defined ($from[$i]) && defined($fromip[$i])) {
314 if ($from[$i] =~ /^localhost(?:\.localdomain)?$/) {
315 if ($fromip[$i] eq '127.0.0.1') {
316 # valid: bouncing around inside 1 machine, via the localhost
317 # interface (freshmeat newsletter does this). TODO: this
318 # may be obsolete, I think we do this in Received.pm anyway
319 $from[$i] = undef;
320 }
321 }
322 }
323
324 my $frm = $from[$i];
325 my $hlo = $helo[$i];
326 my $by = $by[$i];
327
328 dbg2("eval: forged-HELO: from=".(defined $frm ? $frm : "(undef)").
329 " helo=".(defined $hlo ? $hlo : "(undef)").
330 " by=".(defined $by ? $by : "(undef)"));
331
332 # note: this code won't catch IP-address HELOs, but we already have
333 # a separate rule for that anyway.
334
335 next unless ($by =~ /^\w+(?:[\w.-]+\.)+\w+$/);
336
337 my $fip = $fromip[$i];
338
339 if (defined($hlo) && defined($fip)) {
340 if ($hlo =~ /^\d+\.\d+\.\d+\.\d+$/
341 && $fip =~ /^\d+\.\d+\.\d+\.\d+$/
342 && $fip ne $hlo)
343 {
344 $hlo =~ /^(\d+\.\d+)\.\d+\.\d+$/; my $hclassb = $1;
345 $fip =~ /^(\d+\.\d+)\.\d+\.\d+$/; my $fclassb = $1;
346
347 # allow private IP addrs here, could be a legit screwup
348 if ($hclassb && $fclassb &&
349 $hclassb ne $fclassb &&
350 !($hlo =~ /$IP_PRIVATE/o))
351 {
352 dbg2("eval: forged-HELO: massive mismatch on IP-addr HELO: '$hlo' != '$fip'");
353 $pms->{mismatch_ip_helo}++;
354 }
355 }
356 }
357
358 my $prev = $from[$i-1];
359 if (defined($prev) && $i > 0
360 && $prev =~ /^\w+(?:[\w.-]+\.)+\w+$/
361 && $by ne $prev && !_helo_forgery_whitelisted($by, $prev))
362 {
363 dbg2("eval: forged-HELO: mismatch on from: '$prev' != '$by'");
364 $pms->{mismatch_from}++;
365 }
366 }
367}
368
369###########################################################################
370
371# support eval-test verbose debugs using "-Deval"
372sub dbg2 {
373 if (would_log('dbg', 'eval') == 2) {
374 dbg(@_);
375 }
376}
377
37819µs1;