]> git.ipfire.org Git - thirdparty/openssl.git/commitdiff
Avoid shell commandline processing in CA.pl
authorViktor Dukhovni <openssl-users@dukhovni.org>
Fri, 18 Apr 2025 04:18:09 +0000 (14:18 +1000)
committerTomas Mraz <tomas@openssl.org>
Tue, 10 Jun 2025 17:53:11 +0000 (19:53 +0200)
The CA.pl script used to build single-string string commandlines to pass
to a shell via `system(command_string)`.  That was fragile and not a best
practice.

This PR replaces `system(command_string)` with `system { executable } @argv`,
which avoids the shell whenever possible (at least Unix-like systems and
Windows).  The only question mark is whether some sort of quoting is
needed for VMS to preserve the case of commandline arguments even when
processes are spawned directly, rather than via the shell.

Unfortunately, given the way that some environment variables and
command-line options are used to construct the commands to run,
the result is still brittle.  The CA.pl utility really should
be replaced with something better.

CA.pl supports interpolating multiple arguments into the executed
commands.  Previously these were evaluated by a shell, which supported
quoting of values that contain whitespace, backslashes, ...

With a shell no longer used (avoid command injection), backwards
compatibility requires some similar functionality.  The code now handles
double and single-quoted strings (shell-style word splitting), but not
parameter expansion ($foo remains unexpanded) or command substitution
(`cmd` and $(cmd) remain unexpanded).

On Windows system(@LIST) does not correctly preserve argv, do our
own quoting instead and use system(<$quoted_cmd>).

Reviewed-by: Tom Cosgrove <tom.cosgrove@arm.com>
Reviewed-by: Tomas Mraz <tomas@openssl.org>
(Merged from https://github.com/openssl/openssl/pull/27782)

apps/CA.pl.in
test/recipes/80-test_ca.t
util/wrap.pl.in

index 546c4ce35bb39854fa2654cf0250a7319b44ef9a..45051b72dea98bfac93060424d1be03151d4e53d 100644 (file)
@@ -19,14 +19,17 @@ my @OPENSSL_CMDS = ("req", "ca", "pkcs12", "x509", "verify");
 
 my $openssl = $ENV{'OPENSSL'} // "openssl";
 $ENV{'OPENSSL'} = $openssl;
+my @openssl = split_val($openssl);
+
 my $OPENSSL_CONFIG = $ENV{"OPENSSL_CONFIG"} // "";
+my @OPENSSL_CONFIG = split_val($OPENSSL_CONFIG);
 
 # Command invocations.
-my $REQ = "$openssl req $OPENSSL_CONFIG";
-my $CA = "$openssl ca $OPENSSL_CONFIG";
-my $VERIFY = "$openssl verify";
-my $X509 = "$openssl x509";
-my $PKCS12 = "$openssl pkcs12";
+my @REQ = (@openssl, "req", @OPENSSL_CONFIG);
+my @CA = (@openssl, "ca", @OPENSSL_CONFIG);
+my @VERIFY = (@openssl, "verify");
+my @X509 = (@openssl, "x509");
+my @PKCS12 = (@openssl, "pkcs12");
 
 # Default values for various configuration settings.
 my $CATOP = "./demoCA";
@@ -34,8 +37,10 @@ my $CAKEY = "cakey.pem";
 my $CAREQ = "careq.pem";
 my $CACERT = "cacert.pem";
 my $CACRL = "crl.pem";
-my $DAYS = "-days 365";
-my $CADAYS = "-days 1095";     # 3 years
+my @DAYS = qw(-days 365);
+my @CADAYS = qw(-days 1095);   # 3 years
+my @EXTENSIONS = qw(-extensions v3_ca);
+my @POLICY = qw(-policy policy_anything);
 my $NEWKEY = "newkey.pem";
 my $NEWREQ = "newreq.pem";
 my $NEWCERT = "newcert.pem";
@@ -43,31 +48,177 @@ my $NEWP12 = "newcert.p12";
 
 # Commandline parsing
 my %EXTRA;
-my $WHAT = shift @ARGV || "";
+my $WHAT = shift @ARGV // "";
 @ARGV = parse_extra(@ARGV);
 my $RET = 0;
 
+sub split_val {
+    return split_val_win32(@_) if ($^O eq 'MSWin32');
+    my ($val) = @_;
+    my (@ret, @frag);
+
+    # Skip leading whitespace
+    $val =~ m{\A[ \t]*}ogc;
+
+    # Unix shell-compatible split
+    #
+    # Handles backslash escapes outside quotes and
+    # in double-quoted strings.  Parameter and
+    # command-substitution is silently ignored.
+    # Bare newlines outside quotes and (trailing) backslashes are disallowed.
+
+    while (1) {
+        last if (pos($val) == length($val));
+
+        # The first char is never a SPACE or TAB.  Possible matches are:
+        # 1. Ordinary string fragment
+        # 2. Single-quoted string
+        # 3. Double-quoted string
+        # 4. Backslash escape
+        # 5. Bare backlash or newline (rejected)
+        #
+        if ($val =~ m{\G([^'" \t\n\\]+)}ogc) {
+            # Ordinary string
+            push @frag, $1;
+        } elsif ($val =~ m{\G'([^']*)'}ogc) {
+            # Single-quoted string
+            push @frag, $1;
+        } elsif ($val =~ m{\G"}ogc) {
+            # Double-quoted string
+            push @frag, "";
+            while (1) {
+                last if ($val =~ m{\G"}ogc);
+                if ($val =~ m{\G([^"\\]+)}ogcs) {
+                    # literals
+                    push @frag, $1;
+                } elsif ($val =~ m{\G.(["\`\$\\])}ogc) {
+                    # backslash-escaped special
+                    push @frag, $1;
+                } elsif ($val =~ m{\G.(.)}ogcs) {
+                    # backslashed non-special
+                    push @frag, "\\$1" unless $1 eq "\n";
+                } else {
+                    die sprintf("Malformed quoted string: %s\n", $val);
+                }
+            }
+        } elsif ($val =~ m{\G\\(.)}ogc) {
+            # Backslash is unconditional escape outside quoted strings
+            push @frag, $1 unless $1 eq "\n";
+        } else {
+            die sprintf("Bare backslash or newline in: '%s'\n", $val);
+        }
+        # Done if at SPACE, TAB or end, otherwise continue current fragment
+        #
+        next unless ($val =~ m{\G(?:[ \t]+|\z)}ogcs);
+        push @ret, join("", splice(@frag)) if (@frag > 0);
+    }
+    # Handle final fragment
+    push @ret, join("", splice(@frag)) if (@frag > 0);
+    return @ret;
+}
+
+sub split_val_win32 {
+    my ($val) = @_;
+    my (@ret, @frag);
+
+    # Skip leading whitespace
+    $val =~ m{\A[ \t]*}ogc;
+
+    # Windows-compatible split
+    # See: "Parsing C++ command-line arguments" in:
+    # https://learn.microsoft.com/en-us/cpp/cpp/main-function-command-line-args?view=msvc-170
+    #
+    # Backslashes are special only when followed by a double-quote
+    # Pairs of double-quotes make a single double-quote.
+    # Closing double-quotes may be omitted.
+
+    while (1) {
+        last if (pos($val) == length($val));
+
+        # The first char is never a SPACE or TAB.
+        # 1. Ordinary string fragment
+        # 2. Double-quoted string
+        # 3. Backslashes preceding a double-quote
+        # 4. Literal backslashes
+        # 5. Bare newline (rejected)
+        #
+        if ($val =~ m{\G([^" \t\n\\]+)}ogc) {
+            # Ordinary string
+            push @frag, $1;
+        } elsif ($val =~ m{\G"}ogc) {
+            # Double-quoted string
+            push @frag, "";
+            while (1) {
+                if ($val =~ m{\G("+)}ogc) {
+                    # Two double-quotes make one literal double-quote
+                    my $l = length($1);
+                    push @frag, q{"} x int($l/2) if ($l > 1);
+                    next if ($l % 2 == 0);
+                    last;
+                }
+                if ($val =~ m{\G([^"\\]+)}ogc) {
+                    push @frag, $1;
+                } elsif ($val =~ m{\G((?>[\\]+))(?=")}ogc) {
+                    # Backslashes before a double-quote are escapes
+                    my $l = length($1);
+                    push @frag, q{\\} x int($l / 2);
+                    if ($l % 2 == 1) {
+                        ++pos($val);
+                        push @frag, q{"};
+                    }
+                } elsif ($val =~ m{\G((?:(?>[\\]+)[^"\\]+)+)}ogc) {
+                    # Backslashes not before a double-quote are not special
+                    push @frag, $1;
+                } else {
+                    # Tolerate missing closing double-quote
+                    last;
+                }
+            }
+        } elsif ($val =~ m{\G((?>[\\]+))(?=")}ogc) {
+            my $l = length($1);
+            push @frag, q{\\} x int($l / 2);
+            if ($l % 2 == 1) {
+                ++pos($val);
+                push @frag, q{"};
+            }
+        } elsif ($val =~ m{\G([\\]+)}ogc) {
+            # Backslashes not before a double-quote are not special
+            push @frag, $1;
+        } else {
+            die sprintf("Bare newline in: '%s'\n", $val);
+        }
+        # Done if at SPACE, TAB or end, otherwise continue current fragment
+        #
+        next unless ($val =~ m{\G(?:[ \t]+|\z)}ogcs);
+        push @ret, join("", splice(@frag)) if (@frag > 0);
+    }
+    # Handle final fragment
+    push @ret, join("", splice(@frag)) if (@frag);
+    return @ret;
+}
+
 # Split out "-extra-CMD value", and return new |@ARGV|. Fill in
 # |EXTRA{CMD}| with list of values.
 sub parse_extra
 {
+    my @args;
     foreach ( @OPENSSL_CMDS ) {
-        $EXTRA{$_} = '';
+        $EXTRA{$_} = [];
     }
-
-    my @result;
-    while ( scalar(@_) > 0 ) {
-        my $arg = shift;
-        if ( $arg !~ m/-extra-([a-z0-9]+)/ ) {
-            push @result, $arg;
+    while (@_) {
+        my $arg = shift(@_);
+        if ( $arg !~ m{^-extra-(\w+)$} ) {
+            push @args, split_val($arg);
             next;
         }
-        $arg =~ s/-extra-//;
-        die("Unknown \"-${arg}-extra\" option, exiting")
-            unless scalar grep { $arg eq $_ } @OPENSSL_CMDS;
-        $EXTRA{$arg} .= " " . shift;
+        $arg = $1;
+        die "Unknown \"-extra-${arg}\" option, exiting\n"
+            unless grep { $arg eq $_ } @OPENSSL_CMDS;
+        die "Missing \"-extra-${arg}\" option value, exiting\n"
+            unless (@_ > 0);
+        push @{$EXTRA{$arg}}, split_val(shift(@_));
     }
-    return @result;
+    return @args;
 }
 
 
@@ -110,9 +261,9 @@ sub copy_pemfile
 # Wrapper around system; useful for debugging.  Returns just the exit status
 sub run
 {
-    my $cmd = shift;
-    print "====\n$cmd\n" if $verbose;
-    my $status = system($cmd);
+    my ($cmd, @args) = @_;
+    print "====\n$cmd @args\n" if $verbose;
+    my $status = system {$cmd} $cmd, @args;
     print "==> $status\n====\n" if $verbose;
     return $status >> 8;
 }
@@ -131,17 +282,15 @@ EOF
 
 if ($WHAT eq '-newcert' ) {
     # create a certificate
-    $RET = run("$REQ -new -x509 -keyout $NEWKEY -out $NEWCERT $DAYS"
-            . " $EXTRA{req}");
+    $RET = run(@REQ, qw(-new -x509 -keyout), $NEWKEY, "-out", $NEWCERT, @DAYS, @{$EXTRA{req}});
     print "Cert is in $NEWCERT, private key is in $NEWKEY\n" if $RET == 0;
 } elsif ($WHAT eq '-precert' ) {
     # create a pre-certificate
-    $RET = run("$REQ -x509 -precert -keyout $NEWKEY -out $NEWCERT $DAYS"
-            . " $EXTRA{req}");
+    $RET = run(@REQ, qw(-x509 -precert -keyout), $NEWKEY, "-out", $NEWCERT, @DAYS, @{$EXTRA{req}});
     print "Pre-cert is in $NEWCERT, private key is in $NEWKEY\n" if $RET == 0;
 } elsif ($WHAT =~ /^\-newreq(\-nodes)?$/ ) {
     # create a certificate request
-    $RET = run("$REQ -new" . (defined $1 ? " $1" : "") . " -keyout $NEWKEY -out $NEWREQ $EXTRA{req}");
+    $RET = run(@REQ, "-new", (defined $1 ? ($1,) : ()), "-keyout", $NEWKEY, "-out", $NEWREQ, @{$EXTRA{req}});
     print "Request is in $NEWREQ, private key is in $NEWKEY\n" if $RET == 0;
 } elsif ($WHAT eq '-newca' ) {
     # create the directory hierarchy
@@ -174,48 +323,45 @@ if ($WHAT eq '-newcert' ) {
         copy_pemfile($FILE,"${CATOP}/$CACERT", "CERTIFICATE");
     } else {
         print "Making CA certificate ...\n";
-        $RET = run("$REQ -new -keyout ${CATOP}/private/$CAKEY"
-                . " -out ${CATOP}/$CAREQ $EXTRA{req}");
-        $RET = run("$CA -create_serial"
-                . " -out ${CATOP}/$CACERT $CADAYS -batch"
-                . " -keyfile ${CATOP}/private/$CAKEY -selfsign"
-                . " -extensions v3_ca"
-                . " -infiles ${CATOP}/$CAREQ $EXTRA{ca}") if $RET == 0;
+        $RET = run(@REQ, qw(-new -keyout), "${CATOP}/private/$CAKEY",
+                   "-out", "${CATOP}/$CAREQ", @{$EXTRA{req}});
+        $RET = run(@CA, qw(-create_serial -out), "${CATOP}/$CACERT", @CADAYS,
+                   qw(-batch -keyfile), "${CATOP}/private/$CAKEY", "-selfsign",
+                   @EXTENSIONS, "-infiles", "${CATOP}/$CAREQ", @{$EXTRA{ca}})
+            if $RET == 0;
         print "CA certificate is in ${CATOP}/$CACERT\n" if $RET == 0;
     }
 } elsif ($WHAT eq '-pkcs12' ) {
     my $cname = $ARGV[0];
     $cname = "My Certificate" unless defined $cname;
-    $RET = run("$PKCS12 -in $NEWCERT -inkey $NEWKEY"
-            . " -certfile ${CATOP}/$CACERT -out $NEWP12"
-            . " -export -name \"$cname\" $EXTRA{pkcs12}");
-    print "PKCS #12 file is in $NEWP12\n" if $RET == 0;
+    $RET = run(@PKCS12, "-in", $NEWCERT, "-inkey", $NEWKEY,
+               "-certfile", "${CATOP}/$CACERT", "-out", $NEWP12,
+               qw(-export -name), $cname, @{$EXTRA{pkcs12}});
+    print "PKCS#12 file is in $NEWP12\n" if $RET == 0;
 } elsif ($WHAT eq '-xsign' ) {
-    $RET = run("$CA -policy policy_anything -infiles $NEWREQ $EXTRA{ca}");
+    $RET = run(@CA, @POLICY, "-infiles", $NEWREQ, @{$EXTRA{ca}});
 } elsif ($WHAT eq '-sign' ) {
-    $RET = run("$CA -policy policy_anything -out $NEWCERT"
-            . " -infiles $NEWREQ $EXTRA{ca}");
+    $RET = run(@CA, @POLICY, "-out", $NEWCERT,
+               "-infiles", $NEWREQ, @{$EXTRA{ca}});
     print "Signed certificate is in $NEWCERT\n" if $RET == 0;
 } elsif ($WHAT eq '-signCA' ) {
-    $RET = run("$CA -policy policy_anything -out $NEWCERT"
-            . " -extensions v3_ca -infiles $NEWREQ $EXTRA{ca}");
+    $RET = run(@CA, @POLICY, "-out", $NEWCERT, @EXTENSIONS,
+               "-infiles", $NEWREQ, @{$EXTRA{ca}});
     print "Signed CA certificate is in $NEWCERT\n" if $RET == 0;
 } elsif ($WHAT eq '-signcert' ) {
-    $RET = run("$X509 -x509toreq -in $NEWREQ -signkey $NEWREQ"
-            . " -out tmp.pem $EXTRA{x509}");
-    $RET = run("$CA -policy policy_anything -out $NEWCERT"
-            .  "-infiles tmp.pem $EXTRA{ca}") if $RET == 0;
+    $RET = run(@X509, qw(-x509toreq -in), $NEWREQ, "-signkey", $NEWREQ,
+               qw(-out tmp.pem), @{$EXTRA{x509}});
+    $RET = run(@CA, @POLICY, "-out", $NEWCERT,
+               qw(-infiles tmp.pem), @{$EXTRA{ca}}) if $RET == 0;
     print "Signed certificate is in $NEWCERT\n" if $RET == 0;
 } elsif ($WHAT eq '-verify' ) {
     my @files = @ARGV ? @ARGV : ( $NEWCERT );
     foreach my $file (@files) {
-        # -CAfile quoted for VMS, since the C RTL downcases all unquoted
-        # arguments to C programs
-        my $status = run("$VERIFY \"-CAfile\" ${CATOP}/$CACERT $file $EXTRA{verify}");
+        my $status = run(@VERIFY, "-CAfile", "${CATOP}/$CACERT", $file, @{$EXTRA{verify}});
         $RET = $status if $status != 0;
     }
 } elsif ($WHAT eq '-crl' ) {
-    $RET = run("$CA -gencrl -out ${CATOP}/crl/$CACRL $EXTRA{ca}");
+    $RET = run(@CA, qw(-gencrl -out), "${CATOP}/crl/$CACRL", @{$EXTRA{ca}});
     print "Generated CRL is in ${CATOP}/crl/$CACRL\n" if $RET == 0;
 } elsif ($WHAT eq '-revoke' ) {
     my $cname = $ARGV[0];
@@ -223,10 +369,10 @@ if ($WHAT eq '-newcert' ) {
         print "Certificate filename is required; reason optional.\n";
         exit 1;
     }
-    my $reason = $ARGV[1];
-    $reason = " -crl_reason $reason"
-        if defined $reason && crl_reason_ok($reason);
-    $RET = run("$CA -revoke \"$cname\"" . $reason . $EXTRA{ca});
+    my @reason;
+    @reason = ("-crl_reason", $ARGV[1])
+        if defined $ARGV[1] && crl_reason_ok($ARGV[1]);
+    $RET = run(@CA, "-revoke", $cname, @reason, @{$EXTRA{ca}});
 } else {
     print STDERR "Unknown arg \"$WHAT\"\n";
     print STDERR "Use -help for help.\n";
index eb025f4d591f7406065da5b42e1a869c3f1fca9c..c8d5590755eb8c3a1eaa1418d008c20bcda30224 100644 (file)
@@ -21,9 +21,7 @@ setup("test_ca");
 $ENV{OPENSSL} = cmdstr(app(["openssl"]), display => 1);
 
 my $cnf = srctop_file("test","ca-and-certs.cnf");
-my $std_openssl_cnf = '"'
-    . srctop_file("apps", $^O eq "VMS" ? "openssl-vms.cnf" : "openssl.cnf")
-    . '"';
+my $std_openssl_cnf = srctop_file("apps", $^O eq "VMS" ? "openssl-vms.cnf" : "openssl.cnf");
 
 rmtree("demoCA", { safe => 0 });
 
@@ -33,14 +31,14 @@ plan tests => 15;
      $ENV{OPENSSL_CONFIG} = qq(-config "$cnf");
      skip "failed creating CA structure", 4
          if !ok(run(perlapp(["CA.pl","-newca",
-                             "-extra-req", "-key $cakey"], stdin => undef)),
+                             "-extra-req", qq{-key "$cakey"}], stdin => undef)),
                 'creating CA structure');
 
      my $eekey = srctop_file("test", "certs", "ee-key.pem");
      $ENV{OPENSSL_CONFIG} = qq(-config "$cnf");
      skip "failed creating new certificate request", 3
          if !ok(run(perlapp(["CA.pl","-newreq",
-                             '-extra-req', "-outform DER -section userreq -key $eekey"])),
+                             '-extra-req', qq{-outform DER -section userreq -key "$eekey"}])),
                 'creating certificate request');
      $ENV{OPENSSL_CONFIG} = qq(-rand_serial -inform DER -config "$std_openssl_cnf");
      skip "failed to sign certificate request", 2
@@ -55,7 +53,8 @@ plan tests => 15;
 
      my $eekey2 = srctop_file("test", "certs", "ee-key-3072.pem");
      $ENV{OPENSSL_CONFIG} = qq(-config "$cnf");
-     ok(run(perlapp(["CA.pl", "-precert", '-extra-req', "-section userreq -key $eekey2"], stderr => undef)),
+     ok(run(perlapp(["CA.pl", "-precert",
+                     '-extra-req', qq{-section userreq -key "$eekey2"}], stderr => undef)),
         'creating new pre-certificate');
 }
 
index 5126513d4c3e91a58273f0d425b5bca60ad4dd1d..436ec12fcf06c4ba4f2afb5cd74c5e0758b5d728 100644 (file)
@@ -18,6 +18,38 @@ BEGIN {
     OpenSSL::Util->import();
 }
 
+sub quote_cmd_win32 {
+    my $cmd = "";
+
+    foreach my $arg (@_) {
+        if ($arg =~ m{\A[\w,-./@]+\z}) {
+            $cmd .= $arg . q{ };;
+        } else {
+            $cmd .= q{"} . quote_arg_win32($arg) . q{" };
+        }
+    }
+    return substr($cmd, 0, -1);
+}
+
+sub quote_arg_win32 {
+    my ($arg) = @_;
+    my $val = "";
+
+    pos($arg) = 0;
+    while (1) {
+        return $val if (pos($arg) == length($arg));
+        if ($arg =~ m{\G((?:(?>[\\]*)[^"\\]+)+)}ogc) {
+            $val .= $1;
+        } elsif ($arg =~ m{\G"}ogc) {
+            $val .= qq{\\"};
+        } elsif ($arg =~ m{\G((?>[\\]+)(?="|\z))}ogc) {
+            $val .= qq{\\} x (2 * length($1));
+        } else {
+            die sprintf("Internal error quoting: '%s'\n", $arg);
+        }
+    }
+}
+
 my $there = canonpath(catdir(dirname($0), updir()));
 my $std_engines = catdir($there, 'engines');
 my $std_providers = catdir($there, 'providers');
@@ -60,7 +92,12 @@ if ($^O eq 'VMS') {
 
 # The exec() statement on MSWin32 doesn't seem to give back the exit code
 # from the call, so we resort to using system() instead.
-my $waitcode = system @cmd;
+my $waitcode;
+if ($^O eq 'MSWin32') {
+    $waitcode = system(quote_cmd_win32(@cmd));
+} else {
+    $waitcode = system @cmd;
+}
 
 # According to documentation, -1 means that system() couldn't run the command,
 # otherwise, the value is similar to the Unix wait() status value