From: Mark Wooding <mdw@distorted.org.uk>
Date: Mon, 22 Dec 2014 22:19:17 +0000 (+0000)
Subject: sys.lisp: New toy for running external programs.
X-Git-Url: https://git.distorted.org.uk/~mdw/zone/commitdiff_plain/5020fdad3884d6f300cedd7ee9936b20e1579dcc

sys.lisp: New toy for running external programs.
---

diff --git a/sys.lisp b/sys.lisp
index 10cd5ca..d3dfc08 100644
--- a/sys.lisp
+++ b/sys.lisp
@@ -181,4 +181,29 @@
    `temporary-file'."
   `(with-temporary-files* (lambda (,context) ,@body) ,base))
 
+(export 'run-program)
+(defun run-program (command &key input output)
+  "Run a COMMAND, specified as a list of arguments.
+
+   The INPUT and OUTPUT may be `nil' (no input, discard output), or
+   pathnames or namestrings.  Signals an error if the command fails."
+
+  #+ sbcl
+  (let ((proc (sb-ext:run-program (car command) (cdr command)
+				  :wait t :search t
+				  :input input :output output :error t
+				  :if-input-does-not-exist :error
+				  :if-output-exists :supersede)))
+    (unless (and (eq (sb-ext:process-status proc) :exited)
+		 (zerop (sb-ext:process-exit-code proc)))
+      (error "Failed to run command `~{~A~^ ~}': ~S ~S" command
+	     (sb-ext:process-status proc) (sb-ext:process-exit-code proc))))
+
+  #+ clisp
+  (let ((rc (ext:run-program (car command) :arguments (cdr command)
+			     :input input :output output
+			     :if-output-exists :overwrite)))
+    (when rc
+      (error "Failed to run command `~{~A~^ ~}': status ~S" command rc))))
+
 ;;;----- That's all, folks --------------------------------------------------