[bug#57730] [PATCH] syscalls: Adjust for glibc 2.34 and later.

[bug#57730] [PATCH] syscalls: Adjust for glibc 2.34 and later.

[Marius Bakke]

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(-)

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)))))))
 
 \f
 ;;;
-- 
2.37.3

[bug#57730] [PATCH] syscalls: Adjust for glibc 2.34 and later.

[Marius Bakke]

[-- Attachment #1: Type: text/plain, Size: 805 bytes --]

Marius Bakke <marius@gnu.org> skriver:

> 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.

An alternative approach could be to use this helper:

(define gnu-get-libc-version
  (let ((proc (syscall->procedure '* "gnu_get_libc_version" '())))
    (lambda ()
      (let-values (((ret err) (proc)))
        (if (zero? err)
            (pointer->string ret)
            (throw 'system-error "gnu-get-libc-version"
                   "gnu-get-libc-version: ~A"
                   (list (strerror err))
                   (list err)))))))

...and maybe set a %glibc-version variable that can be used as needed.

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 247 bytes --]

[bug#57730] [PATCH] syscalls: Adjust for glibc 2.34 and later.

[Ludovic Courtès]

[-- Attachment #1: Type: text/plain, Size: 1092 bytes --]

Hi,

Marius Bakke <marius@gnu.org> skribis:

> 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.

[...]

>  (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)))

In general, we must ensure that ‘syscall->procedure’ is called only once
per procedure, because it’s expensive compared to the function we’re
wrapping (it’s doing dlopen, dlsym, and all that).

Anyway, I think this should work:


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Type: text/x-patch, Size: 1010 bytes --]

diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index 7842b0a9fc..e081aaca44 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -445,9 +445,14 @@ (define* (syscall->procedure return-type name argument-types
 the returned procedure is called."
   (catch #t
     (lambda ()
+      ;; Note: When #:library is set, try it first and fall back to libc
+      ;; proper.  This is because libraries like libutil.so have been subsumed
+      ;; by libc.so with glibc >= 2.34.
       (let ((ptr (dynamic-func name
                                (if library
-                                   (dynamic-link library)
+                                   (or (false-if-exception
+                                        (dynamic-link library))
+                                       (dynamic-link))
                                    (dynamic-link)))))
         ;; The #:return-errno? facility was introduced in Guile 2.0.12.
         (pointer->procedure return-type ptr argument-types

[-- Attachment #3: Type: text/plain, Size: 30 bytes --]


WDYT?

Thanks,
Ludo’.

[bug#57730] [PATCH] syscalls: Adjust for glibc 2.34 and later.

[Marius Bakke]

[-- Attachment #1: Type: text/plain, Size: 2253 bytes --]

Ludovic Courtès <ludo@gnu.org> skriver:

>>  (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)))
>
> In general, we must ensure that ‘syscall->procedure’ is called only once
> per procedure, because it’s expensive compared to the function we’re
> wrapping (it’s doing dlopen, dlsym, and all that).

That makes sense.

> Anyway, I think this should work:
>
> diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
> index 7842b0a9fc..e081aaca44 100644
> --- a/guix/build/syscalls.scm
> +++ b/guix/build/syscalls.scm
> @@ -445,9 +445,14 @@ (define* (syscall->procedure return-type name argument-types
>  the returned procedure is called."
>    (catch #t
>      (lambda ()
> +      ;; Note: When #:library is set, try it first and fall back to libc
> +      ;; proper.  This is because libraries like libutil.so have been subsumed
> +      ;; by libc.so with glibc >= 2.34.
>        (let ((ptr (dynamic-func name
>                                 (if library
> -                                   (dynamic-link library)
> +                                   (or (false-if-exception
> +                                        (dynamic-link library))
> +                                       (dynamic-link))
>                                     (dynamic-link)))))
>          ;; The #:return-errno? facility was introduced in Guile 2.0.12.
>          (pointer->procedure return-type ptr argument-types
>
> WDYT?

I can confirm this works after reverting 3c8b6fd94ceb1e89821.

Can you commit it, or should I do it on your behalf?  I think we should
try to get it in 1.4.0 so Guix works when linked against system libc on
foreign distributions.

I'll revert 3c8b6fd94ce once this lands on 'core-updates'.

Thanks!

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 247 bytes --]

[bug#57730] [PATCH] syscalls: Adjust for glibc 2.34 and later.

[Mathieu Othacehe]

Hey,

> Can you commit it, or should I do it on your behalf?  I think we should
> try to get it in 1.4.0 so Guix works when linked against system libc on
> foreign distributions.

This indeed seems like the right thing to do :) Marius or Ludo, I think
you can go ahead :)

Thanks,

Mathieu

bug#57730: [PATCH] syscalls: Adjust for glibc 2.34 and later.

[Ludovic Courtès]

Hi,

Mathieu Othacehe <othacehe@gnu.org> skribis:

> Hey,
>
>> Can you commit it, or should I do it on your behalf?  I think we should
>> try to get it in 1.4.0 so Guix works when linked against system libc on
>> foreign distributions.
>
> This indeed seems like the right thing to do :) Marius or Ludo, I think
> you can go ahead :)

Pushed on ‘core-updates’ as 3f6c32a88fc7a4d707ae1ed8ef3f7bd995461aff!

Ludo’.