← 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:20 2017

Filename/usr/local/lib/perl5/site_perl/Mail/SpamAssassin/Plugin/Hashcash.pm
StatementsExecuted 49 statements in 3.90ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1116.96ms10.0msMail::SpamAssassin::Plugin::Hashcash::::BEGIN@108Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108
11195µs511µsMail::SpamAssassin::Plugin::Hashcash::::newMail::SpamAssassin::Plugin::Hashcash::new
11157µs309µsMail::SpamAssassin::Plugin::Hashcash::::set_configMail::SpamAssassin::Plugin::Hashcash::set_config
11153µs63µsMail::SpamAssassin::Plugin::Hashcash::::BEGIN@86Mail::SpamAssassin::Plugin::Hashcash::BEGIN@86
11144µs188µsMail::SpamAssassin::Plugin::Hashcash::::BEGIN@100Mail::SpamAssassin::Plugin::Hashcash::BEGIN@100
11134µs300µsMail::SpamAssassin::Plugin::Hashcash::::BEGIN@98Mail::SpamAssassin::Plugin::Hashcash::BEGIN@98
11131µs193µsMail::SpamAssassin::Plugin::Hashcash::::BEGIN@97Mail::SpamAssassin::Plugin::Hashcash::BEGIN@97
11130µs176µsMail::SpamAssassin::Plugin::Hashcash::::BEGIN@93Mail::SpamAssassin::Plugin::Hashcash::BEGIN@93
11129µs84µsMail::SpamAssassin::Plugin::Hashcash::::BEGIN@89Mail::SpamAssassin::Plugin::Hashcash::BEGIN@89
11129µs180µsMail::SpamAssassin::Plugin::Hashcash::::BEGIN@95Mail::SpamAssassin::Plugin::Hashcash::BEGIN@95
11128µs2.55msMail::SpamAssassin::Plugin::Hashcash::::BEGIN@96Mail::SpamAssassin::Plugin::Hashcash::BEGIN@96
11126µs32µsMail::SpamAssassin::Plugin::Hashcash::::BEGIN@88Mail::SpamAssassin::Plugin::Hashcash::BEGIN@88
11125µs54µsMail::SpamAssassin::Plugin::Hashcash::::BEGIN@87Mail::SpamAssassin::Plugin::Hashcash::BEGIN@87
11124µs92µsMail::SpamAssassin::Plugin::Hashcash::::BEGIN@105Mail::SpamAssassin::Plugin::Hashcash::BEGIN@105
11124µs229µsMail::SpamAssassin::Plugin::Hashcash::::BEGIN@92Mail::SpamAssassin::Plugin::Hashcash::BEGIN@92
11113µs13µ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
86280µs273µs
# spent 63µs (53+10) within Mail::SpamAssassin::Plugin::Hashcash::BEGIN@86 which was called: # once (53µs+10µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 86
use strict;
# spent 63µs making 1 call to Mail::SpamAssassin::Plugin::Hashcash::BEGIN@86 # spent 10µs making 1 call to strict::import
87256µs284µs
# spent 54µs (25+29) within Mail::SpamAssassin::Plugin::Hashcash::BEGIN@87 which was called: # once (25µs+29µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 87
use warnings;
# spent 54µs making 1 call to Mail::SpamAssassin::Plugin::Hashcash::BEGIN@87 # spent 29µs making 1 call to warnings::import
88276µs239µs
# spent 32µs (26+6) within Mail::SpamAssassin::Plugin::Hashcash::BEGIN@88 which was called: # once (26µs+6µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 88
use bytes;
# spent 32µs making 1 call to Mail::SpamAssassin::Plugin::Hashcash::BEGIN@88 # spent 6µs making 1 call to bytes::import
89261µs2139µs
# spent 84µs (29+55) within Mail::SpamAssassin::Plugin::Hashcash::BEGIN@89 which was called: # once (29µs+55µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 89
use re 'taint';
# spent 84µs making 1 call to Mail::SpamAssassin::Plugin::Hashcash::BEGIN@89 # spent 55µs making 1 call to re::import
90
91260µs113µs
# spent 13µs within Mail::SpamAssassin::Plugin::Hashcash::BEGIN@91 which was called: # once (13µs+0s) by Mail::SpamAssassin::PluginHandler::load_plugin at line 91
use Mail::SpamAssassin::Plugin;
# spent 13µs making 1 call to Mail::SpamAssassin::Plugin::Hashcash::BEGIN@91
92264µs2434µs
# spent 229µs (24+205) within Mail::SpamAssassin::Plugin::Hashcash::BEGIN@92 which was called: # once (24µs+205µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 92
use Mail::SpamAssassin::Logger;
# spent 229µs making 1 call to Mail::SpamAssassin::Plugin::Hashcash::BEGIN@92 # spent 205µs making 1 call to Exporter::import
93272µs2322µs
# spent 176µs (30+146) within Mail::SpamAssassin::Plugin::Hashcash::BEGIN@93 which was called: # once (30µs+146µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 93
use Mail::SpamAssassin::Util qw(untaint_var);
# spent 176µs making 1 call to Mail::SpamAssassin::Plugin::Hashcash::BEGIN@93 # spent 146µs making 1 call to Exporter::import
94
95273µs2330µs
# spent 180µs (29+150) within Mail::SpamAssassin::Plugin::Hashcash::BEGIN@95 which was called: # once (29µs+150µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 95
use Errno qw(ENOENT EACCES);
# spent 180µs making 1 call to Mail::SpamAssassin::Plugin::Hashcash::BEGIN@95 # spent 150µs making 1 call to Exporter::import
96269µs25.08ms
# spent 2.55ms (28µs+2.52) within Mail::SpamAssassin::Plugin::Hashcash::BEGIN@96 which was called: # once (28µs+2.52ms) by Mail::SpamAssassin::PluginHandler::load_plugin at line 96
use Fcntl;
# spent 2.55ms making 1 call to Mail::SpamAssassin::Plugin::Hashcash::BEGIN@96 # spent 2.52ms making 1 call to Exporter::import
97273µs2356µs
# spent 193µs (31+162) within Mail::SpamAssassin::Plugin::Hashcash::BEGIN@97 which was called: # once (31µs+162µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 97
use File::Path;
# spent 193µs making 1 call to Mail::SpamAssassin::Plugin::Hashcash::BEGIN@97 # spent 162µs making 1 call to Exporter::import
982143µs2566µs
# spent 300µs (34+266) within Mail::SpamAssassin::Plugin::Hashcash::BEGIN@98 which was called: # once (34µs+266µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 98
use File::Basename;
# spent 300µs making 1 call to Mail::SpamAssassin::Plugin::Hashcash::BEGIN@98 # spent 266µs making 1 call to Exporter::import
99
100
# spent 188µs (44+145) within Mail::SpamAssassin::Plugin::Hashcash::BEGIN@100 which was called: # once (44µs+145µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 103
BEGIN {
101318µs1145µs eval { require Digest::SHA; import Digest::SHA qw(sha1); 1 }
# spent 145µs making 1 call to Exporter::import
102120µs or do { require Digest::SHA1; import Digest::SHA1 qw(sha1) }
103148µs1188µs}
# spent 188µs making 1 call to Mail::SpamAssassin::Plugin::Hashcash::BEGIN@100
104
105286µs2161µs
# spent 92µs (24+68) within Mail::SpamAssassin::Plugin::Hashcash::BEGIN@105 which was called: # once (24µs+68µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 105
use vars qw(@ISA);
# spent 92µs making 1 call to Mail::SpamAssassin::Plugin::Hashcash::BEGIN@105 # spent 68µs making 1 call to vars::import
106117µs@ISA = qw(Mail::SpamAssassin::Plugin);
107
10832.74ms210.2ms
# spent 10.0ms (6.96+3.08) within Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108 which was called: # once (6.96ms+3.08ms) by Mail::SpamAssassin::PluginHandler::load_plugin at line 108
use constant HAS_DB_FILE => eval { require DB_File; };
# spent 10.0ms making 1 call to Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108 # spent 206µs making 1 call to constant::import
109
110# constructor: register the eval rule
111
# spent 511µs (95+416) within Mail::SpamAssassin::Plugin::Hashcash::new which was called: # once (95µs+416µ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;
11317µs my $mailsaobject = shift;
114
115 # some boilerplate...
11612µs $class = ref($class) || $class;
117117µs122µs my $self = $class->SUPER::new($mailsaobject);
# spent 22µs making 1 call to Mail::SpamAssassin::Plugin::new
11812µs bless ($self, $class);
119
120110µs139µs $self->register_eval_rule ("check_hashcash_value");
# spent 39µs making 1 call to Mail::SpamAssassin::Plugin::register_eval_rule
12116µs146µs $self->register_eval_rule ("check_hashcash_double_spend");
# spent 46µs making 1 call to Mail::SpamAssassin::Plugin::register_eval_rule
122
123117µs1309µs $self->set_config($mailsaobject->{conf});
# spent 309µs making 1 call to Mail::SpamAssassin::Plugin::Hashcash::set_config
124
125115µs return $self;
126}
127
128###########################################################################
129
130
# spent 309µs (57+252) within Mail::SpamAssassin::Plugin::Hashcash::set_config which was called: # once (57µs+252µs) by Mail::SpamAssassin::Plugin::Hashcash::new at line 123
sub set_config {
13112µs my($self, $conf) = @_;
13212µs my @cmds;
133
134118µ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µs1252µs $conf->{parser}->register_commands(\@cmds);
# spent 252µ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
34919µ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.