← Index
NYTProf Performance Profile   « line view »
For /usr/local/bin/sa-learn
  Run on Tue Nov 7 05:38:10 2017
Reported on Tue Nov 7 06:16:03 2017

Filename/usr/local/lib/perl5/site_perl/Mail/SpamAssassin/Plugin/Hashcash.pm
StatementsExecuted 49 statements in 3.91ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1117.05ms9.99msMail::SpamAssassin::Plugin::Hashcash::::BEGIN@108Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108
111113µs506µsMail::SpamAssassin::Plugin::Hashcash::::newMail::SpamAssassin::Plugin::Hashcash::new
11156µs65µsMail::SpamAssassin::Plugin::Hashcash::::BEGIN@86Mail::SpamAssassin::Plugin::Hashcash::BEGIN@86
11150µs282µsMail::SpamAssassin::Plugin::Hashcash::::set_configMail::SpamAssassin::Plugin::Hashcash::set_config
11143µs172µsMail::SpamAssassin::Plugin::Hashcash::::BEGIN@100Mail::SpamAssassin::Plugin::Hashcash::BEGIN@100
11142µs112µsMail::SpamAssassin::Plugin::Hashcash::::BEGIN@105Mail::SpamAssassin::Plugin::Hashcash::BEGIN@105
11135µs2.53msMail::SpamAssassin::Plugin::Hashcash::::BEGIN@96Mail::SpamAssassin::Plugin::Hashcash::BEGIN@96
11132µs64µsMail::SpamAssassin::Plugin::Hashcash::::BEGIN@87Mail::SpamAssassin::Plugin::Hashcash::BEGIN@87
11132µs199µsMail::SpamAssassin::Plugin::Hashcash::::BEGIN@97Mail::SpamAssassin::Plugin::Hashcash::BEGIN@97
11131µs241µsMail::SpamAssassin::Plugin::Hashcash::::BEGIN@98Mail::SpamAssassin::Plugin::Hashcash::BEGIN@98
11125µs159µsMail::SpamAssassin::Plugin::Hashcash::::BEGIN@93Mail::SpamAssassin::Plugin::Hashcash::BEGIN@93
11124µs174µsMail::SpamAssassin::Plugin::Hashcash::::BEGIN@95Mail::SpamAssassin::Plugin::Hashcash::BEGIN@95
11122µs27µsMail::SpamAssassin::Plugin::Hashcash::::BEGIN@88Mail::SpamAssassin::Plugin::Hashcash::BEGIN@88
11120µs213µsMail::SpamAssassin::Plugin::Hashcash::::BEGIN@92Mail::SpamAssassin::Plugin::Hashcash::BEGIN@92
11120µs84µ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
86271µs274µs
# spent 65µs (56+9) within Mail::SpamAssassin::Plugin::Hashcash::BEGIN@86 which was called: # once (56µs+9µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 86
use strict;
# spent 65µs making 1 call to Mail::SpamAssassin::Plugin::Hashcash::BEGIN@86 # spent 9µs making 1 call to strict::import
87274µs297µs
# spent 64µs (32+32) within Mail::SpamAssassin::Plugin::Hashcash::BEGIN@87 which was called: # once (32µs+32µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 87
use warnings;
# spent 64µs making 1 call to Mail::SpamAssassin::Plugin::Hashcash::BEGIN@87 # spent 32µs making 1 call to warnings::import
88270µs232µs
# spent 27µs (22+5) within Mail::SpamAssassin::Plugin::Hashcash::BEGIN@88 which was called: # once (22µs+5µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 88
use bytes;
# spent 27µs making 1 call to Mail::SpamAssassin::Plugin::Hashcash::BEGIN@88 # spent 5µs making 1 call to bytes::import
89258µs2147µs
# spent 84µs (20+63) within Mail::SpamAssassin::Plugin::Hashcash::BEGIN@89 which was called: # once (20µs+63µ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 63µs making 1 call to re::import
90
91252µ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
92263µs2406µs
# spent 213µs (20+193) within Mail::SpamAssassin::Plugin::Hashcash::BEGIN@92 which was called: # once (20µs+193µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 92
use Mail::SpamAssassin::Logger;
# spent 213µs making 1 call to Mail::SpamAssassin::Plugin::Hashcash::BEGIN@92 # spent 193µs making 1 call to Exporter::import
93282µs2293µs
# spent 159µs (25+134) within Mail::SpamAssassin::Plugin::Hashcash::BEGIN@93 which was called: # once (25µs+134µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 93
use Mail::SpamAssassin::Util qw(untaint_var);
# spent 159µs making 1 call to Mail::SpamAssassin::Plugin::Hashcash::BEGIN@93 # spent 134µs making 1 call to Exporter::import
94
95265µs2324µs
# spent 174µs (24+150) within Mail::SpamAssassin::Plugin::Hashcash::BEGIN@95 which was called: # once (24µs+150µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 95
use Errno qw(ENOENT EACCES);
# spent 174µs making 1 call to Mail::SpamAssassin::Plugin::Hashcash::BEGIN@95 # spent 150µs making 1 call to Exporter::import
96279µs25.02ms
# spent 2.53ms (35µs+2.49) within Mail::SpamAssassin::Plugin::Hashcash::BEGIN@96 which was called: # once (35µs+2.49ms) by Mail::SpamAssassin::PluginHandler::load_plugin at line 96
use Fcntl;
# spent 2.53ms making 1 call to Mail::SpamAssassin::Plugin::Hashcash::BEGIN@96 # spent 2.49ms making 1 call to Exporter::import
97268µs2367µs
# spent 199µs (32+168) within Mail::SpamAssassin::Plugin::Hashcash::BEGIN@97 which was called: # once (32µs+168µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 97
use File::Path;
# spent 199µs making 1 call to Mail::SpamAssassin::Plugin::Hashcash::BEGIN@97 # spent 168µs making 1 call to Exporter::import
982139µs2451µs
# spent 241µs (31+210) within Mail::SpamAssassin::Plugin::Hashcash::BEGIN@98 which was called: # once (31µs+210µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 98
use File::Basename;
# spent 241µs making 1 call to Mail::SpamAssassin::Plugin::Hashcash::BEGIN@98 # spent 210µs making 1 call to Exporter::import
99
100
# spent 172µs (43+129) within Mail::SpamAssassin::Plugin::Hashcash::BEGIN@100 which was called: # once (43µs+129µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 103
BEGIN {
101318µs1129µs eval { require Digest::SHA; import Digest::SHA qw(sha1); 1 }
# spent 129µs making 1 call to Exporter::import
102119µs or do { require Digest::SHA1; import Digest::SHA1 qw(sha1) }
103184µs1172µs}
# spent 172µs making 1 call to Mail::SpamAssassin::Plugin::Hashcash::BEGIN@100
104
1052102µs2183µs
# spent 112µs (42+70) within Mail::SpamAssassin::Plugin::Hashcash::BEGIN@105 which was called: # once (42µs+70µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 105
use vars qw(@ISA);
# spent 112µs making 1 call to Mail::SpamAssassin::Plugin::Hashcash::BEGIN@105 # spent 70µs making 1 call to vars::import
106116µs@ISA = qw(Mail::SpamAssassin::Plugin);
107
10832.71ms210.2ms
# spent 9.99ms (7.05+2.94) within Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108 which was called: # once (7.05ms+2.94ms) by Mail::SpamAssassin::PluginHandler::load_plugin at line 108
use constant HAS_DB_FILE => eval { require DB_File; };
# spent 9.99ms making 1 call to Mail::SpamAssassin::Plugin::Hashcash::BEGIN@108 # spent 182µs making 1 call to constant::import
109
110# constructor: register the eval rule
111
# spent 506µs (113+393) within Mail::SpamAssassin::Plugin::Hashcash::new which was called: # once (113µs+393µ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;
113111µs my $mailsaobject = shift;
114
115 # some boilerplate...
11612µs $class = ref($class) || $class;
117122µ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
120113µs136µs $self->register_eval_rule ("check_hashcash_value");
# spent 36µs making 1 call to Mail::SpamAssassin::Plugin::register_eval_rule
12116µs153µs $self->register_eval_rule ("check_hashcash_double_spend");
# spent 53µs making 1 call to Mail::SpamAssassin::Plugin::register_eval_rule
122
123115µs1282µs $self->set_config($mailsaobject->{conf});
# spent 282µs making 1 call to Mail::SpamAssassin::Plugin::Hashcash::set_config
124
125113µs return $self;
126}
127
128###########################################################################
129
130
# spent 282µs (50+232) within Mail::SpamAssassin::Plugin::Hashcash::set_config which was called: # once (50µs+232µs) by Mail::SpamAssassin::Plugin::Hashcash::new at line 123
sub set_config {
13112µs my($self, $conf) = @_;
13219µs my @cmds;
133
13416µ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
158116µs1232µs $conf->{parser}->register_commands(\@cmds);
# spent 232µ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.