├── LICENSE.txt ├── README.txt ├── commando.asd ├── commando.lisp └── package.lisp /LICENSE.txt: -------------------------------------------------------------------------------- 1 | 2 | Copyright (c) 2011 Zachary Beane , All Rights Reserved 3 | 4 | Redistribution and use in source and binary forms, with or without 5 | modification, are permitted provided that the following conditions 6 | are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials 14 | provided with the distribution. 15 | 16 | THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED 17 | OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 18 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 19 | ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY 20 | DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 21 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE 22 | GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS 23 | INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, 24 | WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 25 | NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 26 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 27 | 28 | -------------------------------------------------------------------------------- /README.txt: -------------------------------------------------------------------------------- 1 | The Commando library is a slim layer over SB-EXT:RUN-PROGRAM makes it 2 | easy to call Unix commands and capture, process, or ignore the output. 3 | 4 | It's half-baked. If you have any questions or comments about it, 5 | please email me, Zach Beane . 6 | 7 | 8 | -------------------------------------------------------------------------------- /commando.asd: -------------------------------------------------------------------------------- 1 | ;;;; commando.asd 2 | 3 | (asdf:defsystem #:commando 4 | :serial t 5 | :author "Zach Beane " 6 | :version "0.0.1" 7 | :description "A half-baked interface for a supportive shell command 8 | environment." 9 | :depends-on (#:sb-posix 10 | #:alexandria) 11 | :components ((:file "package") 12 | (:file "commando"))) 13 | 14 | -------------------------------------------------------------------------------- /commando.lisp: -------------------------------------------------------------------------------- 1 | ;;;; commando.lisp 2 | 3 | (in-package #:commando) 4 | 5 | ;;; "commando" goes here. Hacks and glory await! 6 | 7 | (defvar *command-output* (make-synonym-stream '*standard-output*)) 8 | (defvar *command-error-output* (make-synonym-stream '*error-output*)) 9 | 10 | ;;; FIXME: Should be a generic function. 11 | (defun stringify-command-argument (argument) 12 | "Convert ARGUMENT to a string suitable for passing to RUN." 13 | (typecase argument 14 | (string argument) 15 | (pathname (native-namestring argument)) 16 | (keyword (format nil "--~(~A~)" argument)) 17 | (t (princ-to-string argument)))) 18 | 19 | (defun run (command &rest arguments) 20 | "Run shell-command COMMAND with ARGUMENTS as arguments. Searches the 21 | PATH environment for the right command to run. Arguments are converted 22 | to strings with STRINGIFY-COMMAND-ARGUMENT. If the command exits with 23 | nonzero status, signals an error." 24 | (let ((process (run-program command 25 | (mapcar #'stringify-command-argument 26 | (flatten arguments)) 27 | :search t 28 | :wait t 29 | :error *command-error-output* 30 | :output *command-output*))) 31 | (let ((code (process-exit-code process))) 32 | (if (zerop code) 33 | t 34 | ;; FIXME: Raise a proper condition that can be handled. 35 | (error "Command exited with non-zero status ~D" code))))) 36 | 37 | (defvar *runstring-command* '("/bin/bash" "-c") 38 | "The command and argument to use to run RUNSTRING shell strings.") 39 | 40 | (defun runstring (command &rest arguments) 41 | "Run COMMAND as an argument to 'sh -c'. If there are any ARGUMENTS, 42 | COMMAND is treated as a format control string and used to construct 43 | the final command." 44 | (when arguments 45 | (setf command (apply #'format nil command 46 | (mapcar #'stringify-command-argument 47 | (flatten arguments))))) 48 | (apply #'run (append *runstring-command* (list command)))) 49 | 50 | (defmacro with-run-output ((stream (command &rest args)) &body body) 51 | "Bind STREAM to the output stream of COMMAND and evaluate BODY." 52 | `(let* ((*command-output* (make-string-output-stream))) 53 | (run ,command ,@args) 54 | (with-input-from-string (,stream (get-output-stream-string *command-output*)) 55 | ,@body))) 56 | 57 | (defun call-with-command-stream (fun command &rest arguments) 58 | "Run shell-comand COMMAND with ARGUMENTS as arguments. While the 59 | command is running, call FUN with one argument, the stream 60 | representing the ongoing output of the command. If the command exits 61 | with nonzero status, signals an error. Like WITH-RUN-OUTPUT, but does 62 | not collect all output in advance." 63 | (let ((process (sb-ext:run-program command 64 | (mapcar #'stringify-command-argument 65 | arguments) 66 | :search t 67 | :output :stream 68 | :error *error-output* 69 | :wait nil))) 70 | (let ((stream (sb-ext:process-output process))) 71 | (unwind-protect 72 | (multiple-value-prog1 73 | (funcall fun stream) 74 | (sb-ext:process-wait process) 75 | (let ((status (sb-ext:process-exit-code process))) 76 | (unless (zerop status) 77 | (error "Non-zero exit from ~S~{ ~S~}: ~D" 78 | command arguments 79 | status)))) 80 | (when (open-stream-p stream) 81 | (ignore-errors (close stream :abort t))))))) 82 | 83 | (defmacro with-command-stream ((stream (command &rest arguments)) &body body) 84 | `(call-with-command-stream (lambda (,stream) 85 | ,@body) ,command ,@arguments)) 86 | 87 | 88 | (defun native-directory-string (pathname) 89 | ;; FIXME: directory-namestring fails on Windows due to lack of drive 90 | ;; info. Maybe I care. 91 | (native-namestring (directory-namestring (probe-file pathname)))) 92 | 93 | (defmacro with-posix-cwd (new-directory &body body) 94 | "Evaluate BODY with *DEFAULT-PATHNAME-DEFAULTS* and the POSIX 95 | working directory set to NEW-DIRECTORY." 96 | ;; fchdir thing from Linux's getcwd(3) 97 | (let ((fd (gensym)) 98 | (new (gensym))) 99 | `(let ((,fd nil) 100 | (,new (native-directory-string ,new-directory))) 101 | (unwind-protect 102 | (let ((*default-pathname-defaults* (probe-file ,new))) 103 | (setf ,fd (sb-posix:open "." 0)) 104 | (sb-posix:chdir ,new) 105 | ,@body) 106 | (when ,fd 107 | (sb-posix:fchdir ,fd) 108 | (ignore-errors (sb-posix:close ,fd))))))) 109 | 110 | (defmacro with-binary-run-output (pathname &body body) 111 | "Evaluate BODY in an environment that binds *COMMAND-OUTPUT* to a 112 | binary output stream." 113 | `(with-open-file (*command-output* ,pathname :direction :output 114 | :element-type '(unsigned-byte 8) 115 | :if-exists :supersede) 116 | ,@body)) 117 | 118 | (defmacro without-run-output (&body body) 119 | "Evaluates BODY in an environment that discards all command output." 120 | `(let ((*command-output* nil)) 121 | ,@body)) 122 | 123 | (defun run-output-lines (command &rest args) 124 | "Return the output of COMMAND as a list of one string per line." 125 | (let ((output (with-output-to-string (*command-output*) 126 | (apply #'run command args)))) 127 | (with-input-from-string (stream output) 128 | (loop for line = (read-line stream nil) 129 | while line collect line)))) 130 | 131 | (defun first-run-line (command &rest arguments) 132 | "Return the first line of output from COMMAND." 133 | (first (apply #'run-output-lines command arguments))) 134 | 135 | 136 | ;;; Temporary directory work 137 | 138 | (defvar *default-temporary-template* 139 | #p"/tmp/commando/" 140 | "This directory is used as the basis of IN-TEMPORARY-DIRECTORY.") 141 | 142 | (defvar *random-alphanumeric* 143 | (concatenate 'string 144 | "abcdefghijklmnopqrstuvwxyz" 145 | "ABCDEFGHIJKLMNOPQRSTUVWXYZ" 146 | "0123456789")) 147 | 148 | (defun random-element (vector) 149 | (aref vector (random (length vector)))) 150 | 151 | (defun random-char () 152 | (random-element *random-alphanumeric*)) 153 | 154 | (defun random-string (length) 155 | (map-into (make-string length) 'random-char)) 156 | 157 | (defun native (pathname) 158 | (native-namestring (merge-pathnames pathname))) 159 | 160 | (defun call-with-temporary-directory (template-pathname fun) 161 | "Call FUN with one argument, a temporary directory that is 162 | unconditionally deleted when FUN returns, either normally or via a 163 | non-local exit." 164 | (flet ((random-temporary () 165 | (let* ((parts (pathname-directory template-pathname)) 166 | (last (first (last parts))) 167 | (randomized (format nil "~A-~A" last (random-string 8)))) 168 | (make-pathname :directory (nconc (butlast parts) (list randomized)) 169 | :defaults template-pathname)))) 170 | (block nil 171 | (tagbody 172 | retry 173 | (let ((path (random-temporary))) 174 | (handler-case 175 | (progn 176 | (sb-posix:mkdir (native path) #o700) 177 | (unwind-protect 178 | (return (funcall fun path)) 179 | (ignore-errors (run "rm" "-rf" (native path))))) 180 | (sb-posix:syscall-error (condition) 181 | (when (= (sb-posix:syscall-errno condition) 182 | sb-posix:eexist) 183 | (go retry)) 184 | (error condition)))))))) 185 | 186 | (defmacro with-temporary-directory ((var &optional 187 | (template-pathname 188 | '*default-temporary-template*)) 189 | &body body) 190 | "Macro-ized version of CALL-WITH-TEMPORARY-DIRECTORY." 191 | `(call-with-temporary-directory ,template-pathname (lambda (,var) ,@body))) 192 | 193 | (defun call-in-temporary-directory (template-pathname fun) 194 | "Call FUN with the POSIX cwd and *DEFAULT-PATHNAME-DEFAULTS* set to 195 | a temporary directory that is unconditionally deleted when FUN 196 | returns, either normally or via a non-local exit." 197 | (call-with-temporary-directory 198 | template-pathname 199 | (lambda (path) 200 | (with-posix-cwd path 201 | (funcall fun))))) 202 | 203 | (defmacro in-temporary-directory (&body body) 204 | "Macro-ized version of CALL-IN-TEMPORARY-DIRECTORY." 205 | `(call-in-temporary-directory *default-temporary-template* 206 | (lambda () ,@body))) 207 | 208 | (defmacro in-specific-temporary-directory (template-pathname &body body) 209 | `(call-in-temporary-directory ,template-pathname 210 | (lambda () ,@body))) 211 | 212 | (defun copy-file (from to) 213 | "Copy the file FROM to the file TO." 214 | (run "cp" (native (truename from)) (native to))) 215 | -------------------------------------------------------------------------------- /package.lisp: -------------------------------------------------------------------------------- 1 | ;;;; package.lisp 2 | 3 | (defpackage #:commando 4 | (:use #:cl) 5 | (:shadowing-import-from #:sb-ext 6 | #:run-program 7 | #:process-exit-code 8 | #:process-output) 9 | (:shadowing-import-from #:sb-ext 10 | #:native-namestring) 11 | (:shadowing-import-from #:sb-posix 12 | #:chdir) 13 | (:shadowing-import-from #:alexandria 14 | #:flatten) 15 | (:export #:*command-output* 16 | #:*command-error-output* 17 | #:*default-temporary-template* 18 | #:*runstring-command*) 19 | (:export #:run 20 | #:runstring 21 | #:call-with-command-stream 22 | #:with-command-stream 23 | #:with-run-output 24 | #:with-posix-cwd 25 | #:with-binary-run-output 26 | #:without-run-output 27 | #:run-output-lines 28 | #:call-with-temporary-directory 29 | #:with-temporary-directory 30 | #:call-in-temporary-directory 31 | #:in-temporary-directory 32 | #:in-specific-temporary-directory 33 | #:copy-file)) 34 | --------------------------------------------------------------------------------