From: Viktor Dukhovni Date: Fri, 18 Apr 2025 04:18:09 +0000 (+1000) Subject: Avoid shell commandline processing in CA.pl X-Git-Tag: openssl-3.0.17~12 X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=98f3768f47cfc76b2717ad7bb0a0c6822a6ce7ec;p=thirdparty%2Fopenssl.git Avoid shell commandline processing in CA.pl 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 Reviewed-by: Tomas Mraz (Merged from https://github.com/openssl/openssl/pull/27782) --- diff --git a/apps/CA.pl.in b/apps/CA.pl.in index 546c4ce35bb..45051b72dea 100644 --- a/apps/CA.pl.in +++ b/apps/CA.pl.in @@ -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"; diff --git a/test/recipes/80-test_ca.t b/test/recipes/80-test_ca.t index eb025f4d591..c8d5590755e 100644 --- a/test/recipes/80-test_ca.t +++ b/test/recipes/80-test_ca.t @@ -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'); } diff --git a/util/wrap.pl.in b/util/wrap.pl.in index 5126513d4c3..436ec12fcf0 100644 --- a/util/wrap.pl.in +++ b/util/wrap.pl.in @@ -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