2 # Copyright 2018-2020 The OpenSSL Project Authors. All Rights Reserved.
4 # Licensed under the Apache License 2.0 (the "License"). You may not use
5 # this file except in compliance with the License. You can obtain a copy
6 # in the file LICENSE in the source distribution or at
7 # https://www.openssl.org/source/license.html
10 no strict 'refs'; # To be able to use strings as function refs
12 use OpenSSL::Test::Utils;
14 use POSIX qw(:limits_h strerror);
20 # In a cross compiled situation, there are chances that our
21 # application is linked against different C libraries than
22 # perl, and may thereby get different error messages for the
24 # The safest is not to test under such circumstances.
25 plan skip_all => 'This is unsupported for cross compiled configurations'
26 if config('CROSS_COMPILE');
28 # The same can be said when compiling OpenSSL with mingw configuration
29 # on Windows when built with msys perl. Similar problems are also observed
30 # in MSVC builds, depending on the perl implementation used.
31 plan skip_all => 'This is unsupported on MSYS/MinGW or MSWin32'
32 if $^O eq 'msys' or $^O eq 'MSWin32';
34 plan skip_all => 'OpenSSL is configured "no-autoerrinit" or "no-err"'
35 if disabled('autoerrinit') || disabled('err');
37 # OpenSSL constants found in <openssl/err.h>
38 use constant ERR_SYSTEM_FLAG => INT_MAX + 1;
39 use constant ERR_LIB_OFFSET => 23; # Offset of the "library" errcode section
41 # OpenSSL "library" numbers
42 use constant ERR_LIB_NONE => 1;
44 # We use Errno::EXPORT_OK as a list of known errno values on the current
45 # system. libcrypto's ERR should either use the same string as perl, or if
46 # it was outside the range that ERR looks at, ERR gives the reason string
47 # "reason(nnn)", where nnn is the errno number.
49 plan tests => scalar @Errno::EXPORT_OK
50 +1 # Checking that error 128 gives 'reason(128)'
51 +1 # Checking that error 0 gives the library name
54 # Test::More:ok() has a sub prototype, which means we need to use the '&ok'
55 # syntax to force it to accept a list as a series of arguments.
57 foreach my $errname (@Errno::EXPORT_OK) {
58 # The error names are perl constants, which are implemented as functions
59 # returning the numeric value of that name.
60 &ok(match_syserr_reason("Errno::$errname"->()))
63 # OpenSSL library 1 is the "unknown" library
64 &ok(match_opensslerr_reason(ERR_LIB_NONE << ERR_LIB_OFFSET | 256,
66 # Reason code 0 of any library gives the library name as reason
67 &ok(match_opensslerr_reason(ERR_LIB_NONE << ERR_LIB_OFFSET | 0,
72 # For an error string "error:xxxxxxxx:lib:func:reason", this returns
73 # the following array:
75 # ( "xxxxxxxx", "lib", "func", "reason" )
77 # Limit to 5 items, in case the reason contains a colon
78 my @erritems = split /:/, $_[0], 5;
80 # Remove the first item, which is always "error"
86 # Compares the first argument as string to each of the arguments 3 and on,
87 # and returns an array of two elements:
88 # 0: True if the first argument matched any of the others, otherwise false
89 # 1: A string describing the test
90 # The returned array can be used as the arguments to Test::More::ok()
96 if (scalar @strings > 1) {
97 $desc = "match '$first' ($desc) with one of ( '"
98 . join("', '", @strings) . "' )";
100 $desc = "match '$first' ($desc) with '$strings[0]'";
103 return ( scalar( grep { $first eq $_ } @strings ) > 0,
107 sub match_opensslerr_reason {
111 my $errcode_hex = sprintf "%x", $errcode;
113 ( run(app([ qw(openssl errstr), $errcode_hex ]), capture => 1) )[0];
115 $reason = ( split_error($reason) )[3];
117 return match_any($reason, $errcode, @strings);
120 sub match_syserr_reason {
124 # The POSIX reason string
125 push @strings, eval {
126 # Set $! to the error number...
128 # ... and $! will give you the error string back
131 # The OpenSSL fallback string
132 push @strings, "reason($errcode)";
134 return match_opensslerr_reason(ERR_SYSTEM_FLAG | $errcode, @strings);