Add support for "e" flag (O_CLOEXEC) to 'open-file'.

* libguile/fports.c (scm_i_mode_to_open_flags): Add 'e' case.
(scm_open_file_with_encoding): Document it.
* test-suite/standalone/test-close-on-exec: New file.
* test-suite/standalone/Makefile.am (check_SCRIPTS, TESTS): Add it.
* doc/ref/api-io.texi (File Ports): Document it.
* NEWS: Update.

5 files changed, 59 insertions, 2 deletions

diff --git a/NEWS b/NEWS
index ca194f319..dfe1895ee 100644
--- a/NEWS
+++ b/NEWS
@@ -11,6 +11,13 @@ Changes in 3.0.9 (since 3.0.8)
 
 * New interfaces and functionality
 
+** `open-file' now supports an "e" flag for O_CLOEXEC
+
+Until now, the high-level `open-file' facility did not provide a way to
+pass O_CLOEXEC to the underlying `open' call.  It can now be done by
+appending "e" to the `mode' string passed as a second argument.  See
+"File Ports" in the manual for more info.
+
 ** Abstract Unix-domain sockets are supported
 
 It is now possible to create an AF_UNIX socket with a leading zero byte
diff --git a/doc/ref/api-io.texi b/doc/ref/api-io.texi
index 93bbca5ba..a0be2dd57 100644
--- a/doc/ref/api-io.texi
+++ b/doc/ref/api-io.texi
@@ -996,6 +996,9 @@ Also, open the file using the binary-compatible character encoding
 @item +
 Open the port for both input and output.  E.g., @code{r+}: open
 an existing file for both input and output.
+@item e
+Mark the underlying file descriptor as close-on-exec, as per the
+@code{O_CLOEXEC} flag.
 @item 0
 Create an "unbuffered" port.  In this case input and output
 operations are passed directly to the underlying port
diff --git a/libguile/fports.c b/libguile/fports.c
index 4a3c30b88..121d50bf0 100644
--- a/libguile/fports.c
+++ b/libguile/fports.c
@@ -1,4 +1,4 @@
-/* Copyright 1995-2004,2006-2015,2017-2020
+/* Copyright 1995-2004,2006-2015,2017-2020,2022
      Free Software Foundation, Inc.
 
    This file is part of Guile.
@@ -208,6 +208,9 @@ scm_i_mode_to_open_flags (SCM mode, int *is_binary, const char *FUNC_NAME)
 	  flags |= O_BINARY;
 #endif
 	  break;
+        case 'e':
+          flags |= O_CLOEXEC;
+          break;
 	case '0':  /* unbuffered: handled later.  */
 	case 'l':  /* line buffered: handled during output.  */
 	  break;
@@ -368,6 +371,9 @@ SCM_DEFINE (scm_i_open_file, "open-file", 2, 0, 1,
 	    "@item +\n"
 	    "Open the port for both input and output.  E.g., @code{r+}: open\n"
 	    "an existing file for both input and output.\n"
+            "@item e\n"
+            "Mark the underlying file descriptor as close-on-exec, as per the\n"
+            "@code{O_CLOEXEC} flag.\n"
 	    "@item 0\n"
 	    "Create an \"unbuffered\" port.  In this case input and output\n"
 	    "operations are passed directly to the underlying port\n"
diff --git a/test-suite/standalone/Makefile.am b/test-suite/standalone/Makefile.am
index e87100c96..547241afa 100644
--- a/test-suite/standalone/Makefile.am
+++ b/test-suite/standalone/Makefile.am
@@ -1,7 +1,7 @@
 ## Process this file with automake to produce Makefile.in.
 ##
 ## Copyright 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010,
-##   2011, 2012, 2013, 2014, 2020, 2021 Free Software Foundation, Inc.
+##   2011, 2012, 2013, 2014, 2020, 2021, 2022 Free Software Foundation, Inc.
 ##
 ## This file is part of GUILE.
 ##
@@ -301,4 +301,7 @@ TESTS += test-stack-overflow
 check_SCRIPTS += test-out-of-memory
 TESTS += test-out-of-memory
 
+check_SCRIPTS += test-close-on-exec
+TESTS += test-close-on-exec
+
 EXTRA_DIST += ${check_SCRIPTS}
diff --git a/test-suite/standalone/test-close-on-exec b/test-suite/standalone/test-close-on-exec
new file mode 100755
index 000000000..1eb46c20a
--- /dev/null
+++ b/test-suite/standalone/test-close-on-exec
@@ -0,0 +1,38 @@
+#!/bin/sh
+exec guile -q -s "$0" "$@"
+!#
+
+;;; Exercise the 'e' flag to 'open-file' (O_CLOEXEC).
+
+(define file
+  (string-append (or (getenv "TMPDIR") "/tmp")
+                 "/guile-test-close-on-exec-"
+                 (number->string (getpid)) ".txt"))
+
+;;; Since fcntl(2) F_GETFD does not return flags such as O_CLOEXEC,
+;;; create a child process, call 'exec', and make sure it doesn't
+;;; inherit the file descriptor.
+(let ((port (open-file file "we")))
+  (display "Hello!\n" port)
+  (let ((pid (primitive-fork)))
+    (if (zero? pid)
+        (dynamic-wind
+          (const #t)
+          (lambda ()
+            (execlp "guile" "guile" "-c"
+                    (object->string
+                     `(catch #t
+                        (lambda ()
+                          (fdopen ,(fileno port) "w")
+                          (primitive-exit 0))
+                        (lambda (key . args)
+                          (pk 'child-exception args)
+                          (if (and (eq? key 'system-error)
+                                   (= EBADF (system-error-errno (cons key args))))
+                              (primitive-exit 1)
+                              (primitive-exit 2)))))))
+          (lambda ()
+            (primitive-exit 3)))
+        (let ((status (pk 'child-status (cdr (waitpid pid)))))
+          (false-if-exception (delete-file file))
+          (exit (equal? (status:exit-val status) 1))))))