01/02: inferior: Close duplicate socketpair file descriptor.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit a4994d739306abcf3f36706012fb88b35a970e6b
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Fri May 20 17:12:01 2022 +0200

    inferior: Close duplicate socketpair file descriptor.
    
    * guix/inferior.scm (open-bidirectional-pipe): Pass SOCK_CLOEXEC to
    'socketpair'.
    * tests/inferior.scm ("close-inferior"): Add test.
---
 guix/inferior.scm  |  6 +++++-
 tests/inferior.scm | 16 +++++++++++++++-
 2 files changed, 20 insertions(+), 2 deletions(-)

diff --git a/guix/inferior.scm b/guix/inferior.scm
index 6949bb3687..54200b75e4 100644
--- a/guix/inferior.scm
+++ b/guix/inferior.scm
@@ -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
diff --git a/tests/inferior.scm b/tests/inferior.scm
index 9992077cb2..56b2fcb7bc 100644
--- a/tests/inferior.scm
+++ b/tests/inferior.scm
@@ -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