[bug#75133] [PATCH] syscalls: Add implementation of statfs for guile-static.

[bug#75133] [PATCH] syscalls: Add implementation of statfs for guile-static.

[Noah Evans]

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

This is needed when bind mounting filesystems from the initrd guile, or else
you get an error like this:
https://lists.gnu.org/archive/html/help-guix/2021-07/msg00050.html

Change-Id: Ibc8f1f27648add90639bd391aff8d61c6a23b884
---
 .../patches/guile-3.0-linux-syscalls.patch    | 34 ++++++++++++++++++-
 .../patches/guile-linux-syscalls.patch        | 34 ++++++++++++++++++-
 guix/build/syscalls.scm                       | 30 ++++++++++------
 3 files changed, 85 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..1332d31241 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 <sys/statfs.h>
++
++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..04645caeb8 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 <sys/statfs.h>
++
++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 2c20edf058..e2af4efd12 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 © 2024 Noah Evans <noahevans256@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -930,18 +931,25 @@ (define-c-struct %statfs
 ;<bits/statfs.h>
   (spare            (array fsword 4)))

 (define statfs
-  (let ((proc (syscall->procedure int (if musl-libc? "statfs"
"statfs64") '(* *))))
-    (lambda (file)
-      "Return a <file-system> data structure describing the file system
+  (if (module-defined? the-scm-module 'statfs-raw)
+      (lambda (file)
+        "Return a <file-system> 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 <file-system> 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."

base-commit: f03a0e2d19f95eb0961472842540970c2f7605f1
-- 
2.46.0