Skip to content

Commit

Permalink
Producing consistent results when a SIGINT is received. Thanks to Leo…
Browse files Browse the repository at this point in the history
…nt for GH#14
  • Loading branch information
david-dick committed Jan 19, 2025
1 parent d07eae1 commit ab5737b
Show file tree
Hide file tree
Showing 6 changed files with 241 additions and 108 deletions.
1 change: 1 addition & 0 deletions MANIFEST
Original file line number Diff line number Diff line change
Expand Up @@ -15,6 +15,7 @@ t/pp.t
t/rand.t
t/export.t
t/core_fork.t
t/core_fork_pp.t
t/core_partial_read.t
t/core_read.t
t/core_sysopen.t
Expand Down
13 changes: 9 additions & 4 deletions URandom.xs
Original file line number Diff line number Diff line change
Expand Up @@ -34,12 +34,13 @@ crypt_urandom_getrandom(length)
char *data;
int result;
CODE:
Newx(data, length + 1u, char);
Newx(data, length + 1u, char);
GETRANDOM:
#ifdef HAVE_CRYPT_URANDOM_NATIVE_GETRANDOM
result = getrandom(data, length, GRND_NONBLOCK);
#else
#ifdef HAVE_CRYPT_URANDOM_SYSCALL_GETRANDOM
result = syscall(SYS_getrandom, data, length, GRND_NONBLOCK);
result = syscall(SYS_getrandom, data, length, GRND_NONBLOCK);
#else
#ifdef HAVE_CRYPT_URANDOM_NATIVE_GETENTROPY
arc4random_buf(data, length);
Expand All @@ -55,8 +56,12 @@ crypt_urandom_getrandom(length)
#endif
#endif
if (result != length) {
Safefree(data);
croak("Only read %d bytes from getrandom:%s", result, strerror(errno));
if (errno == EINTR) {
goto GETRANDOM;
} else {
Safefree(data);
croak("Failed to getrandom:%s", strerror(errno));
}
}
data[result] = '\0';
RETVAL = newSVpv(data, result);
Expand Down
203 changes: 110 additions & 93 deletions lib/Crypt/URandom.pm
Original file line number Diff line number Diff line change
Expand Up @@ -63,72 +63,79 @@ my $_rtlgenrand;
my $_urandom_handle;

sub _init {
if ( OS_WIN32() ) {
require Win32;
require Win32::API;
require Win32::API::Type;
my ( $major, $minor ) = ( Win32::GetOSVersion() )[ 1, 2 ];
my $ntorlower = ( $major < W2K_MAJOR_VERSION() ) ? 1 : 0;
my $w2k =
( $major == W2K_MAJOR_VERSION() and $minor == W2K_MINOR_VERSION() )
? 1
: 0;

if ($ntorlower) {
Carp::croak(
'No secure alternative for random number generation for Win32 versions older than W2K'
);
}
elsif ($w2k) {

my $crypt_acquire_context_a =
Win32::API->new( 'advapi32', 'CryptAcquireContextA', 'PPPNN',
'I' );
if ( !defined $crypt_acquire_context_a ) {
if ( !( ( defined $_initialised ) && ( $_initialised == $PROCESS_ID ) ) ) {
if ( OS_WIN32() ) {
require Win32;
require Win32::API;
require Win32::API::Type;
my ( $major, $minor ) = ( Win32::GetOSVersion() )[ 1, 2 ];
my $ntorlower = ( $major < W2K_MAJOR_VERSION() ) ? 1 : 0;
my $w2k =
( $major == W2K_MAJOR_VERSION()
and $minor == W2K_MINOR_VERSION() )
? 1
: 0;

if ($ntorlower) {
Carp::croak(
"Could not import CryptAcquireContext: $EXTENDED_OS_ERROR");
}

my $context = chr(0) x Win32::API::Type->sizeof('PULONG');
my $result =
$crypt_acquire_context_a->Call( $context, 0, 0, PROV_RSA_FULL(),
CRYPT_SILENT() | VERIFY_CONTEXT() );
my $pack_type = Win32::API::Type::packing('PULONG');
$context = unpack $pack_type, $context;
if ( !$result ) {
Carp::croak("CryptAcquireContext failed: $EXTENDED_OS_ERROR");
'No secure alternative for random number generation for Win32 versions older than W2K'
);
}

my $crypt_gen_random =
Win32::API->new( 'advapi32', 'CryptGenRandom', 'NNP', 'I' );
if ( !defined $crypt_gen_random ) {
Carp::croak(
"Could not import CryptGenRandom: $EXTENDED_OS_ERROR");
elsif ($w2k) {

my $crypt_acquire_context_a =
Win32::API->new( 'advapi32', 'CryptAcquireContextA', 'PPPNN',
'I' );
if ( !defined $crypt_acquire_context_a ) {
Carp::croak(
"Could not import CryptAcquireContext: $EXTENDED_OS_ERROR"
);
}

my $context = chr(0) x Win32::API::Type->sizeof('PULONG');
my $result =
$crypt_acquire_context_a->Call( $context, 0, 0,
PROV_RSA_FULL(), CRYPT_SILENT() | VERIFY_CONTEXT() );
my $pack_type = Win32::API::Type::packing('PULONG');
$context = unpack $pack_type, $context;
if ( !$result ) {
Carp::croak(
"CryptAcquireContext failed: $EXTENDED_OS_ERROR");
}

my $crypt_gen_random =
Win32::API->new( 'advapi32', 'CryptGenRandom', 'NNP', 'I' );
if ( !defined $crypt_gen_random ) {
Carp::croak(
"Could not import CryptGenRandom: $EXTENDED_OS_ERROR");
}
$_context = $context;
$_cryptgenrandom = $crypt_gen_random;
}
$_context = $context;
$_cryptgenrandom = $crypt_gen_random;
}
else {
my $rtlgenrand =
Win32::API->new( 'advapi32', <<'_RTLGENRANDOM_PROTO_');
else {
my $rtlgenrand =
Win32::API->new( 'advapi32', <<'_RTLGENRANDOM_PROTO_');
INT SystemFunction036(
PVOID RandomBuffer,
ULONG RandomBufferLength
)
_RTLGENRANDOM_PROTO_
if ( !defined $rtlgenrand ) {
Carp::croak(
"Could not import SystemFunction036: $EXTENDED_OS_ERROR");
if ( !defined $rtlgenrand ) {
Carp::croak(
"Could not import SystemFunction036: $EXTENDED_OS_ERROR"
);
}
$_rtlgenrand = $rtlgenrand;
}
$_rtlgenrand = $rtlgenrand;
}
}
else {
require FileHandle;
$_urandom_handle = FileHandle->new( PATH(), Fcntl::O_RDONLY() )
or Carp::croak(
q[Failed to open ] . PATH() . qq[ for reading:$OS_ERROR] );
binmode $_urandom_handle;
else {
require FileHandle;
$_urandom_handle = FileHandle->new( PATH(), Fcntl::O_RDONLY() )
or Carp::croak(
q[Failed to open ] . PATH() . qq[ for reading:$OS_ERROR] );
binmode $_urandom_handle;
}
$_initialised = $PROCESS_ID;
}
return;
}
Expand Down Expand Up @@ -157,55 +164,65 @@ sub _urandom {
'The length argument must be supplied and must be an integer');
}
if ( !GETRANDOM_AVAILABLE() ) {
if (
!( ( defined $_initialised ) && ( $_initialised == $PROCESS_ID ) ) )
{
_init();
$_initialised = $PROCESS_ID;
}
_init();
}
if ( OS_WIN32() ) {
my $buffer = chr(0) x $length;
if ($_cryptgenrandom) {

my $result = $_cryptgenrandom->Call( $_context, $length, $buffer );
if ( !$result ) {
Carp::croak("CryptGenRandom failed: $EXTENDED_OS_ERROR");
my $original_length = $length;
my $urandom;
BUFFER_FILLED: {
if ( OS_WIN32() ) {
$urandom = chr(0) x $length;
if ($_cryptgenrandom) {

my $result =
$_cryptgenrandom->Call( $_context, $length, $urandom );
if ( !$result ) {
Carp::croak("CryptGenRandom failed: $EXTENDED_OS_ERROR");
}
}
}
elsif ($_rtlgenrand) {
elsif ($_rtlgenrand) {

my $result = $_rtlgenrand->Call( $buffer, $length );
if ( !$result ) {
Carp::croak("RtlGenRand failed: $EXTENDED_OS_ERROR");
my $result = $_rtlgenrand->Call( $urandom, $length );
if ( !$result ) {
Carp::croak("RtlGenRand failed: $EXTENDED_OS_ERROR");
}
}
}
return $buffer;
}
elsif ( GETRANDOM_AVAILABLE() ) {
return getrandom($length);
}
else {
my $result = $_urandom_handle->$type( my $buffer, $length );
if ( defined $result ) {
if ( $result == $length ) {
return $buffer;
elsif ( GETRANDOM_AVAILABLE() ) {
return getrandom($length);
}
else {
my $result;
if ( defined $urandom ) {
$length = $original_length - ( length $urandom );
$result .= $_urandom_handle->$type( my $buffer, $length );
if ( defined $result ) {
$urandom .= $buffer;
}
}
else {
my $error = $EXTENDED_OS_ERROR;
$result = $_urandom_handle->$type( my $buffer, $length );
if ( defined $result ) {
$urandom .= $buffer;
}
}
if ( ( defined $urandom )
&& ( length $urandom == $original_length ) )
{
return $urandom;
}
elsif ( $OS_ERROR == POSIX::EINTR() ) {
redo BUFFER_FILLED;
}
else {
my $returned_bytes = length $urandom;
my $error = $EXTENDED_OS_ERROR;
$_urandom_handle = undef;
$_initialised = undef;
Carp::croak(
qq[Only read $result bytes from ] . PATH() . qq[:$error] );
Carp::croak( q[Failed to read from ] . PATH() . qq[:$error] );
}
}
else {
my $error = $EXTENDED_OS_ERROR;
$_urandom_handle = undef;
$_initialised = undef;
Carp::croak( q[Failed to read from ] . PATH() . qq[:$error] );
}
}
return $urandom;
}

1; # Magic true value required at end of module
Expand Down
46 changes: 46 additions & 0 deletions t/core_fork_pp.t
Original file line number Diff line number Diff line change
@@ -0,0 +1,46 @@
#! /usr/bin/perl -w

use strict;
use warnings;
use Test::More;
use English();
use Carp();
use English qw( -no_match_vars );
use Exporter();
use XSLoader();
use constant;
use overload;

SKIP: {
if ($^O eq 'MSWin32') {
skip("No functions to override in Win32", 1);
} else {
require FileHandle;
@INC = qw(blib/lib); # making sure we're testing pure perl version
require Crypt::URandom;
my $initial_length = 20;
my $initial_data = Crypt::URandom::urandom($initial_length);
ok(length $initial_data == $initial_length, "Correct number of bytes returned before fork:$initial_length");
if (my $pid = fork) {
my $parent_length = 30;
my $parent_data = Crypt::URandom::urandom($parent_length);
ok(length $parent_data == $parent_length, "Correct number of bytes returned in parent after fork:$parent_length");
waitpid $pid, 0;
ok($? == 0, "Correct number of bytes returned in child after fork");
} elsif (defined $pid) {
my $child_length = 15;
my $child_data = Crypt::URandom::urandom($child_length);
if (length $child_data == $child_length) {
exit 0;
} else {
exit 1;
}
} else {
die "Failed to fork:$!";
}
my $post_length = 20;
my $post_data = Crypt::URandom::urandom($post_length);
ok(length $post_data == $post_length, "Correct number of bytes returned after fork:$post_length");
}
}
done_testing();
22 changes: 19 additions & 3 deletions t/core_partial_read.t
Original file line number Diff line number Diff line change
Expand Up @@ -8,6 +8,7 @@ use Carp();
use English qw( -no_match_vars );
use Exporter();
use XSLoader();
use POSIX();
use constant;
use overload;

Expand All @@ -16,10 +17,10 @@ SKIP: {
skip("No functions to override in Win32", 1);
} else {
no warnings;
*CORE::GLOBAL::read = sub { return 0 };
*CORE::GLOBAL::sysread = sub { return 0 };
*CORE::GLOBAL::read = sub { $_[1] = q[]; $! = POSIX::EAGAIN(); return 0 };
*CORE::GLOBAL::sysread = sub { $_[1] = q[]; $! = POSIX::EAGAIN(); return 0 };
use warnings;
my $required_error_message = quotemeta "Only read 0 bytes from";
my $required_error_message = quotemeta "Failed to read from";
require FileHandle;
@INC = qw(blib/lib); # making sure we're testing pure perl version
require Crypt::URandom;
Expand All @@ -37,6 +38,21 @@ SKIP: {
};
chomp $@;
ok(!$generated && $@ =~ /$required_error_message/smx, "Correct exception thrown when partial sysread returns:$@");
my @sample_random_data = ('a', 'bc');
no warnings;
*CORE::GLOBAL::read = sub { $_[1] = shift @sample_random_data; $! = POSIX::EINTR(); return length $_[1] };
*CORE::GLOBAL::sysread = sub { $_[1] = shift @sample_random_data; $! = POSIX::EINTR(); return length $_[1] };
use warnings;
my $expected_result = join q[], @sample_random_data;
my $actual_result = Crypt::URandom::urandom(3);
ok($actual_result eq $expected_result, "Correctly survived an EINTR in urandom:$actual_result vs $expected_result");
@sample_random_data = ('a', 'bc');
no warnings;
*CORE::GLOBAL::read = sub { $_[1] = shift @sample_random_data; $! = POSIX::EINTR(); return length $_[1] };
*CORE::GLOBAL::sysread = sub { $_[1] = shift @sample_random_data; $! = POSIX::EINTR(); return length $_[1] };
use warnings;
$actual_result = Crypt::URandom::urandom_ub(3);
ok($actual_result eq $expected_result, "Correctly survived an EINTR in urandom_nb:$actual_result vs $expected_result");
}
}
done_testing();
Loading

0 comments on commit ab5737b

Please sign in to comment.