me/guix
Archived
1
0
Fork 0
Code Activity

syscalls: Gracefully handle failure to load libc's libutil.

Browse source 
In particular, libutil is not found when running code on a
statically-linked Guile.

Reported by mahmooz on #guix.

* guix/build/syscalls.scm (syscall->procedure): Add #:library parameter
and honor it.
(openpty, login-tty): Use 'syscall->procedure' instead of calling
'dynamic-link' directly.
This commit is contained in:
Ludovic Courtès 2021-10-26 14:50:54 +02:00
parent 73ae663b21
commit 0a42998a50
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 13 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

22
guix/build/syscalls.scm
View file

@ -424,15 +424,21 @@ expansion-time error is raised if FIELD does not exist in TYPE."
"Evaluate EXPR and restart upon EINTR. Return the value of EXPR." "Evaluate EXPR and restart upon EINTR. Return the value of EXPR."
(call-with-restart-on-EINTR (lambda () expr))) (call-with-restart-on-EINTR (lambda () expr)))
(define (syscall->procedure return-type name argument-types) (define* (syscall->procedure return-type name argument-types
#:key library)
"Return a procedure that wraps the C function NAME using the dynamic FFI, "Return a procedure that wraps the C function NAME using the dynamic FFI,
and that returns two values: NAME's return value, and errno. and that returns two values: NAME's return value, and errno. When LIBRARY is
specified, look up NAME in that library rather than in the global symbol name
space.
If an error occurs while creating the binding, defer the error report until If an error occurs while creating the binding, defer the error report until
the returned procedure is called." the returned procedure is called."
(catch #t (catch #t
(lambda () (lambda ()
(let ((ptr (dynamic-func name (dynamic-link)))) (let ((ptr (dynamic-func name
(if library
(dynamic-link library)
(dynamic-link)))))
;; The #:return-errno? facility was introduced in Guile 2.0.12. ;; The #:return-errno? facility was introduced in Guile 2.0.12.
(pointer->procedure return-type ptr argument-types (pointer->procedure return-type ptr argument-types
#:return-errno? #t))) #:return-errno? #t)))
@ -2289,9 +2295,8 @@ always a positive integer."
(terminal-dimension window-size-rows port (const 25))) (terminal-dimension window-size-rows port (const 25)))
(define openpty (define openpty
(let* ((ptr (dynamic-func "openpty" (dynamic-link "libutil"))) (let ((proc (syscall->procedure int "openpty" '(* * * * *)
(proc (pointer->procedure int ptr '(* * * * *) #:library "libutil")))
#:return-errno? #t)))
(lambda () (lambda ()
"Return two file descriptors: one for the pseudo-terminal control side, "Return two file descriptors: one for the pseudo-terminal control side,
and one for the controlled side." and one for the controlled side."
@ -2312,9 +2317,8 @@ and one for the controlled side."
(values (* head) (* inferior))))))) (values (* head) (* inferior)))))))
(define login-tty (define login-tty
(let* ((ptr (dynamic-func "login_tty" (dynamic-link "libutil"))) (let* ((proc (syscall->procedure int "login_tty" (list int)
(proc (pointer->procedure int ptr (list int) #:library "libutil")))
#:return-errno? #t)))
(lambda (fd) (lambda (fd)
"Make FD the controlling terminal of the current process (with the "Make FD the controlling terminal of the current process (with the
TIOCSCTTY ioctl), redirect standard input, standard output and standard error TIOCSCTTY ioctl), redirect standard input, standard output and standard error