File Coverage

blib/lib/Net/Random.pm
Criterion Covered Total %
statement 50 51 98.0
branch 25 30 83.3
condition 19 21 90.4
subroutine 8 8 100.0
pod 2 2 100.0
total 104 112 92.8


line stmt bran cond sub pod time code
1             package Net::Random;
2              
3 4     4   66148 use strict;
  4         10  
  4         217  
4             local $^W = 1;
5 4     4   21 use vars qw($VERSION %randomness);
  4         7  
  4         371  
6              
7             $VERSION = '2.31';
8              
9             require LWP::UserAgent;
10 4     4   4038 use Sys::Hostname;
  4         5766  
  4         188  
11 4     4   2136 use JSON ();
  4         33431  
  4         80  
12              
13 4     4   33432 use Data::Dumper;
  4         44438  
  4         5648  
14              
15             my $ua = LWP::UserAgent->new(
16             agent => 'perl-Net-Random/'.$VERSION,
17             from => "userid_$<\@".hostname(),
18             timeout => 120,
19             keep_alive => 1,
20             env_proxy => 1
21             );
22              
23             %randomness = (
24             'qrng.anu.edu.au' => { pool => [], retrieve => sub {
25             my $ssl = shift;
26             my $response = $ua->get(
27             ($ssl ? 'https' : 'http') .
28             '://qrng.anu.edu.au/API/jsonI.php?length=1024&size=1&type=uint8'
29             );
30             unless($response->is_success) {
31             warn "Net::Random: Error talking to qrng.anu.edu.au\n";
32             return ();
33             }
34             my $content = eval { JSON::decode_json($response->content()) };
35             if($@) {
36             warn("Net::Random: qrng.anu.edu.au returned bogus JSON\n");
37             return();
38             } elsif(!$content->{success}) {
39             warn("Net::Random: qrng.anu.edu.au said 'success: ".$content->{success}."'\n");
40             return();
41             }
42             @{$content->{data}};
43             } },
44             'fourmilab.ch' => { pool => [], retrieve => sub {
45             my $ssl = shift;
46             my $response = $ua->get(
47             ($ssl ? 'https' : 'http') .
48             '://www.fourmilab.ch/cgi-bin/uncgi/Hotbits?nbytes=1024&fmt=hex'
49             );
50             unless($response->is_success) {
51             warn "Net::Random: Error talking to fourmilab.ch\n";
52             return ();
53             }
54             my $content = $response->content();
55             if($content =~ /Error Generating HotBits/) {
56             warn("Net::Random: fourmilab.ch ran out of randomness for us\n");
57             return ();
58             }
59             map { map { hex } /(..)/g } grep { /^[0-9A-F]+$/ } split(/\s+/, $content);
60             } },
61             'random.org' => { pool => [], retrieve => sub {
62             my $ssl = shift;
63             my $response = $ua->get(
64             ($ssl ? 'https' : 'http') .
65             '://random.org/cgi-bin/randbyte?nbytes=1024&format=hex'
66             );
67              
68             if ( ! $response->is_success ) {
69             warn "Net::Random: Error talking to random.org\n";
70             return ();
71             }
72            
73             $response = $response->content();
74              
75             if($response =~ /quota/i) {
76             warn("Net::Random: random.org ran out of randomness for us\n");
77             return ();
78             }
79             # Old scripts *always* return 200, so look for 'Error:'
80             elsif($response =~ /Error:/) {
81             warn "Net::Random: Server error while talking to random.org\n";
82             return ();
83             }
84              
85             map { hex } split(/\s+/, $response);
86             } }
87             );
88              
89             # recharges the randomness pool
90             sub _recharge {
91 43     43   98 my $self = shift;
92 43         179 $randomness{$self->{src}}->{pool} = [
93 43         207 @{$randomness{$self->{src}}->{pool}},
94 43         75 &{$randomness{$self->{src}}->{retrieve}}($self->{ssl})
95             ];
96             }
97              
98             =head1 NAME
99              
100             Net::Random - get random data from online sources
101              
102             =head1 SYNOPSIS
103              
104             my $rand = Net::Random->new( # use fourmilab.ch's randomness source,
105             src => 'fourmilab.ch', # and return results from 1 to 2000
106             min => 1,
107             max => 2000
108             );
109             @numbers = $rand->get(5); # get 5 numbers
110              
111             my $rand = Net::Random->new( # use qrng.anu.edu.au's randomness source,
112             src => 'qrng.anu.edu.au', # with no explicit range - so values will
113             ); # be in the default range from 0 to 255
114              
115             my $rand = Net::Random->new( # use random.org's randomness source,
116             src => 'random.org',
117             );
118              
119             $number = $rand->get(); # get 1 random number
120              
121             =head1 OVERVIEW
122              
123             The three sources of randomness above correspond to
124             L,
125             L and
126             L.
127             We always get chunks of 1024 bytes
128             at a time, storing it in a pool which is used up as and when needed. The pool
129             is shared between all objects using the same randomness source. When we run
130             out of randomness we go back to the source for more juicy random goodness.
131              
132             If you have set a http_proxy variable in your environment, this will be
133             honoured.
134              
135             While we always fetch 1024 bytes, data can be used up one, two, three or
136             four bytes at a time, depending on the range between the minimum and
137             maximum desired values. There may be a noticeable delay while more
138             random data is fetched.
139              
140             The maintainers of all the randomness sources claim that their data is
141             *truly* random. A some simple tests show that they are certainly more
142             random than the C function on this 'ere machine.
143              
144             =head1 METHODS
145              
146             =over 4
147              
148             =item new
149              
150             The constructor returns a Net::Random object. It takes named parameters,
151             of which one - 'src' - is compulsory, telling the module where to get its
152             random data from. The 'min' and 'max' parameters are optional, and default
153             to 0 and 255 respectively. Both must be integers, and 'max' must be at
154             least min+1. The maximum value of 'max'
155             is 2^32-1, the largest value that can be stored in a 32-bit int, or
156             0xFFFFFFFF. The range between min and max can not be greater than
157             0xFFFFFFFF either.
158              
159             You may also set 'ssl' to 0 if you wish to retrieve data using plaintext
160             (or outbound SSL is prohibited in your network environment for some reason)
161              
162             Currently, the only valid values of 'src' are 'qrng.anu.edu.au', 'fourmilab.ch'
163             and 'random.org'.
164              
165             =cut
166              
167             sub new {
168 34     34 1 34540 my($class, %params) = @_;
169              
170 34 100       156 exists($params{min}) or $params{min} = 0;
171 34 100       110 exists($params{max}) or $params{max} = 255;
172 34 100       109 exists($params{ssl}) or $params{ssl} = 1;
173              
174 135         2132 die("Bad parameters to Net::Random->new():\n".Dumper(\@_)) if(
175             (grep {
176 34 100 66     107 $_ !~ /^(src|min|max|ssl)$/
      100        
      100        
      100        
      100        
      100        
      66        
177             } keys %params) ||
178             !exists($params{src}) ||
179             $params{src} !~ /^(fourmilab\.ch|random\.org|qrng\.anu\.edu\.au)$/ ||
180             $params{min} !~ /^-?\d+$/ ||
181             $params{max} !~ /^-?\d+$/ ||
182             # $params{min} < 0 ||
183             $params{max} > 0xFFFFFFFF ||
184             $params{min} >= $params{max} ||
185             $params{max} - $params{min} > 0xFFFFFFFF
186             );
187              
188 27 50       97 if ( $params{ssl} ) {
189 0 0       0 eval "use LWP::Protocol::https; 1;" or die "LWP::Protocol::https required for SSL connections";
190             }
191              
192 27         219 bless({ %params }, $class);
193             }
194              
195             =item get
196              
197             Takes a single optional parameter, which must be a positive integer.
198             This determines how many random numbers are to be returned and, if not
199             specified, defaults to 1.
200              
201             If it fails to retrieve data, we return undef. Note that random.org and
202             fourmilab.ch
203             ration their random data. If you hit your quota, we spit out a warning.
204             See the section on ERROR HANDLING below.
205              
206             Be careful with context. If you call it in list context, you'll always get
207             a list of results back, even if you only ask for one. If you call it in
208             scalar context you'll either get back a random number if you asked for one
209             result, or an array-ref if you asked for multiple results.
210              
211             =cut
212              
213             sub get {
214 35     35 1 1638 my($self, $results) = @_;
215 35 100       96 defined($results) or $results = 1;
216 35 50       116 die("Bad parameter to Net::Random->get()") if($results =~ /\D/);
217              
218 35         47 my $bytes = 5; # MAXBYTES + 1
219 35         77 foreach my $bits (32, 24, 16, 8) {
220 140 100       521 $bytes-- if($self->{max} - $self->{min} < 2 ** $bits);
221             }
222 35 50       112 die("Out of cucumber error") if($bytes == 5);
223              
224 35         56 my @results = ();
225 35         85 while(@results < $results) {
226 16116 100       31138 $self->_recharge() if(@{$randomness{$self->{src}}->{pool}} < $bytes);
  16116         72847  
227 16116 100       41177 return undef if(@{$randomness{$self->{src}}->{pool}} < $bytes);
  16116         50993  
228              
229 16105         29797 my $random_number = 0;
230 16105         19224 $random_number = ($random_number << 8) + $_ foreach (splice(
  16105         102626  
231             @{$randomness{$self->{src}}->{pool}}, 0, $bytes
232             ));
233            
234 16105         30311 $random_number += $self->{min};
235 16105 100       82640 push @results, $random_number unless($random_number > $self->{max});
236             }
237 24 100       91 if(wantarray()) {
238 20         1063 return @results;
239             } else {
240 4 100       16 if($results == 1) { return $results[0]; }
  2         10  
241 2         14 else { return \@results; }
242             }
243             }
244              
245             =back
246              
247             =head1 BUGS
248              
249             Doesn't handle really BIGNUMs. Patches are welcome to make it use
250             Math::BigInt internally. Note that you'll need to calculate how many
251             random bytes to use per result. I strongly suggest only using BigInts
252             when absolutely necessary, because they are slooooooow.
253              
254             Tests are a bit lame. Really needs to test the results to make sure
255             they're as random as the input (to make sure I haven't introduced any
256             bias).
257              
258             =head1 SECURITY CONCERNS
259              
260             True randomness is very useful for cryptographic applications. Unfortunately,
261             I can not recommend using this module to produce such random data. While
262             some simple testing shows that we can be fairly confident that it is random,
263             and the published methodologies on all the sites used looks sane, you can not,
264             unfortunately, trust that you are getting unique data (ie, someone else might
265             get the same bytes as you), that they don't log who gets what data, or that
266             no-one is intercepting it en route to surreptitiously make a copy..
267              
268             Be aware that if you use an http_proxy - or if your upstream uses a transparent
269             proxy like some of the more shoddy consumer ISPs do - then that is another place
270             that your randomness could be compromised. Even if using https a sophisticated
271             attacker may be able to intercept your data, because I make no effort to
272             verify the sources' SSL certificates (I'd love to receive a patch to do this)
273             and even if I did, there have been cases when trusted CAs issued bogus
274             certificates, which could be used in MITM attacks.
275              
276             I should stress that I *do* trust all the site maintainers to give me data that
277             is sufficiently random and unique for my own uses, but I can not recommend
278             that you do too. As in any security situation, you need to perform your own
279             risk analysis.
280              
281             =head1 ERROR HANDLING
282              
283             There are two types of error that this module can emit which aren't your
284             fault. Those are network
285             errors, in which case it emits a warning:
286              
287             Net::Random: Error talking to [your source]
288              
289             and errors generated by the randomness sources, which look like:
290              
291             Net::Random: [your source] [message]
292              
293             Once you hit either of these errors, it means that either you have run
294             out of randomness and can't get any more, or you are very close to
295             running out of randomness. Because this module's raison d'être
296             is to provide a source of truly random data when you don't have your
297             own one available, it does not provide any pseudo-random fallback.
298              
299             If you want to implement your own fallback, you can catch those warnings
300             by using C<$SIG{__WARN__}>. See C for details.
301              
302             =head1 FEEDBACK
303              
304             I welcome feedback about my code, especially constructive criticism.
305              
306             =head1 AUTHOR, COPYRIGHT and LICENCE
307              
308             Copyright 2003 - 2012 David Cantrell EFE
309              
310             This software is free-as-in-speech software, and may be used,
311             distributed, and modified under the terms of either the GNU
312             General Public Licence version 2 or the Artistic Licence. It's
313             up to you which one you use. The full text of the licences can
314             be found in the files GPL2.txt and ARTISTIC.txt, respectively.
315              
316             =head1 THANKS TO
317              
318             Thanks are also due to the maintainers of the randomness sources. See
319             their web sites for details on how to praise them.
320              
321             Suggestions from the following people have been included:
322              
323             =over
324              
325             =item Rich Rauenzahn
326              
327             Suggested I allow use of an http_proxy;
328              
329             =item Wiggins d Anconia
330              
331             Suggested I mutter in the docs about security concerns;
332              
333             =item Syed Assad
334              
335             Suggested that I use the JSON interface for QRNG instead of scraping
336             the web site;
337              
338             =back
339              
340             And patches from:
341              
342             =over
343              
344             =item Mark Allen
345              
346             code for using SSL;
347              
348             =item Steve Wills
349              
350             code for talking to qrng.anu.edu.au;
351              
352             =back
353              
354             =head1 CONSPIRACY
355              
356             This module is also free-as-in-mason software.
357              
358             =cut
359              
360             1;