test/recipes/02-test_errstr.t

   1 #! /usr/bin/env perl
   2 # Copyright 2018 The OpenSSL Project Authors. All Rights Reserved.
   3 #
   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
   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'");