Skip to content
GitLab
Explore
Sign in
Register
Primary navigation
Search or go to…
Project
I
inferior-shell
Manage
Activity
Members
Labels
Plan
Issues
Issue boards
Milestones
Wiki
Code
Merge requests
Repository
Branches
Commits
Tags
Repository graph
Compare revisions
Build
Pipelines
Jobs
Pipeline schedules
Artifacts
Deploy
Releases
Model registry
Operate
Environments
Monitor
Incidents
Service Desk
Analyze
Value stream analytics
Contributor analytics
CI/CD analytics
Repository analytics
Model experiments
Help
Help
Support
GitLab documentation
Compare GitLab plans
Community forum
Contribute to GitLab
Provide feedback
Terms and privacy
Keyboard shortcuts
?
Snippets
Groups
Projects
Show more breadcrumbs
qitab
inferior-shell
Commits
0b8b4838
Commit
0b8b4838
authored
13 years ago
by
Nathan Hawkins
Browse files
Options
Downloads
Patches
Plain Diff
Add support for sequences of commands
parent
f3821dc7
No related branches found
No related tags found
No related merge requests found
Changes
3
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
pkgdcl.lisp
+2
-1
2 additions, 1 deletion
pkgdcl.lisp
process-spec.lisp
+64
-22
64 additions, 22 deletions
process-spec.lisp
run.lisp
+22
-8
22 additions, 8 deletions
run.lisp
with
88 additions
and
31 deletions
pkgdcl.lisp
+
2
−
1
View file @
0b8b4838
...
...
@@ -7,8 +7,9 @@
(
:export
#:run
#:run/s
#:run/ss
#:run/lines
#:process-spec
#:command-spec
#:pipe-spec
#:or-spec
#:and-spec
#:progn-spec
#:fork-spec
#:print-process-spec
#:parse-process-spec
#:command-arguments
#:command-redirections
#:redirection
#:file-redirection
#:fd-redirection
#:close-redirection
#:!
#:-
#:<
#:>
#:<>
#:>!
#:>>
#:>>!
#:<&
#:>&
#:>&!
#:>>&!
#:>&
#:>>
#:>>&
#:pipe
))
#:>&
#:>>
#:>>&
#:pipe
#:or
#:and
#:progn
#:fork
))
This diff is collapsed.
Click to expand it.
process-spec.lisp
+
64
−
22
View file @
0b8b4838
...
...
@@ -6,10 +6,20 @@
(
defclass
process-spec
(
simple-print-object-mixin
)
())
(
defclass
pip
e-spec
(
process-spec
)
(
defclass
sequenc
e-spec
(
process-spec
)
((
processes
:type
list
:initarg
:processes
:reader
pipe-processes
)))
:initarg
:processes
:reader
sequence-processes
)))
(
defclass
pipe-spec
(
sequence-spec
)
())
(
defclass
or-spec
(
sequence-spec
)
())
(
defclass
and-spec
(
sequence-spec
)
())
(
defclass
progn-spec
(
sequence-spec
)
())
(
defclass
fork-spec
(
sequence-spec
)
())
(
defclass
redirection
(
simple-print-object-mixin
)
())
...
...
@@ -156,21 +166,32 @@
(
clps-current-argument
c
)
nil
)))
(
defun
parse-process-spec
(
spec
)
(
match
spec
(
`
(
pipe
,@
args
)
(
make-instance
'pipe-spec
:processes
(
loop
:for
process
:in
(
mapcar
'parse-process-spec
args
)
:nconc
(
if
(
typep
process
'pipe-spec
)
(
pipe-processes
process
)
(
list
process
)))))
(
`
(
,
*
,@
*
)
(
let
((
c
(
make-instance
'command-parse
)))
(
dolist
(
elem
spec
)
(
parse-command-spec-top-token
c
elem
))
(
command-parse-results
c
)))
(
*
(
error
"Invalid process spec ~S"
spec
))))
(
macrolet
((
make-sequence-instance
(
spec-type
args
)
`
(
make-instance
',spec-type
:processes
(
loop
:for
process
:in
(
mapcar
'parse-process-spec
,
args
)
:nconc
(
etypecase
process
(
,
spec-type
(
sequence-processes
process
))
(
sequence-spec
(
list
process
))
(
command-spec
(
list
process
)))))))
(
match
spec
(
`
(
pipe
,@
args
)
(
make-sequence-instance
pipe-spec
args
))
(
`
(
or
,@
args
)
(
make-sequence-instance
or-spec
args
))
(
`
(
and
,@
args
)
(
make-sequence-instance
and-spec
args
))
(
`
(
progn
,@
args
)
(
make-sequence-instance
progn-spec
args
))
(
`
(
fork
,@
args
)
(
make-sequence-instance
fork-spec
args
))
(
`
(
,
*
,@
*
)
(
let
((
c
(
make-instance
'command-parse
)))
(
dolist
(
elem
spec
)
(
parse-command-spec-top-token
c
elem
))
(
command-parse-results
c
)))
(
*
(
error
"Invalid process spec ~S"
spec
)))))
(
defun
parse-command-spec-top-token
(
c
x
)
(
labels
...
...
@@ -246,6 +267,7 @@
(
null
())
(
keyword
(
a
(
format
nil
"--~(~a~)"
x
)))
(
symbol
(
a
(
string-downcase
x
)))
(
pathname
(
a
(
namestring
(
translate-logical-pathname
x
))))
(
cons
(
c
x
)))))
(
defun
parse-command-spec-token
(
c
x
)
...
...
@@ -259,6 +281,7 @@
(
null
())
(
keyword
(
e
(
format
nil
"--~(~a~)"
x
)))
(
symbol
(
e
(
string-downcase
x
)))
(
pathname
(
e
(
namestring
(
translate-logical-pathname
x
))))
(
cons
(
c
x
))))
(
c
(
x
)
(
match
x
...
...
@@ -289,13 +312,32 @@
(
loop
:for
r
:in
redirections
:do
(
princ
" "
s
)
(
print-process-spec
r
s
))))))
(
def
method
print-process-s
pec
((
spec
pipe-spec
)
&optional
s
)
(
def
un
print-process-s
equence-joined
(
spec
separator
empty
s
&optional
tail
)
(
with-output-stream
(
s
)
(
let
((
processes
(
pip
e-processes
spec
)))
(
let
((
processes
(
sequenc
e-processes
spec
)))
(
if
processes
(
loop
:for
(
p
.
rest
)
:on
processes
:do
(
print-process-spec
p
s
)
(
when
rest
(
princ
" | "
s
)))
(
princ
"cat"
s
)))))
(
progn
(
princ
"("
s
)
(
loop
:for
(
p
.
rest
)
:on
processes
:do
(
print-process-spec
p
s
)
(
when
rest
(
princ
separator
s
)))
(
princ
")"
s
)
(
when
tail
(
princ
tail
s
)))
(
princ
empty
s
)))))
(
defmethod
print-process-spec
((
spec
pipe-spec
)
&optional
s
)
(
print-process-sequence-joined
spec
" | "
"cat"
s
))
(
defmethod
print-process-spec
((
spec
or-spec
)
&optional
s
)
(
print-process-sequence-joined
spec
" || "
"false"
s
))
(
defmethod
print-process-spec
((
spec
and-spec
)
&optional
s
)
(
print-process-sequence-joined
spec
" && "
"true"
s
))
(
defmethod
print-process-spec
((
spec
progn-spec
)
&optional
s
)
(
print-process-sequence-joined
spec
"; "
"true"
s
))
(
defmethod
print-process-spec
((
spec
fork-spec
)
&optional
s
)
(
print-process-sequence-joined
spec
"; "
"true"
s
" &"
))
(
defmethod
print-process-spec
((
spec
string
)
&optional
s
)
(
xcvb-driver::output-string
spec
s
))
...
...
This diff is collapsed.
Click to expand it.
run.lisp
+
22
−
8
View file @
0b8b4838
...
...
@@ -23,6 +23,27 @@
spec
`
(
ssh
,
host
,
(
print-process-spec
spec
))))
(
defmethod
run-spec
((
spec
process-spec
)
&rest
keys
&key
ignore-error-status
output
)
(
let
((
command
(
if
(
and
(
typep
spec
'command-spec
)
(
null
(
command-redirections
spec
)))
(
command-arguments
spec
)
(
print-process-spec
spec
))))
(
run-program/
command
:ignore-error-status
ignore-error-status
:output
output
)))
;; This only works with run because run-program/ doesn't return an
;; exit code if :output is set.
;; (defmethod run-spec ((spec or-spec) &rest keys &key ignore-error-status output)
;; (let ((processes (sequence-processes spec))
;; (return-code 1))
;; (loop :for p :in processes :do
;; (setf return-code (run-spec p :ignore-error-status ignore-error-status :output output))
;; :until (and (numberp return-code) (= return-code 0)))
;; return-code))
(
defun
run-process-spec
(
spec
&rest
keys
&key
ignore-error-status
output
host
)
(
declare
(
ignore
ignore-error-status
output
))
(
etypecase
host
...
...
@@ -33,14 +54,7 @@
(
cons
(
apply
'run-process-spec
(
parse-process-spec
spec
)
keys
))
(
process-spec
(
let
((
command
(
if
(
and
(
typep
spec
'command-spec
)
(
null
(
command-redirections
spec
)))
(
command-arguments
spec
)
(
print-process-spec
spec
))))
(
run-program/
command
:ignore-error-status
ignore-error-status
:output
output
)))))
(
run-spec
spec
:ignore-error-status
ignore-error-status
:output
output
))))
(
string
(
apply
'run-process-spec
(
on-host-spec
host
spec
)
:host
nil
keys
))
(
function
...
...
This diff is collapsed.
Click to expand it.
Preview
0%
Loading
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Save comment
Cancel
Please
register
or
sign in
to comment