← Index
NYTProf Performance Profile   « line view »
For /usr/local/bin/sa-learn
  Run on Sun Nov 5 03:09:29 2017
Reported on Mon Nov 6 13:20:48 2017

Filename/usr/local/lib/perl5/site_perl/Mail/SpamAssassin/Plugin/Hashcash.pm
StatementsExecuted 49 statements in 3.75ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1116.56ms9.03msMail::SpamAssassin::Plugin::Hashcash::::BEGIN@108Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108
11173µs408µsMail::SpamAssassin::Plugin::Hashcash::::newMail::SpamAssassin::Plugin::Hashcash::new
11153µs66µsMail::SpamAssassin::Plugin::Hashcash::::BEGIN@86Mail::SpamAssassin::Plugin::Hashcash::BEGIN@86
11139µs248µsMail::SpamAssassin::Plugin::Hashcash::::set_configMail::SpamAssassin::Plugin::Hashcash::set_config
11129µs162µsMail::SpamAssassin::Plugin::Hashcash::::BEGIN@98Mail::SpamAssassin::Plugin::Hashcash::BEGIN@98
11128µs103µsMail::SpamAssassin::Plugin::Hashcash::::BEGIN@100Mail::SpamAssassin::Plugin::Hashcash::BEGIN@100
11125µs1.36msMail::SpamAssassin::Plugin::Hashcash::::BEGIN@96Mail::SpamAssassin::Plugin::Hashcash::BEGIN@96
11124µs126µsMail::SpamAssassin::Plugin::Hashcash::::BEGIN@97Mail::SpamAssassin::Plugin::Hashcash::BEGIN@97
11123µs193µsMail::SpamAssassin::Plugin::Hashcash::::BEGIN@92Mail::SpamAssassin::Plugin::Hashcash::BEGIN@92
11122µs62µsMail::SpamAssassin::Plugin::Hashcash::::BEGIN@87Mail::SpamAssassin::Plugin::Hashcash::BEGIN@87
11122µs113µsMail::SpamAssassin::Plugin::Hashcash::::BEGIN@95Mail::SpamAssassin::Plugin::Hashcash::BEGIN@95
11122µs29µsMail::SpamAssassin::Plugin::Hashcash::::BEGIN@88Mail::SpamAssassin::Plugin::Hashcash::BEGIN@88
11121µs98µsMail::SpamAssassin::Plugin::Hashcash::::BEGIN@105Mail::SpamAssassin::Plugin::Hashcash::BEGIN@105
11121µs113µsMail::SpamAssassin::Plugin::Hashcash::::BEGIN@93Mail::SpamAssassin::Plugin::Hashcash::BEGIN@93
11120µs88µsMail::SpamAssassin::Plugin::Hashcash::::BEGIN@89Mail::SpamAssassin::Plugin::Hashcash::BEGIN@89
11112µs12µsMail::SpamAssassin::Plugin::Hashcash::::BEGIN@91Mail::SpamAssassin::Plugin::Hashcash::BEGIN@91
0000s0sMail::SpamAssassin::Plugin::Hashcash::::_check_hashcash_resourceMail::SpamAssassin::Plugin::Hashcash::_check_hashcash_resource
0000s0sMail::SpamAssassin::Plugin::Hashcash::::_run_hashcashMail::SpamAssassin::Plugin::Hashcash::_run_hashcash
0000s0sMail::SpamAssassin::Plugin::Hashcash::::_run_hashcash_for_one_stringMail::SpamAssassin::Plugin::Hashcash::_run_hashcash_for_one_string
0000s0sMail::SpamAssassin::Plugin::Hashcash::::check_hashcash_double_spendMail::SpamAssassin::Plugin::Hashcash::check_hashcash_double_spend
0000s0sMail::SpamAssassin::Plugin::Hashcash::::check_hashcash_valueMail::SpamAssassin::Plugin::Hashcash::check_hashcash_value
0000s0sMail::SpamAssassin::Plugin::Hashcash::::was_hashcash_token_double_spentMail::SpamAssassin::Plugin::Hashcash::was_hashcash_token_double_spent
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1# <@LICENSE>
2# Licensed to the Apache Software Foundation (ASF) under one or more
3# contributor license agreements. See the NOTICE file distributed with
4# this work for additional information regarding copyright ownership.
5# The ASF licenses this file to you under the Apache License, Version 2.0
6# (the "License"); you may not use this file except in compliance with
7# the License. You may obtain a copy of the License at:
8#
9# http://www.apache.org/licenses/LICENSE-2.0
10#
11# Unless required by applicable law or agreed to in writing, software
12# distributed under the License is distributed on an "AS IS" BASIS,
13# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
14# See the License for the specific language governing permissions and
15# limitations under the License.
16# </@LICENSE>
17
18=head1 NAME
19
20Mail::SpamAssassin::Plugin::Hashcash - perform hashcash verification tests
21
22=head1 SYNOPSIS
23
24 loadplugin Mail::SpamAssassin::Plugin::Hashcash
25
26=head1 DESCRIPTION
27
28Hashcash is a payment system for email where CPU cycles used as the
29basis for an e-cash system. This plugin makes it possible to use valid
30hashcash tokens added by mail programs as a bonus for messages.
31
32=cut
33
34=head1 USER SETTINGS
35
36=over 4
37
38=item use_hashcash { 1 | 0 } (default: 1)
39
40Whether to use hashcash, if it is available.
41
42=cut
43
44=item hashcash_accept user@example.com ...
45
46Used to specify addresses that we accept HashCash tokens for. You should set
47it to match all the addresses that you may receive mail at.
48
49Like whitelist and blacklist entries, the addresses are file-glob-style
50patterns, so C<friend@somewhere.com>, C<*@isp.com>, or C<*.domain.net> will all
51work. Specifically, C<*> and C<?> are allowed, but all other metacharacters
52are not. Regular expressions are not used for security reasons.
53
54The sequence C<%u> is replaced with the current user's username, which
55is useful for ISPs or multi-user domains.
56
57Multiple addresses per line, separated by spaces, is OK. Multiple
58C<hashcash_accept> lines is also OK.
59
60=cut
61
62=item hashcash_doublespend_path /path/to/file (default: ~/.spamassassin/hashcash_seen)
63
64Path for HashCash double-spend database. HashCash tokens are only usable once,
65so their use is tracked in this database to avoid providing a loophole.
66
67By default, each user has their own, in their C<~/.spamassassin> directory with
68mode 0700/0600. Note that once a token is 'spent' it is written to this file,
69and double-spending of a hashcash token makes it invalid, so this is not
70suitable for sharing between multiple users.
71
72=cut
73
74=item hashcash_doublespend_file_mode (default: 0700)
75
76The file mode bits used for the HashCash double-spend database file.
77
78Make sure you specify this using the 'x' mode bits set, as it may also be used
79to create directories. However, if a file is created, the resulting file will
80not have any execute bits set (the umask is set to 111).
81
82=cut
83
84package Mail::SpamAssassin::Plugin::Hashcash;
85
86270µs278µs
# spent 66µs (53+12) within Mail::SpamAssassin::Plugin::Hashcash::BEGIN@86 which was called: # once (53µs+12µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 86
use strict;
# spent 66µs making 1 call to Mail::SpamAssassin::Plugin::Hashcash::BEGIN@86 # spent 12µs making 1 call to strict::import
87256µs2102µs
# spent 62µs (22+40) within Mail::SpamAssassin::Plugin::Hashcash::BEGIN@87 which was called: # once (22µs+40µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 87
use warnings;
# spent 62µs making 1 call to Mail::SpamAssassin::Plugin::Hashcash::BEGIN@87 # spent 40µs making 1 call to warnings::import
88257µs236µs
# spent 29µs (22+7) within Mail::SpamAssassin::Plugin::Hashcash::BEGIN@88 which was called: # once (22µs+7µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 88
use bytes;
# spent 29µs making 1 call to Mail::SpamAssassin::Plugin::Hashcash::BEGIN@88 # spent 7µs making 1 call to bytes::import
89256µs2155µs
# spent 88µs (20+68) within Mail::SpamAssassin::Plugin::Hashcash::BEGIN@89 which was called: # once (20µs+68µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 89
use re 'taint';
# spent 88µs making 1 call to Mail::SpamAssassin::Plugin::Hashcash::BEGIN@89 # spent 68µs making 1 call to re::import
90
91253µs112µs
# spent 12µs within Mail::SpamAssassin::Plugin::Hashcash::BEGIN@91 which was called: # once (12µs+0s) by Mail::SpamAssassin::PluginHandler::load_plugin at line 91
use Mail::SpamAssassin::Plugin;
# spent 12µs making 1 call to Mail::SpamAssassin::Plugin::Hashcash::BEGIN@91
92262µs2362µs
# spent 193µs (23+170) within Mail::SpamAssassin::Plugin::Hashcash::BEGIN@92 which was called: # once (23µs+170µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 92
use Mail::SpamAssassin::Logger;
# spent 193µs making 1 call to Mail::SpamAssassin::Plugin::Hashcash::BEGIN@92 # spent 170µs making 1 call to Exporter::import
93266µs2205µs
# spent 113µs (21+92) within Mail::SpamAssassin::Plugin::Hashcash::BEGIN@93 which was called: # once (21µs+92µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 93
use Mail::SpamAssassin::Util qw(untaint_var);
# spent 113µs making 1 call to Mail::SpamAssassin::Plugin::Hashcash::BEGIN@93 # spent 92µs making 1 call to Exporter::import
94
95255µs2205µs
# spent 113µs (22+92) within Mail::SpamAssassin::Plugin::Hashcash::BEGIN@95 which was called: # once (22µs+92µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 95
use Errno qw(ENOENT EACCES);
# spent 113µs making 1 call to Mail::SpamAssassin::Plugin::Hashcash::BEGIN@95 # spent 92µs making 1 call to Exporter::import
96256µs22.69ms
# spent 1.36ms (25µs+1.33) within Mail::SpamAssassin::Plugin::Hashcash::BEGIN@96 which was called: # once (25µs+1.33ms) by Mail::SpamAssassin::PluginHandler::load_plugin at line 96
use Fcntl;
# spent 1.36ms making 1 call to Mail::SpamAssassin::Plugin::Hashcash::BEGIN@96 # spent 1.33ms making 1 call to Exporter::import
97257µs2228µs
# spent 126µs (24+102) within Mail::SpamAssassin::Plugin::Hashcash::BEGIN@97 which was called: # once (24µs+102µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 97
use File::Path;
# spent 126µs making 1 call to Mail::SpamAssassin::Plugin::Hashcash::BEGIN@97 # spent 102µs making 1 call to Exporter::import
982135µs2295µs
# spent 162µs (29+133) within Mail::SpamAssassin::Plugin::Hashcash::BEGIN@98 which was called: # once (29µs+133µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 98
use File::Basename;
# spent 162µs making 1 call to Mail::SpamAssassin::Plugin::Hashcash::BEGIN@98 # spent 133µs making 1 call to Exporter::import
99
100
# spent 103µs (28+75) within Mail::SpamAssassin::Plugin::Hashcash::BEGIN@100 which was called: # once (28µs+75µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 103
BEGIN {
101312µs175µs eval { require Digest::SHA; import Digest::SHA qw(sha1); 1 }
# spent 75µs making 1 call to Exporter::import
102117µs or do { require Digest::SHA1; import Digest::SHA1 qw(sha1) }
103148µs1103µs}
# spent 103µs making 1 call to Mail::SpamAssassin::Plugin::Hashcash::BEGIN@100
104
105293µs2175µs
# spent 98µs (21+77) within Mail::SpamAssassin::Plugin::Hashcash::BEGIN@105 which was called: # once (21µs+77µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 105
use vars qw(@ISA);
# spent 98µs making 1 call to Mail::SpamAssassin::Plugin::Hashcash::BEGIN@105 # spent 77µs making 1 call to vars::import
106121µs@ISA = qw(Mail::SpamAssassin::Plugin);
107
10832.73ms29.23ms
# spent 9.03ms (6.56+2.47) within Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108 which was called: # once (6.56ms+2.47ms) by Mail::SpamAssassin::PluginHandler::load_plugin at line 108
use constant HAS_DB_FILE => eval { require DB_File; };
# spent 9.03ms making 1 call to Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108 # spent 200µs making 1 call to constant::import
109
110# constructor: register the eval rule
111
# spent 408µs (73+334) within Mail::SpamAssassin::Plugin::Hashcash::new which was called: # once (73µs+334µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 1 of (eval 38)[Mail/SpamAssassin/PluginHandler.pm:129]
sub new {
11212µs my $class = shift;
11312µs my $mailsaobject = shift;
114
115 # some boilerplate...
11612µs $class = ref($class) || $class;
117114µs125µs my $self = $class->SUPER::new($mailsaobject);
# spent 25µs making 1 call to Mail::SpamAssassin::Plugin::new
11812µs bless ($self, $class);
119
120111µs142µs $self->register_eval_rule ("check_hashcash_value");
# spent 42µs making 1 call to Mail::SpamAssassin::Plugin::register_eval_rule
12116µs119µs $self->register_eval_rule ("check_hashcash_double_spend");
# spent 19µs making 1 call to Mail::SpamAssassin::Plugin::register_eval_rule
122
12318µs1248µs $self->set_config($mailsaobject->{conf});
# spent 248µs making 1 call to Mail::SpamAssassin::Plugin::Hashcash::set_config
124
125110µs return $self;
126}
127
128###########################################################################
129
130
# spent 248µs (39+208) within Mail::SpamAssassin::Plugin::Hashcash::set_config which was called: # once (39µs+208µs) by Mail::SpamAssassin::Plugin::Hashcash::new at line 123
sub set_config {
13112µs my($self, $conf) = @_;
13212µs my @cmds;
133
13417µs push(@cmds, {
135 setting => 'use_hashcash',
136 default => 1,
137 type => $Mail::SpamAssassin::Conf::CONF_TYPE_NUMERIC,
138 });
139
14014µs push(@cmds, {
141 setting => 'hashcash_doublespend_path',
142 default => '__userstate__/hashcash_seen',
143 type => $Mail::SpamAssassin::Conf::CONF_TYPE_STRING,
144 });
145
14613µs push(@cmds, {
147 setting => 'hashcash_doublespend_file_mode',
148 default => "0700",
149 type => $Mail::SpamAssassin::Conf::CONF_TYPE_NUMERIC,
150 });
151
15214µs push(@cmds, {
153 setting => 'hashcash_accept',
154 default => {},
155 type => $Mail::SpamAssassin::Conf::CONF_TYPE_ADDRLIST,
156 });
157
158118µs1208µs $conf->{parser}->register_commands(\@cmds);
# spent 208µs making 1 call to Mail::SpamAssassin::Conf::Parser::register_commands
159}
160
161###########################################################################
162
163sub check_hashcash_value {
164 my ($self, $scanner, $valmin, $valmax) = @_;
165 my $val = $self->_run_hashcash($scanner);
166 return ($val >= $valmin && $val < $valmax);
167}
168
169sub check_hashcash_double_spend {
170 my ($self, $scanner) = @_;
171 $self->_run_hashcash($scanner);
172 return ($scanner->{hashcash_double_spent});
173}
174
175############################################################################
176
177sub _run_hashcash {
178 my ($self, $scanner) = @_;
179
180 if (defined $scanner->{hashcash_value}) { return $scanner->{hashcash_value}; }
181
182 $scanner->{hashcash_value} = 0;
183
184 # X-Hashcash: 0:031118:camram-spam@camram.org:c068b58ade6dcbaf
185 # or:
186 # X-hashcash: 1:20:040803:hashcash@freelists.org::6dcdb3a3ad4e1b86:1519d
187 # X-hashcash: 1:20:040803:jm@jmason.org::6b484d06469ccb28:8838a
188 # X-hashcash: 1:20:040803:adam@cypherspace.org::a1cbc54bf0182ea8:5d6a0
189
190 # call down to {msg} so that we can get it as an array of
191 # individual headers
192 my @hdrs = $scanner->{msg}->get_header ("X-Hashcash");
193 if (scalar @hdrs == 0) {
194 @hdrs = $scanner->{msg}->get_header ("Hashcash");
195 }
196
197 foreach my $hc (@hdrs) {
198 my $value = $self->_run_hashcash_for_one_string($scanner, $hc);
199 if ($value) {
200 # remove the "double-spend" bool if we did find a usable string;
201 # this happens when one string is already spent, but another
202 # string has not yet been.
203 delete $scanner->{hashcash_double_spent};
204 return $value;
205 }
206 }
207 return 0;
208}
209
210sub _run_hashcash_for_one_string {
211 my ($self, $scanner, $hc) = @_;
212
213 if (!$hc) { return 0; }
214 $hc =~ s/\s+//gs; # remove whitespace from multiline, folded tokens
215
216 # untaint the string for paranoia, making sure not to allow \n \0 \' \"
217 if ($hc =~ /^[-A-Za-z0-9\xA0-\xFF:_\/\%\@\.\,\= \*\+\;]+$/) {
218 $hc = untaint_var($hc);
219 }
220 if (!$hc) { return 0; }
221
222 my ($ver, $bits, $date, $rsrc, $exts, $rand, $trial);
223 if ($hc =~ /^0:/) {
224 ($ver, $date, $rsrc, $trial) = split (/:/, $hc, 4);
225 }
226 elsif ($hc =~ /^1:/) {
227 ($ver, $bits, $date, $rsrc, $exts, $rand, $trial) =
228 split (/:/, $hc, 7);
229 # extensions are, as yet, unused by SpamAssassin
230 }
231 else {
232 dbg("hashcash: version $ver stamps not yet supported");
233 return 0;
234 }
235
236 if (!$trial) {
237 dbg("hashcash: no trial in stamp '$hc'");
238 return 0;
239 }
240
241 my $accept = $scanner->{conf}->{hashcash_accept};
242 if (!$self->_check_hashcash_resource ($scanner, $accept, $rsrc)) {
243 dbg("hashcash: resource $rsrc not accepted here");
244 return 0;
245 }
246
247 # get the hash collision from the token. Computing the hash collision
248 # is very easy (great!) -- just get SHA1(token) and count the 0 bits at
249 # the start of the SHA1 hash, according to the draft at
250 # http://www.hashcash.org/draft-hashcash.txt .
251 my $value = 0;
252 my $bitstring = unpack ("B*", sha1($hc));
253 $bitstring =~ /^(0+)/ and $value = length $1;
254
255 # hashcash v1 tokens: if the "claimed value" of the token is less than
256 # what the token actually contains (ie. token was accidentally generated
257 # with 24 bits instead of the claimed 20), then cut it down to just the
258 # claimed value. that way it's a bit tidier and more deterministic.
259 if ($bits && $value > $bits) {
260 $value = $bits;
261 }
262
263 dbg("hashcash: token value: $value");
264
265 if ($self->was_hashcash_token_double_spent ($scanner, $hc)) {
266 $scanner->{hashcash_double_spent} = 1;
267 return 0;
268 }
269
270 $scanner->{hashcash_value} = $value;
271 return $value;
272}
273
274sub was_hashcash_token_double_spent {
275 my ($self, $scanner, $token) = @_;
276
277 my $main = $self->{main};
278 if (!$main->{conf}->{hashcash_doublespend_path}) {
279 dbg("hashcash: hashcash_doublespend_path not defined or empty");
280 return 0;
281 }
282 if (!HAS_DB_FILE) {
283 dbg("hashcash: DB_File module not installed, cannot use double-spend db");
284 return 0;
285 }
286
287 my $path = $main->sed_path ($main->{conf}->{hashcash_doublespend_path});
288 my $parentdir = dirname ($path);
289 my $stat_errn = stat($parentdir) ? 0 : 0+$!;
290 if ($stat_errn == 0 && !-d _) {
291 dbg("hashcash: parent dir $parentdir exists but is not a directory");
292 } elsif ($stat_errn == ENOENT) {
293 # run in an eval(); if mkpath has no perms, it calls die()
294 eval {
295 mkpath ($parentdir, 0, (oct ($main->{conf}->{hashcash_doublespend_file_mode}) & 0777));
296 };
297 }
298
299 my %spenddb;
300 if (!tie %spenddb, "DB_File", $path, O_RDWR|O_CREAT,
301 (oct ($main->{conf}->{hashcash_doublespend_file_mode}) & 0666))
302 {
303 dbg("hashcash: failed to tie to $path: $@ $!");
304 # not a serious error. TODO?
305 return 0;
306 }
307
308 if (exists $spenddb{$token}) {
309 untie %spenddb;
310 dbg("hashcash: token '$token' spent already");
311 return 1;
312 }
313
314 $spenddb{$token} = time;
315 dbg("hashcash: marking token '$token' as spent");
316
317 # TODO: expiry?
318
319 untie %spenddb;
320
321 return 0;
322}
323
324sub _check_hashcash_resource {
325 my ($self, $scanner, $list, $addr) = @_;
326 $addr = lc $addr;
327 if (defined ($list->{$addr})) { return 1; }
328 study $addr; # study is a no-op since perl 5.16.0, eliminating related bugs
329
330 foreach my $regexp (values %{$list})
331 {
332 # allow %u == current username
333 # \\ is added by $conf->add_to_addrlist()
334 $regexp =~ s/\\\%u/$scanner->{main}->{username}/gs;
335
336 if ($addr =~ /$regexp/i) {
337 return 1;
338 }
339 }
340
341 # TODO: use "To" and "Cc" addresses gleaned from the mails in the Bayes
342 # database trained as ham, as well.
343
344 return 0;
345}
346
347############################################################################
348
349110µs1;
350
351=back
352
353=cut
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.