dev/abcl.lisp

   1 (in-package #:trivial-shell)
   2
   3 (defun %shell-command (command input)
   4   #+unix
   5   (with-input (input-stream (or input :none))
   6     (let (proc out-string err-string in-string out-stream err-stream in-stream)
   7       (setf proc (system:run-program *bourne-compatible-shell* (list "-c" command) :wait nil))
   8       (when input-stream
   9         (setf in-stream (system:process-input proc))
  10         (setf in-string (file-to-string-as-lines input-stream))
  11         ;; on all UNIXen the line-ending character is of 1 byte length
  12         (write-string in-string in-stream :end (- (length in-string) 1))
  13         (close in-stream))
  14       (setf out-stream (system:process-output proc))
  15       (setf err-stream (system:process-error proc))
  16       (setf out-string (file-to-string-as-lines out-stream))
  17       (setf err-string (file-to-string-as-lines err-stream))
  18       (close out-stream)
  19       (close err-stream)
  20       (values out-string err-string (system:process-exit-code proc))))
  21   #+(not unix)
  22   (error 'unsupported-function-error :function 'shell-command))
  23
  24 (defun %os-process-id ()
  25   (error 'unsupported-function-error :function 'os-process-id))
  26
  27 (defun %get-env-var (name)
  28   (extensions:getenv name))
  29
  30 (defun %exit (code)
  31   (extensions:exit :status code))