mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-07 07:26:13 -05:00
inferior: Close duplicate socketpair file descriptor.
* guix/inferior.scm (open-bidirectional-pipe): Pass SOCK_CLOEXEC to 'socketpair'. * tests/inferior.scm ("close-inferior"): Add test.
This commit is contained in:
parent
102e383360
commit
a4994d7393
2 changed files with 20 additions and 2 deletions
|
@ -141,7 +141,11 @@ (define (open-bidirectional-pipe command . args)
|
|||
This is equivalent to (open-pipe* OPEN_BOTH ...) except that the result is a
|
||||
regular file port that can be passed to 'select' ('open-pipe*' returns a
|
||||
custom binary port)."
|
||||
(match (socketpair AF_UNIX SOCK_STREAM 0)
|
||||
;; Make sure the sockets are close-on-exec; failing to do that, a second
|
||||
;; inferior (for instance) would inherit the underlying file descriptor, and
|
||||
;; thus (close-port PARENT) in the original process would have no effect:
|
||||
;; the REPL process wouldn't get EOF on standard input.
|
||||
(match (socketpair AF_UNIX (logior SOCK_STREAM SOCK_CLOEXEC) 0)
|
||||
((parent . child)
|
||||
(match (primitive-fork)
|
||||
(0
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2018-2022 Ludovic Courtès <ludo@gnu.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
|
@ -62,6 +62,20 @@ (define (manifest-entry->list entry)
|
|||
(close-inferior inferior)
|
||||
(list a (inferior-object? b))))))
|
||||
|
||||
(test-equal "close-inferior"
|
||||
'((hello) (world))
|
||||
(let* ((inferior1 (open-inferior %top-builddir #:command "scripts/guix"))
|
||||
(lst1 (inferior-eval '(list 'hello) inferior1))
|
||||
(inferior2 (open-inferior %top-builddir #:command "scripts/guix"))
|
||||
(lst2 (inferior-eval '(list 'world) inferior2)))
|
||||
;; This call succeeds if and only if INFERIOR2 does not also hold a file
|
||||
;; descriptor to the socketpair beneath INFERIOR1; otherwise it blocks.
|
||||
;; See <https://issues.guix.gnu.org/55441#10>.
|
||||
(close-inferior inferior1)
|
||||
|
||||
(close-inferior inferior2)
|
||||
(list lst1 lst2)))
|
||||
|
||||
(test-equal "&inferior-exception"
|
||||
'(a b c d)
|
||||
(let ((inferior (open-inferior %top-builddir
|
||||
|
|
Loading…
Reference in a new issue