mirror of
https://github.com/openssl/openssl.git
synced 2024-12-27 06:21:43 +08:00
1b726e9b91
We now check that if libcrypto hasn't loaded the string for some particular system error, it gives us "reason(nnn)" instead, where 'nnn' is the system error number in decimal. We go through all possible error macros that perl serves us, not only the POSIX ones. Reviewed-by: David von Oheimb <david.von.oheimb@siemens.com> (Merged from https://github.com/openssl/openssl/pull/12343)
136 lines
4.5 KiB
Perl
136 lines
4.5 KiB
Perl
#! /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(:limits_h strerror);
|
|
|
|
use Data::Dumper;
|
|
|
|
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');
|
|
|
|
# OpenSSL constants found in <openssl/err.h>
|
|
use constant ERR_SYSTEM_FLAG => INT_MAX + 1;
|
|
use constant ERR_LIB_OFFSET => 23; # Offset of the "library" errcode section
|
|
|
|
# OpenSSL "library" numbers
|
|
use constant ERR_LIB_NONE => 1;
|
|
|
|
# We use Errno::EXPORT_OK as a list of known errno values on the current
|
|
# system. libcrypto's ERR should either use the same string as perl, or if
|
|
# it was outside the range that ERR looks at, ERR gives the reason string
|
|
# "reason(nnn)", where nnn is the errno number.
|
|
|
|
plan tests => scalar @Errno::EXPORT_OK
|
|
+1 # Checking that error 128 gives 'reason(128)'
|
|
+1 # Checking that error 0 gives the library name
|
|
;
|
|
|
|
# Test::More:ok() has a sub prototype, which means we need to use the '&ok'
|
|
# syntax to force it to accept a list as a series of arguments.
|
|
|
|
foreach my $errname (@Errno::EXPORT_OK) {
|
|
# The error names are perl constants, which are implemented as functions
|
|
# returning the numeric value of that name.
|
|
&ok(match_syserr_reason("Errno::$errname"->()))
|
|
}
|
|
|
|
# OpenSSL library 1 is the "unknown" library
|
|
&ok(match_opensslerr_reason(ERR_LIB_NONE << ERR_LIB_OFFSET | 256,
|
|
"reason(256)"));
|
|
# Reason code 0 of any library gives the library name as reason
|
|
&ok(match_opensslerr_reason(ERR_LIB_NONE << ERR_LIB_OFFSET | 0,
|
|
"unknown library"));
|
|
|
|
exit 0;
|
|
|
|
# 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;
|
|
}
|
|
|
|
# Compares the first argument as string to each of the arguments 3 and on,
|
|
# and returns an array of two elements:
|
|
# 0: True if the first argument matched any of the others, otherwise false
|
|
# 1: A string describing the test
|
|
# The returned array can be used as the arguments to Test::More::ok()
|
|
sub match_any {
|
|
my $first = shift;
|
|
my $desc = shift;
|
|
my @strings = @_;
|
|
|
|
if (scalar @strings > 1) {
|
|
$desc = "match '$first' ($desc) with one of ( '"
|
|
. join("', '", @strings) . "' )";
|
|
} else {
|
|
$desc = "match '$first' ($desc) with '$strings[0]'";
|
|
}
|
|
|
|
return ( scalar( grep { $first eq $_ } @strings ) > 0,
|
|
$desc );
|
|
}
|
|
|
|
sub match_opensslerr_reason {
|
|
my $errcode = shift;
|
|
my @strings = @_;
|
|
|
|
my $errcode_hex = sprintf "%x", $errcode;
|
|
my $reason =
|
|
( run(app([ qw(openssl errstr), $errcode_hex ]), capture => 1) )[0];
|
|
$reason =~ s|\R$||;
|
|
$reason = ( split_error($reason) )[3];
|
|
|
|
return match_any($reason, $errcode, @strings);
|
|
}
|
|
|
|
sub match_syserr_reason {
|
|
my $errcode = shift;
|
|
|
|
my @strings = ();
|
|
# The POSIX reason string
|
|
push @strings, eval {
|
|
# Set $! to the error number...
|
|
local $! = $errcode;
|
|
# ... and $! will give you the error string back
|
|
$!
|
|
};
|
|
# The OpenSSL fallback string
|
|
push @strings, "reason($errcode)";
|
|
|
|
return match_opensslerr_reason(ERR_SYSTEM_FLAG | $errcode, @strings);
|
|
}
|