commit d98375a7a29510e6211d6c3406bf9f3adc9c2ffe parent 2e5c192d6d90ad6cec970421bda48ceeeec1d31a Author: Tomas Hlavaty <tom@logand.com> Date: Thu, 29 Aug 2013 00:20:14 +0200 rw.os:make-program introduced Diffstat:
| M | os.lisp | | | 153 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++--------------------- |
1 file changed, 113 insertions(+), 40 deletions(-)
diff --git a/os.lisp b/os.lisp @@ -22,57 +22,130 @@ (defpackage :rw.os (:use :cl) - (:export :run-command + (:export :make-program + :run-command :sha1sum :with-program-output)) (in-package :rw.os) +(defun make-program (input output cmd args) + #-(or ccl ecl sbcl cmu clisp) + (error "TODO port RW.OS:MAKE-PROGRAM") + #+ccl + (let ((p (ccl:run-program cmd + args + :input input + :output output + :error nil + :sharing :external + :wait nil))) + (let ((status (ccl:external-process-status p))) + (if input + (assert (eq :running status)) + (assert (member status '(:running :exited))))) + (lambda (msg) + (ecase msg + (status-and-code (ccl:external-process-status p)) + (input-stream (ccl:external-process-input-stream p)) + (output-stream (ccl:external-process-output-stream p)) + (wait (ccl::external-process-wait p)) + (close (flet ((finish (x) (when x (close x)))) + (finish (ccl:external-process-output-stream p)) + (finish (ccl:external-process-input-stream p)) + (finish (ccl:external-process-error-stream p))))))) + #+ecl + (multiple-value-bind (io x p) + (ext:run-program cmd + args + :input input + :output output + :error nil + :wait nil) + (declare (ignore x)) + (let ((status (ext:external-process-status p))) + (if input + (assert (eq :running status)) + (assert (member status '(:running :exited))))) + (lambda (msg) + (ecase msg + (status-and-code (ext:external-process-status p)) + (input-stream io) + (output-stream io) + (wait (ext:external-process-wait p)) + (close (warn "TODO #+ecl MAKE-PROGRAM port CLOSE"))))) + #+sbcl + (let ((p (sb-ext:run-program cmd + args + :input input + :output output + :error nil + :wait nil + :search t))) + (let ((status (sb-ext:process-status p))) + (if input + (assert (eq :running status)) + (assert (member status '(:running :exited))))) + (lambda (msg) + (ecase msg + (status-and-code (sb-ext:process-status p)) + (input-stream (sb-ext:process-input p)) + (output-stream (sb-ext:process-output p)) + (wait (sb-ext:process-wait p)) + (close (sb-ext:process-close p))))) + #+cmu + (let ((p (ext:run-program cmd + args + :input input + :output output + :error nil + :wait nil))) + (let ((status (sb-ext:process-status p))) + (if input + (assert (eq :running status)) + (assert (member status '(:running :exited))))) + (lambda (msg) + (ecase msg + (status-and-code (sb-ext:process-status p)) + (input-stream (sb-ext:process-input p)) + (output-stream (sb-ext:process-output p)) + (wait (sb-ext:process-wait p)) + (close (ext:process-close p))))) + #+clisp + (let ((p (ext:run-program cmd + :arguments args + :input input + :output output + :error nil + :wait nil))) + (let ((status :running)) ;; TODO + (if input + (assert (eq :running status)) + (assert (member status '(:running :exited))))) + (lambda (msg) + (ecase msg + (status-and-code (values :running 0)) ;; TODO + (input-stream p) + (output-stream p) + (wait (ext:process-wait p)) ;; TODO + (close (close p)))))) + (defun throw-error (cmd args code error-plist) (when error-plist (let ((reason (or (cdr (assoc code error-plist)) ""))) (error (format nil "~a error ~d: ~a ~s" cmd code reason args))))) (defun call-with-program-output (output cmd args error-plist fn) - #-(or cmu sbcl clisp openmcl ecl) - (error "TODO port RW.OS::CALL-WITH-PROGRAM-OUTPUT") - (let ((p - #+cmu(ext:run-program cmd args :output output) - #+sbcl(sb-ext:run-program cmd args :output output :search t) - #+clisp(ext:run-program cmd :arguments args :output output) - #+openmcl(ccl:run-program cmd args :output output) - #+ecl(nth-value 2 (ext:run-program cmd args - :input nil - :output output - :error nil)))) - (when p - (unwind-protect - (let ((code #+cmu(ext:process-exit-code p) - #+sbcl(sb-ext:process-exit-code p) - #+clisp 0 - #+openmcl(multiple-value-bind (a b) - (ccl:external-process-status p) - (declare (ignore a)) - b) - #+ecl(ext::external-process-%code p))) - (if (eq 0 code) - (if (eq :stream output) - (funcall fn - #+cmu(ext:process-output p) - #+sbcl(sb-ext:process-output p) - #+clisp p - #+openmcl(ccl:external-process-output-stream p) - #+ecl(ext:external-process-output p)) - t) - (throw-error cmd args code error-plist))) - #+cmu(ext:process-close p) - #+sbcl(sb-ext:process-close p) - #+openmcl(flet ((finish (x) (when x (close x)))) - (finish (ccl:external-process-output-stream p)) - (finish (ccl:external-process-input-stream p)) - (finish (ccl:external-process-error-stream p))) - ;; TODO ecl process clean up? - )))) + (let ((p (make-program nil output cmd args))) + (unwind-protect + (multiple-value-bind (status code) (funcall p 'status-and-code) + (assert (member status '(:running :exited))) + (if (member code '(nil 0)) + (if (eq :stream output) + (funcall fn (funcall p 'output-stream)) + t) + (throw-error cmd args code error-plist))) + (funcall p 'close)))) (defun run-command (cmd args &optional error-plist) (call-with-program-output nil cmd args error-plist nil))