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

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

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."
(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,
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
the returned procedure is called."
(catch #t
(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.
(pointer->procedure return-type ptr argument-types
#:return-errno? #t)))
@ -2289,9 +2295,8 @@ always a positive integer."
(terminal-dimension window-size-rows port (const 25)))
(define openpty
(let* ((ptr (dynamic-func "openpty" (dynamic-link "libutil")))
(proc (pointer->procedure int ptr '(* * * * *)
#:return-errno? #t)))
(let ((proc (syscall->procedure int "openpty" '(* * * * *)
#:library "libutil")))
(lambda ()
"Return two file descriptors: one for the pseudo-terminal control side,
and one for the controlled side."
@ -2312,9 +2317,8 @@ and one for the controlled side."
(values (* head) (* inferior)))))))
(define login-tty
(let* ((ptr (dynamic-func "login_tty" (dynamic-link "libutil")))
(proc (pointer->procedure int ptr (list int)
#:return-errno? #t)))
(let* ((proc (syscall->procedure int "login_tty" (list int)
#:library "libutil")))
(lambda (fd)
"Make FD the controlling terminal of the current process (with the
TIOCSCTTY ioctl), redirect standard input, standard output and standard error