os.lisp

   1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Name:          os.lisp
   6 ;;;; Purpose:       Operating System utilities
   7 ;;;; Programmer:    Kevin M. Rosenberg
   8 ;;;; Date Started:  Jul 2003
   9 ;;;;
  10 ;;;; $Id$
  11 ;;;;
  12 ;;;; *************************************************************************
  13
  14 (in-package #:kmrcl)
  15
  16 (defun command-output (control-string &rest args)
  17   "Interpolate ARGS into CONTROL-STRING as if by FORMAT, and
  18 synchronously execute the result using a Bourne-compatible shell,
  19 returns (VALUES string-output error-output exit-status)"
  20   (let ((command (apply #'format nil control-string args)))
  21     #+sbcl
  22     (let ((process (sb-ext:run-program
  23                     "/bin/sh"
  24                     (list "-c" command)
  25                     :input nil :output :stream :error :stream)))
  26       (values
  27        (sb-impl::process-output process)
  28        (sb-impl::process-error process)
  29        (sb-impl::process-exit-code process)))
  30
  31     #+(or cmu scl)
  32     (let ((process (ext:run-program
  33                     "/bin/sh"
  34                     (list "-c" command)
  35                     :input nil :output :stream :error :stream)))
  36       (values
  37        (ext::process-output process)
  38        (ext::process-error process)
  39        (ext::process-exit-code process)))
  40
  41     #+allegro
  42     (multiple-value-bind (output error status)
  43         (excl.osi:command-output command :whole t)
  44       (values output error status))
  45
  46     #+lispworks
  47     ;; BUG: Lispworks combines output and error streams
  48     (let ((output (make-string-output-stream)))
  49       (unwind-protect
  50           (let ((status
  51                  (system:call-system-showing-output
  52                   command
  53                   :shell-type "/bin/sh"
  54                   :output-stream output)))
  55             (values (get-output-stream-string output) nil status))
  56         (close output)))
  57
  58     #+clisp
  59     ;; BUG: CLisp doesn't allow output to user-specified stream
  60     (values
  61      nil
  62      nil
  63      (ext:run-shell-command  command :output :terminal :wait t))
  64
  65     #+openmcl
  66     (let* ((process (ccl:run-program
  67                      "/bin/sh"
  68                      (list "-c" command)
  69                      :input nil :output :stream :error :stream
  70                      :wait t))
  71            (output (read-stream-to-string (ccl::external-process-output-stream process)))
  72            (error (read-stream-to-string (ccl::external-process-error-stream process))))
  73       (close (ccl::external-process-output-stream process))
  74       (close (ccl::external-process-error-stream process))
  75       (values output
  76               error
  77               (nth-value 1 (ccl::external-process-status process))))
  78
  79     #-(or openmcl clisp lispworks allegro scl cmu sbcl)
  80     (error "COMMAND-OUTPUT not implemented for this Lisp")
  81
  82     ))
  83
  84 (defun run-shell-command (control-string &rest args)
  85   "Interpolate ARGS into CONTROL-STRING as if by FORMAT, and
  86 synchronously execute the result using a Bourne-compatible shell,
  87 returns (VALUES output-string pid)"
  88   (let ((command (apply #'format nil control-string args)))
  89     #+sbcl
  90     (sb-impl::process-exit-code
  91      (sb-ext:run-program
  92       "/bin/sh"
  93       (list  "-c" command)
  94       :input nil :output nil))
  95
  96     #+(or cmu scl)
  97     (ext:process-exit-code
  98      (ext:run-program
  99       "/bin/sh"
 100       (list  "-c" command)
 101       :input nil :output nil))
 102
 103
 104     #+allegro
 105     (excl:run-shell-command command :input nil :output nil
 106                             :wait t)
 107
 108     #+lispworks
 109     (system:call-system-showing-output
 110      command
 111      :shell-type "/bin/sh"
 112      :output-stream output)
 113
 114     #+clisp             ;XXX not exactly *verbose-out*, I know
 115     (ext:run-shell-command  command :output :terminal :wait t)
 116
 117     #+openmcl
 118     (nth-value 1
 119                (ccl:external-process-status
 120                 (ccl:run-program "/bin/sh" (list "-c" command)
 121                                  :input nil :output nil
 122                                  :wait t)))
 123
 124     #-(or openmcl clisp lispworks allegro scl cmu sbcl)
 125     (error "RUN-SHELL-PROGRAM not implemented for this Lisp")
 126
 127     ))