Implement verbatim arg handling in Proc

This solves Raku/problem-solving#20.
rakudo · Jun 5, 2020 · 709941c · 709941c
1 parent cde948a
commit 709941c
Show file tree

Hide file tree

Showing 2 changed files with 46 additions and 8 deletions.
diff --git a/src/core.c/Proc.pm6 b/src/core.c/Proc.pm6
@@ -165,22 +165,22 @@ my class Proc {
           if nqp::istype($!exitcode,Nil);
     }
 
-    method spawn(*@args where .so, :$cwd = $*CWD, :$env --> Bool:D) {
+    method spawn(*@args where .so, :$cwd = $*CWD, :$env, :$win-verbatim-args = False --> Bool:D) {
         @!command := @args.List;
-        self!spawn-internal(@args, $cwd, $env)
+        self!spawn-internal(@args, $cwd, $env, :$win-verbatim-args)
     }
 
     method shell($cmd, :$cwd = $*CWD, :$env --> Bool:D) {
         @!command := $cmd.List;
         my @args := Rakudo::Internals.IS-WIN
             ?? (%*ENV<ComSpec>, '/c', $cmd)
             !! ('/bin/sh', '-c', $cmd);
-        self!spawn-internal(@args, $cwd, $env)
+        self!spawn-internal(@args, $cwd, $env, :win-verbatim-args)
     }
 
-    method !spawn-internal(@args, $cwd, $env --> Bool:D) {
+    method !spawn-internal(@args, $cwd, $env, :$win-verbatim-args --> Bool:D) {
         my %ENV := $env ?? $env.hash !! %*ENV;
-        $!proc := Proc::Async.new(|@args, :$!w);
+        $!proc := Proc::Async.new(|@args, :$!w, :$win-verbatim-args);
         .() for @!pre-spawn;
         $!finished = $!proc.start(:$cwd, :%ENV, scheduler => $PROCESS::SCHEDULER);
         my $is-spawned := do {
@@ -240,9 +240,9 @@ my class Proc {
 proto sub run(|) {*}
 multi sub run(*@args where .so, :$in = '-', :$out = '-', :$err = '-',
         Bool :$bin, Bool :$chomp = True, Bool :$merge,
-        Str  :$enc, Str:D :$nl = "\n", :$cwd = $*CWD, :$env) {
+        Str  :$enc, Str:D :$nl = "\n", :$cwd = $*CWD, :$env, :$win-verbatim-args = False) {
     my $proc := Proc.new(:$in, :$out, :$err, :$bin, :$chomp, :$merge, :$enc, :$nl);
-    $proc.spawn(@args, :$cwd, :$env);
+    $proc.spawn(@args, :$cwd, :$env, :$win-verbatim-args);
     $proc
 }
 

diff --git a/src/core.c/Proc/Async.pm6 b/src/core.c/Proc/Async.pm6
@@ -101,6 +101,7 @@ my class Proc::Async {
     has $.w;
     has $.enc = 'utf8';
     has $.translate-nl = True;
+    has $.win-verbatim-args = False;
     has Bool $.started = False;
     has $!stdout_supply;
     has CharsOrBytes $!stdout_type;
@@ -285,6 +286,22 @@ my class Proc::Async {
         $promise
     }
 
+    method !win-quote-CommandLineToArgvW(*@args where .so) {
+        my @quoted_args;
+        for @args -> $arg {
+            if !$arg.contains(' ') && !$arg.contains('"') && !$arg.contains('\t') && !$arg.contains('\n') && !$arg.contains('\v') {
+                @quoted_args.push: $arg;
+            }
+            else {
+                my $quoted_arg = $arg;
+                $quoted_arg ~~ s:g/ ( \\* ) \" /$0$0\\\"/;
+                $quoted_arg ~~ s/ ( \\+ ) $ /$0$0/;
+                @quoted_args.push: '"' ~ $quoted_arg ~ '"';
+            }
+        }
+        @quoted_args.join: ' '
+    }
+
     method start(Proc::Async:D:
       :$scheduler = $*SCHEDULER, :$ENV, :$cwd = $*CWD
     --> Promise) {
@@ -302,6 +319,27 @@ my class Proc::Async {
 
     method !start-internal($scheduler, $ENV, $cwd --> Promise) {
         my %ENV := $ENV ?? $ENV.hash !! %*ENV;
+
+#?if jvm
+        # The Java process API does not allow disabling Javas
+        # sophisticated heuristics of command mangling.
+        # So it's not easily possible to do the quoting ourselves.
+        # So the $!win-quote-args argument is ignored on JVM and we
+        # just let Java do its magic.
+        my @quoted-args := @!args;
+#?endif
+#?if !jvm
+        my @quoted-args;
+        if Rakudo::Internals.IS-WIN {
+            @quoted-args.push($!win-verbatim-args
+                ?? @!args.join(' ')
+                !! self!win-quote-CommandLineToArgvW(@!args));
+        }
+        else {
+            @quoted-args := @!args;
+        }
+#?endif
+
         $!exit_promise := Promise.new;
 
         my Mu $callbacks := nqp::hash();
@@ -355,7 +393,7 @@ my class Proc::Async {
         nqp::bindkey($callbacks, 'stderr_fd', $!stderr-fd) if $!stderr-fd.DEFINITE;
 
         $!process_handle := nqp::spawnprocasync($scheduler.queue(:hint-affinity),
-            CLONE-LIST-DECONTAINERIZED($!path,@!args),
+            CLONE-LIST-DECONTAINERIZED($!path,@quoted-args),
             $cwd.Str,
             CLONE-HASH-DECONTAINERIZED(%ENV),
             $callbacks,