File Coverage

lib/Crypt/DRBG/Hash.pm
Criterion Covered Total %
statement 88 105 83.8
branch 8 12 66.6
condition 3 5 60.0
subroutine 13 15 86.6
pod 1 1 100.0
total 113 138 81.8


line stmt bran cond sub pod time code
1             package Crypt::DRBG::Hash;
2             $Crypt::DRBG::Hash::VERSION = '0.000001';
3 11     11   52143 use 5.006;
  11         36  
4 11     11   56 use strict;
  11         21  
  11         230  
5 11     11   47 use warnings;
  11         21  
  11         365  
6              
7 11     11   8052 use parent 'Crypt::DRBG';
  11         3232  
  11         73  
8              
9 11     11   9846 use Digest::SHA ();
  11         40588  
  11         9278  
10              
11             =head1 NAME
12              
13             Crypt::DRBG::Hash - Fast, cryptographically secure PRNG
14              
15             =head1 SYNOPSIS
16              
17             use Crypt::DRBG::Hash;
18              
19             my $drbg = Crypt::DRBG::Hash->new(auto => 1);
20             my $data = $drbg->generate(42);
21             ... # do something with your 42 bytes here
22              
23             my $drbg2 = Crypt::DRBG::Hash->new(seed => "my very secret seed");
24             my $data2 = $drbg->generate(42);
25              
26             =head1 DESCRIPTION
27              
28             Crypt::DRBG::Hash is an implementation of the Hash_DRBG from NIST SP800-90A. It
29             is a fast, cryptographically secure PRNG. By default, it uses SHA-512.
30              
31             However, if provided a seed, it will produce the same sequence of bytes I
32             called the same way each time>. This makes it useful for simulations that
33             require good but repeatable random numbers.
34              
35             Note, however, that due to the way the DRBGs are designed, making a single
36             request and making multiple requests for the same number of bytes will result in
37             different data. For example, two 16-byte requests will not produce the same
38             values as one 32-byte request.
39              
40             This class derives from Crypt::DRBG, which provides several utility functions.
41              
42             =head1 SUBROUTINES/METHODS
43              
44             =head2 Crypt::DRBG::Hash->new(%params)
45              
46             Creates a new Crypt::DRBG::Hash.
47              
48             %params can contain all valid values for Crypt::DRBG::initialize, plus the
49             following.
50              
51             =over 4
52              
53             =item algo
54              
55             The algorithm to use for generating bytes. The default is "512", for
56             SHA-512. This provides optimal performance for 64-bit machines.
57              
58             If Perl (and hence Digest::SHA) was built with a compiler lacking 64-bit integer
59             support, use "256" here. "256" may also provide better performance for 32-bit
60             machines.
61              
62             =back
63              
64             =cut
65              
66             sub new {
67 1354     1354 1 4543247 my ($class, %params) = @_;
68              
69 1354   33     7081 $class = ref($class) || $class;
70 1354         2811 my $self = bless {}, $class;
71              
72 1354   100     5797 my $algo = $self->{algo} = $params{algo} || '512';
73 1354         3882 $algo =~ tr{/}{}d;
74 1354 50       10333 $self->{s_func} = Digest::SHA->can("sha$algo") or
75             die "Unsupported algorithm '$algo'";
76 1354 100       6542 $self->{seedlen} = $algo =~ /^(384|512)$/ ? 111 : 55;
77 1354         2357 $self->{reseed_interval} = 4294967295; # (2^32)-1
78 1354         2137 $self->{bytes_per_request} = 2 ** 16;
79 1354         4337 $self->{outlen} = substr($algo, -3) / 8;
80 1354         2892 $self->{security_strength} = $self->{outlen} / 2;
81 1354         3963 $self->{min_length} = $self->{security_strength};
82 1354         2345 $self->{max_length} = 4294967295; # (2^32)-1
83              
84             # If we have a 64-bit Perl, make things much faster.
85 1354         2563 my $is_64 = (4294967295 + 2) != 1;
86 1354 50       2622 if ($is_64) {
87 1354         3129 $self->{s_add} = \&_add_64;
88             }
89             else {
90 0         0 require Math::BigInt;
91 0         0 Math::BigInt->import(try => 'GMP');
92              
93             $self->{s_mask} =
94 0         0 (Math::BigInt->new->bone << ($self->{seedlen} * 8)) - 1;
95 0         0 $self->{s_add} = \&_add_32;
96             }
97              
98 1354         6096 $self->initialize(%params);
99              
100 1353         5464 return $self;
101             }
102              
103             sub _add {
104 10789     10789   303701 my ($self, @args) = @_;
105 10789         16714 my $func = $self->{s_add};
106 10789         20684 return $self->$func(@args);
107             }
108              
109             sub _derive {
110 2706     2706   4286 my ($self, $hashdata, $len) = @_;
111              
112 2706         5969 my $count = ($len + ($self->{outlen} - 1)) / $self->{outlen};
113 2706         3545 my $data = '';
114 2706         3892 my $func = $self->{s_func};
115 2706         6645 for (1..$count) {
116 5860         56210 $data .= $func->(pack('CN', $_, $len * 8) . $hashdata);
117             }
118 2706         7121 return substr($data, 0, $len);
119             }
120              
121             sub _seed {
122 1353     1353   2241 my ($self, $seed) = @_;
123              
124 1353         3616 my $v = $self->_derive($seed, $self->{seedlen});
125 1353         4528 my $c = $self->_derive("\x00$v", $self->{seedlen});
126 1353         4986 $self->{state} = {c => $c, v => $v};
127 1353         3045 $self->{reseed_counter} = 1;
128 1353         3376 return 1;
129             }
130              
131             sub _reseed {
132 0     0   0 my ($self, $seed) = @_;
133              
134 0         0 return $self->_seed("\x01$self->{state}{v}$seed");
135             }
136              
137             sub _add_32 {
138 0     0   0 my ($self, @args) = @_;
139 0         0 my @items = map { Math::BigInt->new("0x" . unpack("H*", $_)) } @args;
  0         0  
140 0         0 my $final = Math::BigInt->new->bzero;
141 0         0 foreach my $val (@items) {
142 0         0 $final += $val;
143             }
144 0         0 $final &= $self->{s_mask};
145 0         0 my $data = substr($final->as_hex, 2);
146 0 0       0 $data = "0$data" if length($data) & 1;
147 0         0 $data = pack("H*", $data);
148 0         0 return ("\x00" x ($self->{seedlen} - length($data))) . $data;
149             }
150              
151             sub _add_64 {
152 14826     14826   30120 my ($self, $x, @args) = @_;
153              
154 11     11   76 use integer;
  11         13  
  11         49  
155              
156 14826         22140 my $nbytes = $self->{seedlen} + 1;
157 14826         17889 my $nu32s = $nbytes / 4;
158             # Optimize based on the fact that the first argument is always full-length.
159 14826         62520 my @result = unpack('V*', reverse "\x00$x");
160             my @vals = map {
161 14826         30701 [unpack('V*', reverse(("\x00" x ($nbytes - length($_))) . $_))]
  20212         108810  
162             } @args;
163              
164 14826         32214 foreach my $i (0..($nu32s-1)) {
165 277144         358962 my $total = $result[$i];
166 277144         384947 foreach my $val (@vals) {
167 377776         563198 $total += $val->[$i];
168             }
169 277144 100       581027 if ($total > 0xffffffff) {
170 39136         59873 $result[$i+1] += $total >> 32;
171             }
172 277144         402256 $result[$i] = $total;
173             }
174 14826         98056 return substr(reverse(pack("V*", @result)), 1);
175             }
176              
177             sub _hashgen {
178 2693     2693   5146 my ($self, $v, $len) = @_;
179              
180 2693         4071 my $func = $self->{s_func};
181 2693         8249 my $count = int(($len + ($self->{outlen} - 1)) / $self->{outlen});
182 2693         4105 my $data = '';
183 2693         6083 for (1..$count) {
184 10757         51634 $data .= $func->($v);
185 10757         27716 $v = $self->_add($v, "\x01");
186             }
187 2693         7386 return substr($data, 0, $len);
188             }
189              
190             =head2 $drbg->generate($bytes, $additional_data)
191              
192             Generate and return $bytes bytes. $bytes cannot exceed 2^16.
193              
194             If $additional_data is specified, add this additional data to the DRBG.
195              
196             =cut
197              
198             sub _generate {
199 2693     2693   4557 my ($self, $len, $seed) = @_;
200              
201 2693         8449 $self->_check_reseed($len);
202              
203 2693         3578 my ($func, $add) = @{$self}{qw/s_func s_add/};
  2693         6499  
204 2693         3845 my ($c, $v) = @{$self->{state}}{qw/c v/};
  2693         6639  
205 2693 100       6419 if (defined $seed) {
206 1344         11352 my $w = $func->("\x02$v$seed");
207 1344         3478 $v = $self->$add($v, $w);
208             }
209 2693         6373 my $data = $self->_hashgen($v, $len);
210 2693         21217 my $h = $func->("\x03$v");
211 2693         9527 $v = $self->$add($v, $h, $c, pack("N*", $self->{reseed_counter}));
212 2693         4932 $self->{reseed_counter}++;
213 2693         5168 $self->{state}{v} = $v;
214 2693         12078 return substr($data, 0, $len);
215             }
216              
217             =head1 AUTHOR
218              
219             brian m. carlson, C<< >>
220              
221             =head1 BUGS
222              
223             Please report any bugs or feature requests to C, or through
224             the web interface at L. I will be notified, and then you'll
225             automatically be notified of progress on your bug as I make changes.
226              
227              
228              
229              
230             =head1 SUPPORT
231              
232             You can find documentation for this module with the perldoc command.
233              
234             perldoc Crypt::DRBG::Hash
235              
236              
237             You can also look for information at:
238              
239             =over 4
240              
241             =item * RT: CPAN's request tracker (report bugs here)
242              
243             L
244              
245             =item * AnnoCPAN: Annotated CPAN documentation
246              
247             L
248              
249             =item * CPAN Ratings
250              
251             L
252              
253             =item * Search CPAN
254              
255             L
256              
257             =back
258              
259              
260             =head1 ACKNOWLEDGEMENTS
261              
262              
263             =head1 LICENSE AND COPYRIGHT
264              
265             Copyright 2015 brian m. carlson.
266              
267             This program is distributed under the MIT (X11) License:
268             L
269              
270             Permission is hereby granted, free of charge, to any person
271             obtaining a copy of this software and associated documentation
272             files (the "Software"), to deal in the Software without
273             restriction, including without limitation the rights to use,
274             copy, modify, merge, publish, distribute, sublicense, and/or sell
275             copies of the Software, and to permit persons to whom the
276             Software is furnished to do so, subject to the following
277             conditions:
278              
279             The above copyright notice and this permission notice shall be
280             included in all copies or substantial portions of the Software.
281              
282             THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
283             EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
284             OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
285             NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
286             HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
287             WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
288             FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
289             OTHER DEALINGS IN THE SOFTWARE.
290              
291              
292             =cut
293              
294             1; # End of Crypt::DRBG::Hash