line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
=head1 NAME |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
Digest::Hashcash - generate Hashcashes (http://www.hashcash.org) |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
=head1 SYNOPSIS |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
use Digest::Hashcash; |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
=head1 DESCRIPTION |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
This module implements the hashcash hash (or digest, although it's |
12
|
|
|
|
|
|
|
not clearly a digest). For all your information needs please visit |
13
|
|
|
|
|
|
|
http://www.hashcash.org. |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
One thing to note about this module is that it requires ISO C99 support, |
16
|
|
|
|
|
|
|
both in your compiler and your standard library. If you don't have a |
17
|
|
|
|
|
|
|
compiler that supports ISO C, get gcc at http://gcc.gnu.org/ :) |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
=over 4 |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
=cut |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
package Digest::Hashcash; |
24
|
|
|
|
|
|
|
|
25
|
1
|
|
|
1
|
|
1678
|
use Time::Local; |
|
1
|
|
|
|
|
1845
|
|
|
1
|
|
|
|
|
69
|
|
26
|
1
|
|
|
1
|
|
692
|
use Time::HiRes; |
|
1
|
|
|
|
|
1704
|
|
|
1
|
|
|
|
|
5
|
|
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
require XSLoader; |
29
|
|
|
|
|
|
|
|
30
|
1
|
|
|
1
|
|
131
|
no warnings; |
|
1
|
|
|
|
|
7
|
|
|
1
|
|
|
|
|
898
|
|
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
$VERSION = 1.1; |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
XSLoader::load Digest::Hashcash, $VERSION; |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
=item $secs = estimate_time $size |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
Estimate the average time necessary to calculate a token of the given |
39
|
|
|
|
|
|
|
size. |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
See also C. |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
=item $size = estimate_size $time[, $min] |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
Estimate the size that can be calculated in the given time (which is an |
46
|
|
|
|
|
|
|
upper bound). The function will not return a size less then C. |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
Estimating the time to be used can go wrong by as much as 50% (but is |
49
|
|
|
|
|
|
|
usually quite accurate), and the estimation itself can take as much as a |
50
|
|
|
|
|
|
|
second on slower (
|
51
|
|
|
|
|
|
|
example) usually handle it within a hundredth of a second or so. |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
The estimation will be done only once, so you can call this fucntion as |
54
|
|
|
|
|
|
|
often as you like without incuring the overhead everytime. |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
=cut |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
my $rounds; |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
sub _rounds { |
61
|
1
|
|
33
|
1
|
|
1502
|
$rounds ||= &_estimate_rounds(); |
62
|
|
|
|
|
|
|
} |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
sub estimate_time { |
65
|
1
|
|
|
1
|
1
|
399
|
my ($size) = @_; |
66
|
1
|
|
|
|
|
5
|
2**$size / &_rounds; |
67
|
|
|
|
|
|
|
} |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
sub estimate_size { |
70
|
1
|
|
|
1
|
1
|
194
|
my ($time, $min) = @_; |
71
|
1
|
|
|
|
|
8
|
$time = (log $time * $rounds) / log 2; |
72
|
1
|
50
|
|
|
|
6
|
$time < $min ? $min : int $time; |
73
|
|
|
|
|
|
|
} |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
=item $cipher = new Digest::Hashcash [param => value...] |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
=over 4 |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
=item size => 18 |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
The number of collisions, in bits. Every bit increases the time to create |
82
|
|
|
|
|
|
|
the token (and thus the cash) by two. |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
=item uid => "" |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
A string used to make the token more unique (e.g. the senders address) |
87
|
|
|
|
|
|
|
and reduce token collisions. The string must only contain characters |
88
|
|
|
|
|
|
|
valid for the trial part of the token, e.g. uuencoded, base64 or |
89
|
|
|
|
|
|
|
e-mail-address-parts are useful here. |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
=item extrarand => 0 |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
The extra bytes of randomness to add to the token in addition to the |
94
|
|
|
|
|
|
|
standard amount. Each byte adds a little bit over 6 bit of randomness to |
95
|
|
|
|
|
|
|
the token. |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
The standard amount of randomness is 8 (> 51 bits of randomness). |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
=item timestamp => 0 |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
The timestamp to use. A value of 0 (the default) means to use the current |
102
|
|
|
|
|
|
|
time. |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
=back |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
=item $token = $cipher->hash ($data [, param => value...]) |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
Creates and returns a new token. This can take some time. |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
Any additional parameters are interpreted the same way as arguments to |
111
|
|
|
|
|
|
|
C. |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
=item $prefix = $cipher->verify ($token [, param => value...])) |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
Checks the given token and returns true if the token has the minimum |
116
|
|
|
|
|
|
|
number of prefix bits, or false otherwise. The value returned is actually |
117
|
|
|
|
|
|
|
the number of collisions, so to find the number of collisions bits specify |
118
|
|
|
|
|
|
|
C<< collisions => 0 >>. |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
Any additional parameters are interpreted the same way as arguments to |
121
|
|
|
|
|
|
|
C. |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
=item $resource = $cipher->resource ($token) |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
Returns the resource part, or C. |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
=item $tstamp = $ciper->timestamp ($token) |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
Returns the timestamp part (in the same format as perl's C |
130
|
|
|
|
|
|
|
C. |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
=back |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
=cut |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
sub new { |
137
|
2
|
|
|
2
|
1
|
592
|
my $class = shift; |
138
|
|
|
|
|
|
|
|
139
|
2
|
|
|
|
|
15
|
bless { @_ }, $class; |
140
|
|
|
|
|
|
|
} |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
sub hash { |
143
|
162
|
|
|
162
|
1
|
33540
|
my $self = shift; |
144
|
162
|
|
|
|
|
936
|
my %arg = (%$self, resource => @_); |
145
|
|
|
|
|
|
|
|
146
|
162
|
|
|
|
|
315942
|
&_gentoken(@arg{qw(size timestamp resource uid extrarand)}); |
147
|
|
|
|
|
|
|
} |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
sub verify { |
150
|
166
|
|
|
166
|
1
|
2169
|
my ($self, $token) = (shift, shift); |
151
|
166
|
|
|
|
|
766
|
my %arg = (%$self, @_); |
152
|
|
|
|
|
|
|
|
153
|
166
|
|
|
|
|
1028
|
my $prefix = &_prefixlen($token); |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
$prefix < $arg{size} |
156
|
|
|
|
|
|
|
? undef |
157
|
166
|
50
|
|
|
|
725
|
: $prefix; |
158
|
|
|
|
|
|
|
} |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
sub resource { |
161
|
1
|
|
|
1
|
1
|
164
|
my ($self, $token) = @_; |
162
|
|
|
|
|
|
|
|
163
|
1
|
50
|
|
|
|
11
|
$token =~ /^\d+:\d*:(.*):/ |
164
|
|
|
|
|
|
|
or return undef; |
165
|
|
|
|
|
|
|
|
166
|
1
|
|
|
|
|
6
|
return $1; |
167
|
|
|
|
|
|
|
} |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
sub timestamp { |
170
|
1
|
|
|
1
|
1
|
162
|
my ($self, $token) = @_; |
171
|
|
|
|
|
|
|
|
172
|
1
|
50
|
|
|
|
11
|
$token =~ /^\d+:(\d*):.*:/ |
173
|
|
|
|
|
|
|
or return undef; |
174
|
|
|
|
|
|
|
|
175
|
1
|
|
|
|
|
2
|
my ($y, $m, $d, $H, $M, $S); |
176
|
1
|
|
|
|
|
4
|
local $_ = $1; |
177
|
1
|
50
|
|
|
|
7
|
$y = /\G(\d\d)/gc ? $1 : return undef; |
178
|
1
|
50
|
|
|
|
6
|
$m = /\G(\d\d)/gc ? $1 : 1; |
179
|
1
|
50
|
|
|
|
6
|
$d = /\G(\d\d)/gc ? $1 : 1; |
180
|
1
|
50
|
|
|
|
11
|
$H = /\G(\d\d)/gc ? $1 : 0; |
181
|
1
|
50
|
|
|
|
5
|
$M = /\G(\d\d)/gc ? $1 : 0; |
182
|
1
|
50
|
|
|
|
7
|
$S = /\G(\d\d)/gc ? $1 : 0; |
183
|
|
|
|
|
|
|
|
184
|
1
|
|
|
|
|
8
|
return timegm $S, $M, $H, $d, $m - 1, $y; |
185
|
|
|
|
|
|
|
} |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
=head1 SEE ALSO |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
L. |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
=head1 SUPPORT FOR THE PERL MULTICORE SPECIFICATION |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
This module supports the perl multicore specification |
194
|
|
|
|
|
|
|
() for token generation of any length |
195
|
|
|
|
|
|
|
and size. |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
=head1 BUGS |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
* There is a y2k+100 problem, as I always assume the same as Time::Local. |
200
|
|
|
|
|
|
|
This is a problem with the hashcash specification, which specifies |
201
|
|
|
|
|
|
|
years as 2 digits :( |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
=head1 AUTHOR |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
Marc Lehmann |
206
|
|
|
|
|
|
|
http://home.schmorp.de |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
=cut |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
1; |
211
|
|
|
|
|
|
|
|