From 981af9992881b7395692bd6233722464d173a51f Mon Sep 17 00:00:00 2001 From: Noah Evans Date: Thu, 26 Dec 2024 14:28:35 -0500 Subject: [PATCH] syscalls: Add implementation of statfs for guile-static. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This is needed when bind mounting file systems from the initrd guile, or else you get an error like this: https://lists.gnu.org/archive/html/help-guix/2021-07/msg00050.html * guix/build/syscalls.scm (statfs): Add implementation for calling from guile-static. * gnu/packages/patches/guile-3.0-linux-syscalls.patch, gnu/packages/patches/guile-linux-syscalls.patch (statfs-raw): C Function to support above. Change-Id: Ibc8f1f27648add90639bd391aff8d61c6a23b884 Signed-off-by: Ludovic Courtès --- .../patches/guile-3.0-linux-syscalls.patch | 34 ++++++++++++++++++- .../patches/guile-linux-syscalls.patch | 34 ++++++++++++++++++- guix/build/syscalls.scm | 32 +++++++++++------ 3 files changed, 87 insertions(+), 13 deletions(-) diff --git a/gnu/packages/patches/guile-3.0-linux-syscalls.patch b/gnu/packages/patches/guile-3.0-linux-syscalls.patch index 0d27f77ee2..13921b8b70 100644 --- a/gnu/packages/patches/guile-3.0-linux-syscalls.patch +++ b/gnu/packages/patches/guile-3.0-linux-syscalls.patch @@ -6,7 +6,7 @@ a statically-linked Guile in an initrd that doesn't have libc.so around. diff --git a/libguile/posix.c b/libguile/posix.c --- a/libguile/posix.c +++ b/libguile/posix.c -@@ -2375,6 +2375,336 @@ scm_init_popen (void) +@@ -2375,6 +2375,368 @@ scm_init_popen (void) } #endif /* HAVE_START_CHILD */ @@ -339,6 +339,38 @@ diff --git a/libguile/posix.c b/libguile/posix.c +} +#undef FUNC_NAME +#endif ++ ++#include ++ ++SCM_DEFINE (scm_statfs_raw, "statfs-raw", 1, 0, 0, ++ (SCM filesystem), ++ "Return a bytevector describing @var{filesystem}") ++#define FUNC_NAME s_scm_statfs_raw ++{ ++ int err; ++ char *c_filesystem; ++ SCM bv; ++ ++ c_filesystem = scm_to_locale_string (filesystem); ++ ++ bv = scm_c_make_bytevector (sizeof (struct statfs)); ++ struct statfs *bv_pointer = scm_to_pointer (scm_bytevector_to_pointer (bv, scm_from_int (0))); ++ ++ err = statfs (c_filesystem, bv_pointer); ++ if (err != 0) ++ err = errno; ++ ++ free (c_filesystem); ++ ++ if (err != 0) ++ { ++ errno = err; ++ SCM_SYSERROR; ++ } ++ ++ return bv; ++} ++#undef FUNC_NAME + void scm_init_posix () diff --git a/gnu/packages/patches/guile-linux-syscalls.patch b/gnu/packages/patches/guile-linux-syscalls.patch index 12cddff47b..1ebbc72c52 100644 --- a/gnu/packages/patches/guile-linux-syscalls.patch +++ b/gnu/packages/patches/guile-linux-syscalls.patch @@ -7,7 +7,7 @@ diff --git a/libguile/posix.c b/libguile/posix.c index b0fcad5fd..1343186e3 100644 --- a/libguile/posix.c +++ b/libguile/posix.c -@@ -2341,6 +2341,335 @@ scm_init_popen (void) +@@ -2341,6 +2341,367 @@ scm_init_popen (void) } #endif /* HAVE_START_CHILD */ @@ -339,6 +339,38 @@ index b0fcad5fd..1343186e3 100644 +} +#undef FUNC_NAME +#endif ++ ++#include ++ ++SCM_DEFINE (scm_statfs_raw, "statfs-raw", 1, 0, 0, ++ (SCM filesystem), ++ "Return a bytevector describing @var{filesystem}") ++#define FUNC_NAME s_scm_statfs_raw ++{ ++ int err; ++ char *c_filesystem; ++ SCM bv; ++ ++ c_filesystem = scm_to_locale_string (filesystem); ++ ++ bv = scm_c_make_bytevector (sizeof (struct statfs)); ++ struct statfs *bv_pointer = scm_to_pointer (scm_bytevector_to_pointer (bv, scm_from_int (0))); ++ ++ err = statfs (c_filesystem, bv_pointer); ++ if (err != 0) ++ err = errno; ++ ++ free (c_filesystem); ++ ++ if (err != 0) ++ { ++ errno = err; ++ SCM_SYSERROR; ++ } ++ ++ return bv; ++} ++#undef FUNC_NAME + void scm_init_posix () diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index 7e16452462..42232fc7f1 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -9,6 +9,7 @@ ;;; Copyright © 2021 Chris Marusich ;;; Copyright © 2021 Tobias Geerinckx-Rice ;;; Copyright © 2022 Oleg Pykhalov +;;; Copyright © 2024 Noah Evans ;;; ;;; This file is part of GNU Guix. ;;; @@ -988,18 +989,27 @@ (define-c-struct %statfs ; (spare (array fsword 4))) (define statfs - (let ((proc (syscall->procedure int (if musl-libc? "statfs" "statfs64") '(* *)))) - (lambda (file) - "Return a data structure describing the file system + ;; Check whether we are using the statically-linked Guile, which provides + ;; 'statfs-raw' from libguile via a patch. + (if (module-defined? the-scm-module 'statfs-raw) + (lambda (file) + "Return a data structure describing the file system mounted at FILE." - (let*-values (((stat) (make-bytevector sizeof-statfs)) - ((ret err) (proc (string->pointer file) - (bytevector->pointer stat)))) - (if (zero? ret) - (read-statfs stat) - (throw 'system-error "statfs" "~A: ~A" - (list file (strerror err)) - (list err))))))) + (read-statfs ((module-ref the-scm-module 'statfs-raw) file))) + (let ((proc (syscall->procedure int + (if musl-libc? "statfs" "statfs64") + '(* *)))) + (lambda (file) + "Return a data structure describing the file system +mounted at FILE." + (let*-values (((stat) (make-bytevector sizeof-statfs)) + ((ret err) (proc (string->pointer file) + (bytevector->pointer stat)))) + (if (zero? ret) + (read-statfs stat) + (throw 'system-error "statfs" "~A: ~A" + (list file (strerror err)) + (list err)))))))) (define (free-disk-space file) "Return the free disk space, in bytes, on the file system that hosts FILE."