Changeset 15397

Timestamp:

May 29, 2012, 2:07:06 AM (12 years ago)

Author:

Gary Byers

Message:

Windows version of RUN-PROGRAM and related functions:
RUN-PROGRAM allows its "args" argument to be a SIMPLE-STRING (as well
as a list of SIMPLE-STRINGs).

Use MAKE-WINDOWS-COMMAND-LINE (not just JOIN-STRINGS) to build the
command-line for CreateProcess from a cons of the RUN-PROGRAM "program
name" and "args" arguments. A literal string "args" argument is passed
verbatim to the command line; the program name and any arguments in a
list-typed "args" arguments are processd by surrounding space/tab with
double-quotes and prefixing literal double-quote characters with backslash;
all other characters are passed verbatim to the command line and arguments
are separated by spaces.

This seems to be at least a first approximation of the rules used by
the MSVC runtime, though I haven't seen those rules written down
anywhere. (The program name is processed by the OS and any quoting of
it has to be done in a canonical way.)

This may fix ticket:858. How would anyone know ?

File:

• trunk/source/level-1/linux-files.lisp (modified) (3 diffs)

trunk/source/level-1/linux-files.lisp

@@ -1717 +1717 @@
     "Invoke an external program as an OS subprocess of lisp."
     (declare (ignore pty))
-    (unless (every #'(lambda (a) (typep a 'simple-string)) args)
+    (push program args)
+    (unless (do* ((args args (cdr args)))
+                 ((atom args)
+                  (or (typep args 'simple-string)
+                      (null args)))
+              (unless (typep (car args) 'simple-string)
+                (return)))
       (error "Program args must all be simple strings : ~s" args))
-    (push program args)
     (let* ((token (list 0))
            (in-fd nil)
@@ -1808 +1813 @@
         (monitor-external-process proc))))
 
-  (defun join-strings (strings)
-    (reduce (lambda (left right) (concatenate 'string left " " right)) strings))
+  (defun make-windows-command-line (strings)
+    (with-output-to-string (out)
+      (do* ((strings strings (cdr strings)))
+           ((atom strings)     
+            (if strings (write-string strings out)))
+        (let* ((string (car strings)))
+          (dotimes (i (length string))
+            (let* ((c (schar string i)))
+              (case c
+                ((#\space #\tab)
+                 (write-char #\" out)
+                 (write-char c out)
+                 (write-char #\" out))
+                (#\"
+                 (write-char #\\ out)
+                 (write-char #\" out))
+                (t (write-char c out)))))
+          (when strings (write-char #\space out))))))
 
   (defun create-windows-process (new-in new-out new-err cmdstring env)
@@ -1849 +1870 @@
   (defun exec-with-io-redirection (new-in new-out new-err args proc &optional env)
     (multiple-value-bind (win handle-to-process-or-error)
-        (create-windows-process new-in new-out new-err (join-strings args) env)
+        (create-windows-process new-in new-out new-err (make-windows-command-line args) env)
       (if win
         handle-to-process-or-error