4593433056

Build Type

github

Committed by GitHub

Commit Message

Merge ba4c978fa into dda9bd457

Pull Request Pull Request #9: Bump cross-platform-actions/action from 0.10.0 to 0.11.0

Run Details

38 of 38 relevant lines covered (100.0%)

13143.47 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

100.0

/lib/Net/Random.pm

package Net::Random;

use strict;
local $^W = 1;
use vars qw($VERSION %randomness);

$VERSION = '2.32';

require LWP::UserAgent;
use Sys::Hostname;
use JSON ();

use Data::Dumper;

my $ua = LWP::UserAgent->new(
  agent   => 'perl-Net-Random/'.$VERSION,
  from  => "userid_$<\@".hostname(),
  timeout => 120,
  keep_alive => 1,
  env_proxy => 1
);

%randomness = (
  'qrng.anu.edu.au' => { pool => [], retrieve => sub {
    my $ssl = shift;
    my $response = $ua->get( 
      ($ssl ? 'https' : 'http') .
      '://qrng.anu.edu.au/API/jsonI.php?length=1024&size=1&type=uint8'
    );
    unless($response->is_success) {
      warn "Net::Random: Error talking to qrng.anu.edu.au\n";
      return ();
    }
    my $content = eval { JSON::decode_json($response->content()) };
    if($@) {
      warn("Net::Random: qrng.anu.edu.au returned bogus JSON\n");
      return();
    } elsif(!$content->{success}) {
      warn("Net::Random: qrng.anu.edu.au said 'success: ".$content->{success}."'\n");
      return();
    }
    @{$content->{data}};
  } },
  'fourmilab.ch' => { pool => [], retrieve => sub {
    my $ssl = shift;
    my $response = $ua->get( 
      ($ssl ? 'https' : 'http') .
      '://www.fourmilab.ch/cgi-bin/uncgi/Hotbits?nbytes=1024&fmt=hex'
    );
    unless($response->is_success) {
      warn "Net::Random: Error talking to fourmilab.ch\n";
      return ();
    }
    my $content = $response->content();
    if($content =~ /Error Generating HotBits/) {
      warn("Net::Random: fourmilab.ch ran out of randomness for us\n");
      return ();
    }
    map { map { hex } /(..)/g } grep { /^[0-9A-F]+$/ } split(/\s+/, $content);
  } },
  'random.org'   => { pool => [], retrieve => sub {
    my $ssl = shift;
    my $response = $ua->get(
      ($ssl ? 'https' : 'http') .
      '://random.org/cgi-bin/randbyte?nbytes=1024&format=hex'
    );

    if ( ! $response->is_success ) {
      warn "Net::Random: Error talking to random.org\n";
      return ();
    }
  
    $response = $response->content();

    if($response =~ /quota/i) {
      warn("Net::Random: random.org ran out of randomness for us\n");
      return ();
    }
    # Old scripts *always* return 200, so look for 'Error:'
    elsif($response =~ /Error:/) {
      warn "Net::Random: Server error while talking to random.org\n";
      return ();
    }

    map { hex } split(/\s+/, $response);
  } }
);

# recharges the randomness pool
sub _recharge {
  my $self = shift;
  $randomness{$self->{src}}->{pool} = [
    @{$randomness{$self->{src}}->{pool}},
    &{$randomness{$self->{src}}->{retrieve}}($self->{ssl})
  ];
}

=head1 NAME

Net::Random - get random data from online sources

=head1 SYNOPSIS

  my $rand = Net::Random->new( # use fourmilab.ch's randomness source,
    src => 'fourmilab.ch',     # and return results from 1 to 2000
    min => 1,
    max => 2000
  );
  @numbers = $rand->get(5);    # get 5 numbers

  my $rand = Net::Random->new( # use qrng.anu.edu.au's randomness source,
    src => 'qrng.anu.edu.au',  # with no explicit range - so values will
  );                           # be in the default range from 0 to 255

  my $rand = Net::Random->new( # use random.org's randomness source,
    src => 'random.org',
  );

  $number = $rand->get();      # get 1 random number

=head1 OVERVIEW

The three sources of randomness above correspond to
L<https://www.fourmilab.ch/cgi-bin/uncgi/Hotbits?nbytes=1024&fmt=hex>,
L<https://random.org/cgi-bin/randbyte?nbytes=1024&format=hex> and 
L<https://qrng.anu.edu.au/API/jsonI.php?length=1024&size=1&type=uint8>.
We always get chunks of 1024 bytes
at a time, storing it in a pool which is used up as and when needed.  The pool
is shared between all objects using the same randomness source.  When we run
out of randomness we go back to the source for more juicy random goodness.

If you have set a http_proxy variable in your environment, this will be
honoured.

While we always fetch 1024 bytes, data can be used up one, two, three or
four bytes at a time, depending on the range between the minimum and
maximum desired values.  There may be a noticeable delay while more
random data is fetched.

The maintainers of all the randomness sources claim that their data is
*truly* random.  A some simple tests show that they are certainly more
random than the C<rand()> function on this 'ere machine.

=head1 METHODS

=over 4

=item new

The constructor returns a Net::Random object.  It takes named parameters,
of which one - 'src' - is compulsory, telling the module where to get its
random data from.  The 'min' and 'max' parameters are optional, and default
to 0 and 255 respectively.  Both must be integers, and 'max' must be at
least min+1.  The maximum value of 'max'
is 2^32-1, the largest value that can be stored in a 32-bit int, or
0xFFFFFFFF.  The range between min and max can not be greater than
0xFFFFFFFF either.

You may also set 'ssl' to 0 if you wish to retrieve data using plaintext
(or outbound SSL is prohibited in your network environment for some reason)

Currently, the only valid values of 'src' are 'qrng.anu.edu.au', 'fourmilab.ch'
and 'random.org'.

=cut

sub new {
  my($class, %params) = @_;

  exists($params{min}) or $params{min} = 0;
  exists($params{max}) or $params{max} = 255;
  exists($params{ssl}) or $params{ssl} = 1;

  die("Bad parameters to Net::Random->new():\n".Dumper(\@_)) if(
    (grep {
      $_ !~ /^(src|min|max|ssl)$/
    } keys %params) ||
    !exists($params{src}) ||
    $params{src} !~ /^(fourmilab\.ch|random\.org|qrng\.anu\.edu\.au)$/ ||
    $params{min} !~ /^-?\d+$/ ||
    $params{max} !~ /^-?\d+$/ ||
    # $params{min} < 0 ||
    $params{max} > 0xFFFFFFFF ||
    $params{min} >= $params{max} ||
    $params{max} - $params{min} > 0xFFFFFFFF
  );

  if ( $params{ssl} ) {
    eval "use LWP::Protocol::https; 1;" or die "LWP::Protocol::https required for SSL connections";
  }

  bless({ %params }, $class);
}

=item get

Takes a single optional parameter, which must be a positive integer.
This determines how many random numbers are to be returned and, if not
specified, defaults to 1.

If it fails to retrieve data, we return undef.  Note that random.org and
fourmilab.ch
ration their random data.  If you hit your quota, we spit out a warning.
See the section on ERROR HANDLING below.

Be careful with context. If you call it in list context, you'll always get
a list of results back, even if you only ask for one. If you call it in
scalar context you'll either get back a random number if you asked for one
result, or an array-ref if you asked for multiple results.

=cut

sub get {
  my($self, $results) = @_;
  defined($results) or $results = 1;
  die("Bad parameter to Net::Random->get()") if($results =~ /\D/);

  my $bytes = 5; # MAXBYTES + 1
  foreach my $bits (32, 24, 16, 8) {
    $bytes-- if($self->{max} - $self->{min} < 2 ** $bits);
  }
  die("Out of cucumber error") if($bytes == 5);

  my @results = ();
  while(@results < $results) {
    $self->_recharge() if(@{$randomness{$self->{src}}->{pool}} < $bytes);
    return undef if(@{$randomness{$self->{src}}->{pool}} < $bytes);

    my $random_number = 0;
    $random_number = ($random_number << 8) + $_ foreach (splice(
      @{$randomness{$self->{src}}->{pool}}, 0, $bytes
    ));
    
    $random_number += $self->{min};
    push @results, $random_number unless($random_number > $self->{max});
  }
  if(wantarray()) {
     return @results;
  } else {
     if($results == 1) { return $results[0]; }
      else { return \@results; }
  }
}

=back

=head1 BUGS

Doesn't handle really BIGNUMs.  Patches are welcome to make it use
Math::BigInt internally.  Note that you'll need to calculate how many
random bytes to use per result.  I strongly suggest only using BigInts
when absolutely necessary, because they are slooooooow.

Tests are a bit lame.  Really needs to test the results to make sure
they're as random as the input (to make sure I haven't introduced any
bias).

=head1 SECURITY CONCERNS

True randomness is very useful for cryptographic applications.  Unfortunately,
I can not recommend using this module to produce such random data.  While
some simple testing shows that we can be fairly confident that it is random,
and the published methodologies on all the sites used looks sane, you can not,
unfortunately, trust that you are getting unique data (ie, someone else might
get the same bytes as you), that they don't log who gets what data, or that
no-one is intercepting it en route to surreptitiously make a copy..

Be aware that if you use an http_proxy - or if your upstream uses a transparent
proxy like some of the more shoddy consumer ISPs do - then that is another place
that your randomness could be compromised.  Even if using https a sophisticated
attacker may be able to intercept your data, because I make no effort to
verify the sources' SSL certificates (I'd love to receive a patch to do this)
and even if I did, there have been cases when trusted CAs issued bogus
certificates, which could be used in MITM attacks.

I should stress that I *do* trust all the site maintainers to give me data that
is sufficiently random and unique for my own uses, but I can not recommend
that you do too.  As in any security situation, you need to perform your own
risk analysis.

=head1 ERROR HANDLING

There are two types of error that this module can emit which aren't your
fault.  Those are network
errors, in which case it emits a warning:

  Net::Random: Error talking to [your source]

and errors generated by the randomness sources, which look like:

  Net::Random: [your source] [message]

Once you hit either of these errors, it means that either you have run
out of randomness and can't get any more, or you are very close to
running out of randomness.  Because this module's raison d'&ecirc;tre
is to provide a source of truly random data when you don't have your
own one available, it does not provide any pseudo-random fallback.

If you want to implement your own fallback, you can catch those warnings
by using C<$SIG{__WARN__}>.  See C<perldoc perlvar> for details.

=head1 FEEDBACK

I welcome feedback about my code, especially constructive criticism.

=head1 AUTHOR, COPYRIGHT and LICENCE

Copyright 2003 - 2012 David Cantrell E<lt>F<david@cantrell.org.uk>E<gt>

This software is free-as-in-speech software, and may be used,
distributed, and modified under the terms of either the GNU
General Public Licence version 2 or the Artistic Licence. It's
up to you which one you use. The full text of the licences can
be found in the files GPL2.txt and ARTISTIC.txt, respectively.

=head1 THANKS TO

Thanks are also due to the maintainers of the randomness sources.  See
their web sites for details on how to praise them.

Suggestions from the following people have been included:

=over

=item Rich Rauenzahn

Suggested I allow use of an http_proxy;

=item Wiggins d Anconia

Suggested I mutter in the docs about security concerns;

=item Syed Assad

Suggested that I use the JSON interface for QRNG instead of scraping 
the web site;

=back

And patches from:

=over

=item Mark Allen

code for using SSL;

=item Steve Wills

code for talking to qrng.anu.edu.au;

=back

=head1 CONSPIRACY

This module is also free-as-in-mason software.

=cut

1;

1	package Net::Random;
2
3	use strict;	4✔
4	local $^W = 1;
5	use vars qw($VERSION %randomness);	4✔
6
7	$VERSION = '2.32';
8
9	require LWP::UserAgent;
10	use Sys::Hostname;	4✔
11	use JSON ();	4✔
12
13	use Data::Dumper;	4✔
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	my $self = shift;	150✔
92	$randomness{$self->{src}}->{pool} = [
93	@{$randomness{$self->{src}}->{pool}},	150✔
94	&{$randomness{$self->{src}}->{retrieve}}($self->{ssl})	150✔
95	];	150✔
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<https://www.fourmilab.ch/cgi-bin/uncgi/Hotbits?nbytes=1024&fmt=hex>,
125	L<https://random.org/cgi-bin/randbyte?nbytes=1024&format=hex> and
126	L<https://qrng.anu.edu.au/API/jsonI.php?length=1024&size=1&type=uint8>.
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<rand()> 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	my($class, %params) = @_;	44✔
169
170	exists($params{min}) or $params{min} = 0;	44✔
171	exists($params{max}) or $params{max} = 255;	44✔
172	exists($params{ssl}) or $params{ssl} = 1;	44✔
173
174	die("Bad parameters to Net::Random->new():\n".Dumper(\@_)) if(
175	(grep {
176	$_ !~ /^(src\|min\|max\|ssl)$/	175✔
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	44✔
186	);
187
188	if ( $params{ssl} ) {	37✔
189	eval "use LWP::Protocol::https; 1;" or die "LWP::Protocol::https required for SSL connections";	10✔
190	}
191
192	bless({ %params }, $class);	37✔
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	my($self, $results) = @_;	45✔
215	defined($results) or $results = 1;	45✔
216	die("Bad parameter to Net::Random->get()") if($results =~ /\D/);	45✔
217
218	my $bytes = 5; # MAXBYTES + 1	45✔
219	foreach my $bits (32, 24, 16, 8) {	45✔
220	$bytes-- if($self->{max} - $self->{min} < 2 ** $bits);	180✔
221	}
222	die("Out of cucumber error") if($bytes == 5);	45✔
223
224	my @results = ();	45✔
225	while(@results < $results) {	45✔
226	$self->_recharge() if(@{$randomness{$self->{src}}->{pool}} < $bytes);	71,124✔
227	return undef if(@{$randomness{$self->{src}}->{pool}} < $bytes);	71,124✔
228
229	my $random_number = 0;	71,103✔
230	$random_number = ($random_number << 8) + $_ foreach (splice(	71,103✔
231	@{$randomness{$self->{src}}->{pool}}, 0, $bytes	71,103✔
232	));
233
234	$random_number += $self->{min};	71,103✔
235	push @results, $random_number unless($random_number > $self->{max});	71,103✔
236	}
237	if(wantarray()) {	24✔
238	return @results;	20✔
239	} else {
240	if($results == 1) { return $results[0]; }	4✔
241	else { return \@results; }	2✔
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<perldoc perlvar> 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 E<lt>F<david@cantrell.org.uk>E<gt>
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;

DrHyde / perl-modules-Net-Random / 4593433056

Source File Press 'n' to go to next uncovered line, 'b' for previous

Source File
Press 'n' to go to next uncovered line, 'b' for previous