"Fossies" - the Fresh Open Source Software Archive

Member "openssl-1.1.1b/test/recipes/02-test_errstr.t" (26 Feb 2019, 4135 Bytes) of package /linux/misc/openssl-1.1.1b.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file.

    1 #! /usr/bin/env perl
    2 # Copyright 2018-2019 The OpenSSL Project Authors. All Rights Reserved.
    3 #
    4 # Licensed under the OpenSSL license (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
    8 
    9 use strict;
   10 no strict 'refs';               # To be able to use strings as function refs
   11 use OpenSSL::Test;
   12 use OpenSSL::Test::Utils;
   13 use Errno qw(:POSIX);
   14 use POSIX qw(strerror);
   15 
   16 # We actually have space for up to 4095 error messages,
   17 # numerically speaking...  but we're currently only using
   18 # numbers 1 through 127.
   19 # This constant should correspond to the same constant
   20 # defined in crypto/err/err.c, or at least must not be
   21 # assigned a greater number.
   22 use constant NUM_SYS_STR_REASONS => 127;
   23 
   24 setup('test_errstr');
   25 
   26 # In a cross compiled situation, there are chances that our
   27 # application is linked against different C libraries than
   28 # perl, and may thereby get different error messages for the
   29 # same error.
   30 # The safest is not to test under such circumstances.
   31 plan skip_all => 'This is unsupported for cross compiled configurations'
   32     if config('CROSS_COMPILE');
   33 
   34 # The same can be said when compiling OpenSSL with mingw configuration
   35 # on Windows when built with msys perl.  Similar problems are also observed
   36 # in MSVC builds, depending on the perl implementation used.
   37 plan skip_all => 'This is unsupported on MSYS/MinGW or MSWin32'
   38     if $^O eq 'msys' or $^O eq 'MSWin32';
   39 
   40 plan skip_all => 'OpenSSL is configured "no-autoerrinit" or "no-err"'
   41     if disabled('autoerrinit') || disabled('err');
   42 
   43 # These are POSIX error names, which Errno implements as functions
   44 # (this is documented)
   45 my @posix_errors = @{$Errno::EXPORT_TAGS{POSIX}};
   46 
   47 if ($^O eq 'MSWin32') {
   48     # On Windows, these errors have been observed to not always be loaded by
   49     # apps/openssl, while they are in perl, which causes a difference that we
   50     # consider a false alarm.  So we skip checking these errors.
   51     # Because we can't know exactly what symbols exist in a perticular perl
   52     # version, we resort to discovering them directly in the Errno package
   53     # symbol table.
   54     my @error_skiplist = qw(
   55         ENETDOWN
   56         ENETUNREACH
   57         ENETRESET
   58         ECONNABORTED
   59         EISCONN
   60         ENOTCONN
   61         ESHUTDOWN
   62         ETOOMANYREFS
   63         ETIMEDOUT
   64         EHOSTDOWN
   65         EHOSTUNREACH
   66         EALREADY
   67         EINPROGRESS
   68         ESTALE
   69         EUCLEAN
   70         ENOTNAM
   71         ENAVAIL
   72         ENOMEDIUM
   73         ENOKEY
   74     );
   75     @posix_errors =
   76         grep {
   77             my $x = $_;
   78             ! grep {
   79                 exists $Errno::{$_} && $x == $Errno::{$_}
   80             } @error_skiplist
   81         } @posix_errors;
   82 }
   83 
   84 plan tests => scalar @posix_errors
   85     +1                          # Checking that error 128 gives 'reason(128)'
   86     +1                          # Checking that error 0 gives the library name
   87     ;
   88 
   89 foreach my $errname (@posix_errors) {
   90     my $errnum = "Errno::$errname"->();
   91 
   92  SKIP: {
   93         skip "Error $errname ($errnum) isn't within our range", 1
   94             if $errnum > NUM_SYS_STR_REASONS;
   95 
   96         my $perr = eval {
   97             # Set $! to the error number...
   98             local $! = $errnum;
   99             # ... and $! will give you the error string back
  100             $!
  101         };
  102 
  103         # We know that the system reasons are in OpenSSL error library 2
  104         my @oerr = run(app([ qw(openssl errstr), sprintf("2%06x", $errnum) ]),
  105                        capture => 1);
  106         $oerr[0] =~ s|\R$||;
  107         $oerr[0] =~ s|.*system library:||g; # The actual message is last
  108 
  109         ok($oerr[0] eq $perr, "($errnum) '$oerr[0]' == '$perr'");
  110     }
  111 }
  112 
  113 my @after = run(app([ qw(openssl errstr 2000080) ]), capture => 1);
  114 $after[0] =~ s|\R$||;
  115 $after[0] =~ s|.*system library:||g;
  116 ok($after[0] eq "reason(128)", "(128) '$after[0]' == 'reason(128)'");
  117 
  118 my @zero = run(app([ qw(openssl errstr 2000000) ]), capture => 1);
  119 $zero[0] =~ s|\R$||;
  120 $zero[0] =~ s|.*system library:||g;
  121 ok($zero[0] eq "system library", "(0) '$zero[0]' == 'system library'");