unofficial mirror of guix-patches@gnu.org 
 help / color / mirror / code / Atom feed
From: Noah Evans <noahevans256@gmail.com>
To: 75133@debbugs.gnu.org
Subject: [bug#75133] [PATCH] syscalls: Add implementation of statfs for guile-static.
Date: Thu, 26 Dec 2024 14:28:35 -0500	[thread overview]
Message-ID: <CALbcCJgO_hdEwom79Yn663S0H+FcgrpZNkte8Xx_igQDLZY22w@mail.gmail.com> (raw)

* 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




                 reply	other threads:[~2024-12-27 13:48 UTC|newest]

Thread overview: [no followups] expand[flat|nested]  mbox.gz  Atom feed

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://guix.gnu.org/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=CALbcCJgO_hdEwom79Yn663S0H+FcgrpZNkte8Xx_igQDLZY22w@mail.gmail.com \
    --to=noahevans256@gmail.com \
    --cc=75133@debbugs.gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/guix.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).