andrius
/
gash
mirror of https://git.savannah.gnu.org/git/gash.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Close ports opened for redirects. 

* gash/shell.scm (redir->parameter+port): Rename this...
(process-redirect): ...to this, and make it return a list with the
third element being a boolean indicating if the port was opened by us.
(sh:with-redirects): Close ports when the new boolean is set.
This commit is contained in:
Timothy Sample 2019-12-02 11:05:49 -05:00
parent 22205a00a3
commit 121d9cb435
1 changed files with 24 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

48
gash/shell.scm
View File

@ -167,45 +167,46 @@ environment variable bindings @var{bindings}."
;;; Redirects.
(define (redir->parameter+port redir)
"Convert @var{redir} into a pair consisting of the current-port
parameter to be updated and the port that should be its new value (or
@code{#f} if it should be considered closed)."
(define (process-redir redir)
"Convert @var{redir} into a list consisting of the current-port
parameter to be updated, the port that should be its new value (or
@code{#f} if it should be considered closed), and a boolean indicating
if it is our responsibility to close the port."
(define* (make-parameter+port fd target #:optional (open-flags 0))
(define* (make-processed-redir fd target #:optional (open-flags 0))
(let ((port (match target
((? port?) target)
((? string?) (open target open-flags))
;; TODO: Verify open-flags.
((? integer?) ((fd->current-port target)))
(#f #f))))
`(,(fd->current-port fd) . ,port)))
`(,(fd->current-port fd) ,port ,(string? target))))
(match redir
(('< (? integer? fd) (? string? filename))
(make-parameter+port fd filename O_RDONLY))
(make-processed-redir fd filename O_RDONLY))
(('> (? integer? fd) (? string? filename))
;; TODO: Observe noclobber.
(make-parameter+port fd filename (logior O_WRONLY O_CREAT O_TRUNC)))
(make-processed-redir fd filename (logior O_WRONLY O_CREAT O_TRUNC)))
(('>! (? integer? fd) (? string? filename))
(make-parameter+port fd filename (logior O_WRONLY O_CREAT O_TRUNC)))
(make-processed-redir fd filename (logior O_WRONLY O_CREAT O_TRUNC)))
(('>> fd filename)
(make-parameter+port fd filename (logior O_WRONLY O_CREAT O_APPEND)))
(make-processed-redir fd filename (logior O_WRONLY O_CREAT O_APPEND)))
(('<> fd filename)
(make-parameter+port fd filename (logior O_RDWR O_CREAT)))
(make-processed-redir fd filename (logior O_RDWR O_CREAT)))
(('<& (? integer? fd1) (? integer? fd2))
(make-parameter+port fd1 fd2))
(make-processed-redir fd1 fd2))
(('<& (? integer? fd) '-)
(make-parameter+port fd #f))
(make-processed-redir fd #f))
(('>& (? integer? fd1) (? integer? fd2))
(make-parameter+port fd1 fd2))
(make-processed-redir fd1 fd2))
(('>& (? integer? fd) '-)
(make-parameter+port fd #f))
(make-processed-redir fd #f))
(('<< (? integer? fd) text)
(let ((port (tmpfile)))
(display text port)
(seek port 0 SEEK_SET)
(make-parameter+port fd port)))))
(make-processed-redir fd port)))))
(define (sh:set-redirects redirs)
"Put the redirects @var{redirs} into effect."
@ -213,11 +214,10 @@ parameter to be updated and the port that should be its new value (or
(match redirs
(() #t)
((redir . rest)
(match (false-if-exception
(redir->parameter+port redir))
(match (false-if-exception (process-redir redir))
(#f (set-status! 1)
(errexit))
((parameter . port)
((parameter port close?)
(parameter port)
(loop rest)))))))
@ -228,15 +228,15 @@ parameter to be updated and the port that should be its new value (or
;; only way.
((fold-right (lambda (redir thunk)
(lambda ()
(match (false-if-exception
(redir->parameter+port redir))
(match (false-if-exception (process-redir redir))
(#f (set-status! 1)
(errexit))
((parameter . port)
((parameter port close?)
(parameterize ((parameter port))
(thunk))
(when (output-port? port)
(force-output port))))))
(cond
(close? (close-port port))
((output-port? port) (force-output port)))))))
thunk
redirs)))