File Coverage

blib/lib/Net/OnlineCode/RNG.pm
Criterion Covered Total %
statement 50 80 62.5
branch 4 12 33.3
condition 2 2 100.0
subroutine 14 21 66.6
pod 0 13 0.0
total 70 128 54.6


line stmt bran cond sub pod time code
1             package Net::OnlineCode::RNG;
2              
3 1     1   14590 use strict;
  1         2  
  1         32  
4 1     1   4 use warnings;
  1         1  
  1         21  
5              
6 1     1   4 use Fcntl;
  1         4  
  1         230  
7 1     1   484 use Digest::SHA qw(sha1);
  1         2641  
  1         76  
8 1     1   456 use POSIX qw(ceil floor);
  1         4761  
  1         5  
9              
10 1     1   775 use vars qw(@ISA @EXPORT_OK %EXPORT_TAGS $VERSION);
  1         2  
  1         100  
11              
12             require Exporter;
13              
14             @ISA = qw(Exporter);
15             @EXPORT_OK = qw(random_uuid_160);
16             $VERSION = '0.04';
17              
18             #
19             # Random number generator
20             #
21              
22             # A portable random number generator is needed if this program is to
23             # be used to transfer data from one machine to another. This is
24             # because the sending program does not transmit any metadata along
25             # with the check blocks to indicate which and how many composite
26             # blocks each contains. Likewise, the information relating which and
27             # how many message blocks are contained in an auxiliary block is not
28             # sent.
29             #
30             # While it would be possible to send this metadata in a particular
31             # implementation, the solution used here is based on having identical
32             # pseudo-random number generators set up on both sender and receiver
33             # machines. When the sender machine begins a transfer, it will send a
34             # random 160-bit number, along with any other metadata such as
35             # filename, file size, block size and q and e parameters. Both sender
36             # and receiver then seed a deterministic PRNG with the 160-bit value.
37             #
38             # The sender then uses this seeded PRNG to randomly create 0.55qen
39             # auxiliary blocks. The receiver carries out the same operation and
40             # since it is using both the same seed value and the same RNG
41             # algorithm, both sides should agree on which message blocks are xored
42             # into which auxiliary blocks.
43             #
44             # In a similar manner, when sending a check block, the receiver first
45             # selects a random seed value. This seed value is then used with the
46             # RNG algorithm to select which composite blocks are to be included in
47             # the check block. When the receiver receives the packet it unpacks
48             # the seed value and uses it to seed the RNG. It goes through the same
49             # algorithm that the sender used to decide which composite blocks were
50             # included in the check block and saves that information along with
51             # the data for the check block itself.
52             #
53             # The RNG used in this implementation is based on repeated application
54             # of the SHA-1 message digest algorithm. This was chosen because:
55             #
56             # * SHA-1 is a published standard, so we can be fairly certain that
57             # the implementations on different machines will produce the same
58             # results.
59             #
60             # * there are implementations available in a variety of languages, so
61             # it is possible to make interoperable implementations in those
62             # languages
63             #
64             # * it produces a 160-bit value, which is large enough to use as a
65             # unique block (or filename) ID, even if used in a long-running
66             # program
67             #
68             # * also, we can feed the output of one call to the digest function
69             # back in as input to get a new pseudo-random number. It should be
70             # highly unlikely that cycles will appear over the lifetime of its
71             # use, so it is unlikely to skew the probability distributions that
72             # we want to use.
73             #
74             # * message digest functions are designed with some desirable features
75             # in mind, such as having output bits that are uncorrelated with the
76             # input, having long limit cycles and not having obvious biases in
77             # the output. These features are very useful when using a message
78             # digest algorithm as a PRNG.
79             #
80             # The one potential disadvantage of using a message digest algorithm
81             # over some other custom PRNG is that it may not perform as well.
82             # However, I believe that the benefits of using a readily-available
83             # implementation (along with the other advantages listed) outweigh
84             # this minor disadvantage. For those reasons, I will use SHA-1 here.
85              
86              
87             # RNG object only contains seed and current values so store them in an
88             # array rather than a hash for efficiency.
89              
90 1     1   5 use constant CURRENT => 0;
  1         1  
  1         67  
91 1     1   4 use constant SEED => 1;
  1         1  
  1         589  
92              
93             sub new {
94              
95 2     2 0 11 my ($class, $seed) = @_;
96 2         4 my $self = [ undef, $seed ];
97              
98 2         3 bless $self, $class;
99 2         5 $self->seed($seed);
100 2         3 return $self;
101             }
102              
103             sub new_random {
104              
105 0     0 0 0 my $class = shift;
106 0         0 my $self = [ undef, undef ];
107              
108 0         0 bless $self, $class;
109 0         0 $self->seed_random();
110 0         0 return $self;
111             }
112              
113              
114             # Note that seed/srand with no args is usually implemented to
115             # pick a random value. For this application, it's better to set
116             # up some deterministic value
117              
118             sub seed {
119 3     3 0 4 my $self = shift;
120 3         3 my $seed = shift;
121              
122 3 50       6 die "seed: self object not a reference\n" unless ref($self);
123              
124 3 100       6 $seed = "\0" x 20 unless defined($seed);
125 3         6 $self->[SEED] = $seed;
126 3         4 $self->[CURRENT] = $seed;
127 3         5 return $seed;
128             }
129              
130             # Also provide seed_random to set a random seed
131             sub seed_random {
132 0     0 0 0 my $self = shift;
133              
134 0         0 return $self->seed(random_uuid_160());
135             }
136              
137             sub get_seed {
138 3     3 0 316 return shift->[SEED];
139             }
140              
141             # As per Perl's rand, return a float value, 0 <= value < x
142             sub rand {
143 51     51 0 588 my ($self,$max) = @_;
144 51   100     63 $max = $max || 1.0;
145 51         34 $max += 0.0; # ensure max is a float
146              
147 51         33 my ($maxint,$r, $ratio, $current) = (0xffffffff);
148 51         34 while(1) {
149             # advance to the next rand
150 51         158 $current = $self->[CURRENT] = sha1($self->[CURRENT]);
151              
152             # Unpack first 32-bit little-endian word from SHA1 value
153 51         53 $r = unpack "V1", $current;
154              
155             # We calculate the rand by max * uint/(max 32-bit int).
156             # Divide first
157 51 50       68 if ($r < $maxint) {
158 51         31 $ratio = $r / $maxint;
159 51         38 $ratio *= $max;
160 51         67 return $ratio;
161             }
162             }
163             }
164              
165             # Encapsulate the most common use case of wanting random integers in
166             # the range [0,max]
167             sub randint {
168 0     0 0 0 my ($self, $max) = @_;
169 0         0 return floor($self->rand($max + 1));
170             }
171              
172             # The remaining subs are debugging purposes. They report back the
173             # last random number in a variety of formats, but do not advance
174             # to the next rand
175              
176              
177             sub current {
178 3     3 0 14 return shift->[CURRENT];
179             }
180              
181             sub as_string { # alias for "current" method
182 1     1 0 4 return shift->[CURRENT];
183             }
184              
185             # Unpacking as bytes or 32-bit unsigned ints. Using little-endian
186             # since it's more common
187             sub as_byte_array {
188 0     0 0   return unpack "C20", shift->[CURRENT];
189             }
190              
191             sub as_uint32_array {
192 0     0 0   return unpack "V5", shift->[CURRENT];
193             }
194              
195              
196             sub as_hex {
197 0     0 0   return unpack "H40", shift->[CURRENT];
198             }
199              
200             # *nix-specific helper function to get a random 160-bit value from the
201             # output of /dev/urandom. This does not affect the current value of
202             # the RNG, but the returned value can be used to seed it.
203              
204             sub random_uuid_160 {
205 0     0 0   my $self = shift; # we don't need an object ref.
206              
207             # sysopen/sysread avoids any potential problem with opening file in
208             # non-binary mode
209 0 0         if(!sysopen (RAND, "/dev/urandom", O_RDONLY)) {
210              
211             # This probably isn't a Linux machine, so fall back to using
212             # Perl's internal (non-secure) RNG. This isn't meant to be a
213             # proper solution---it's only so that smoker tests don't die on
214             # Windows platforms or other *nix distros that have a /dev/random
215             # but not a /dev/urandom
216              
217             # always warn since this is a potential security problem and not
218             # really meant to be used
219 0           warn "This machine doesn't have /dev/urandom; using rand() instead\n";
220              
221 0           my $uuid="";
222 0           for (1..20) { $uuid.= chr CORE::rand 256 }; # rand() is ambiguous
  0            
223 0           return $uuid;
224              
225             }
226              
227 0           my $bits = '';
228 0           my $chunk = '';
229 0           my $rc = 0;
230              
231             # use a loop in case we read fewer than the required number of bytes
232 0           do {
233 0           $rc = (sysread RAND,$chunk,20-length($bits));
234              
235 0 0         if (defined ($rc)) {
236 0 0         if ($rc) {
237 0           $bits .= $chunk;
238             } else {
239 0           die "Random source dried up (unexpected EOF)!\n";
240             }
241             } else {
242 0           die "Failed to sysread from urandom: $!\n";
243             }
244             } while (length $bits < 20);
245              
246 0           return $bits;
247             }
248              
249             1;
250