(address . guix-patches@gnu.org)
20220911105051.16901-1-marius@gnu.org
This is a re-implementation of 3c8b6fd94ceb1e898216929e8768fb518dbf1de9 that
works with new and old libc's.
* guix/build/syscalls.scm (openpty, login-tty): Wrap in exception handlers and
retry with libutil if the first call is unsuccessful.
---
guix/build/syscalls.scm | 71 ++++++++++++++++++++++++++---------------
1 file changed, 45 insertions(+), 26 deletions(-)
Toggle diff (98 lines)
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index b00615d9b7..eee90216eb 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -9,6 +9,7 @@
;;; Copyright © 2021 Chris Marusich <cmmarusich@gmail.com>
;;; Copyright © 2021 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2022 Oleg Pykhalov <go.wigust@gmail.com>
+;;; Copyright © 2022 Marius Bakke <marius@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -2339,39 +2340,57 @@ (define* (terminal-rows #:optional (port (current-output-port)))
(terminal-dimension window-size-rows port (const 25)))
(define openpty
- (let ((proc (syscall->procedure int "openpty" '(* * * * *)
- #:library "libutil")))
- (lambda ()
- "Return two file descriptors: one for the pseudo-terminal control side,
+ (lambda* (#:optional library)
+ "Return two file descriptors: one for the pseudo-terminal control side,
and one for the controlled side."
+ (let ((proc (syscall->procedure int "openpty" '(* * * * *)
+ #:library library)))
(let ((head (make-bytevector (sizeof int)))
(inferior (make-bytevector (sizeof int))))
- (let-values (((ret err)
- (proc (bytevector->pointer head)
- (bytevector->pointer inferior)
- %null-pointer %null-pointer %null-pointer)))
- (unless (zero? ret)
- (throw 'system-error "openpty" "~A"
- (list (strerror err))
- (list err))))
-
- (let ((* (lambda (bv)
- (bytevector-sint-ref bv 0 (native-endianness)
- (sizeof int)))))
- (values (* head) (* inferior)))))))
+ (catch 'system-error
+ (lambda ()
+ (let-values (((ret err)
+ (proc (bytevector->pointer head)
+ (bytevector->pointer inferior)
+ %null-pointer %null-pointer %null-pointer)))
+ (unless (zero? ret)
+ (throw 'system-error "openpty" "~A"
+ (list (strerror err))
+ (list err)))
+
+ (let ((* (lambda (bv)
+ (bytevector-sint-ref bv 0 (native-endianness)
+ (sizeof int)))))
+ (values (* head) (* inferior)))))
+ (lambda args
+ (if (and (= (system-error-errno args) 38)
+ (not library))
+ ;; Prior to glibc 2.34, openpty resided in libutil.
+ ;; Try again, fingers crossed!
+ (openpty "libutil")
+ (apply throw args))))))))
(define login-tty
- (let* ((proc (syscall->procedure int "login_tty" (list int)
- #:library "libutil")))
- (lambda (fd)
- "Make FD the controlling terminal of the current process (with the
+ (lambda* (fd #:optional library)
+ "Make FD the controlling terminal of the current process (with the
TIOCSCTTY ioctl), redirect standard input, standard output and standard error
output to this terminal, and close FD."
- (let-values (((ret err) (proc fd)))
- (unless (zero? ret)
- (throw 'system-error "login-pty" "~A"
- (list (strerror err))
- (list err)))))))
+ (let ((proc (syscall->procedure int "login_tty" (list int)
+ #:library library)))
+ (catch 'system-error
+ (lambda ()
+ (let-values (((ret err) (proc fd)))
+ (unless (zero? ret)
+ (throw 'system-error "login-pty" "~A"
+ (list (strerror err))
+ (list err)))))
+ (lambda args
+ (if (and (= (system-error-errno args) 38)
+ (not library))
+ ;; Prior to glibc 2.34, login-pty resided in libutil.
+ ;; Try again, fingers crossed!
+ (login-tty fd "libutil")
+ (apply throw args)))))))
;;;
--
2.37.3