File Coverage

blib/lib/Crypt/Random/Provider/egd.pm

Criterion	Covered	Total	%
statement	22	54	40.7
branch	2	24	8.3
condition	0	18	0.0
subroutine	7	9	77.7
pod	0	3	0.0
total	31	108	28.7

##
## Copyright (c) 1998-2025, Vipul Ved Prakash.  All rights reserved.
## This code is free software; you can redistribute it and/or modify
## it under the same terms as Perl itself.

use strict;
use warnings;
package Crypt::Random::Provider::egd;

use IO::Socket;
use Carp;
use Math::Pari qw(pari2num);

our $VERSION = '1.57';

sub _defaultsource {

    my $source;
    for my $d (qw( /var/run/egd-pool /dev/egd-pool /etc/entropy )) {
        if (IO::Socket::UNIX->new(Peer => $d)) { $source = $d; last }
    }
    return $source;

}


sub new {

    my ($class, %args) = @_;
    my $self = { Source => $args{Source} || $args{Device} || $args{Filename} };
    $$self{Source} = $class->_defaultsource() unless $$self{Source};
    croak "egd entropy pool file not found.\n" unless $$self{Source};
    return bless $self, $class;

}


sub get_data {

    my ( $self, %params ) = @_;
    my $class = ref $self || $self;
    $self = {} unless ref $self;

    my $bytes    = $params{Length} ||
                   (int( pari2num($params{ Size }) / 8) + 1);
    my $dev      = $params{Source} || $$self{Source};
    my $skip     = $params{Skip};

    croak "$dev doesn't exist.  aborting." unless $dev && -e $dev;

    my $s = IO::Socket::UNIX->new(Peer => $dev);
    croak "couldn't talk to egd. $!" unless $s;

    my($r, $read) = ('', 0);
    while ($read < $bytes) {
        my $msg = pack "CC", 0x01, 1;
        $s->syswrite($msg, length $msg);
        my $rt;
        my $nread = $s->sysread($rt, 1);
        croak "read from entropy socket failed" unless $nread == 1;
        my $count = unpack("C", $rt);
        $nread = $s->sysread($rt, $count);
        croak "couldn't get all the requested entropy.  aborting."
            unless $nread == $count;
        unless ($skip && $skip =~ /\Q$rt\E/) {
            if ($params{Verbosity}) { print '.' unless $read % 2 }
            $r .= $rt;
            $read++;
        }
    }

    $r;
}


sub available {

    my $class = shift;
    return 1 if $class->_defaultsource();
    return;

}


1;