civodul pushed a commit to branch devel
in repository shepherd.
commit 47c693d51a991e9a3d5ed6e75760c61e329cc537
Author: Ludovic Courtès <[email protected]>
AuthorDate: Sun Nov 3 17:48:15 2024 +0100
shepherd: Replace ‘call-with-{input,output}-file’ with O_CLOEXEC variant.
This was done in Guix System in (gnu services shepherd) but really
belongs here.
* modules/shepherd.scm (call-with-input-file/close-on-exec)
(call-with-output-file/close-on-exec): New procedures.
(main): Replace ‘call-with-input-file’ and ‘call-with-output-file’.
---
modules/shepherd.scm | 28 ++++++++++++++++++++++++++++
1 file changed, 28 insertions(+)
diff --git a/modules/shepherd.scm b/modules/shepherd.scm
index 5cad6d3..48cb5a3 100644
--- a/modules/shepherd.scm
+++ b/modules/shepherd.scm
@@ -317,6 +317,32 @@ configuration file '~a': ~s")
(next-command))))))
+;; In Guile 3.0.x, 'call-with-input-file' & co. do not open their files as
+;; O_CLOEXEC. The two procedures below address that.
+
+(define* (call-with-input-file/close-on-exec file proc
+ #:key
+ guess-encoding
+ encoding binary)
+ "Like @code{call-with-input-file}, but always open files as close-on-exec."
+ ;; Note: 'open-file' supports the "e" flag for O_CLOEXEC, but only since
+ ;; 3.0.9, hence the use of 'open'.
+ (call-with-port (open file (logior O_RDONLY O_CLOEXEC))
+ (lambda (port)
+ (cond (binary (set-port-encoding! port #f))
+ (encoding (set-port-encoding! port encoding))
+ (guess-encoding (set-port-encoding! port (file-encoding port))))
+ (proc port))))
+
+(define* (call-with-output-file/close-on-exec file proc
+ #:key encoding binary)
+ "Like @code{call-with-output-file}, but always open files as close-on-exec."
+ (call-with-port (open file (logior O_WRONLY O_CREAT O_CLOEXEC))
+ (lambda (port)
+ (cond (binary (set-port-encoding! port #f))
+ (encoding (set-port-encoding! port encoding)))
+ (proc port))))
+
(define-syntax replace-core-bindings!
(syntax-rules (<>)
"Replace the given core bindings in the current process, restoring them
upon
@@ -536,6 +562,8 @@ fork in the child process."
(spawn-command command)))
(system spawn-shell-command)
(primitive-load primitive-load*)
+ (call-with-input-file call-with-input-file/close-on-exec)
+ (call-with-output-file call-with-output-file/close-on-exec)
((@ (guile) sleep) (@ (fibers) sleep)))
(run-daemon #:socket-file socket-file
