Filename | /usr/local/lib/perl5/site_perl/Mail/SpamAssassin/Plugin/SpamCop.pm |
Statements | Executed 40 statements in 3.81ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 50.4ms | 143ms | BEGIN@53 | Mail::SpamAssassin::Plugin::SpamCop::
1 | 1 | 1 | 86µs | 333µs | new | Mail::SpamAssassin::Plugin::SpamCop::
1 | 1 | 1 | 48µs | 212µs | set_config | Mail::SpamAssassin::Plugin::SpamCop::
1 | 1 | 1 | 36µs | 232µs | BEGIN@52 | Mail::SpamAssassin::Plugin::SpamCop::
1 | 1 | 1 | 35µs | 35µs | BEGIN@44 | Mail::SpamAssassin::Plugin::SpamCop::
1 | 1 | 1 | 31µs | 231µs | BEGIN@45 | Mail::SpamAssassin::Plugin::SpamCop::
1 | 1 | 1 | 29µs | 6.15ms | BEGIN@46 | Mail::SpamAssassin::Plugin::SpamCop::
1 | 1 | 1 | 28µs | 42µs | BEGIN@47 | Mail::SpamAssassin::Plugin::SpamCop::
1 | 1 | 1 | 28µs | 34µs | BEGIN@49 | Mail::SpamAssassin::Plugin::SpamCop::
1 | 1 | 1 | 26µs | 100µs | BEGIN@55 | Mail::SpamAssassin::Plugin::SpamCop::
1 | 1 | 1 | 23µs | 60µs | BEGIN@48 | Mail::SpamAssassin::Plugin::SpamCop::
1 | 1 | 1 | 22µs | 88µs | BEGIN@50 | Mail::SpamAssassin::Plugin::SpamCop::
0 | 0 | 0 | 0s | 0s | __ANON__[:112] | Mail::SpamAssassin::Plugin::SpamCop::
0 | 0 | 0 | 0s | 0s | __ANON__[:140] | Mail::SpamAssassin::Plugin::SpamCop::
0 | 0 | 0 | 0s | 0s | plugin_report | Mail::SpamAssassin::Plugin::SpamCop::
0 | 0 | 0 | 0s | 0s | smtp_dbg | Mail::SpamAssassin::Plugin::SpamCop::
0 | 0 | 0 | 0s | 0s | spamcop_report | Mail::SpamAssassin::Plugin::SpamCop::
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 | |||||
20 | Mail::SpamAssassin::Plugin::SpamCop - perform SpamCop reporting of messages | ||||
21 | |||||
22 | =head1 SYNOPSIS | ||||
23 | |||||
24 | loadplugin Mail::SpamAssassin::Plugin::SpamCop | ||||
25 | |||||
26 | =head1 DESCRIPTION | ||||
27 | |||||
28 | SpamCop is a service for reporting spam. SpamCop determines the origin | ||||
29 | of unwanted email and reports it to the relevant Internet service | ||||
30 | providers. By reporting spam, you have a positive impact on the | ||||
31 | problem. Reporting unsolicited email also helps feed spam filtering | ||||
32 | systems, including, but not limited to, the SpamCop blacklist used in | ||||
33 | SpamAssassin as a DNSBL. | ||||
34 | |||||
35 | Note that spam reports sent by this plugin to SpamCop each include the | ||||
36 | entire spam message. | ||||
37 | |||||
38 | See http://www.spamcop.net/ for more information about SpamCop. | ||||
39 | |||||
40 | =cut | ||||
41 | |||||
42 | package Mail::SpamAssassin::Plugin::SpamCop; | ||||
43 | |||||
44 | 2 | 79µs | 1 | 35µs | # spent 35µs within Mail::SpamAssassin::Plugin::SpamCop::BEGIN@44 which was called:
# once (35µs+0s) by Mail::SpamAssassin::PluginHandler::load_plugin at line 44 # spent 35µs making 1 call to Mail::SpamAssassin::Plugin::SpamCop::BEGIN@44 |
45 | 2 | 82µs | 2 | 430µs | # spent 231µs (31+200) within Mail::SpamAssassin::Plugin::SpamCop::BEGIN@45 which was called:
# once (31µs+200µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 45 # spent 231µs making 1 call to Mail::SpamAssassin::Plugin::SpamCop::BEGIN@45
# spent 200µs making 1 call to Exporter::import |
46 | 2 | 114µs | 2 | 12.3ms | # spent 6.15ms (29µs+6.12) within Mail::SpamAssassin::Plugin::SpamCop::BEGIN@46 which was called:
# once (29µs+6.12ms) by Mail::SpamAssassin::PluginHandler::load_plugin at line 46 # spent 6.15ms making 1 call to Mail::SpamAssassin::Plugin::SpamCop::BEGIN@46
# spent 6.12ms making 1 call to IO::Socket::import |
47 | 2 | 75µs | 2 | 55µs | # spent 42µs (28+13) within Mail::SpamAssassin::Plugin::SpamCop::BEGIN@47 which was called:
# once (28µs+13µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 47 # spent 42µs making 1 call to Mail::SpamAssassin::Plugin::SpamCop::BEGIN@47
# spent 13µs making 1 call to strict::import |
48 | 2 | 73µs | 2 | 96µs | # spent 60µs (23+37) within Mail::SpamAssassin::Plugin::SpamCop::BEGIN@48 which was called:
# once (23µs+37µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 48 # spent 60µs making 1 call to Mail::SpamAssassin::Plugin::SpamCop::BEGIN@48
# spent 37µs making 1 call to warnings::import |
49 | 2 | 74µs | 2 | 41µs | # spent 34µs (28+7) within Mail::SpamAssassin::Plugin::SpamCop::BEGIN@49 which was called:
# once (28µs+7µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 49 # spent 34µs making 1 call to Mail::SpamAssassin::Plugin::SpamCop::BEGIN@49
# spent 7µs making 1 call to bytes::import |
50 | 2 | 90µs | 2 | 154µs | # spent 88µs (22+66) within Mail::SpamAssassin::Plugin::SpamCop::BEGIN@50 which was called:
# once (22µs+66µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 50 # spent 88µs making 1 call to Mail::SpamAssassin::Plugin::SpamCop::BEGIN@50
# spent 66µs making 1 call to re::import |
51 | |||||
52 | 3 | 108µs | 2 | 428µs | # spent 232µs (36+196) within Mail::SpamAssassin::Plugin::SpamCop::BEGIN@52 which was called:
# once (36µs+196µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 52 # spent 232µs making 1 call to Mail::SpamAssassin::Plugin::SpamCop::BEGIN@52
# spent 196µs making 1 call to constant::import |
53 | 3 | 415µs | 2 | 143ms | # spent 143ms (50.4+92.6) within Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 which was called:
# once (50.4ms+92.6ms) by Mail::SpamAssassin::PluginHandler::load_plugin at line 53 # spent 143ms making 1 call to Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53
# spent 187µs making 1 call to constant::import |
54 | |||||
55 | 2 | 2.54ms | 2 | 174µs | # spent 100µs (26+74) within Mail::SpamAssassin::Plugin::SpamCop::BEGIN@55 which was called:
# once (26µs+74µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 55 # spent 100µs making 1 call to Mail::SpamAssassin::Plugin::SpamCop::BEGIN@55
# spent 74µs making 1 call to vars::import |
56 | 1 | 16µs | @ISA = qw(Mail::SpamAssassin::Plugin); | ||
57 | |||||
58 | # spent 333µs (86+247) within Mail::SpamAssassin::Plugin::SpamCop::new which was called:
# once (86µs+247µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 1 of (eval 71)[Mail/SpamAssassin/PluginHandler.pm:129] | ||||
59 | 1 | 3µs | my $class = shift; | ||
60 | 1 | 2µs | my $mailsaobject = shift; | ||
61 | |||||
62 | 1 | 2µs | $class = ref($class) || $class; | ||
63 | 1 | 12µs | 1 | 24µs | my $self = $class->SUPER::new($mailsaobject); # spent 24µs making 1 call to Mail::SpamAssassin::Plugin::new |
64 | 1 | 2µs | bless ($self, $class); | ||
65 | |||||
66 | # are network tests enabled? | ||||
67 | 1 | 11µs | if (!$mailsaobject->{local_tests_only} && HAS_NET_DNS && HAS_NET_SMTP) { | ||
68 | 1 | 8µs | $self->{spamcop_available} = 1; | ||
69 | 1 | 11µs | 1 | 10µs | dbg("reporter: network tests on, attempting SpamCop"); # spent 10µs making 1 call to Mail::SpamAssassin::Logger::dbg |
70 | } | ||||
71 | else { | ||||
72 | $self->{spamcop_available} = 0; | ||||
73 | dbg("reporter: local tests only, disabling SpamCop"); | ||||
74 | } | ||||
75 | |||||
76 | 1 | 11µs | 1 | 212µs | $self->set_config($mailsaobject->{conf}); # spent 212µs making 1 call to Mail::SpamAssassin::Plugin::SpamCop::set_config |
77 | |||||
78 | 1 | 14µs | return $self; | ||
79 | } | ||||
80 | |||||
81 | # spent 212µs (48+164) within Mail::SpamAssassin::Plugin::SpamCop::set_config which was called:
# once (48µs+164µs) by Mail::SpamAssassin::Plugin::SpamCop::new at line 76 | ||||
82 | 1 | 2µs | my($self, $conf) = @_; | ||
83 | 1 | 2µs | my @cmds; | ||
84 | |||||
85 | =head1 USER OPTIONS | ||||
86 | |||||
87 | =over 4 | ||||
88 | |||||
89 | =item spamcop_from_address user@example.com (default: none) | ||||
90 | |||||
91 | This address is used during manual reports to SpamCop as the From: | ||||
92 | address. You can use your normal email address. If this is not set, a | ||||
93 | guess will be used as the From: address in SpamCop reports. | ||||
94 | |||||
95 | =cut | ||||
96 | |||||
97 | push (@cmds, { | ||||
98 | setting => 'spamcop_from_address', | ||||
99 | default => '', | ||||
100 | type => $Mail::SpamAssassin::Conf::CONF_TYPE_STRING, | ||||
101 | code => sub { | ||||
102 | my ($self, $key, $value, $line) = @_; | ||||
103 | if ($value =~ /([^<\s]+\@[^>\s]+)/) { | ||||
104 | $self->{spamcop_from_address} = $1; | ||||
105 | } | ||||
106 | elsif ($value =~ /^$/) { | ||||
107 | return $Mail::SpamAssassin::Conf::MISSING_REQUIRED_VALUE; | ||||
108 | } | ||||
109 | else { | ||||
110 | return $Mail::SpamAssassin::Conf::INVALID_VALUE; | ||||
111 | } | ||||
112 | }, | ||||
113 | 1 | 14µs | }); | ||
114 | |||||
115 | =item spamcop_to_address user@example.com (default: generic reporting address) | ||||
116 | |||||
117 | Your customized SpamCop report submission address. You need to obtain | ||||
118 | this address by registering at C<http://www.spamcop.net/>. If this is | ||||
119 | not set, SpamCop reports will go to a generic reporting address for | ||||
120 | SpamAssassin users and your reports will probably have less weight in | ||||
121 | the SpamCop system. | ||||
122 | |||||
123 | =cut | ||||
124 | |||||
125 | push (@cmds, { | ||||
126 | setting => 'spamcop_to_address', | ||||
127 | default => 'spamassassin-submit@spam.spamcop.net', | ||||
128 | type => $Mail::SpamAssassin::Conf::CONF_TYPE_STRING, | ||||
129 | code => sub { | ||||
130 | my ($self, $key, $value, $line) = @_; | ||||
131 | if ($value =~ /([^<\s]+\@[^>\s]+)/) { | ||||
132 | $self->{spamcop_to_address} = $1; | ||||
133 | } | ||||
134 | elsif ($value =~ /^$/) { | ||||
135 | return $Mail::SpamAssassin::Conf::MISSING_REQUIRED_VALUE; | ||||
136 | } | ||||
137 | else { | ||||
138 | return $Mail::SpamAssassin::Conf::INVALID_VALUE; | ||||
139 | } | ||||
140 | }, | ||||
141 | 1 | 7µs | }); | ||
142 | |||||
143 | =item spamcop_max_report_size (default: 50) | ||||
144 | |||||
145 | Messages larger than this size (in kilobytes) will be truncated in | ||||
146 | report messages sent to SpamCop. The default setting is the maximum | ||||
147 | size that SpamCop will accept at the time of release. | ||||
148 | |||||
149 | =cut | ||||
150 | |||||
151 | 1 | 6µs | push (@cmds, { | ||
152 | setting => 'spamcop_max_report_size', | ||||
153 | default => 50, | ||||
154 | type => $Mail::SpamAssassin::Conf::CONF_TYPE_NUMERIC | ||||
155 | }); | ||||
156 | |||||
157 | 1 | 20µs | 1 | 164µs | $conf->{parser}->register_commands(\@cmds); # spent 164µs making 1 call to Mail::SpamAssassin::Conf::Parser::register_commands |
158 | } | ||||
159 | |||||
160 | sub plugin_report { | ||||
161 | my ($self, $options) = @_; | ||||
162 | |||||
163 | return unless $self->{spamcop_available}; | ||||
164 | |||||
165 | if (!$options->{report}->{options}->{dont_report_to_spamcop}) { | ||||
166 | if ($self->spamcop_report($options)) { | ||||
167 | $options->{report}->{report_available} = 1; | ||||
168 | info("reporter: spam reported to SpamCop"); | ||||
169 | $options->{report}->{report_return} = 1; | ||||
170 | } | ||||
171 | else { | ||||
172 | info("reporter: could not report spam to SpamCop"); | ||||
173 | } | ||||
174 | } | ||||
175 | } | ||||
176 | |||||
177 | sub smtp_dbg { | ||||
178 | my ($command, $smtp) = @_; | ||||
179 | |||||
180 | dbg("reporter: SpamCop sent $command"); | ||||
181 | my $code = $smtp->code(); | ||||
182 | my $message = $smtp->message(); | ||||
183 | my $debug; | ||||
184 | $debug .= $code if $code; | ||||
185 | $debug .= ($code ? " " : "") . $message if $message; | ||||
186 | chomp $debug; | ||||
187 | dbg("reporter: SpamCop received $debug"); | ||||
188 | return 1; | ||||
189 | } | ||||
190 | |||||
191 | sub spamcop_report { | ||||
192 | my ($self, $options) = @_; | ||||
193 | |||||
194 | # original text | ||||
195 | my $original = ${$options->{text}}; | ||||
196 | |||||
197 | # check date | ||||
198 | my $header = $original; | ||||
199 | $header =~ s/\r?\n\r?\n.*//s; | ||||
200 | my $date = Mail::SpamAssassin::Util::receive_date($header); | ||||
201 | if ($date && $date < time - 2*86400) { | ||||
202 | warn("reporter: SpamCop message older than 2 days, not reporting\n"); | ||||
203 | return 0; | ||||
204 | } | ||||
205 | |||||
206 | # message variables | ||||
207 | my $boundary = "----------=_" . sprintf("%08X.%08X",time,int(rand(2**32))); | ||||
208 | while ($original =~ /^\Q${boundary}\E$/m) { | ||||
209 | $boundary .= "/".sprintf("%08X",int(rand(2**32))); | ||||
210 | } | ||||
211 | my $description = "spam report via " . Mail::SpamAssassin::Version(); | ||||
212 | my $trusted = $options->{msg}->{metadata}->{relays_trusted_str}; | ||||
213 | my $untrusted = $options->{msg}->{metadata}->{relays_untrusted_str}; | ||||
214 | my $user = $options->{report}->{main}->{'username'} || 'unknown'; | ||||
215 | my $host = Mail::SpamAssassin::Util::fq_hostname() || 'unknown'; | ||||
216 | my $from = $options->{report}->{conf}->{spamcop_from_address} || "$user\@$host"; | ||||
217 | |||||
218 | # message data | ||||
219 | my %head = ( | ||||
220 | 'To' => $options->{report}->{conf}->{spamcop_to_address}, | ||||
221 | 'From' => $from, | ||||
222 | 'Subject' => 'report spam', | ||||
223 | 'Date' => Mail::SpamAssassin::Util::time_to_rfc822_date(), | ||||
224 | 'Message-Id' => | ||||
225 | sprintf("<%08X.%08X@%s>",time,int(rand(2**32)),$host), | ||||
226 | 'MIME-Version' => '1.0', | ||||
227 | 'Content-Type' => "multipart/mixed; boundary=\"$boundary\"", | ||||
228 | ); | ||||
229 | |||||
230 | # truncate message | ||||
231 | if (length($original) > $self->{main}->{conf}->{spamcop_max_report_size} * 1024) { | ||||
232 | substr($original, ($self->{main}->{conf}->{spamcop_max_report_size} * 1024)) = | ||||
233 | "\n[truncated by SpamAssassin]\n"; | ||||
234 | } | ||||
235 | |||||
236 | my $body = <<"EOM"; | ||||
237 | This is a multi-part message in MIME format. | ||||
238 | |||||
239 | --$boundary | ||||
240 | Content-Type: message/rfc822; x-spam-type=report | ||||
241 | Content-Description: $description | ||||
242 | Content-Disposition: attachment | ||||
243 | Content-Transfer-Encoding: 8bit | ||||
244 | X-Spam-Relays-Trusted: $trusted | ||||
245 | X-Spam-Relays-Untrusted: $untrusted | ||||
246 | |||||
247 | $original | ||||
248 | --$boundary-- | ||||
249 | |||||
250 | EOM | ||||
251 | |||||
252 | # compose message | ||||
253 | my $message; | ||||
254 | while (my ($k, $v) = each %head) { | ||||
255 | $message .= "$k: $v\n"; | ||||
256 | } | ||||
257 | $message .= "\n" . $body; | ||||
258 | |||||
259 | # send message | ||||
260 | my $failure; | ||||
261 | my $mx = $head{To}; | ||||
262 | my $hello = Mail::SpamAssassin::Util::fq_hostname() || $from; | ||||
263 | $mx =~ s/.*\@//; | ||||
264 | $hello =~ s/.*\@//; | ||||
265 | for my $rr (Net::DNS::mx($mx)) { | ||||
266 | my $exchange = Mail::SpamAssassin::Util::untaint_hostname($rr->exchange); | ||||
267 | next unless $exchange; | ||||
268 | my $smtp; | ||||
269 | if ($smtp = Net::SMTP->new($exchange, | ||||
270 | Hello => $hello, | ||||
271 | Port => 587, | ||||
272 | Timeout => 10)) | ||||
273 | { | ||||
274 | if ($smtp->mail($from) && smtp_dbg("FROM $from", $smtp) && | ||||
275 | $smtp->recipient($head{To}) && smtp_dbg("TO $head{To}", $smtp) && | ||||
276 | $smtp->data($message) && smtp_dbg("DATA", $smtp) && | ||||
277 | $smtp->quit() && smtp_dbg("QUIT", $smtp)) | ||||
278 | { | ||||
279 | # tell user we succeeded after first attempt if we previously failed | ||||
280 | warn("reporter: SpamCop report to $exchange succeeded\n") if defined $failure; | ||||
281 | return 1; | ||||
282 | } | ||||
283 | my $code = $smtp->code(); | ||||
284 | my $text = $smtp->message(); | ||||
285 | $failure = "$code $text" if ($code && $text); | ||||
286 | } | ||||
287 | $failure ||= "Net::SMTP error"; | ||||
288 | chomp $failure; | ||||
289 | warn("reporter: SpamCop report to $exchange failed: $failure\n"); | ||||
290 | } | ||||
291 | |||||
292 | return 0; | ||||
293 | } | ||||
294 | |||||
295 | 1 | 14µs | 1; | ||
296 | |||||
297 | =back | ||||
298 | |||||
299 | =cut |