File Coverage

blib/lib/Sys/GetRandom/PP.pm

Criterion	Covered	Total	%
statement	43	45	95.5
branch	8	14	57.1
condition	3	9	33.3
subroutine	8	8	100.0
pod	2	2	100.0
total	64	78	82.0

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,
        'openbsd'       => 7,
        '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"
    };
    +{
        _IS_OPENBSD    => $^O eq 'openbsd',
        _SYS_getrandom => $getrandom,
        GRND_NONBLOCK  => 1,
        GRND_RANDOM    => 2,
    }
};
BEGIN {
    require Errno if _IS_OPENBSD;
}

our $VERSION = '0.09';

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

sub getrandom ($$;$$) {
    if (@_ < 2 || @_ > 4) {
        croak 'Usage: ' . __PACKAGE__ . '::getrandom($buffer, $length, $flags = 0, $offset = 0)';
    }
    my $bufref = \$_[0];
    my (undef, $length, $flags, $offset) = @_;
    $length |= 0;
    $flags |= 0;
    $offset |= 0;
    $$bufref .= '';

    my $realbuf = "\0" x $length;

    my $r;
    if (_IS_OPENBSD) {
        # validate, but ignore
        if ($flags & ~(GRND_NONBLOCK | GRND_RANDOM)) {
            $! = Errno::EINVAL;
            return undef;
        }
        $r = syscall _SYS_getrandom, $realbuf, $length;
        if ($r == -1) {
            return undef;
        }
        $r = $length;
    } else {
        $r = syscall _SYS_getrandom, $realbuf, $length, $flags;
        if ($r == -1) {
            return undef;
        }
        substr($realbuf, $r) = '';
    }


    my $dlen = $offset - length $$bufref;
    $$bufref .= "\0" x $dlen
        if $dlen > 0;
    substr($$bufref, $offset) = $realbuf;

    $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__