File Coverage

blib/lib/Rand/Urandom.pm
Criterion Covered Total %
statement 54 66 81.8
branch 12 26 46.1
condition 3 8 37.5
subroutine 12 12 100.0
pod 2 4 50.0
total 83 116 71.5


line stmt bran cond sub pod time code
1             package Rand::Urandom;
2 3     3   47430 use strict;
  3         6  
  3         90  
3 3     3   9 use warnings;
  3         6  
  3         75  
4 3     3   9 use Config;
  3         15  
  3         102  
5 3     3   1518 use POSIX qw(EINTR ENOSYS);
  3         14214  
  3         21  
6 3     3   2484 use Exporter qw(import);
  3         3  
  3         1491  
7              
8             our @EXPORT_OK = qw(perl_rand rand_bytes);
9             our $VERSION = '0.02';
10              
11             ## no critic (Subroutines::ProhibitSubroutinePrototypes)
12             sub use_urandom(;$) {
13 11   100 11 0 1050 my $max = shift || 1;
14              
15 11         57 my $buf = rand_bytes(8);
16 11         12 my $n;
17 11 50       1631 if($Config{'use64bitint'}) {
18 11         6084 $n = unpack('Q', $buf);
19             }else {
20             # just treat it as 2 longs for now...
21 0         0 $n = unpack('LL', $buf);
22             }
23 11 100       54 return $n if ($max == 2**64);
24              
25 9         20 $max *= $n / 2**64;
26 9         126 return $max;
27             }
28              
29             sub try_syscall {
30 13     13 0 14 my $num = shift;
31 13 50       324 if ($Config{'osname'} !~ m/linux/) {
32 0         0 return;
33             }
34              
35 13 50       107 my $syscall = $Config{'archname'} =~ m/x86_64/ ? 318 : 355;
36 13         22 my $ret;
37 13         41 my $buf = ' ' x $num;
38 13         17 my $tries = 0;
39 13         57 local $! = undef;
40 13   0     13 do {
41 13         52 $ret = syscall($syscall, $buf, $num, 0);
42 13 50       114 if ($! == ENOSYS) {
43 13         28 return;
44             }
45              
46 0 0       0 if ($ret != $num) {
47 0         0 warn "Rand::Urandom: huh, getrandom() returned $ret... trying again";
48 0         0 $ret = -1;
49 0         0 $! = EINTR;
50             }
51              
52 0 0       0 if ($tries++ > 100) {
53 0         0 warn 'Rand::Urandom: getrandom() looped lots, falling back';
54 0         0 return;
55             }
56             } while ($ret == -1 && $! == EINTR);
57              
58 0         0 return $buf;
59             }
60              
61             sub rand_bytes {
62 13     13 1 1543 my $num = shift;
63              
64 13         45 my $buf = try_syscall($num);
65 13 50       30 if (!$buf) {
66 13         16 local $! = undef;
67 13 50       205 my $file = -r '/dev/arandom' ? '/dev/arandom' : '/dev/urandom';
68 13 50       377 open(my $fh, '<:raw', $file) || die "Rand::Urandom: Can't open $file: $!";
69              
70 13         9530 my $got = read($fh, $buf, $num);
71 13 50 33     75 if ($got == 0 || $got != $num) {
72 0         0 die "Rand::Urandom: failed to read from $file: $!";
73             }
74 13 50       137 close($fh) || die "Rand::Urandom: close failed: $!";
75             }
76 13         46 return $buf;
77             }
78              
79             my $orig_rand;
80             sub perl_rand {
81 4 50   4 1 137 if ($^V lt 'v5.16') {
82 0         0 die 'Rand::Urandom: sorry, you cant access the original rand function on perls older than 5.16';
83             }
84              
85 4         192 goto &$orig_rand;
86             }
87              
88             sub BEGIN {
89 3     3   15 no warnings 'redefine';
  3         3  
  3         102  
90 3     3   9 no warnings 'prototype';
  3         3  
  3         150  
91 3     3   6 $orig_rand = \&CORE::rand;
92 3         57 *CORE::GLOBAL::rand = \&use_urandom;
93             }
94              
95              
96             1;
97             __END__