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