From a4994d739306abcf3f36706012fb88b35a970e6b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Fri, 20 May 2022 17:12:01 +0200 Subject: [PATCH] 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 +;;; Copyright © 2018-2022 Ludovic Courtès ;;; ;;; 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 . + (close-inferior inferior1) + + (close-inferior inferior2) + (list lst1 lst2))) + (test-equal "&inferior-exception" '(a b c d) (let ((inferior (open-inferior %top-builddir