lambda-utils/shell.lisp

   1 (in-package :lambda-utils)
   2
   3 (defun getenv (var)
   4   "Return the value of this environment variable"
   5   #+sbcl(sb-posix:getenv var)
   6   #-sbcl(error "getenv: Not implemented for this Common Lisp"))
   7
   8
   9 (defun find-in-path (prog)
  10   "Find prog in system path"
  11   (let ((paths (split-sequence #\: (getenv "PATH"))))
  12     (dolist (dir paths)
  13       (let ((path (make-pathname :directory dir :name prog)))
  14         (when (probe-file path)
  15           (return-from find-in-path path))))
  16     (error  "Program ~a not found in path ~a" prog paths)))       ; TODO: Use cerror here
  17
  18
  19
  20 (defun exec-prog-l (prog args)
  21   "Find prog in the path and execute it  with args given by a list.
  22 Version with args in a list.
  23 Example: (exec-prog-l \"echo\" '(\"a\" \"b\")) ==> a b "
  24   (run-prog (find-in-path prog) :args args))
  25
  26 (defun exec-prog (prog &rest args)
  27   "Find prog in the path and execute it  with args given by a list
  28 Example: (exec-prog \"echo\" \"a\" \"b\") ==> a b "
  29   (exec-prog-l prog args))
  30
  31 (defun run-prog (prog &key args (wait t) (opts nil))
  32   "Common interface to shell. Does not return anything useful."
  33   #+sbcl (apply #'sb-ext:run-program prog args :wait wait :output *standard-output* opts)
  34   #-(or sbcl)
  35   (error 'not-implemented :proc (list 'run-prog prog opts)))
  36
  37 (defun pipe-output (prog &rest args)
  38   "Return an output stream which will go to the command."
  39   #+allegro (excl:run-shell-command (format nil "~a~{ ~a~}" prog args)
  40                                     :input :stream :wait nil)
  41   #+clisp (#+lisp=cl ext:make-pipe-output-stream
  42            #-lisp=cl lisp:make-pipe-output-stream
  43                      (format nil "~a~{ ~a~}" prog args))
  44   #+cmu (ext:process-input (ext:run-program prog args :input :stream
  45                                             :output t :wait nil))
  46   #+gcl (si::fp-input-stream (apply #'si:run-process prog args))
  47   #+lispworks (sys::open-pipe (format nil "~a~{ ~a~}" prog args)
  48                               :direction :output)
  49   #+lucid (lcl:run-program prog :arguments args :wait nil :output :stream)
  50   #+sbcl (sb-ext:process-input (sb-ext:run-program prog args :input :stream
  51                                                    :output t :wait nil))
  52   #-(or allegro clisp cmu gcl lispworks lucid sbcl)
  53   (error 'not-implemented :proc (list 'pipe-output prog args)))
  54
  55 (defun pipe-input (prog &rest args)
  56   "Return an input stream from which the command output will be read."
  57   #+allegro (excl:run-shell-command (format nil "~a~{ ~a~}" prog args)
  58                                     :output :stream :wait nil)
  59   #+clisp (#+lisp=cl ext:make-pipe-input-stream
  60            #-lisp=cl lisp:make-pipe-input-stream
  61                      (format nil "~a~{ ~a~}" prog args))
  62   #+cmu (ext:process-output (ext:run-program prog args :output :stream
  63                                              :error t :input t :wait nil))
  64   #+gcl (si::fp-output-stream (apply #'si:run-process prog args))
  65   #+lispworks (sys::open-pipe (format nil "~a~{ ~a~}" prog args)
  66                               :direction :input)
  67   #+lucid (lcl:run-program prog :arguments args :wait nil :input :stream)
  68   #+sbcl (sb-ext:process-output (sb-ext:run-program prog args :output :stream
  69                                                     :error t :input t :wait nil))
  70   #-(or allegro clisp cmu gcl lispworks lucid sbcl)
  71   (error 'not-implemented :proc (list 'pipe-input prog args)))
  72
  73 ;;; Allegro CL: a simple `close' does NOT get rid of the process.
  74 ;;; The right way, of course, is to define a Gray stream `pipe-stream',
  75 ;;; define the `close' method and use `with-open-stream'.
  76 ;;; Unfortunately, not every implementation supports Gray streams, so we
  77 ;;; have to stick with this to further the portability.
  78
  79 (defun close-pipe (stream)
  80   "Close the pipe stream."
  81   (declare (stream stream))
  82   (close stream)
  83   #+allegro (sys:reap-os-subprocess))
  84
  85 (defmacro with-open-pipe ((pipe open) &body body)
  86   "Open the pipe, do something, then close it."
  87   `(let ((,pipe ,open))
  88     (declare (stream ,pipe))
  89     (unwind-protect (progn ,@body)
  90       (close-pipe ,pipe))))
  91
  92
  93 ;; Shell reader macro
  94
  95 (eval-when (:compile-toplevel :load-toplevel :execute)
  96   (set-macro-character #\] (get-macro-character #\)))
  97   (set-dispatch-macro-character #\# #\[
  98                                 (lambda (stream char1 char2)
  99                                   (declare (ignore char1 char2))
 100                                   (setf (readtable-case *readtable*) :preserve)
 101                                   (unwind-protect
 102                                        (let ((command-line (read-delimited-list #\] stream t)))
 103                                          `(exec-prog-l ,(princ-to-string (car command-line))
 104                                                        ',(mapcar #'princ-to-string (rest command-line))))
 105                                     (setf (readtable-case *readtable*) :upcase))))
 106   ) ; eval-when
 107