From ab5737bed5aec17f9b5daedfaf17ea5dd4442baa Mon Sep 17 00:00:00 2001 From: David Dick Date: Sun, 19 Jan 2025 18:37:07 +1100 Subject: [PATCH] Producing consistent results when a SIGINT is received. Thanks to Leont for GH#14 --- MANIFEST | 1 + URandom.xs | 13 ++- lib/Crypt/URandom.pm | 203 +++++++++++++++++++++++------------------- t/core_fork_pp.t | 46 ++++++++++ t/core_partial_read.t | 22 ++++- t/getrandom.t | 64 +++++++++++-- 6 files changed, 241 insertions(+), 108 deletions(-) create mode 100644 t/core_fork_pp.t diff --git a/MANIFEST b/MANIFEST index 3af2c0d..d0edc51 100644 --- a/MANIFEST +++ b/MANIFEST @@ -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 diff --git a/URandom.xs b/URandom.xs index a6fc357..54baeab 100644 --- a/URandom.xs +++ b/URandom.xs @@ -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); @@ -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); diff --git a/lib/Crypt/URandom.pm b/lib/Crypt/URandom.pm index 9dfcfec..319b6a0 100644 --- a/lib/Crypt/URandom.pm +++ b/lib/Crypt/URandom.pm @@ -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; } @@ -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 diff --git a/t/core_fork_pp.t b/t/core_fork_pp.t new file mode 100644 index 0000000..019f5a1 --- /dev/null +++ b/t/core_fork_pp.t @@ -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(); diff --git a/t/core_partial_read.t b/t/core_partial_read.t index 762135e..aed970a 100644 --- a/t/core_partial_read.t +++ b/t/core_partial_read.t @@ -8,6 +8,7 @@ use Carp(); use English qw( -no_match_vars ); use Exporter(); use XSLoader(); +use POSIX(); use constant; use overload; @@ -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; @@ -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(); diff --git a/t/getrandom.t b/t/getrandom.t index db429ab..4bf428b 100644 --- a/t/getrandom.t +++ b/t/getrandom.t @@ -17,7 +17,9 @@ if ($^O eq 'MSWin32') { SKIP: { if ($^O eq 'linux') { # LD_PRELOAD trick works here if (($optional{DEFINE}) && ($optional{DEFINE} eq '-DHAVE_CRYPT_URANDOM_NATIVE_GETRANDOM')) { - + my $is_covering = !!(eval 'Devel::Cover::get_coverage()'); + my @extra_args = $is_covering ? ('-MDevel::Cover') : (); + my $correct_length = 27; my $failed_number_of_bytes = 13; my $error_number = POSIX::EINTR() + 0; my $c_path = 'getrandom.c'; @@ -28,32 +30,78 @@ SKIP: { #include #include +int count = 0; + ssize_t getrandom(void *buf, size_t buflen, unsigned int flags) { - errno = $error_number; - return $failed_number_of_bytes; + count = count + 1; + if (count <= 2) { + errno = $error_number; + return $failed_number_of_bytes; + } else { + errno = 0; + return buflen; + } } _OUT_ my $binary_path = './getrandom.so'; my $result = system { $Config{cc} } $Config{cc}, $Config{cccdlflags}, '-shared', '-o', $binary_path, $c_path; - ok($result == 0, "Compiled a LD_PRELOAD binary at $binary_path:$!"); + ok($result == 0, "Compiled a LD_PRELOAD binary at $binary_path:$?"); my $handle = FileHandle->new(); + if (my $pid = $handle->open(q[-|])) { + my $line = <$handle>; + chomp $line; + my $actual_length = length $line; + ok($actual_length == $correct_length, "getrandom hit with INT signal after $failed_number_of_bytes bytes recovers to produce correct length of $correct_length bytes:$actual_length"); + waitpid $pid, 0; + ok($? == 0, "Successfully processed getrandom"); + } elsif (defined $pid) { + local $ENV{LD_PRELOAD} = $binary_path; + eval { + exec { $^X } $^X, (map { "-I$_" } @INC), @extra_args, '-MCrypt::URandom', '-e', 'my $data = Crypt::URandom::getrandom(' . $correct_length . '); print "$data\n"; exit 0;' or die "Failed to exec $^X:$!"; + } or do { + warn "$@"; + }; + exit 1; + } else { + die "Failed to fork:$!"; + } + unlink $c_path or die "Failed to unlink $c_path:$!"; + unlink $binary_path or die "Failed to unlink $binary_path:$!";; + + $failed_number_of_bytes = -1; + $error_number = POSIX::EAGAIN() + 0; + $c_handle = FileHandle->new($c_path, Fcntl::O_CREAT() | Fcntl::O_WRONLY() | Fcntl::O_EXCL()) or die "Failed to open $c_path for writing:$!"; + print $c_handle <<"_OUT_"; +#include +#include +#include + +ssize_t getrandom(void *buf, size_t buflen, unsigned int flags) { + errno = $error_number; + return $failed_number_of_bytes; +} +_OUT_ + $result = system { $Config{cc} } $Config{cc}, $Config{cccdlflags}, '-shared', '-o', $binary_path, $c_path; + ok($result == 0, "Compiled a LD_PRELOAD binary at $binary_path:$!"); + $handle = FileHandle->new(); + if (my $pid = $handle->open(q[-|])) { my $line = <$handle>; chomp $line; my ($actual_error, $entire_message) = split /\t/smx, $line; - $! = POSIX::EINTR(); + $! = POSIX::EAGAIN(); my $correct_error = "$!"; ok($actual_error eq $correct_error, "Correct error caught:'$actual_error' vs '$correct_error'"); - my $correct_message = "Only read $failed_number_of_bytes bytes from getrandom:$actual_error"; + my $correct_message = "Failed to getrandom:$actual_error"; my $quoted_correct_message = quotemeta $correct_message; ok($entire_message =~ /^$quoted_correct_message/smx, "Error message is correct:$entire_message"); waitpid $pid, 0; - ok($? == 0, "Successfully caught exception for broken getrandom"); + ok($? == 0, "Successfully caught exception for broken getrandom:$?"); } elsif (defined $pid) { local $ENV{LD_PRELOAD} = $binary_path; eval { - exec { $^X } $^X, (map { "-I$_" } @INC), '-MCrypt::URandom', '-e', 'eval { Crypt::URandom::getrandom(28); } or do { print "$!\t$@\n"; exit 0 }; exit 1;' or die "Failed to exec $^X:$!"; + exec { $^X } $^X, (map { "-I$_" } @INC), @extra_args, '-MCrypt::URandom', '-e', 'eval { Crypt::URandom::getrandom(28); } or do { print "$!\t$@\n"; exit 0 }; exit 1;' or die "Failed to exec $^X:$!"; } or do { warn "$@"; };