Filename | /usr/local/lib/perl5/site_perl/Mail/SpamAssassin/Plugin/FreeMail.pm |
Statements | Executed 12958 statements in 125ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
501 | 1 | 1 | 96.2ms | 117ms | parse_config | Mail::SpamAssassin::Plugin::FreeMail::
5138 | 2 | 1 | 17.9ms | 17.9ms | CORE:match (opcode) | Mail::SpamAssassin::Plugin::FreeMail::
2 | 2 | 1 | 3.25ms | 3.25ms | CORE:regcomp (opcode) | Mail::SpamAssassin::Plugin::FreeMail::
1 | 1 | 1 | 960µs | 2.01ms | finish_parsing_end | Mail::SpamAssassin::Plugin::FreeMail::
93 | 3 | 1 | 385µs | 385µs | CORE:subst (opcode) | Mail::SpamAssassin::Plugin::FreeMail::
1 | 1 | 1 | 129µs | 3.12ms | new | Mail::SpamAssassin::Plugin::FreeMail::
1 | 1 | 1 | 56µs | 66µs | BEGIN@2 | Mail::SpamAssassin::Plugin::FreeMail::
1 | 1 | 1 | 42µs | 243µs | set_config | Mail::SpamAssassin::Plugin::FreeMail::
4 | 4 | 1 | 28µs | 28µs | CORE:qr (opcode) | Mail::SpamAssassin::Plugin::FreeMail::
1 | 1 | 1 | 25µs | 174µs | BEGIN@114 | Mail::SpamAssassin::Plugin::FreeMail::
1 | 1 | 1 | 24µs | 54µs | BEGIN@3 | Mail::SpamAssassin::Plugin::FreeMail::
1 | 1 | 1 | 24µs | 37µs | dbg | Mail::SpamAssassin::Plugin::FreeMail::
1 | 1 | 1 | 22µs | 22µs | BEGIN@112 | Mail::SpamAssassin::Plugin::FreeMail::
1 | 1 | 1 | 13µs | 13µs | BEGIN@111 | Mail::SpamAssassin::Plugin::FreeMail::
0 | 0 | 0 | 0s | 0s | _got_hit | Mail::SpamAssassin::Plugin::FreeMail::
0 | 0 | 0 | 0s | 0s | _is_freemail | Mail::SpamAssassin::Plugin::FreeMail::
0 | 0 | 0 | 0s | 0s | _parse_body | Mail::SpamAssassin::Plugin::FreeMail::
0 | 0 | 0 | 0s | 0s | check_freemail_body | Mail::SpamAssassin::Plugin::FreeMail::
0 | 0 | 0 | 0s | 0s | check_freemail_from | Mail::SpamAssassin::Plugin::FreeMail::
0 | 0 | 0 | 0s | 0s | check_freemail_header | Mail::SpamAssassin::Plugin::FreeMail::
0 | 0 | 0 | 0s | 0s | check_freemail_replyto | Mail::SpamAssassin::Plugin::FreeMail::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Mail::SpamAssassin::Plugin::FreeMail; | ||||
2 | 2 | 62µs | 2 | 76µs | # spent 66µs (56+10) within Mail::SpamAssassin::Plugin::FreeMail::BEGIN@2 which was called:
# once (56µs+10µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 2 # spent 66µs making 1 call to Mail::SpamAssassin::Plugin::FreeMail::BEGIN@2
# spent 10µs making 1 call to strict::import |
3 | 2 | 239µs | 2 | 83µs | # spent 54µs (24+30) within Mail::SpamAssassin::Plugin::FreeMail::BEGIN@3 which was called:
# once (24µs+30µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 3 # spent 54µs making 1 call to Mail::SpamAssassin::Plugin::FreeMail::BEGIN@3
# spent 30µs making 1 call to warnings::import |
4 | 1 | 2µs | my $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 | |||||
111 | 2 | 58µs | 1 | 13µs | # spent 13µs within Mail::SpamAssassin::Plugin::FreeMail::BEGIN@111 which was called:
# once (13µs+0s) by Mail::SpamAssassin::PluginHandler::load_plugin at line 111 # spent 13µs making 1 call to Mail::SpamAssassin::Plugin::FreeMail::BEGIN@111 |
112 | 2 | 70µs | 1 | 22µs | # spent 22µs within Mail::SpamAssassin::Plugin::FreeMail::BEGIN@112 which was called:
# once (22µs+0s) by Mail::SpamAssassin::PluginHandler::load_plugin at line 112 # spent 22µs making 1 call to Mail::SpamAssassin::Plugin::FreeMail::BEGIN@112 |
113 | |||||
114 | 2 | 5.49ms | 2 | 322µs | # spent 174µs (25+148) within Mail::SpamAssassin::Plugin::FreeMail::BEGIN@114 which was called:
# once (25µs+148µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 114 # spent 174µs making 1 call to Mail::SpamAssassin::Plugin::FreeMail::BEGIN@114
# spent 148µs making 1 call to vars::import |
115 | 1 | 17µs | @ISA = qw(Mail::SpamAssassin::Plugin); | ||
116 | |||||
117 | # default email whitelist | ||||
118 | 1 | 28µs | 1 | 9µs | $email_whitelist = qr/ # spent 9µ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... | ||||
133 | 2 | 16µs | 1 | 4µ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 | |||||
145 | 1 | 22µs | 1 | 12µs | # spent 37µs (24+12) within Mail::SpamAssassin::Plugin::FreeMail::dbg which was called:
# once (24µs+12µs) by Mail::SpamAssassin::Plugin::FreeMail::finish_parsing_end at line 275 # spent 12µs making 1 call to Mail::SpamAssassin::Logger::dbg |
146 | |||||
147 | # spent 3.12ms (129µs+2.99) within Mail::SpamAssassin::Plugin::FreeMail::new which was called:
# once (129µs+2.99ms) by Mail::SpamAssassin::PluginHandler::load_plugin at line 1 of (eval 111)[Mail/SpamAssassin/PluginHandler.pm:129] | ||||
148 | 1 | 3µs | my ($class, $mailsa) = @_; | ||
149 | |||||
150 | 1 | 2µs | $class = ref($class) || $class; | ||
151 | 1 | 11µs | 1 | 22µs | my $self = $class->SUPER::new($mailsa); # spent 22µs making 1 call to Mail::SpamAssassin::Plugin::new |
152 | 1 | 2µs | bless ($self, $class); | ||
153 | |||||
154 | 1 | 8µs | $self->{freemail_available} = 1; | ||
155 | 1 | 8µs | 1 | 243µs | $self->set_config($mailsa->{conf}); # spent 243µs making 1 call to Mail::SpamAssassin::Plugin::FreeMail::set_config |
156 | 1 | 11µs | 1 | 27µs | $self->register_eval_rule("check_freemail_replyto"); # spent 27µs making 1 call to Mail::SpamAssassin::Plugin::register_eval_rule |
157 | 1 | 6µs | 1 | 20µs | $self->register_eval_rule("check_freemail_from"); # spent 20µs making 1 call to Mail::SpamAssassin::Plugin::register_eval_rule |
158 | 1 | 6µs | 1 | 24µs | $self->register_eval_rule("check_freemail_header"); # spent 24µs making 1 call to Mail::SpamAssassin::Plugin::register_eval_rule |
159 | 1 | 6µs | 1 | 18µs | $self->register_eval_rule("check_freemail_body"); # spent 18µ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 | ||||
164 | 1 | 2.67ms | 2 | 2.64ms | $self->{email_regex} = qr/ # spent 2.63ms making 1 call to Mail::SpamAssassin::Plugin::FreeMail::CORE:regcomp
# spent 6µ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 | |||||
177 | 1 | 12µs | return $self; | ||
178 | } | ||||
179 | |||||
180 | # spent 243µs (42+201) within Mail::SpamAssassin::Plugin::FreeMail::set_config which was called:
# once (42µs+201µs) by Mail::SpamAssassin::Plugin::FreeMail::new at line 155 | ||||
181 | 1 | 2µs | my ($self, $conf) = @_; | ||
182 | 1 | 2µs | my @cmds; | ||
183 | 1 | 7µs | push(@cmds, { | ||
184 | setting => 'freemail_max_body_emails', | ||||
185 | default => 5, | ||||
186 | type => $Mail::SpamAssassin::Conf::CONF_TYPE_NUMERIC, | ||||
187 | } | ||||
188 | ); | ||||
189 | 1 | 3µs | push(@cmds, { | ||
190 | setting => 'freemail_max_body_freemails', | ||||
191 | default => 3, | ||||
192 | type => $Mail::SpamAssassin::Conf::CONF_TYPE_NUMERIC, | ||||
193 | } | ||||
194 | ); | ||||
195 | 1 | 3µs | push(@cmds, { | ||
196 | setting => 'freemail_skip_when_over_max', | ||||
197 | default => 1, | ||||
198 | type => $Mail::SpamAssassin::Conf::CONF_TYPE_NUMERIC, | ||||
199 | } | ||||
200 | ); | ||||
201 | 1 | 3µs | push(@cmds, { | ||
202 | setting => 'freemail_skip_bulk_envfrom', | ||||
203 | default => 1, | ||||
204 | type => $Mail::SpamAssassin::Conf::CONF_TYPE_NUMERIC, | ||||
205 | } | ||||
206 | ); | ||||
207 | 1 | 4µs | push(@cmds, { | ||
208 | setting => 'freemail_add_describe_email', | ||||
209 | default => 1, | ||||
210 | type => $Mail::SpamAssassin::Conf::CONF_TYPE_NUMERIC, | ||||
211 | } | ||||
212 | ); | ||||
213 | 1 | 19µs | 1 | 201µs | $conf->{parser}->register_commands(\@cmds); # spent 201µs making 1 call to Mail::SpamAssassin::Conf::Parser::register_commands |
214 | } | ||||
215 | |||||
216 | # spent 117ms (96.2+21.0) within Mail::SpamAssassin::Plugin::FreeMail::parse_config which was called 501 times, avg 234µs/call:
# 501 times (96.2ms+21.0ms) by Mail::SpamAssassin::PluginHandler::callback at line 204 of Mail/SpamAssassin/PluginHandler.pm, avg 234µs/call | ||||
217 | 501 | 827µs | my ($self, $opts) = @_; | ||
218 | |||||
219 | 501 | 1.08ms | if ($opts->{key} eq "freemail_domains") { | ||
220 | 501 | 7.07ms | foreach my $temp (split(/\s+/, $opts->{value})) { | ||
221 | 2569 | 36.1ms | 2569 | 11.8ms | if ($temp =~ /^[a-z0-9.*?-]+$/i) { # spent 11.8ms making 2569 calls to Mail::SpamAssassin::Plugin::FreeMail::CORE:match, avg 5µs/call |
222 | 2569 | 7.00ms | my $value = lc($temp); | ||
223 | 2569 | 43.8ms | 2569 | 6.00ms | if ($value =~ /[*?]/) { # separate wildcard list # spent 6.00ms making 2569 calls to Mail::SpamAssassin::Plugin::FreeMail::CORE:match, avg 2µs/call |
224 | 31 | 162µs | $self->{freemail_temp_wc}{$value} = 1; | ||
225 | } | ||||
226 | else { | ||||
227 | 2538 | 11.4ms | $self->{freemail_domains}{$value} = 1; | ||
228 | } | ||||
229 | } | ||||
230 | else { | ||||
231 | warn("invalid freemail_domains: $temp"); | ||||
232 | } | ||||
233 | } | ||||
234 | 501 | 3.08ms | 501 | 3.17ms | $self->inhibit_further_callbacks(); # spent 3.17ms making 501 calls to Mail::SpamAssassin::Plugin::inhibit_further_callbacks, avg 6µs/call |
235 | 501 | 3.37ms | 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.01ms (960µs+1.05) within Mail::SpamAssassin::Plugin::FreeMail::finish_parsing_end which was called:
# once (960µs+1.05ms) by Mail::SpamAssassin::PluginHandler::callback at line 204 of Mail/SpamAssassin/PluginHandler.pm | ||||
256 | 1 | 2µs | my ($self, $opts) = @_; | ||
257 | |||||
258 | 1 | 3µs | my $wcount = 0; | ||
259 | 1 | 6µs | if (defined $self->{freemail_temp_wc}) { | ||
260 | 1 | 2µs | my @domains; | ||
261 | 2 | 36µs | foreach my $value (keys %{$self->{freemail_temp_wc}}) { | ||
262 | 31 | 417µs | 31 | 202µs | $value =~ s/\./\\./g; # spent 202µs making 31 calls to Mail::SpamAssassin::Plugin::FreeMail::CORE:subst, avg 7µs/call |
263 | 31 | 240µs | 31 | 60µs | $value =~ s/\?/./g; # spent 60µs making 31 calls to Mail::SpamAssassin::Plugin::FreeMail::CORE:subst, avg 2µs/call |
264 | 31 | 330µs | 31 | 123µs | $value =~ s/\*/[^.]*/g; # spent 123µs making 31 calls to Mail::SpamAssassin::Plugin::FreeMail::CORE:subst, avg 4µs/call |
265 | 31 | 171µs | push(@domains, $value); | ||
266 | } | ||||
267 | 1 | 10µs | my $doms = join('|', @domains); | ||
268 | 1 | 662µs | 2 | 626µs | $self->{freemail_domains_re} = qr/\@(?:${doms})$/; # spent 616µs making 1 call to Mail::SpamAssassin::Plugin::FreeMail::CORE:regcomp
# spent 10µs making 1 call to Mail::SpamAssassin::Plugin::FreeMail::CORE:qr |
269 | 1 | 3µs | $wcount = scalar @domains; | ||
270 | 2 | 47µs | undef %{$self->{freemail_temp_wc}}; | ||
271 | } | ||||
272 | |||||
273 | 2 | 8µs | my $count = scalar keys %{$self->{freemail_domains}}; | ||
274 | 1 | 5µs | if ($count + $wcount) { | ||
275 | 1 | 18µs | 1 | 37µs | dbg("loaded freemail_domains entries: $count normal, $wcount wildcard"); # spent 37µ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 | |||||
287 | 1 | 12µs | return 0; | ||
288 | } | ||||
289 | |||||
290 | sub _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 | |||||
320 | sub _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 | |||||
388 | sub _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 | |||||
406 | sub 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 | |||||
451 | sub 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 | |||||
489 | sub 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 | |||||
532 | sub 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 | |||||
609 | 1 | 14µs | 1; | ||
# spent 17.9ms within Mail::SpamAssassin::Plugin::FreeMail::CORE:match which was called 5138 times, avg 3µs/call:
# 2569 times (11.8ms+0s) by Mail::SpamAssassin::Plugin::FreeMail::parse_config at line 221, avg 5µs/call
# 2569 times (6.00ms+0s) by Mail::SpamAssassin::Plugin::FreeMail::parse_config at line 223, avg 2µs/call | |||||
# spent 28µs within Mail::SpamAssassin::Plugin::FreeMail::CORE:qr which was called 4 times, avg 7µs/call:
# once (10µs+0s) by Mail::SpamAssassin::Plugin::FreeMail::finish_parsing_end at line 268
# once (9µs+0s) by Mail::SpamAssassin::PluginHandler::load_plugin at line 118
# once (6µ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:regcomp; # opcode | |||||
# spent 385µs within Mail::SpamAssassin::Plugin::FreeMail::CORE:subst which was called 93 times, avg 4µs/call:
# 31 times (202µs+0s) by Mail::SpamAssassin::Plugin::FreeMail::finish_parsing_end at line 262, avg 7µs/call
# 31 times (123µs+0s) by Mail::SpamAssassin::Plugin::FreeMail::finish_parsing_end at line 264, avg 4µs/call
# 31 times (60µs+0s) by Mail::SpamAssassin::Plugin::FreeMail::finish_parsing_end at line 263, avg 2µs/call |