xref: /freebsd/crypto/openssl/test/recipes/tconversion.pl (revision e0c4386e7e71d93b0edc0c8fa156263fc4a8b0b6)
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