From 9d86792973e2bf11128b74fb8fd616ae0d9cfd6c Mon Sep 17 00:00:00 2001
From: "Robert P. Goldman" <rpgoldman@sift.net>
Date: Mon, 29 Jun 2015 16:51:50 -0500
Subject: [PATCH] Fix RUN-PROGRAM handling of shell cmds. Fix Allegro shell on
 Windows.

Fix for launchpad bug 1469550.

Fix %NORMALIZE-SYSTEM-COMMAND for ACL + Windows, by explicitly forcing
use of "CMD /c".

Force RUN-PROGRAM to runs shell on string command argument, per its
docstring (unless explicitly overridden by the caller).
---
 uiop/run-program.lisp | 20 +++++++++++++++++---
 1 file changed, 17 insertions(+), 3 deletions(-)

diff --git a/uiop/run-program.lisp b/uiop/run-program.lisp
index 03f53a89..ea2d0150 100644
--- a/uiop/run-program.lisp
+++ b/uiop/run-program.lisp
@@ -737,10 +737,18 @@ It returns a process-info plist with possible keys:
 
   (defun %normalize-system-command (command) ;; helper for %USE-SYSTEM
     (etypecase command
-      (string command)
+      (string
+       (os-cond
+        ((os-windows-p)
+         #+allegro
+         (concatenate 'string "cmd /c " command)
+         #-allegro command)
+        (t command)))
       (list (escape-shell-command
              (os-cond
               ((os-unix-p) (cons "exec" command))
+              ((os-windows-p) #+allegro (append '("cmd" "/c") command)
+                              #-allegro command)
               (t command))))))
 
   (defun %redirected-system-command (command in out err directory) ;; helper for %USE-SYSTEM
@@ -817,7 +825,7 @@ It returns a process-info plist with possible keys:
       (values output-result error-output-result exit-code)))
 
   (defun run-program (command &rest keys
-                       &key ignore-error-status force-shell
+                       &key ignore-error-status (force-shell nil force-shell-suppliedp)
                          (input nil inputp) (if-input-does-not-exist :error)
                          output (if-output-exists :overwrite)
                          (error-output nil error-output-p) (if-error-output-exists :overwrite)
@@ -829,7 +837,8 @@ either a list of strings specifying a program and list of arguments,
 or a string specifying a shell command (/bin/sh on Unix, CMD.EXE on Windows).
 
 Always call a shell (rather than directly execute the command when possible)
-if FORCE-SHELL is specified.
+if FORCE-SHELL is specified.  Similarly, never call a shell if FORCE-SHELL is
+specified to be NIL.
 
 Signal a continuable SUBPROCESS-ERROR if the process wasn't successful (exit-code 0),
 unless IGNORE-ERROR-STATUS is specified.
@@ -877,6 +886,11 @@ or an indication of failure via the EXIT-CODE of the process"
     (declare (ignorable ignore-error-status))
     #-(or abcl allegro clasp clisp clozure cmu cormanlisp ecl gcl lispworks mcl mkcl sbcl scl xcl)
     (error "RUN-PROGRAM not implemented for this Lisp")
+    ;; per doc string, set FORCE-SHELL to T if we get command as a string.  But
+    ;; don't override user's specified preference. [2015/06/29:rpg]
+    (when (stringp command)
+      (unless force-shell-suppliedp
+        (setf force-shell t)))
     (flet ((default (x xp output) (cond (xp x) ((eq output :interactive) :interactive))))
       (apply (if (or force-shell
                      #+(or clasp clisp ecl) (or (not ignore-error-status) t)
-- 
GitLab