diff --git a/pkgdcl.lisp b/pkgdcl.lisp index 169094134100ce30eb8f7b9c81d696c4664ee4ef..b710fe11add9718bcbb574dbd285752ab06a054a 100644 --- a/pkgdcl.lisp +++ b/pkgdcl.lisp @@ -7,8 +7,9 @@ (:export #:run #:run/s #:run/ss #:run/lines #:process-spec #:command-spec #:pipe-spec + #:or-spec #:and-spec #:progn-spec #:fork-spec #:print-process-spec #:parse-process-spec #:command-arguments #:command-redirections #:redirection #:file-redirection #:fd-redirection #:close-redirection #:! #:- #:< #:> #:<> #:>! #:>> #:>>! #:<& #:>& #:>&! #:>>&! - #:>& #:>> #:>>& #:pipe)) + #:>& #:>> #:>>& #:pipe #:or #:and #:progn #:fork)) diff --git a/process-spec.lisp b/process-spec.lisp index 953a0c2fac5d1a82ee0b8e0db3c2c5e213b0ea2c..4272590618e3a43fc32a2e87c73c021052400a6a 100644 --- a/process-spec.lisp +++ b/process-spec.lisp @@ -6,10 +6,20 @@ (defclass process-spec (simple-print-object-mixin) ()) -(defclass pipe-spec (process-spec) +(defclass sequence-spec (process-spec) ((processes :type list - :initarg :processes :reader pipe-processes))) + :initarg :processes :reader sequence-processes))) + +(defclass pipe-spec (sequence-spec) ()) + +(defclass or-spec (sequence-spec) ()) + +(defclass and-spec (sequence-spec) ()) + +(defclass progn-spec (sequence-spec) ()) + +(defclass fork-spec (sequence-spec) ()) (defclass redirection (simple-print-object-mixin) ()) @@ -156,21 +166,32 @@ (clps-current-argument c) nil))) (defun parse-process-spec (spec) - (match spec - (`(pipe ,@args) - (make-instance - 'pipe-spec :processes - (loop :for process :in (mapcar 'parse-process-spec args) - :nconc (if (typep process 'pipe-spec) - (pipe-processes process) - (list process))))) - (`(,* ,@*) - (let ((c (make-instance 'command-parse))) - (dolist (elem spec) - (parse-command-spec-top-token c elem)) - (command-parse-results c))) - (* - (error "Invalid process spec ~S" spec)))) + (macrolet ((make-sequence-instance (spec-type args) + `(make-instance + ',spec-type :processes + (loop :for process :in (mapcar 'parse-process-spec ,args) + :nconc (etypecase process + (,spec-type (sequence-processes process)) + (sequence-spec (list process)) + (command-spec (list process))))))) + (match spec + (`(pipe ,@args) + (make-sequence-instance pipe-spec args)) + (`(or ,@args) + (make-sequence-instance or-spec args)) + (`(and ,@args) + (make-sequence-instance and-spec args)) + (`(progn ,@args) + (make-sequence-instance progn-spec args)) + (`(fork ,@args) + (make-sequence-instance fork-spec args)) + (`(,* ,@*) + (let ((c (make-instance 'command-parse))) + (dolist (elem spec) + (parse-command-spec-top-token c elem)) + (command-parse-results c))) + (* + (error "Invalid process spec ~S" spec))))) (defun parse-command-spec-top-token (c x) (labels @@ -246,6 +267,7 @@ (null ()) (keyword (a (format nil "--~(~a~)" x))) (symbol (a (string-downcase x))) + (pathname (a (namestring (translate-logical-pathname x)))) (cons (c x))))) (defun parse-command-spec-token (c x) @@ -259,6 +281,7 @@ (null ()) (keyword (e (format nil "--~(~a~)" x))) (symbol (e (string-downcase x))) + (pathname (e (namestring (translate-logical-pathname x)))) (cons (c x)))) (c (x) (match x @@ -289,13 +312,32 @@ (loop :for r :in redirections :do (princ " " s) (print-process-spec r s)))))) -(defmethod print-process-spec ((spec pipe-spec) &optional s) +(defun print-process-sequence-joined (spec separator empty s &optional tail) (with-output-stream (s) - (let ((processes (pipe-processes spec))) + (let ((processes (sequence-processes spec))) (if processes - (loop :for (p . rest) :on processes :do - (print-process-spec p s) (when rest (princ " | " s))) - (princ "cat" s))))) + (progn + (princ "(" s) + (loop :for (p . rest) :on processes :do + (print-process-spec p s) (when rest (princ separator s))) + (princ ")" s) + (when tail (princ tail s))) + (princ empty s))))) + +(defmethod print-process-spec ((spec pipe-spec) &optional s) + (print-process-sequence-joined spec " | " "cat" s)) + +(defmethod print-process-spec ((spec or-spec) &optional s) + (print-process-sequence-joined spec " || " "false" s)) + +(defmethod print-process-spec ((spec and-spec) &optional s) + (print-process-sequence-joined spec " && " "true" s)) + +(defmethod print-process-spec ((spec progn-spec) &optional s) + (print-process-sequence-joined spec "; " "true" s)) + +(defmethod print-process-spec ((spec fork-spec) &optional s) + (print-process-sequence-joined spec "; " "true" s " &")) (defmethod print-process-spec ((spec string) &optional s) (xcvb-driver::output-string spec s)) diff --git a/run.lisp b/run.lisp index 57ba8a0573b98ad2c4d990e89e663c3fda1d0650..4603bb7a60b69b67f8b4f6a126f120c0d99cbd74 100644 --- a/run.lisp +++ b/run.lisp @@ -23,6 +23,27 @@ spec `(ssh ,host ,(print-process-spec spec)))) +(defmethod run-spec ((spec process-spec) &rest keys &key ignore-error-status output) + (let ((command + (if (and (typep spec 'command-spec) + (null (command-redirections spec))) + (command-arguments spec) + (print-process-spec spec)))) + (run-program/ command + :ignore-error-status ignore-error-status + :output output))) + +;; This only works with run because run-program/ doesn't return an +;; exit code if :output is set. + +;; (defmethod run-spec ((spec or-spec) &rest keys &key ignore-error-status output) +;; (let ((processes (sequence-processes spec)) +;; (return-code 1)) +;; (loop :for p :in processes :do +;; (setf return-code (run-spec p :ignore-error-status ignore-error-status :output output)) +;; :until (and (numberp return-code) (= return-code 0))) +;; return-code)) + (defun run-process-spec (spec &rest keys &key ignore-error-status output host) (declare (ignore ignore-error-status output)) (etypecase host @@ -33,14 +54,7 @@ (cons (apply 'run-process-spec (parse-process-spec spec) keys)) (process-spec - (let ((command - (if (and (typep spec 'command-spec) - (null (command-redirections spec))) - (command-arguments spec) - (print-process-spec spec)))) - (run-program/ command - :ignore-error-status ignore-error-status - :output output))))) + (run-spec spec :ignore-error-status ignore-error-status :output output)))) (string (apply 'run-process-spec (on-host-spec host spec) :host nil keys)) (function