ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 21:38:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

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 ;;; 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. ;;; 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. ;; the REPL process wouldn't get EOF on standard input.
(match (socketpair AF_UNIX (logior SOCK_STREAM SOCK_CLOEXEC) 0) (match (socketpair AF_UNIX (logior SOCK_STREAM SOCK_CLOEXEC) 0)
((parent . child) ((parent . child)
(match (primitive-fork) (if (defined? 'spawn)
(0 (let* ((void (open-fdes "/dev/null" O_WRONLY))
(dynamic-wind (pid (catch 'system-error
(lambda () (lambda ()
#t) (spawn command (cons command args)
(lambda () #:input child
(close-port parent) #:output child
(close-fdes 0) #:error (if (file-port? (current-error-port))
(close-fdes 1) (current-error-port)
(close-fdes 2) void)))
(dup2 (fileno child) 0) (const #f)))) ;can't exec, for instance ENOENT
(dup2 (fileno child) 1) (close-fdes void)
;; Mimic 'open-pipe*'. (close-port child)
(if (file-port? (current-error-port)) (values parent pid))
(let ((error-port-fileno (match (primitive-fork) ;Guile < 3.0.9
(fileno (current-error-port)))) (0
(unless (eq? error-port-fileno 2) (dynamic-wind
(dup2 error-port-fileno (lambda ()
2))) #t)
(dup2 (open-fdes "/dev/null" O_WRONLY) (lambda ()
2)) (close-port parent)
(apply execlp command command args)) (close-fdes 0)
(lambda () (close-fdes 1)
(primitive-_exit 127)))) (close-fdes 2)
(pid (dup2 (fileno child) 0)
(close-port child) (dup2 (fileno child) 1)
(values parent pid)))))) ;; 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) (define* (inferior-pipe directory command error-port)
"Return two values: an input/output pipe on the Guix instance in DIRECTORY "Return two values: an input/output pipe on the Guix instance in DIRECTORY