mirror of https://github.com/openssl/openssl.git
Split arguments taking quotes into account
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/27432)
This commit is contained in:
Viktor Dukhovni
Tomas Mraz
parent
0b1bdef38e
commit
287bbb28b0
156
apps/CA.pl.in
156
apps/CA.pl.in
|
|
@ -19,10 +19,10 @@ my @OPENSSL_CMDS = ("req", "ca", "pkcs12", "x509", "verify");
|
|||
|
||||
my $openssl = $ENV{'OPENSSL'} // "openssl";
|
||||
$ENV{'OPENSSL'} = $openssl;
|
||||
my @openssl = split(" ", $openssl);
|
||||
my @openssl = split_val($openssl);
|
||||
|
||||
my $OPENSSL_CONFIG = $ENV{"OPENSSL_CONFIG"} // "";
|
||||
my @OPENSSL_CONFIG = split(" ", $OPENSSL_CONFIG);
|
||||
my @OPENSSL_CONFIG = split_val($OPENSSL_CONFIG);
|
||||
|
||||
# Command invocations.
|
||||
my @REQ = (@openssl, "req", @OPENSSL_CONFIG);
|
||||
|
|
@ -52,6 +52,151 @@ 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
|
||||
|
|
@ -63,14 +208,15 @@ sub parse_extra
|
|||
while (@_) {
|
||||
my $arg = shift(@_);
|
||||
if ( $arg !~ m{^-extra-(\w+)$} ) {
|
||||
push @args, $arg;
|
||||
push @args, split_val($arg);
|
||||
next;
|
||||
}
|
||||
$arg = $1;
|
||||
die "Unknown \"-extra-${arg}\" option, exiting\n"
|
||||
unless grep { $arg eq $_ } @OPENSSL_CMDS;
|
||||
# XXX no quoting of arguments with internal whitespace supported
|
||||
push @{$EXTRA{$arg}}, split(" ", shift(@_));
|
||||
die "Missing \"-extra-${arg}\" option value, exiting\n"
|
||||
unless (@_ > 0);
|
||||
push @{$EXTRA{$arg}}, split_val(shift(@_));
|
||||
}
|
||||
return @args;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -35,19 +35,19 @@ require_ok(srctop_file("test", "recipes", "tconversion.pl"));
|
|||
|
||||
SKIP: {
|
||||
my $cakey = src_file("ca-key.pem");
|
||||
$ENV{OPENSSL_CONFIG} = qq(-config $cnf);
|
||||
$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 = src_file("ee-key.pem");
|
||||
$ENV{OPENSSL_CONFIG} = qq(-config $cnf);
|
||||
$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);
|
||||
$ENV{OPENSSL_CONFIG} = qq(-rand_serial -inform DER -config "$std_openssl_cnf");
|
||||
skip "failed to sign certificate request", 2
|
||||
if !is(yes(cmdstr(perlapp(["CA.pl", "-sign"]))), 0,
|
||||
'signing certificate request');
|
||||
|
|
@ -59,8 +59,9 @@ require_ok(srctop_file("test", "recipes", "tconversion.pl"));
|
|||
if disabled("ct");
|
||||
|
||||
my $eekey2 = src_file("ee-key-3072.pem");
|
||||
$ENV{OPENSSL_CONFIG} = qq(-config $cnf);
|
||||
ok(run(perlapp(["CA.pl", "-precert", '-extra-req', "-section userreq -key $eekey2"], stderr => undef)),
|
||||
$ENV{OPENSSL_CONFIG} = qq(-config "$cnf");
|
||||
ok(run(perlapp(["CA.pl", "-precert",
|
||||
'-extra-req', qq{-section userreq -key "$eekey2"}], stderr => undef)),
|
||||
'creating new pre-certificate');
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -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');
|
||||
|
|
@ -90,7 +122,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
|
||||
|
|
|
|||
Loading…
Reference in New Issue