File Coverage

blib/lib/Data/Entropy/RawSource/RandomOrg.pm
Criterion Covered Total %
statement 19 92 20.6
branch 0 38 0.0
condition n/a
subroutine 6 16 37.5
pod 9 9 100.0
total 34 155 21.9


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             Data::Entropy::RawSource::RandomOrg - download entropy from random.org
4              
5             =head1 SYNOPSIS
6              
7             use Data::Entropy::RawSource::RandomOrg;
8              
9             my $rawsrc = Data::Entropy::RawSource::RandomOrg->new;
10              
11             $c = $rawsrc->getc;
12             # and the rest of the I/O handle interface
13              
14             =head1 DESCRIPTION
15              
16             This class provides an I/O handle connected to a stream of random octets
17             being generated by an electromagnetic noise detector connected to the
18             random.org server. This is a strong source of random bits, but is not
19             suitable for security applications because the bits are passed over the
20             Internet unencrypted. The handle implements a substantial subset of
21             the interface described in 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 bits generated at random.org are, theoretically and as far as anyone
28             can tell, totally unbiased and uncorrelated. However, they are sent
29             over the Internet in the clear, and so are subject to interception and
30             alteration by an adversary. This is therefore generally unsuitable for
31             security applications. The capacity of the random bit server is also
32             limited. This class will slow down requests if the server's entropy
33             pool is less than half full, and (as requested by the server operators)
34             pause entirely if the entropy pool is less than 20% full.
35              
36             Applications requiring secret entropy should generate it locally
37             (see L). Applications requiring a
38             large amount of entropy should generate it locally or download it from
39             randomnumbers.info (see L).
40             Applications requiring a large amount of apparently-random data,
41             but not true entropy, might prefer to fake it cryptographically (see
42             L).
43              
44             =cut
45              
46             package Data::Entropy::RawSource::RandomOrg;
47              
48 1     1   95129 { use 5.006; }
  1         5  
  1         68  
49 1     1   8 use warnings;
  1         2  
  1         47  
50 1     1   15 use strict;
  1         2  
  1         54  
51              
52 1     1   1911 use Errno 1.00 qw(EIO);
  1         2621  
  1         515  
53 1     1   2219 use HTTP::Lite 2.2 ();
  1         27102  
  1         2249  
54              
55             our $VERSION = "0.007";
56              
57             =head1 CONSTRUCTOR
58              
59             =over
60              
61             =item Data::Entropy::RawSource::RandomOrg->new
62              
63             Creates and returns a handle object referring to a stream of random
64             octets generated by random.org.
65              
66             =cut
67              
68             sub new {
69 1     1 1 211 my($class) = @_;
70 1         12 my $http = HTTP::Lite->new;
71 1         157 $http->http11_mode(1);
72 1         14 return bless({
73             http => $http,
74             buffer => "",
75             bufpos => 0,
76             error => 0,
77             }, $class);
78             }
79              
80             =back
81              
82             =head1 METHODS
83              
84             A subset of the interfaces described in L and L
85             are provided:
86              
87             =over
88              
89             =item $rawsrc->read(BUFFER, LENGTH[, OFFSET])
90              
91             =item $rawsrc->getc
92              
93             =item $rawsrc->ungetc(ORD)
94              
95             =item $rawsrc->eof
96              
97             Buffered reading from the source, as in L.
98              
99             =item $rawsrc->sysread(BUFFER, LENGTH[, OFFSET])
100              
101             Unbuffered reading from the source, as in L.
102              
103             =item $rawsrc->close
104              
105             Does nothing.
106              
107             =item $rawsrc->opened
108              
109             Retruns true to indicate that the source is available for I/O.
110              
111             =item $rawsrc->clearerr
112              
113             =item $rawsrc->error
114              
115             Error handling, as in L.
116              
117             =back
118              
119             The buffered (C et al) and unbuffered (C et al) sets
120             of methods are interchangeable, because no such distinction is made by
121             this class.
122              
123             Methods to write to the file are unimplemented because the stream is
124             fundamentally read-only. Methods to seek are unimplemented because the
125             stream is non-rewindable; C works, however.
126              
127             =cut
128              
129             sub _checkbuf {
130 0     0     my($self) = @_;
131 0           $self->{http}->reset;
132 0 0         unless($self->{http}->request(
133             "http://www.random.org/cgi-bin/checkbuf"
134             ) == 200) {
135 0           $! = EIO;
136 0           return undef;
137             }
138 0 0         unless($self->{http}->body =~
139             /\A[\ \t\n]*([0-9]{1,3}(?:\.[0-9]+)?)\%[\ \t\n]*\z/) {
140 0           $! = EIO;
141 0           return undef;
142             }
143 0           return $1;
144             }
145              
146             sub _ensure_buffer {
147 0     0     my($self) = @_;
148 0 0         return 1 unless $self->{bufpos} == length($self->{buffer});
149 0           while(1) {
150 0           my $fillpct = $self->_checkbuf;
151 0 0         return 0 unless defined $fillpct;
152 0 0         if($fillpct >= 20) {
153 0 0         sleep((50 - $fillpct)*0.2) if $fillpct < 50;
154 0           last;
155             }
156 0           sleep 10;
157             }
158 0           $self->{http}->reset;
159 0 0         unless($self->{http}->request(
160             "http://www.random.org/cgi-bin/randbyte?nbytes=256&format=f"
161             ) == 200) {
162 0           $! = EIO;
163 0           return 0;
164             }
165 0           $self->{buffer} = $self->{http}->body;
166 0           $self->{bufpos} = 0;
167 0 0         if($self->{buffer} !~ /\A[\x00-\xff]+\z/) {
168 0           $self->{buffer} = "";
169 0           $! = EIO;
170 0           return 0;
171             }
172 0           return 1;
173             }
174              
175 0     0 1   sub close { 1 }
176              
177 0     0 1   sub opened { 1 }
178              
179 0     0 1   sub error { $_[0]->{error} }
180              
181             sub clearerr {
182 0     0 1   my($self) = @_;
183 0           $self->{error} = 0;
184 0           return 0;
185             }
186              
187             sub getc {
188 0     0 1   my($self) = @_;
189 0 0         unless($self->_ensure_buffer) {
190 0           $self->{error} = 1;
191 0           return undef;
192             }
193 0           return substr($self->{buffer}, $self->{bufpos}++, 1);
194             }
195              
196             sub ungetc {
197 0     0 1   my($self, $cval) = @_;
198 0 0         if($self->{bufpos} == 0) {
199 0           $self->{buffer} = chr($cval).$self->{buffer};
200             } else {
201 0           $self->{bufpos}--;
202             }
203             }
204              
205             sub read {
206 0     0 1   my($self, undef, $length, $offset) = @_;
207 0 0         return undef if $length < 0;
208 0 0         $_[1] = "" unless defined $_[1];
209 0 0         if(!defined($offset)) {
    0          
    0          
210 0           $offset = 0;
211 0           $_[1] = "";
212             } elsif($offset < 0) {
213 0 0         return undef if $offset < -length($_[1]);
214 0           substr $_[1], $offset, -$offset, "";
215 0           $offset = length($_[1]);
216             } elsif($offset > length($_[1])) {
217 0           $_[1] .= "\0" x ($offset - length($_[1]));
218             } else {
219 0           substr $_[1], $offset, length($_[1]) - $offset, "";
220             }
221 0           my $original_offset = $offset;
222 0           while($length != 0) {
223 0 0         unless($self->_ensure_buffer) {
224 0           $self->{error} = 1;
225 0           last;
226             }
227 0           my $avail = length($self->{buffer}) - $self->{bufpos};
228 0 0         if($length < $avail) {
229 0           $_[1] .= substr($self->{buffer}, $self->{bufpos},
230             $length);
231 0           $offset += $length;
232 0           $self->{bufpos} += $length;
233 0           last;
234             }
235 0           $_[1] .= substr($self->{buffer}, $self->{bufpos}, $avail);
236 0           $offset += $avail;
237 0           $length -= $avail;
238 0           $self->{bufpos} += $avail;
239             }
240 0           my $nread = $offset - $original_offset;
241 0 0         return $nread == 0 ? undef : $nread;
242             }
243              
244             *sysread = \&read;
245              
246 0     0 1   sub eof { 0 }
247              
248             =head1 SEE ALSO
249              
250             L,
251             L,
252             L,
253             L,
254             L
255              
256             =head1 AUTHOR
257              
258             Andrew Main (Zefram)
259              
260             =head1 COPYRIGHT
261              
262             Copyright (C) 2006, 2007, 2009, 2011
263             Andrew Main (Zefram)
264              
265             =head1 LICENSE
266              
267             This module is free software; you can redistribute it and/or modify it
268             under the same terms as Perl itself.
269              
270             =cut
271              
272             1;