Ticket #496: shell-escaping.patch

shell.scm

@@ -1 +1 @@
 ;;;; shell.scm
 
 
-(module shell (execute run run* shell shell shell-verbose command)
+(module shell (execute run run* shell shell-verbose)
 
 (import scheme chicken)
-(use extras utils data-structures)
+(use data-structures posix)
 
 
 (define shell-verbose (make-parameter #f))
 
-(define (command . cmds)
-  (apply
-   values
-   (map (lambda (cmd)
-          (string-intersperse (map ->string (flatten cmd))))
-        cmds)))
-
 (define (execute cmds #!key status verbose)
   (let ((ss 
          (map
           (lambda (cmd)
-            (let ((cmd (command cmd)))
-              (when (or verbose (shell-verbose))
-                (printf "  ~A~%~!" cmd))
-              (let ((r (system cmd)))
-                (cond (status r)
-                      ((not (zero? r)) 
-                       (error 
-                        'execute
-                        "shell command failed with non-zero exit status"
-                        cmd r))))))
+            (let ((cmd (flatten cmd)))
+              (when (or verbose (shell-verbose))
+                (printf "  ~A~%~!" (string-intersperse cmd)))
+              (let ((r (nth-value 2 (process-wait (process-run (car cmd) (cdr cmd))))))
+                (cond (status r)
+                      ((not (zero? r)) 
+                       (error 
+                        'execute
+                        "shell command failed with non-zero exit status"
+                        cmd r))))))
           cmds)))
     (if status (apply values ss) (void))))