dev/shell.lisp

   1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
   2
   3 (in-package #:metashell)
   4
   5 (defgeneric file-to-string-as-lines (pathname)
   6   (:documentation ""))
   7
   8 (defmethod file-to-string-as-lines ((pathname pathname))
   9   (with-open-file (stream pathname :direction :input)
  10     (file-to-string-as-lines stream)))
  11
  12 (defmethod file-to-string-as-lines ((stream stream))
  13   (with-output-to-string (s)
  14     (loop for line = (read-line stream nil :eof nil)
  15          until (eq line :eof) do
  16          (princ line s)
  17          (terpri s))))
  18
  19 (defmethod shell-command ((command pathname) &key input)
  20   (shell-command (namestring command) :input input))
  21
  22 (defmethod shell-command ((command t) &key input)
  23   "Synchronously execute `command` using a Bourne-compatible shell,
  24 returns (values output error-output exit-status).
  25
  26 The `command` can be a full path to a shell executable binary
  27 or just its name. In the later case, the variable `*shell-search-paths*`
  28 will be used to find the executable.
  29
  30 Depending on the implementation, the variable `*bourne-compatible-shell*`
  31 may be used to find a shell to use in executing `command`."
  32   (let* ((pos-/ (position #\/ command))
  33          (pos-space (find-command-ending-in-string command))
  34          (binary (subseq command 0 (or pos-space)))
  35          (args (and pos-space (subseq command pos-space))))
  36     (when (or (not pos-/)
  37               (and pos-/ pos-space)
  38               (and pos-space
  39                    (< pos-/ pos-space)))
  40       ;; no slash in the command portion, try to find the command with
  41       ;; our path
  42       (setf binary
  43             (or (loop for path in *shell-search-paths* do
  44                      (let ((full-binary (make-pathname :name binary
  45                                                        :defaults path)))
  46                        (when (and (probe-file full-binary)
  47                                   (directory-pathname-p full-binary))
  48                          (return full-binary))))
  49                 binary)))
  50     (multiple-value-bind (output error status)
  51         (%shell-command (format nil "~a~@[ ~a~]" binary args) input)
  52       (values output error status))))
  53
  54 (defun find-command-ending-in-string (command)
  55   (let ((checking? t))
  56     (loop for ch across command
  57        for i from 0 do
  58          (cond ((and checking? (char= ch #\Space))
  59                 (return i))
  60                ((char= ch #\\)
  61                 (setf checking? nil))
  62                (t
  63                 (setf checking? t))))))
  64
  65 (defun os-process-id ()
  66   "Return the process-id of the currently executing OS process."
  67   (%os-process-id))
  68
  69 (defun get-env-var (name)
  70   "Return the value of the environment variable `name`."
  71   (%get-env-var name))
  72
  73 (defun exit (&optional (code :success))
  74   "Exit the process. CODE is either a numeric exit code, or the special values :SUCCESS
  75 or :FAILURE, which maps to the appropriate exit codes for the operating system."
  76   ;; Currently, :SUCCESS always maps to 0 and :FAILURE maps to 1
  77   (%exit (cond ((eq code :success) 0)
  78                ((eq code :failure) 1)
  79                ((integerp code) code)
  80                (t (error "Illegal exit code: ~s (should be an integer or the values :SUCCESS or :FAILURE)" code)))))