File Coverage

blib/lib/Data/Entropy/RawSource/CryptCounter.pm
Criterion Covered Total %
statement 128 154 83.1
branch 40 70 57.1
condition 10 26 38.4
subroutine 27 28 96.4
pod 14 14 100.0
total 219 292 75.0


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             Data::Entropy::RawSource::CryptCounter - counter mode of block cipher
4             as I/O handle
5              
6             =head1 SYNOPSIS
7              
8             use Data::Entropy::RawSource::CryptCounter;
9              
10             my $rawsrc = Data::Entropy::RawSource::CryptCounter
11             ->new(Crypt::Rijndael->new($key));
12              
13             $c = $rawsrc->getc;
14             # and the rest of the I/O handle interface
15              
16             =head1 DESCRIPTION
17              
18             This class provides an I/O handle connected to a virtual file which
19             contains the output of a block cipher in counter mode. This makes a
20             good source of pseudorandom bits. The handle implements a substantial
21             subset of the interfaces described in L and L.
22              
23             For use as a general entropy source, it is recommended to wrap an object
24             of this class using C, which provides methods to
25             extract entropy in more convenient forms than mere octets.
26              
27             The amount of entropy the virtual file actually contains is only the
28             amount that is in the key, which is at most the length of the key.
29             It superficially appears to be much more than this, if (and to the
30             extent that) the block cipher is secure. This technique is not
31             suitable for all problems, and requires a careful choice of block
32             cipher and keying method. Applications requiring true entropy
33             should generate it (see L) or
34             download it (see L and
35             L).
36              
37             =cut
38              
39             package Data::Entropy::RawSource::CryptCounter;
40              
41 3     3   37395 { use 5.006; }
  3         11  
  3         140  
42 3     3   18 use warnings;
  3         4  
  3         90  
43 3     3   17 use strict;
  3         6  
  3         484  
44              
45 3     3   932 use Params::Classify 0.000 qw(is_number is_ref is_string);
  3         2767  
  3         10665  
46              
47             our $VERSION = "0.007";
48              
49             =head1 CONSTRUCTOR
50              
51             =over
52              
53             =item Data::Entropy::RawSource::CryptCounter->new(KEYED_CIPHER)
54              
55             KEYED_CIPHER must be a cipher object supporting the standard C
56             and C methods. For example, an instance of C
57             (with the default C) would be appropriate. A handle object
58             is created and returned which refers to a virtual file containing the
59             output of the cipher's counter mode.
60              
61             =cut
62              
63             sub new {
64 3     3 1 37 my($class, $cipher) = @_;
65 3         61 return bless({
66             cipher => $cipher,
67             blksize => $cipher->blocksize,
68             counter => "\0" x $cipher->blocksize,
69             subpos => 0,
70             }, $class);
71             }
72              
73             =back
74              
75             =head1 METHODS
76              
77             A subset of the interfaces described in L and L
78             are provided:
79              
80             =over
81              
82             =item $rawsrc->read(BUFFER, LENGTH[, OFFSET])
83              
84             =item $rawsrc->getc
85              
86             =item $rawsrc->ungetc(ORD)
87              
88             =item $rawsrc->eof
89              
90             Buffered reading from the source, as in L.
91              
92             =item $rawsrc->sysread(BUFFER, LENGTH[, OFFSET])
93              
94             Unbuffered reading from the source, as in L.
95              
96             =item $rawsrc->close
97              
98             Does nothing.
99              
100             =item $rawsrc->opened
101              
102             Retruns true to indicate that the source is available for I/O.
103              
104             =item $rawsrc->clearerr
105              
106             =item $rawsrc->error
107              
108             Error handling, as in L.
109              
110             =item $rawsrc->getpos
111              
112             =item $rawsrc->setpos(POS)
113              
114             =item $rawsrc->tell
115              
116             =item $rawsrc->seek(POS, WHENCE)
117              
118             Move around within the buffered source, as in L.
119              
120             =item $rawsrc->sysseek(POS, WHENCE)
121              
122             Move around within the unbuffered source, as in L.
123              
124             =back
125              
126             The buffered (C et al) and unbuffered (C et al) sets
127             of methods are interchangeable, because no such distinction is made by
128             this class.
129              
130             C, C, and C only work within the first 4 GiB of the
131             virtual file. The file is actually much larger than that: for Rijndael
132             (AES), or any other cipher with a 128-bit block, the file is 2^52 YiB
133             (2^132 B). C and C work throughout the file.
134              
135             Methods to write to the file are unimplemented because the virtual file
136             is fundamentally read-only.
137              
138             =cut
139              
140             sub _ensure_buffer {
141 60018     60018   78152 my($self) = @_;
142 60018 100       191095 $self->{buffer} = $self->{cipher}->encrypt($self->{counter})
143             unless exists $self->{buffer};
144             }
145              
146             sub _clear_buffer {
147 3762     3762   5070 my($self) = @_;
148 3762         11912 delete $self->{buffer};
149             }
150              
151             sub _increment_counter {
152 3753     3753   6110 my($self) = @_;
153 3753         9951 for(my $i = 0; $i != $self->{blksize}; $i++) {
154 3767         8735 my $c = ord(substr($self->{counter}, $i, 1));
155 3767 100       8310 unless($c == 255) {
156 3753         9963 substr $self->{counter}, $i, 1, chr($c + 1);
157 3753         7057 return;
158             }
159 14         55 substr $self->{counter}, $i, 1, "\0";
160             }
161 0         0 $self->{counter} = undef;
162             }
163              
164             sub _decrement_counter {
165 0     0   0 my($self) = @_;
166 0         0 for(my $i = 0; ; $i++) {
167 0         0 my $c = ord(substr($self->{counter}, $i, 1));
168 0 0       0 unless($c == 0) {
169 0         0 substr $self->{counter}, $i, 1, chr($c - 1);
170 0         0 return;
171             }
172 0         0 substr $self->{counter}, $i, 1, "\xff";
173             }
174             }
175              
176 1     1 1 6 sub close { 1 }
177              
178 1     1 1 5 sub opened { 1 }
179              
180 1     1 1 5 sub error { 0 }
181              
182 1     1 1 5 sub clearerr { 0 }
183              
184             sub getc {
185 60010     60010 1 82133 my($self) = @_;
186 60010 50       151329 return undef unless defined $self->{counter};
187 60010         121444 $self->_ensure_buffer;
188 60010         135660 my $ret = substr($self->{buffer}, $self->{subpos}, 1);
189 60010 100       168358 if(++$self->{subpos} == $self->{blksize}) {
190 3750         11412 $self->_increment_counter;
191 3750         4857 $self->{subpos} = 0;
192 3750         7805 $self->_clear_buffer;
193             }
194 60010         219198 return $ret;
195             }
196              
197             sub ungetc {
198 1     1 1 3 my($self, undef) = @_;
199 1 50       23 unless($self->{subpos} == 0) {
200 1         2 $self->{subpos}--;
201 1         3 return;
202             }
203 0 0       0 return if $self->{counter} =~ /\A\0*\z/;
204 0         0 $self->_decrement_counter;
205 0         0 $self->{subpos} = $self->{blksize} - 1;
206 0         0 $self->_clear_buffer;
207             }
208              
209             sub read {
210 7     7 1 18 my($self, undef, $length, $offset) = @_;
211 7 50       21 return undef if $length < 0;
212 7 100       21 $_[1] = "" unless defined $_[1];
213 7 100       94 if(!defined($offset)) {
    100          
    100          
214 4         6 $offset = 0;
215 4         8 $_[1] = "";
216             } elsif($offset < 0) {
217 1 50       6 return undef if $offset < -length($_[1]);
218 1         3 substr $_[1], $offset, -$offset, "";
219 1         2 $offset = length($_[1]);
220             } elsif($offset > length($_[1])) {
221 1         5 $_[1] .= "\0" x ($offset - length($_[1]));
222             } else {
223 1         4 substr $_[1], $offset, length($_[1]) - $offset, "";
224             }
225 7         10 my $original_offset = $offset;
226 7   66     46 while($length != 0 && defined($self->{counter})) {
227 8         19 $self->_ensure_buffer;
228 8         18 my $avail = $self->{blksize} - $self->{subpos};
229 8 100       25 if($length < $avail) {
230 5         13 $_[1] .= substr($self->{buffer}, $self->{subpos},
231             $length);
232 5         7 $offset += $length;
233 5         10 $self->{subpos} += $length;
234 5         7 last;
235             }
236 3         12 $_[1] .= substr($self->{buffer}, $self->{subpos}, $avail);
237 3         6 $offset += $avail;
238 3         3 $length -= $avail;
239 3         11 $self->_increment_counter;
240 3         5 $self->{subpos} = 0;
241 3         11 $self->_clear_buffer;
242             }
243 7         42 return $offset - $original_offset;
244             }
245              
246             *sysread = \&read;
247              
248             sub tell {
249 20     20 1 780 my($self) = @_;
250 3     3   1948 use integer;
  3         23  
  3         20  
251 20         40 my $ctr = $self->{counter};
252 20         24 my $nblocks;
253 20 50       492 if(defined $ctr) {
254 20 50       98 return -1 if $ctr =~ /\A.{4,}[^\0]/s;
255 20 50       54 $ctr .= "\0\0\0\0" if $self->{blksize} < 4;
256 20         67 $nblocks = unpack("V", $ctr);
257             } else {
258 0 0       0 return -1 if $self->{blksize} >= 4;
259 0         0 $nblocks = 1 << ($self->{blksize} << 3);
260             }
261 20         46 my $pos = $nblocks * $self->{blksize} + $self->{subpos};
262 20 50       70 return -1 unless ($pos-$self->{subpos}) / $self->{blksize} == $nblocks;
263 20         78 return $pos;
264             }
265              
266 3     3   6387 use constant SEEK_SET => 0;
  3         11  
  3         293  
267 3     3   30 use constant SEEK_CUR => 1;
  3         6  
  3         161  
268 3     3   48 use constant SEEK_END => 2;
  3         12  
  3         420  
269              
270             sub sysseek {
271 19     19 1 34 my($self, $offset, $whence) = @_;
272 19 100       60 if($whence == SEEK_SET) {
    100          
    50          
273 3     3   18 use integer;
  3         5  
  3         15  
274 11 100       44 return undef if $offset < 0;
275 8         17 my $ctr = $offset / $self->{blksize};
276 8         13 my $subpos = $offset % $self->{blksize};
277 8         27 $ctr = pack("V", $ctr);
278 8 50       19 if($self->{blksize} < 4) {
279             return undef unless
280 0 0       0 my $chopped = substr($ctr, $self->{blksize},
281             4-$self->{blksize}, "");
282 0 0 0     0 if($chopped =~ /\A\x{01}\0*\z/ && $subpos == 0) {
    0          
283 0         0 $self->{counter} = undef;
284 0         0 $self->{subpos} = 0;
285 0         0 $self->_clear_buffer;
286 0         0 return $offset;
287             } elsif($chopped !~ /\A\0+\z/) {
288 0         0 return undef;
289             }
290             } else {
291 8         26 $ctr .= "\0" x ($self->{blksize} - 4);
292             }
293 8         15 $self->{counter} = $ctr;
294 8         14 $self->{subpos} = $subpos;
295 8         22 $self->_clear_buffer;
296 8   100     63 return $offset || "0 but true";
297             } elsif($whence == SEEK_CUR) {
298 7         19 my $pos = $self->tell;
299 7 50       20 return undef if $pos == -1;
300 7         25 return $self->sysseek($pos + $offset, SEEK_SET);
301             } elsif($whence == SEEK_END) {
302 3     3   1700 use integer;
  3         7  
  3         18  
303 1 50       5 return undef if $offset > 0;
304 1 50       10 return undef if $self->{blksize} >= 4;
305 0         0 my $nblocks = 1 << ($self->{blksize} << 3);
306 0         0 my $pos = $nblocks * $self->{blksize};
307 0 0       0 return undef unless $pos/$self->{blksize} == $nblocks;
308 0         0 return $self->sysseek($pos + $offset, SEEK_SET);
309             } else {
310 0         0 return undef;
311             }
312             }
313              
314 7 100   7 1 30 sub seek { shift->sysseek(@_) ? 1 : 0 }
315              
316             sub getpos {
317 1     1 1 4 my($self) = @_;
318 1         6 return [ $self->{counter}, $self->{subpos} ];
319             }
320              
321             sub setpos {
322 1     1 1 3 my($self, $pos) = @_;
323 1 50 33     14 return undef unless is_ref($pos, "ARRAY") && @$pos == 2;
324 1         3 my($ctr, $subpos) = @$pos;
325 1 50 33     5 unless(!defined($ctr) && $subpos == 0) {
326 1 50 33     16 return undef unless is_string($ctr) &&
      33        
      33        
      33        
327             length($ctr) == $self->{blksize} &&
328             is_number($subpos) &&
329             $subpos >= 0 && $subpos < $self->{blksize};
330             }
331 1         33 $self->{counter} = $ctr;
332 1         2 $self->{subpos} = $subpos;
333 1         3 $self->_clear_buffer;
334 1         4 return "0 but true";
335             }
336              
337             sub eof {
338 1     1 1 3 my($self) = @_;
339 1         5 return !defined($self->{counter});
340             }
341              
342             =head1 SEE ALSO
343              
344             L,
345             L,
346             L,
347             L,
348             L
349              
350             =head1 AUTHOR
351              
352             Andrew Main (Zefram)
353              
354             =head1 COPYRIGHT
355              
356             Copyright (C) 2006, 2007, 2009, 2011
357             Andrew Main (Zefram)
358              
359             =head1 LICENSE
360              
361             This module is free software; you can redistribute it and/or modify it
362             under the same terms as Perl itself.
363              
364             =cut
365              
366             1;