File Coverage

blib/lib/Crypt/URandom.pm

Criterion	Covered	Total	%
statement	50	91	54.9
branch	17	44	38.6
condition	3	6	50.0
subroutine	11	16	68.7
pod	2	9	22.2
total	83	166	50.0

package Crypt::URandom;

use warnings;
use strict;
use Carp();
use English qw( -no_match_vars );
use Exporter();
*import = \&Exporter::import;
our @EXPORT_OK = qw(
  urandom
  urandom_ub
);
our %EXPORT_TAGS = ( 'all' => \@EXPORT_OK, );

our $VERSION  = '0.39';
our @CARP_NOT = ('Crypt::URandom');

sub CRYPT_SILENT      { return 64; }               # hex 40
sub PROV_RSA_FULL     { return 1; }
sub VERIFY_CONTEXT    { return 4_026_531_840; }    # hex 'F0000000'
sub W2K_MAJOR_VERSION { return 5; }
sub W2K_MINOR_VERSION { return 0; }
sub SINGLE_QUOTE      { return q[']; }

sub PATH {
    my $path = '/dev/urandom';
    if ( $OSNAME eq 'freebsd' ) {
        $path = '/dev/random';    # FreeBSD's /dev/random is non-blocking
    }
    return $path;
}

my $_initialised;
my $_context;
my $_cryptgenrandom;
my $_rtlgenrand;
my $_urandom_handle;

sub _init {
    if ( $OSNAME eq 'MSWin32' ) {
        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 ) {
                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;
        }
        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");
            }
            $_rtlgenrand = $rtlgenrand;
        }
    }
    else {
        require FileHandle;
        $_urandom_handle = FileHandle->new( PATH(), Fcntl::O_RDONLY() )
          or Carp::croak( 'Failed to open '
              . SINGLE_QUOTE()
              . PATH()
              . SINGLE_QUOTE()
              . " for reading:$OS_ERROR" );
        binmode $_urandom_handle;
    }
    return;
}

sub urandom_ub {
    my ($length) = @_;
    return _urandom( 'sysread', $length );
}

sub urandom {
    my ($length) = @_;
    return _urandom( 'read', $length );
}

sub _urandom {
    my ( $type, $length ) = @_;

    my $length_ok;
    if ( defined $length ) {
        if ( $length =~ /^\d+$/xms ) {
            $length_ok = 1;
        }
    }
    if ( !$length_ok ) {
        Carp::croak(
            'The length argument must be supplied and must be an integer');
    }
    if ( !( ( defined $_initialised ) && ( $_initialised == $PROCESS_ID ) ) ) {
        _init();
        $_initialised = $PROCESS_ID;
    }
    if ( $OSNAME eq 'MSWin32' ) {
        my $buffer = chr(0) x $length;
        if ($_cryptgenrandom) {

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

            my $result = $_rtlgenrand->Call( $buffer, $length );
            if ( !$result ) {
                Carp::croak("RtlGenRand failed: $EXTENDED_OS_ERROR");
            }
        }
        return $buffer;
    }
    else {
        my $result = $_urandom_handle->$type( my $buffer, $length );
        if ( defined $result ) {
            if ( $result == $length ) {
                return $buffer;
            }
            else {
                $_urandom_handle = undef;
                $_initialised    = undef;
                Carp::croak( "Only read $result bytes from "
                      . SINGLE_QUOTE()
                      . PATH()
                      . SINGLE_QUOTE() );
            }
        }
        else {
            my $error = $OS_ERROR;
            $_urandom_handle = undef;
            $_initialised    = undef;
            Carp::croak( 'Failed to read from '
                  . SINGLE_QUOTE()
                  . PATH()
                  . SINGLE_QUOTE()
                  . ":$error" );
        }
    }
}

1;    # Magic true value required at end of module
__END__