File Coverage

blib/lib/Rand/Urandom.pm

Criterion	Covered	Total	%
statement	57	72	79.1
branch	17	38	44.7
condition	6	14	42.8
subroutine	12	12	100.0
pod	2	4	50.0
total	94	140	67.1

package Rand::Urandom;
use strict;
use warnings;
use Config;
use POSIX qw(EINTR ENOSYS);
use Exporter qw(import);

our @EXPORT_OK = qw(perl_rand rand_bytes);
our $VERSION = '0.03';

## no critic (Subroutines::ProhibitSubroutinePrototypes)
sub use_urandom(;$) {
	my $max = shift || 1;

	my $buf = rand_bytes(8);
	my $n;
	if($Config{'use64bitint'}) {
		$n = unpack('Q', $buf);
	}else {
		# just treat it as 2 longs for now...
		$n = unpack('LL', $buf);
	}
	return $n if ($max == 2**64);

	$max *= $n / 2**64;
	return $max;
}

my $syscall;
my $bsd;
sub try_syscall {
	my $num = shift;

	if(!defined $syscall) {
		if($Config{'osname'} =~ m/openbsd/i && $Config{'archname'} =~ m/amd64/) {
			$syscall = 7;
			$bsd = 1;
		}elsif ($Config{'osname'} =~ m/linux/) {
			$syscall = $Config{'archname'} =~ m/x86_64/ ? 318 : 355;
		}else {
			$syscall = -1;
		}
	}
	return if($syscall < 0);

	my $ret;
	my $buf   = ' ' x $num;
	my $tries = 0;
	local $! = undef;
	do {
		$ret = syscall($syscall, $buf, $num, 0);
		if ($! == ENOSYS) {
			return;
		}

		if ($ret != ($bsd ? 0 : $num)) {
			warn "Rand::Urandom: huh, getrandom() returned $ret... trying again";
			$ret = -1;
			$!   = EINTR;
		}

		if ($tries++ > 100) {
			warn 'Rand::Urandom: getrandom() looped lots, falling back';
			return;
		}
	} while ($ret == -1 && $! == EINTR);

	# didn't fill in the buffer? fallback
	return if($buf =~ m/^ +$/);

	return $buf;
}

sub rand_bytes {
	my $num = shift;

	my $buf;
	$buf = try_syscall($num) if(!defined $syscall || $syscall > 0);

	if (!$buf) {
		local $! = undef;
		my $file = -r '/dev/arandom' ? '/dev/arandom' : '/dev/urandom';
		open(my $fh, '<:raw', $file) || die "Rand::Urandom: Can't open $file: $!";

		my $got = read($fh, $buf, $num);
		if ($got == 0 || $got != $num) {
			die "Rand::Urandom: failed to read from $file: $!";
		}
		close($fh) || die "Rand::Urandom: close failed: $!";
	}
	return $buf;
}

my $orig_rand;
sub perl_rand {
	if ($^V lt 'v5.16') {
		die 'Rand::Urandom: sorry, you cant access the original rand function on perls older than 5.16';
	}

	goto &$orig_rand;
}

sub BEGIN {
	no warnings 'redefine';
	no warnings 'prototype';
	$orig_rand           = \&CORE::rand;
	*CORE::GLOBAL::rand = \&use_urandom;
}


1;
__END__