test/recipes/tconversion.pl

   1 #! /usr/bin/env perl
   2 # Copyright 2015-2021 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
  10 use strict;
  11 use warnings;
  12
  13 use File::Compare qw/compare_text/;
  14 use File::Copy;
  15 use OpenSSL::Test qw/:DEFAULT/;
  16
  17 my %conversionforms = (
  18     # Default conversion forms.  Other series may be added with
  19     # specific test types as key.
  20     "*"         => [ "d", "p" ],
  21     "msb"       => [ "d", "p", "msblob" ],
  22     );
  23 sub tconversion {
  24     my %opts = @_;
  25
  26     die "Missing option -type" unless $opts{-type};
  27     die "Missing option -in" unless $opts{-in};
  28     my $testtype = $opts{-type};
  29     my $t = $opts{-in};
  30     my $prefix = $opts{-prefix} // $testtype;
  31     my @conversionforms =
  32         defined($conversionforms{$testtype}) ?
  33         @{$conversionforms{$testtype}} :
  34         @{$conversionforms{"*"}};
  35     my @openssl_args;
  36     if (defined $opts{-args}) {
  37         @openssl_args = @{$opts{-args}} if ref $opts{-args} eq 'ARRAY';
  38         @openssl_args = ($opts{-args}) if ref $opts{-args} eq '';
  39     }
  40     @openssl_args = ($testtype) unless @openssl_args;
  41
  42     my $n = scalar @conversionforms;
  43     my $totaltests =
  44         1                       # for initializing
  45         + $n                    # initial conversions from p to all forms (A)
  46         + $n*$n                 # conversion from result of A to all forms (B)
  47         + 1                     # comparing original test file to p form of A
  48         + $n*($n-1);            # comparing first conversion to each fom in A with B
  49     $totaltests-- if ($testtype eq "p7d"); # no comparison of original test file
  50     plan tests => $totaltests;
  51
  52     my @cmd = ("openssl", @openssl_args);
  53
  54     my $init;
  55     if (scalar @openssl_args > 0 && $openssl_args[0] eq "pkey") {
  56         $init = ok(run(app([@cmd, "-in", $t, "-out", "$prefix-fff.p"])),
  57                    'initializing');
  58     } else {
  59         $init = ok(copy($t, "$prefix-fff.p"), 'initializing');
  60     }
  61     if (!$init) {
  62         diag("Trying to copy $t to $prefix-fff.p : $!");
  63     }
  64
  65   SKIP: {
  66       skip "Not initialized, skipping...", 22 unless $init;
  67
  68       foreach my $to (@conversionforms) {
  69           ok(run(app([@cmd,
  70                       "-in", "$prefix-fff.p",
  71                       "-inform", "p",
  72                       "-out", "$prefix-f.$to",
  73                       "-outform", $to])),
  74              "p -> $to");
  75       }
  76
  77       foreach my $to (@conversionforms) {
  78           foreach my $from (@conversionforms) {
  79               ok(run(app([@cmd,
  80                           "-in", "$prefix-f.$from",
  81                           "-inform", $from,
  82                           "-out", "$prefix-ff.$from$to",
  83                           "-outform", $to])),
  84                  "$from -> $to");
  85           }
  86       }
  87
  88       if ($testtype ne "p7d") {
  89           is(cmp_text("$prefix-fff.p", "$prefix-f.p"), 0,
  90              'comparing orig to p');
  91       }
  92
  93       foreach my $to (@conversionforms) {
  94           next if $to eq "d";
  95           foreach my $from (@conversionforms) {
  96               is(cmp_text("$prefix-f.$to", "$prefix-ff.$from$to"), 0,
  97                  "comparing $to to $from$to");
  98           }
  99       }
 100     }
 101 }
 102
 103 sub cmp_text {
 104     return compare_text(@_, sub {
 105         $_[0] =~ s/\R//g;
 106         $_[1] =~ s/\R//g;
 107         return $_[0] ne $_[1];
 108     });
 109 }
 110
 111 sub file_contains {
 112     $_ = shift @_;
 113     my $pattern = shift @_;
 114     open(DATA, $_) or return 0;
 115     $_= join('', <DATA>);
 116     close(DATA);
 117     s/\s+/ /g; # take multiple whitespace (including newline) as single space
 118     return m/$pattern/ ? 1 : 0;
 119 }
 120
 121 sub cert_contains {
 122     my $cert = shift @_;
 123     my $pattern = shift @_;
 124     my $expected = shift @_;
 125     my $name = shift @_;
 126     my $out = "cert_contains.out";
 127     run(app(["openssl", "x509", "-noout", "-text", "-in", $cert, "-out", $out]));
 128     is(file_contains($out, $pattern), $expected, ($name ? "$name: " : "").
 129        "$cert should ".($expected ? "" : "not ")."contain: \"$pattern\"");
 130     # not unlinking $out
 131 }
 132
 133 sub uniq (@) {
 134     my %seen = ();
 135     grep { not $seen{$_}++ } @_;
 136 }
 137
 138 sub file_n_different_lines {
 139     my $filename = shift @_;
 140     open(DATA, $filename) or return 0;
 141     chomp(my @lines = <DATA>);
 142     close(DATA);
 143     return scalar(uniq @lines);
 144 }
 145
 146 sub cert_ext_has_n_different_lines {
 147     my $cert = shift @_;
 148     my $expected = shift @_;
 149     my $exts = shift @_;
 150     my $name = shift @_;
 151     my $out = "cert_n_different_exts.out";
 152     run(app(["openssl", "x509", "-noout", "-ext", $exts,
 153              "-in", $cert, "-out", $out]));
 154     is(file_n_different_lines($out), $expected, ($name ? "$name: " : "").
 155        "$cert '$exts' output should contain $expected different lines");
 156     # not unlinking $out
 157 }
 158
 159 1;