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
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
|
#! /usr/bin/env perl
# Copyright 2018 The OpenSSL Project Authors. All Rights Reserved.
#
# Licensed under the Apache License 2.0 (the "License"). You may not use
# this file except in compliance with the License. You can obtain a copy
# in the file LICENSE in the source distribution or at
# https://www.openssl.org/source/license.html
use strict;
no strict 'refs'; # To be able to use strings as function refs
use OpenSSL::Test;
use OpenSSL::Test::Utils;
use Errno qw(:POSIX);
use POSIX qw(strerror);
# We actually have space for up to 4095 error messages,
# numerically speaking... but we're currently only using
# numbers 1 through 127.
# This constant should correspond to the same constant
# defined in crypto/err/err.c, or at least must not be
# assigned a greater number.
use constant NUM_SYS_STR_REASONS => 127;
setup('test_errstr');
# In a cross compiled situation, there are chances that our
# application is linked against different C libraries than
# perl, and may thereby get different error messages for the
# same error.
# The safest is not to test under such circumstances.
plan skip_all => 'This is unsupported for cross compiled configurations'
if config('CROSS_COMPILE');
# The same can be said when compiling OpenSSL with mingw configuration
# on Windows when built with msys perl. Similar problems are also observed
# in MSVC builds, depending on the perl implementation used.
plan skip_all => 'This is unsupported on MSYS/MinGW or MSWin32'
if $^O eq 'msys' or $^O eq 'MSWin32';
plan skip_all => 'OpenSSL is configured "no-autoerrinit" or "no-err"'
if disabled('autoerrinit') || disabled('err');
# These are POSIX error names, which Errno implements as functions
# (this is documented)
my @posix_errors = @{$Errno::EXPORT_TAGS{POSIX}};
if ($^O eq 'MSWin32') {
# On Windows, these errors have been observed to not always be loaded by
# apps/openssl, while they are in perl, which causes a difference that we
# consider a false alarm. So we skip checking these errors.
# Because we can't know exactly what symbols exist in a perticular perl
# version, we resort to discovering them directly in the Errno package
# symbol table.
my @error_skiplist = qw(
ENETDOWN
ENETUNREACH
ENETRESET
ECONNABORTED
EISCONN
ENOTCONN
ESHUTDOWN
ETOOMANYREFS
ETIMEDOUT
EHOSTDOWN
EHOSTUNREACH
EALREADY
EINPROGRESS
ESTALE
EUCLEAN
ENOTNAM
ENAVAIL
ENOMEDIUM
ENOKEY
);
@posix_errors =
grep {
my $x = $_;
! grep {
exists $Errno::{$_} && $x == $Errno::{$_}
} @error_skiplist
} @posix_errors;
}
plan tests => scalar @posix_errors
+1 # Checking that error 128 gives 'reason(128)'
+1 # Checking that error 0 gives the library name
;
foreach my $errname (@posix_errors) {
my $errnum = "Errno::$errname"->();
SKIP: {
skip "Error $errname ($errnum) isn't within our range", 1
if $errnum > NUM_SYS_STR_REASONS;
my $perr = eval {
# Set $! to the error number...
local $! = $errnum;
# ... and $! will give you the error string back
$!
};
# We know that the system reasons are in OpenSSL error library 2
my @oerr = run(app([ qw(openssl errstr), sprintf("2%06x", $errnum) ]),
capture => 1);
$oerr[0] =~ s|\R$||;
@oerr = split_error($oerr[0]);
ok($oerr[3] eq $perr, "($errnum) '$oerr[3]' == '$perr'");
}
}
my @after = run(app([ qw(openssl errstr 2000080) ]), capture => 1);
$after[0] =~ s|\R$||;
@after = split_error($after[0]);
ok($after[3] eq "reason(128)", "(128) '$after[3]' == 'reason(128)'");
my @zero = run(app([ qw(openssl errstr 2000000) ]), capture => 1);
$zero[0] =~ s|\R$||;
@zero = split_error($zero[0]);
ok($zero[3] eq "system library", "(0) '$zero[3]' == 'system library'");
# For an error string "error:xxxxxxxx:lib:func:reason", this returns
# the following array:
#
# ( "xxxxxxxx", "lib", "func", "reason" )
sub split_error {
# Limit to 5 items, in case the reason contains a colon
my @erritems = split /:/, $_[0], 5;
# Remove the first item, which is always "error"
shift @erritems;
return @erritems;
}
|
