mirror/guix
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/guix.git synced 2025-01-18 13:36:36 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions

syscalls: Add implementation of statfs for guile-static.

Browse source 
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 <ludo@gnu.org>
This commit is contained in:
Noah Evans 2024-12-26 14:28:35 -05:00 committed by Ludovic Courtès
parent c8797e81fb
commit 981af99928
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
3 changed files with 87 additions and 13 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

34
gnu/packages/patches/guile-3.0-linux-syscalls.patch
View file

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

34
gnu/packages/patches/guile-linux-syscalls.patch
View file

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

32
guix/build/syscalls.scm
View file

@ -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.
;;;
@ -988,18 +989,27 @@ (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
;; 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 <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."