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)

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
+        die "Missing \"-extra-${arg}\" option value, exiting\n"
-        push @{$EXTRA{$arg}}, split(" ", shift(@_));
+            unless (@_ > 0);
+        push @{$EXTRA{$arg}}, split_val(shift(@_));
     }
     return @args;
 }

test/recipes/80-test_ca.t

@@ -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);
+     $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');
 }
 

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');
@@ -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