Newer
Older
Francois-Rene Rideau
committed
#+xcvb (module (:depends-on ("macros" "process-spec")))
(in-package :inferior-shell)
Francois-Rene Rideau
committed
(defvar *backend* :auto)
Nathan Hawkins
committed
Francois-Rene Rideau
committed
(defun on-host-spec (host spec)
(if (current-host-name-p host)
spec
`(ssh ,host ,(print-process-spec spec))))
(deftype direct-command-spec ()
'(and command-spec (satisfies direct-command-spec-p)))
(defun direct-command-spec-p (spec)
(and (typep spec 'command-spec)
(null (command-redirections spec))))
(defun run-spec (spec &key ignore-error-status output)
(let* ((command
(if (consp spec)
(parse-process-spec spec)
spec))
(command
(etypecase command
(direct-command-spec
(command-arguments spec))
(process-spec
(print-process-spec spec))
(string
spec))))
(case output
((t)
(run-program/ command :ignore-error-status ignore-error-status))
(otherwise
(run-program/
command :ignore-error-status ignore-error-status :output output)))))
Francois-Rene Rideau
committed
(defun run-process-spec (spec &rest keys &key ignore-error-status output host backend)
Francois-Rene Rideau
committed
(etypecase host
(null
(etypecase spec
(string
(run-spec spec :ignore-error-status ignore-error-status :output output))
Francois-Rene Rideau
committed
(cons
(apply 'run-process-spec (parse-process-spec spec) keys))
(process-spec
Francois-Rene Rideau
committed
(ecase (or backend *backend*)
#+(and sbcl sb-thread unix)
((:sbcl)
(let ((interactive (eq :output :interactive)))
(sbcl-run
spec :input interactive :output (or interactive output) :error t
:ignore-error-status ignore-error-status)))
Francois-Rene Rideau
committed
((:auto)
(run-spec spec :ignore-error-status ignore-error-status :output output))))))
Francois-Rene Rideau
committed
(string
(apply 'run-process-spec (on-host-spec host spec) :host nil keys))
(function
(apply 'run-process-spec (funcall host spec) :host nil keys))))
(defun run (cmd &key time (output t) show host (on-error (list "Command ~S failed~@[ on ~A~]" cmd host)))
Francois-Rene Rideau
committed
(labels ((process-time ()
(if time (time (process-command)) (process-command)))
(process-command ()
(handler-case
(run-process-spec
cmd
:ignore-error-status nil :output output :host host)
Francois-Rene Rideau
committed
(subprocess-error () (error-behaviour on-error)))))
Francois-Rene Rideau
committed
(when show
(format *trace-output* "; ~A~%" (print-process-spec cmd)))
Francois-Rene Rideau
committed
(process-time)))
(defun run/s (cmd &rest keys &key on-error time show host)
"run command CMD, return its standard output results as a string."
(declare (ignore on-error time show host))
(apply 'run cmd :output 'string keys))
(defun run/ss (cmd &rest keys &key on-error time show host)
"Like run/s, but strips the line ending off the result string;
very much like `cmd` or $(cmd) at the shell"
(declare (ignore on-error time show host))
(apply 'run cmd :output :string/stripped keys))
(defun slurp-stream-string/stripped (input-stream)
(stripln (slurp-stream-string input-stream)))
(defmethod slurp-input-stream ((x (eql :string/stripped)) input-stream
&key &allow-other-keys)
(slurp-stream-string/stripped input-stream))
Francois-Rene Rideau
committed
(defun run/lines (cmd &rest keys &key on-error time show host)
"Like run/s, but return a list of lines rather than one string"
(declare (ignore on-error time show host))
(apply 'run cmd :output :lines keys))