File Coverage

blib/lib/Digest/Hashcash.pm
Criterion Covered Total %
statement 38 38 100.0
branch 10 20 50.0
condition 1 3 33.3
subroutine 11 11 100.0
pod 7 7 100.0
total 67 79 84.8


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