summary refs log tree commit diff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2021-10-26 14:50:54 +0200
committerLudovic Courtès <ludo@gnu.org>2021-10-26 14:53:43 +0200
commit0a42998a50e8bbe9e49142b21a570db00efe7491 (patch)
tree6f7b451747b56c561d9b55d4381fd00edb355123
parent73ae663b213bb943b35dd719283bbdbb4ce3bab2 (diff)
downloadguix-0a42998a50e8bbe9e49142b21a570db00efe7491.tar.gz
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.
-rw-r--r--guix/build/syscalls.scm22
1 files changed, 13 insertions, 9 deletions
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index 7ea6b56e54..b305133c37 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -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