File Coverage

blib/lib/Sys/GetRandom/PP.pm

Criterion	Covered	Total	%
statement	38	41	92.6
branch	8	16	50.0
condition	3	9	33.3
subroutine	7	7	100.0
pod	2	2	100.0
total	58	75	77.3

package Sys::GetRandom::PP;
use strict;
use warnings;

use Exporter qw(import);
use Carp qw(croak);

use constant do {
    my %bits_getrandom = (
        'dragonfly'     => 550,
        'freebsd'       => 563,
        'midnightbsd'   => 563,
        'netbsd'        => 91,
        'solaris'       => 126,
        'aarch64-linux' => 278,
        'armv6l-linux'  => 384,
        'i686-linux'    => 355,
        'x86_64-linux'  => 318,
    );
    my $getrandom = $bits_getrandom{$^O} || do {
        require Config;
        my ($arch) = $Config::Config{archname} =~ m{^([^\-]+-[^\-]+)};
        $bits_getrandom{$arch} || die "Unsupported platform: $arch"
    };
    +{
        _SYS_getrandom => $getrandom,
        GRND_NONBLOCK  => 1,
        GRND_RANDOM    => 2,
    }
};

our $VERSION = '0.06_001';
$VERSION =~ tr/_//d;

our @EXPORT_OK = qw(
    GRND_RANDOM
    GRND_NONBLOCK
    getrandom
    random_bytes
);

sub getrandom ($$;$) {
    if (@_ < 2 || @_ > 3) {
        croak 'Usage: ' . __PACKAGE__ . '::getrandom($buffer, $length, $flags = 0)';
    }
    my $bufref = \$_[0];
    my (undef, $length, $flags) = @_;
    $length |= 0;
    $flags |= 0;
    $$bufref .= '';
    utf8::downgrade $$bufref;
    my $dlen = $length - length $$bufref;
    $$bufref .= $dlen > 0 ? "\0" x $dlen : '';
    my $r = syscall _SYS_getrandom, $$bufref, $length, $flags;
    if ($r == -1) {
        substr($$bufref, -$dlen) = '' if $dlen > 0;
        return undef;
    }
    substr($$bufref, $r) = '';
    $r
}

sub random_bytes {
    my ($n) = @_;
    $n |= 0;
    $n >= 0 && $n <= 256
        or croak "Argument to random_bytes() must be an integer between 0 and 256, not $n";
    return '' if $n == 0;
    defined(my $r = getrandom(my $buf, $n))
        or die "Internal error: getrandom(\$buf, $n) failed: $!";
    $r == $n
        or die "Internal error: getrandom(\$buf, $n) returned $r";
    $buf
}

1
__END__