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