1# This Source Code Form is subject to the terms of the Mozilla Public
2# License, v. 2.0. If a copy of the MPL was not distributed with this
3# file, You can obtain one at http://mozilla.org/MPL/2.0/.
4#
5# This Source Code Form is "Incompatible With Secondary Licenses", as
6# defined by the Mozilla Public License, v. 2.0.
7
8package Bugzilla::RNG;
9use strict;
10use base qw(Exporter);
11use Bugzilla::Constants qw(ON_WINDOWS);
12
13use Math::Random::ISAAC;
14use if ON_WINDOWS, 'Win32::API';
15
16our $RNG;
17our @EXPORT_OK = qw(rand srand irand);
18
19# ISAAC, a 32-bit generator, should only be capable of generating numbers
20# between 0 and 2^32 - 1. We want _to_float to generate numbers possibly
21# including 0, but always less than 1.0. Dividing the integer produced
22# by irand() by this number should do that exactly.
23use constant DIVIDE_BY => 2**32;
24
25# How many bytes of seed to read.
26use constant SEED_SIZE => 16; # 128 bits.
27
28#################
29# Windows Stuff #
30#################
31
32# The type of cryptographic service provider we want to use.
33# This doesn't really matter for our purposes, so we just pick
34# PROV_RSA_FULL, which seems reasonable. For more info, see
35# http://msdn.microsoft.com/en-us/library/aa380244(v=VS.85).aspx
36use constant PROV_RSA_FULL => 1;
37
38# Flags for CryptGenRandom:
39# Don't ever display a UI to the user, just fail if one would be needed.
40use constant CRYPT_SILENT => 64;
41# Don't require existing public/private keypairs.
42use constant CRYPT_VERIFYCONTEXT => 0xF0000000;
43
44# For some reason, BOOLEAN doesn't work properly as a return type with
45# Win32::API.
46use constant RTLGENRANDOM_PROTO => <<END;
47INT SystemFunction036(
48  PVOID RandomBuffer,
49  ULONG RandomBufferLength
50)
51END
52
53#################
54# RNG Functions #
55#################
56
57sub rand (;$) {
58    my ($limit) = @_;
59    my $int = irand();
60    return _to_float($int, $limit);
61}
62
63sub irand (;$) {
64    my ($limit) = @_;
65    Bugzilla::RNG::srand() if !defined $RNG;
66    my $int = $RNG->irand();
67    if (defined $limit) {
68        # We can't just use the mod operator because it will bias
69        # our output. Search for "modulo bias" on the Internet for
70        # details. This is slower than mod(), but does not have a bias,
71        # as demonstrated by Math::Random::Secure's uniform.t test.
72        return int(_to_float($int, $limit));
73    }
74    return $int;
75}
76
77sub srand (;$) {
78    my ($value) = @_;
79    # Remove any RNG that might already have been made.
80    $RNG = undef;
81    my %args;
82    if (defined $value) {
83        $args{seed} = $value;
84    }
85    $RNG = _create_rng(\%args);
86}
87
88sub _to_float {
89    my ($integer, $limit) = @_;
90    $limit ||= 1;
91    return ($integer / DIVIDE_BY) * $limit;
92}
93
94##########################
95# Seed and PRNG Creation #
96##########################
97
98sub _create_rng {
99    my ($params) = @_;
100
101    if (!defined $params->{seed}) {
102        $params->{seed} = _get_seed();
103    }
104
105    _check_seed($params->{seed});
106
107    my @seed_ints = unpack('L*', $params->{seed});
108
109    my $rng = Math::Random::ISAAC->new(@seed_ints);
110
111    # It's faster to skip the frontend interface of Math::Random::ISAAC
112    # and just use the backend directly. However, in case the internal
113    # code of Math::Random::ISAAC changes at some point, we do make sure
114    # that the {backend} element actually exists first.
115    return $rng->{backend} ? $rng->{backend} : $rng;
116}
117
118sub _check_seed {
119    my ($seed) = @_;
120    if (length($seed) < 8) {
121        warn "Your seed is less than 8 bytes (64 bits). It could be"
122             . " easy to crack";
123    }
124    # If it looks like we were seeded with a 32-bit integer, warn the
125    # user that they are making a dangerous, easily-crackable mistake.
126    elsif (length($seed) <= 10 and $seed =~ /^\d+$/) {
127        warn "RNG seeded with a 32-bit integer, this is easy to crack";
128    }
129}
130
131sub _get_seed {
132    return _windows_seed() if ON_WINDOWS;
133
134    if (-r '/dev/urandom') {
135        return _read_seed_from('/dev/urandom');
136    }
137
138    return _read_seed_from('/dev/random');
139}
140
141sub _read_seed_from {
142    my ($from) = @_;
143
144    open(my $fh, '<', $from) or die "$from: $!";
145    my $buffer;
146    read($fh, $buffer, SEED_SIZE);
147    if (length($buffer) < SEED_SIZE) {
148        die "Could not read enough seed bytes from $from, got only "
149            . length($buffer);
150    }
151    close $fh;
152    return $buffer;
153}
154
155sub _windows_seed {
156    my ($major, $minor) = (Win32::GetOSVersion())[1,2];
157    if ($major < 5) {
158        die "Bugzilla does not support versions of Windows before"
159            . " Windows 2000";
160    }
161    # This means Windows 2000.
162    if ($major == 5 and $minor == 0) {
163        return _win2k_seed();
164    }
165
166    my $rtlgenrand = Win32::API->new('advapi32', RTLGENRANDOM_PROTO);
167    if (!defined $rtlgenrand) {
168        die "Could not import RtlGenRand: $^E";
169    }
170    my $buffer = chr(0) x SEED_SIZE;
171    my $result = $rtlgenrand->Call($buffer, SEED_SIZE);
172    if (!$result) {
173        die "RtlGenRand failed: $^E";
174    }
175    return $buffer;
176}
177
178sub _win2k_seed {
179    my $crypt_acquire = Win32::API->new(
180        "advapi32", 'CryptAcquireContext', 'PPPNN', 'I');
181    if (!defined $crypt_acquire) {
182        die "Could not import CryptAcquireContext: $^E";
183    }
184
185    my $crypt_release = Win32::API->new(
186        "advapi32", 'CryptReleaseContext', 'NN', 'I');
187    if (!defined $crypt_release) {
188        die "Could not import CryptReleaseContext: $^E";
189    }
190
191    my $crypt_gen_random = Win32::API->new(
192        "advapi32", 'CryptGenRandom', 'NNP', 'I');
193    if (!defined $crypt_gen_random) {
194        die "Could not import CryptGenRandom: $^E";
195    }
196
197    my $context = chr(0) x Win32::API::Type->sizeof('PULONG');
198    my $acquire_result = $crypt_acquire->Call(
199        $context, 0, 0, PROV_RSA_FULL, CRYPT_SILENT | CRYPT_VERIFYCONTEXT);
200    if (!defined $acquire_result) {
201        die "CryptAcquireContext failed: $^E";
202    }
203
204    my $pack_type = Win32::API::Type::packing('PULONG');
205    $context = unpack($pack_type, $context);
206
207    my $buffer = chr(0) x SEED_SIZE;
208    my $rand_result = $crypt_gen_random->Call($context, SEED_SIZE, $buffer);
209    my $rand_error = $^E;
210    # We don't check this if it fails, we don't care.
211    $crypt_release->Call($context, 0);
212    if (!defined $rand_result) {
213        die "CryptGenRandom failed: $rand_error";
214    }
215    return $buffer;
216}
217
2181;
219