TakeV/guix
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

inferior: Use 'spawn' on Guile 3.0.9+.

Browse source 
* guix/inferior.scm (open-bidirectional-pipe): When 'spawn' is defined,
use it instead of 'primitive-fork'.
This commit is contained in:
Ludovic Courtès 2023-01-26 10:18:31 +01:00
parent 0d22ea8282
commit fed3953d70
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 42 additions and 28 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

70
guix/inferior.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018-2022 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2018-2023 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -149,33 +149,47 @@ (define (open-bidirectional-pipe command . args)
;; 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
(dynamic-wind
(lambda ()
#t)
(lambda ()
(close-port parent)
(close-fdes 0)
(close-fdes 1)
(close-fdes 2)
(dup2 (fileno child) 0)
(dup2 (fileno child) 1)
;; Mimic 'open-pipe*'.
(if (file-port? (current-error-port))
(let ((error-port-fileno
(fileno (current-error-port))))
(unless (eq? error-port-fileno 2)
(dup2 error-port-fileno
2)))
(dup2 (open-fdes "/dev/null" O_WRONLY)
2))
(apply execlp command command args))
(lambda ()
(primitive-_exit 127))))
(pid
(close-port child)
(values parent pid))))))
(if (defined? 'spawn)
(let* ((void (open-fdes "/dev/null" O_WRONLY))
(pid (catch 'system-error
(lambda ()
(spawn command (cons command args)
#:input child
#:output child
#:error (if (file-port? (current-error-port))
(current-error-port)
void)))
(const #f)))) ;can't exec, for instance ENOENT
(close-fdes void)
(close-port child)
(values parent pid))
(match (primitive-fork) ;Guile < 3.0.9
(0
(dynamic-wind
(lambda ()
#t)
(lambda ()
(close-port parent)
(close-fdes 0)
(close-fdes 1)
(close-fdes 2)
(dup2 (fileno child) 0)
(dup2 (fileno child) 1)
;; Mimic 'open-pipe*'.
(if (file-port? (current-error-port))
(let ((error-port-fileno
(fileno (current-error-port))))
(unless (eq? error-port-fileno 2)
(dup2 error-port-fileno
2)))
(dup2 (open-fdes "/dev/null" O_WRONLY)
2))
(apply execlp command command args))
(lambda ()
(primitive-_exit 127))))
(pid
(close-port child)
(values parent pid)))))))
(define* (inferior-pipe directory command error-port)
"Return two values: an input/output pipe on the Guix instance in DIRECTORY