File Coverage

blib/lib/Crypt/URandom.pm
Criterion Covered Total %
statement 47 91 51.6
branch 16 44 36.3
condition 2 6 33.3
subroutine 11 16 68.7
pod 2 9 22.2
total 78 166 46.9


line stmt bran cond sub pod time code
1             package Crypt::URandom;
2              
3 5     5   223854 use warnings;
  5         28  
  5         183  
4 5     5   29 use strict;
  5         10  
  5         109  
5 5     5   25 use Carp();
  5         21  
  5         103  
6 5     5   2470 use English qw( -no_match_vars );
  5         14138  
  5         29  
7 5     5   1657 use Exporter();
  5         10  
  5         5558  
8             *import = \&Exporter::import;
9             our @EXPORT_OK = qw(
10             urandom
11             urandom_ub
12             );
13             our %EXPORT_TAGS = ( 'all' => \@EXPORT_OK, );
14              
15             our $VERSION = '0.37';
16             our @CARP_NOT = ('Crypt::URandom');
17              
18 0     0 0 0 sub CRYPT_SILENT { return 64; } # hex 40
19 0     0 0 0 sub PROV_RSA_FULL { return 1; }
20 0     0 0 0 sub VERIFY_CONTEXT { return 4_026_531_840; } # hex 'F0000000'
21 0     0 0 0 sub W2K_MAJOR_VERSION { return 5; }
22 0     0 0 0 sub W2K_MINOR_VERSION { return 0; }
23 12     12 0 911 sub SINGLE_QUOTE { return q[']; }
24              
25             sub PATH {
26 14     14 0 33 my $path = '/dev/urandom';
27 14 50       44 if ( $OSNAME eq 'freebsd' ) {
28 0         0 $path = '/dev/random'; # FreeBSD's /dev/random is non-blocking
29             }
30 14         83 return $path;
31             }
32              
33             my $_initialised;
34             my $_context;
35             my $_cryptgenrandom;
36             my $_rtlgenrand;
37             my $_urandom_handle;
38              
39             sub _init {
40 8 50   8   34 if ( $OSNAME eq 'MSWin32' ) {
41 0         0 require Win32;
42 0         0 require Win32::API;
43 0         0 require Win32::API::Type;
44 0         0 my ( $major, $minor ) = ( Win32::GetOSVersion() )[ 1, 2 ];
45 0 0       0 my $ntorlower = ( $major < W2K_MAJOR_VERSION() ) ? 1 : 0;
46 0 0 0     0 my $w2k =
47             ( $major == W2K_MAJOR_VERSION() and $minor == W2K_MINOR_VERSION() )
48             ? 1
49             : 0;
50              
51 0 0       0 if ($ntorlower) {
    0          
52 0         0 Carp::croak(
53             'No secure alternative for random number generation for Win32 versions older than W2K'
54             );
55             }
56             elsif ($w2k) {
57              
58 0         0 my $crypt_acquire_context_a =
59             Win32::API->new( 'advapi32', 'CryptAcquireContextA', 'PPPNN',
60             'I' );
61 0 0       0 if ( !defined $crypt_acquire_context_a ) {
62 0         0 Carp::croak(
63             "Could not import CryptAcquireContext: $EXTENDED_OS_ERROR");
64             }
65              
66 0         0 my $context = chr(0) x Win32::API::Type->sizeof('PULONG');
67 0         0 my $result =
68             $crypt_acquire_context_a->Call( $context, 0, 0, PROV_RSA_FULL(),
69             CRYPT_SILENT() | VERIFY_CONTEXT() );
70 0         0 my $pack_type = Win32::API::Type::packing('PULONG');
71 0         0 $context = unpack $pack_type, $context;
72 0 0       0 if ( !$result ) {
73 0         0 Carp::croak("CryptAcquireContext failed: $EXTENDED_OS_ERROR");
74             }
75              
76 0         0 my $crypt_gen_random =
77             Win32::API->new( 'advapi32', 'CryptGenRandom', 'NNP', 'I' );
78 0 0       0 if ( !defined $crypt_gen_random ) {
79 0         0 Carp::croak(
80             "Could not import CryptGenRandom: $EXTENDED_OS_ERROR");
81             }
82 0         0 $_context = $context;
83 0         0 $_cryptgenrandom = $crypt_gen_random;
84             }
85             else {
86 0         0 my $rtlgenrand =
87             Win32::API->new( 'advapi32', <<'_RTLGENRANDOM_PROTO_');
88             INT SystemFunction036(
89             PVOID RandomBuffer,
90             ULONG RandomBufferLength
91             )
92             _RTLGENRANDOM_PROTO_
93 0 0       0 if ( !defined $rtlgenrand ) {
94 0         0 Carp::croak(
95             "Could not import SystemFunction036: $EXTENDED_OS_ERROR");
96             }
97 0         0 $_rtlgenrand = $rtlgenrand;
98             }
99             }
100             else {
101 8         1843 require FileHandle;
102 8 100       39556 $_urandom_handle = FileHandle->new( PATH(), Fcntl::O_RDONLY() )
103             or Carp::croak( 'Failed to open '
104             . SINGLE_QUOTE()
105             . PATH()
106             . SINGLE_QUOTE()
107             . " for reading:$OS_ERROR" );
108 6         575 binmode $_urandom_handle;
109             }
110 6         12 return;
111             }
112              
113             sub urandom_ub {
114 7     7 1 706 my ($length) = @_;
115 7         16 return _urandom( 'sysread', $length );
116             }
117              
118             sub urandom {
119 11     11 1 12665 my ($length) = @_;
120 11         29 return _urandom( 'read', $length );
121             }
122              
123             sub _urandom {
124 18     18   39 my ( $type, $length ) = @_;
125              
126 18         27 my $length_ok;
127 18 100       50 if ( defined $length ) {
128 17 100       97 if ( $length =~ /^\d+$/xms ) {
129 16         32 $length_ok = 1;
130             }
131             }
132 18 100       43 if ( !$length_ok ) {
133 2         309 Carp::croak(
134             'The length argument must be supplied and must be an integer');
135             }
136 16 100 66     67 if ( !( ( defined $_initialised ) && ( $_initialised == $PROCESS_ID ) ) ) {
137 8         20 _init();
138 6         30 $_initialised = $PROCESS_ID;
139             }
140 14 50       50 if ( $OSNAME eq 'MSWin32' ) {
141 0         0 my $buffer = chr(0) x $length;
142 0 0       0 if ($_cryptgenrandom) {
    0          
143              
144 0         0 my $result = $_cryptgenrandom->Call( $_context, $length, $buffer );
145 0 0       0 if ( !$result ) {
146 0         0 Carp::croak("CryptGenRandom failed: $EXTENDED_OS_ERROR");
147             }
148             }
149             elsif ($_rtlgenrand) {
150              
151 0         0 my $result = $_rtlgenrand->Call( $buffer, $length );
152 0 0       0 if ( !$result ) {
153 0         0 Carp::croak("RtlGenRand failed: $EXTENDED_OS_ERROR");
154             }
155             }
156 0         0 return $buffer;
157             }
158             else {
159 14         78 my $result = $_urandom_handle->$type( my $buffer, $length );
160 14 100       340 if ( defined $result ) {
161 10 50       21 if ( $result == $length ) {
162 10         67 return $buffer;
163             }
164             else {
165 0         0 $_urandom_handle = undef;
166 0         0 $_initialised = undef;
167 0         0 Carp::croak( "Only read $result bytes from "
168             . SINGLE_QUOTE()
169             . PATH()
170             . SINGLE_QUOTE() );
171             }
172             }
173             else {
174 4         23 my $error = $OS_ERROR;
175 4         47 $_urandom_handle = undef;
176 4         9 $_initialised = undef;
177 4         8 Carp::croak( 'Failed to read from '
178             . SINGLE_QUOTE()
179             . PATH()
180             . SINGLE_QUOTE()
181             . ":$error" );
182             }
183             }
184             }
185              
186             1; # Magic true value required at end of module
187             __END__