1 ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
3 ;;; invoke.lisp --- Half-baked portable run-program.
5 ;;; Copyright (C) 2005-2006, Dan Knap <dankna@accela.net>
6 ;;; Copyright (C) 2005-2006, Emily Backes <lucca@accela.net>
7 ;;; Copyright (C) 2007, Stelian Ionescu <sionescu@cddr.org>
8 ;;; Copyright (C) 2007, Luis Oliveira <loliveira@common-lisp.net>
10 ;;; Permission is hereby granted, free of charge, to any person
11 ;;; obtaining a copy of this software and associated documentation
12 ;;; files (the "Software"), to deal in the Software without
13 ;;; restriction, including without limitation the rights to use, copy,
14 ;;; modify, merge, publish, distribute, sublicense, and/or sell copies
15 ;;; of the Software, and to permit persons to whom the Software is
16 ;;; furnished to do so, subject to the following conditions:
18 ;;; The above copyright notice and this permission notice shall be
19 ;;; included in all copies or substantial portions of the Software.
21 ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
22 ;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
23 ;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
24 ;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
25 ;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
26 ;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
27 ;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
28 ;;; DEALINGS IN THE SOFTWARE.
31 (in-package #:iolib-grovel
)
35 #-
(or abcl allegro clisp cmu ecl lispworks openmcl sbcl scl
)
36 (error "%INVOKE is unimplemented for this Lisp. Patches welcome.")
38 ;; FIXME: doesn't do shell quoting
40 (defun %invoke
(command arglist
)
41 (let ((cmdline (reduce (lambda (str1 str2
)
42 (concatenate 'string str1
" " str2
))
43 arglist
:initial-value command
))
44 (stream (make-string-output-stream)))
45 (values (ext:run-shell-command cmdline
:output stream
)
46 (get-output-stream-string stream
))))
48 ;;; FIXME: As best I can tell CLISP's EXT:RUN-PROGRAM can either
49 ;;; create new streams OR return the exit code, but not both. Using
50 ;;; existing streams doesn't seem to be an option either.
52 (defun %invoke
(command arglist
)
53 (let ((ret (ext:run-program command
:arguments arglist
)))
54 (values (etypecase ret
60 ;;; FIXME: there's no way to tell from EXT:RUN-PROGRAM whether the
61 ;;; command failed or not. Using EXT:SYSTEM instead, but we should
64 (defun %invoke
(command arglist
)
65 (values (ext:system
(format nil
"~A~{ ~A~}" command arglist
))
68 #+(or openmcl cmu scl sbcl
)
69 (defun %invoke
(command arglist
)
72 (with-output-to-string (s)
73 (let ((process (#+openmcl ccl
:run-program
74 #+(or cmu scl
) ext
:run-program
75 #+sbcl sb-ext
:run-program
76 command arglist
#-win32
:output
#-win32 s
78 #+sbcl
:search
#+sbcl t
)))
80 (write-line "note: SBCL on windows can't redirect output.")
83 1 (ccl:external-process-status process
))
84 #+sbcl
(sb-ext:process-exit-code process
)
85 #+(or cmu scl
) (ext:process-exit-code process
))))))
86 (values exit-code output
)))
89 (defun %invoke
(command arglist
)
90 (let ((cmd #-mswindows
(concatenate 'vector
(list command command
) arglist
)
91 #+mswindows
(format nil
"~A~{ ~A~}" command arglist
)))
92 (multiple-value-bind (output error-output exit-code
)
93 (excl.osi
:command-output cmd
:whole t
)
94 (declare (ignore error-output
))
95 (values exit-code output
))))
97 ;;; FIXME: Runs shell, and arguments are unquoted.
99 (defun %invoke
(command arglist
)
100 (let ((s (make-string-output-stream)))
101 (values (sys:call-system-showing-output
102 (format nil
"~A~{ ~A~}" command arglist
)
103 :output-stream s
:prefix
"" :show-cmd nil
)
104 (get-output-stream-string s
))))
106 ;;; Do we really want to suppress the output by default?
107 (defun invoke (command &rest args
)
108 (when (pathnamep command
)
109 (setf command
(cffi-sys:native-namestring command
)))
110 (format *debug-io
* "; ~A~{ ~A~}~%" command args
)
111 (multiple-value-bind (exit-code output
)
112 (%invoke command args
)
113 (unless (zerop exit-code
)
114 (error "External process exited with code ~S.~@
115 Command was: ~S~{ ~S~}~@
117 exit-code command args output
))))