1package Math::Prime::Util::Entropy;
2use strict;
3use warnings;
4use Carp qw/carp croak confess/;
5
6BEGIN {
7  $Math::Prime::Util::Entropy::AUTHORITY = 'cpan:DANAJ';
8  $Math::Prime::Util::Entropy::VERSION = '0.73';
9}
10
11sub _read_file {
12  my($file, $nbytes) = @_;
13  use Fcntl;
14  my($s, $buffer, $nread) = ('', '', 0);
15  return unless -r $file;
16  sysopen(my $fh, $file, O_RDONLY);
17  binmode $fh;
18  while ($nread < $nbytes) {
19    my $thisread = sysread $fh, $buffer, $nbytes-$nread;
20    last unless defined $thisread && $thisread > 0;
21    $s .= $buffer;
22    $nread += length($buffer);
23  }
24  return unless $nbytes == length($s);
25  return $s;
26}
27
28sub _try_urandom {
29  if (-r "/dev/urandom") {
30    return ('urandom', sub { _read_file("/dev/urandom",shift); }, 0, 1);
31  }
32  if (-r "/dev/random") {
33    return ('random', sub { _read_file("/dev/random",shift); }, 1, 1);
34  }
35  return;
36}
37
38sub _try_win32 {
39    return unless $^O eq 'MSWin32';
40    eval { require Win32; require Win32::API; require Win32::API::Type; 1; }
41        or return;
42    use constant CRYPT_SILENT      => 0x40;       # Never display a UI.
43    use constant PROV_RSA_FULL     => 1;          # Which service provider.
44    use constant VERIFY_CONTEXT    => 0xF0000000; # Don't need existing keepairs
45    use constant W2K_MAJOR_VERSION => 5;          # Windows 2000
46    use constant W2K_MINOR_VERSION => 0;
47    my ($major, $minor) = (Win32::GetOSVersion())[1, 2];
48    return if $major < W2K_MAJOR_VERSION;
49
50    if ($major == W2K_MAJOR_VERSION && $minor == W2K_MINOR_VERSION) {
51        # We are Windows 2000.  Use the older CryptGenRandom interface.
52        my $crypt_acquire_context_a =
53            Win32::API->new('advapi32','CryptAcquireContextA','PPPNN','I');
54        return unless defined $crypt_acquire_context_a;
55        my $context = chr(0) x Win32::API::Type->sizeof('PULONG');
56        my $result = $crypt_acquire_context_a->Call(
57             $context, 0, 0, PROV_RSA_FULL, CRYPT_SILENT | VERIFY_CONTEXT );
58        return unless $result;
59        my $pack_type = Win32::API::Type::packing('PULONG');
60        $context = unpack $pack_type, $context;
61        my $crypt_gen_random =
62            Win32::API->new( 'advapi32', 'CryptGenRandom', 'NNP', 'I' );
63        return unless defined $crypt_gen_random;
64        return ('CryptGenRandom',
65            sub {
66                my $nbytes = shift;
67                my $buffer = chr(0) x $nbytes;
68                my $result = $crypt_gen_random->Call($context, $nbytes, $buffer);
69                croak "CryptGenRandom failed: $^E" unless $result;
70                return $buffer;
71            }, 0, 1);  # Assume non-blocking and strong
72    } else {
73        my $rtlgenrand = Win32::API->new( 'advapi32', <<'_RTLGENRANDOM_PROTO_');
74INT SystemFunction036(
75  PVOID RandomBuffer,
76  ULONG RandomBufferLength
77)
78_RTLGENRANDOM_PROTO_
79        return unless defined $rtlgenrand;
80        return ('RtlGenRand',
81            sub {
82                my $nbytes = shift;
83                my $buffer = chr(0) x $nbytes;
84                my $result = $rtlgenrand->Call($buffer, $nbytes);
85                croak "RtlGenRand failed: $^E" unless $result;
86                return $buffer;
87            }, 0, 1);  # Assume non-blocking and strong
88    }
89    return;
90}
91
92sub _try_crypt_prng {
93  return unless eval { require Crypt::PRNG; 1; };
94  return ('Crypt::PRNG', sub { Crypt::PRNG::random_bytes(shift) }, 0, 1);
95}
96
97sub _try_crypt_random_seed {
98  return unless eval { require Crypt::Random::Seed; 1; };
99  return ('Crypt::Random::Seed', sub { my $source = Crypt::Random::Seed->new(NonBlocking=>1); return unless $source; $source->random_bytes(shift) }, 0, 1);
100}
101
102my $_method;
103
104sub entropy_bytes {
105  my $nbytes = shift;
106  my @methodlist = ( \&_try_win32,                 # All we have for Windows
107                     \&_try_urandom,               # Best if available
108                     \&_try_crypt_random_seed,     # More sources, fallbacks
109                     \&_try_crypt_prng,            # Good CSPRNG, worse seeding
110                   );
111
112  if (!defined $_method) {
113    foreach my $m (@methodlist) {
114      my ($name, $rsub, $isblocking, $isstrong) = $m->();
115      if (defined $name) {
116        $_method = $rsub;
117        last;
118      }
119    }
120  }
121  return unless defined $_method;
122  $_method->($nbytes);
123}
124
1251;
126
127__END__
128
129
130# ABSTRACT:  Get a good random seed
131
132=pod
133
134=encoding utf8
135
136=head1 NAME
137
138Math::Prime::Util::Entropy - Get a good random seed
139
140
141=head1 VERSION
142
143Version 0.73
144
145
146=head1 SYNOPSIS
147
148=head1 DESCRIPTION
149
150Provides a single method to get a good seed if possible.  This is a streamlined
151version of L<Crypt::Random::Seed>, with ideas from L<Bytes::Random::Secure::Tiny>.
152
153=head2 entropy_bytes
154
155Takes a number of bytes C<n> and returns either undef (no good seed available) or
156a binary string with good entropy.
157
158We try in order:
159
160   - the Win32 Crypto API
161   - /dev/urandom
162   - /dev/random
163   - L<Crypt::Random::Seed>
164   - L<Crypt::PRNG>
165
166=head1 SEE ALSO
167
168L<Math::Prime::Util>
169L<Crypt::Random::Seed>
170L<Bytes::Random::Secure>
171L<Bytes::Random::Secure::Tiny>
172L<Crypt::PRNG>
173
174=head1 AUTHORS
175
176Dana Jacobsen E<lt>dana@acm.orgE<gt>
177
178
179=head1 COPYRIGHT
180
181Copyright 2017 by Dana Jacobsen E<lt>dana@acm.orgE<gt>
182
183This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
184
185=cut
186