me
/
guix
Archived
1
0
Fork 0
Code

inferior: Close duplicate socketpair file descriptor. 

* guix/inferior.scm (open-bidirectional-pipe): Pass SOCK_CLOEXEC to
'socketpair'.
* tests/inferior.scm ("close-inferior"): Add test.
Ludovic Courtès 2022-05-20 17:12:01 +02:00
parent 102e383360
commit a4994d7393
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 20 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
guix/inferior.scm
View File

@ -141,7 +141,11 @@ regular file port (socket).
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

16
tests/inferior.scm
View File

@ -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 @@
(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