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