File Coverage

blib/lib/Net/Random.pm
Criterion Covered Total %
statement 81 81 100.0
branch 27 30 90.0
condition 19 21 90.4
subroutine 18 18 100.0
pod 2 2 100.0
total 147 152 96.7


line stmt bran cond sub pod time code
1             package Net::Random;
2              
3 4     4   139055 use strict;
  4         21  
  4         178  
4             local $^W = 1;
5 4     4   24 use vars qw($VERSION %randomness);
  4         7  
  4         302  
6              
7             $VERSION = '2.32';
8              
9             require LWP::UserAgent;
10 4     4   1849 use Sys::Hostname;
  4         4196  
  4         201  
11 4     4   2569 use JSON ();
  4         41404  
  4         108  
12              
13 4     4   1830 use Data::Dumper;
  4         19399  
  4         4739  
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 196     196   498 my $self = shift;
92             $randomness{$self->{src}}->{pool} = [
93 196         1016 @{$randomness{$self->{src}}->{pool}},
94 196         823 &{$randomness{$self->{src}}->{retrieve}}($self->{ssl})
95 196         295 ];
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 44     44 1 36333 my($class, %params) = @_;
169              
170 44 100       227 exists($params{min}) or $params{min} = 0;
171 44 100       152 exists($params{max}) or $params{max} = 255;
172 44 100       126 exists($params{ssl}) or $params{ssl} = 1;
173              
174             die("Bad parameters to Net::Random->new():\n".Dumper(\@_)) if(
175             (grep {
176 175         2291 $_ !~ /^(src|min|max|ssl)$/
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 44 100 66     155 $params{max} - $params{min} > 0xFFFFFFFF
      100        
      100        
      100        
      100        
      100        
      66        
186             );
187              
188 37 100       141 if ( $params{ssl} ) {
189 10 50   1   7471 eval "use LWP::Protocol::https; 1;" or die "LWP::Protocol::https required for SSL connections";
  1     1   9  
  1     1   2  
  1     1   12  
  1     1   12  
  1     1   2  
  1     1   21  
  1     1   12  
  1     1   2  
  1     1   25  
  1         12  
  1         2  
  1         22  
  1         14  
  1         3  
  1         26  
  1         15  
  1         2  
  1         26  
  1         12  
  1         4  
  1         24  
  1         8  
  1         2  
  1         12  
  1         12  
  1         3  
  1         24  
  1         13  
  1         3  
  1         23  
190             }
191              
192 37         366 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 45     45 1 1615 my($self, $results) = @_;
215 45 100       122 defined($results) or $results = 1;
216 45 50       167 die("Bad parameter to Net::Random->get()") if($results =~ /\D/);
217              
218 45         92 my $bytes = 5; # MAXBYTES + 1
219 45         116 foreach my $bits (32, 24, 16, 8) {
220 180 100       584 $bytes-- if($self->{max} - $self->{min} < 2 ** $bits);
221             }
222 45 50       108 die("Out of cucumber error") if($bytes == 5);
223              
224 45         94 my @results = ();
225 45         115 while(@results < $results) {
226 100407 100       120324 $self->_recharge() if(@{$randomness{$self->{src}}->{pool}} < $bytes);
  100407         191261  
227 100407 100       128328 return undef if(@{$randomness{$self->{src}}->{pool}} < $bytes);
  100407         180211  
228              
229 100393         123482 my $random_number = 0;
230 100393         120036 $random_number = ($random_number << 8) + $_ foreach (splice(
231 100393         218352 @{$randomness{$self->{src}}->{pool}}, 0, $bytes
232             ));
233            
234 100393         137078 $random_number += $self->{min};
235 100393 100       214273 push @results, $random_number unless($random_number > $self->{max});
236             }
237 31 100       87 if(wantarray()) {
238 27         940 return @results;
239             } else {
240 4 100       10 if($results == 1) { return $results[0]; }
  2         13  
241 2         12 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;