From Code to Community: Sponsoring The Perl and Raku Conference 2025 Learn more

DDICK / Crypt-URandom-0.41_01 / t / core_read.t 

            

              
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72

              
#! /usr/bin/perl -w
use strict;
use warnings;
use Test::More;
BEGIN {
        if ($^O eq 'MSWin32') {
                require Win32;
                require Win32::API;
                require Win32::API::Type;
        }
}
SKIP: {
        if ($^O eq 'MSWin32') {
                no warnings;
                sub Win32::API::new { return }
                use warnings;
                my $required_error_message = quotemeta "Could not import";
                require Crypt::URandom;
                my $generated = 0;
                eval {
                        Crypt::URandom::urandom(1);
                        $generated = 1;
                };
                chomp $@;
                ok(!$generated && $@ =~ /$required_error_message/smx, "Correct exception thrown when Win32::API->new() is overridden:$@");
        } else {
                no warnings;
                *CORE::GLOBAL::read = sub { $! = POSIX::EACCES(); return };
                *CORE::GLOBAL::sysread = sub { $! = POSIX::EACCES(); return };
                use warnings;
                require POSIX;
                my $required_error_message = q[(?:] . (quotemeta POSIX::strerror(POSIX::EACCES())) . q[|Permission[ ]denied)];
                my %optional;
                eval `cat ./check_random.pl`;
                if ($optional{DEFINE}) {
                        skip("Found getrandom in $^O", 1);
                } else {
                        require Crypt::URandom;
                        my $generated = 0;
                        eval {
                                Crypt::URandom::urandom(1);
                                $generated = 1;
                        };
                        chomp $@;
                        ok(!$generated && $@ =~ /$required_error_message/smx, "Correct exception thrown when read is overridden:$@");
                        $generated = 0;
                        eval {
                                Crypt::URandom::urandom(1);
                                $generated = 1;
                        };
                        chomp $@;
                        ok(!$generated && $@ =~ /$required_error_message/smx, "Correct exception thrown when read is overridden twice:$@");
                        $generated = 0;
                        eval {
                                Crypt::URandom::urandom_ub(1);
                                $generated = 1;
                        };
                        chomp $@;
                        ok(!$generated && $@ =~ /$required_error_message/smx, "Correct exception thrown when sysread is overridden:$@");
                        $generated = 0;
                        eval {
                                Crypt::URandom::urandom_ub(1);
                                $generated = 1;
                        };
                        chomp $@;
                        ok(!$generated && $@ =~ /$required_error_message/smx, "Correct exception thrown when sysread is overridden twice:$@");
                }
        }
}
done_testing();