[PATCH] Add statvfs bindings.

[PATCH] Add statvfs bindings.

[Marius Bakke]

* libguile/filesys.c (scm_statvfs2scm): New function.
(scm_statvfs): New procedure.
* libguile/filesys.h: Add scm_statvfs.
* libguile/syscalls.h (fstatvfs_or_fstatvfs64, statvfs_or_statvfs64,
scm_from_fsblkcnt_t_or_fsblkcnt64_t,
scm_from_fsfilcnt_t_or_fsfilcnt64_t): New macros.
* module/ice-9/posix.scm (statvfs:block-size, statvfs:fragment-size,
statvfs:blocks, statvfs:blocks-free, statvfs:block-available,
statvfs:files, statvfs:files-free, statvfs:files-available,
statvfs:fsid, statvfs:flags, statvfs:name-max): New variables.
* libguile/posix.c (scm_init_posix): Add ST_MANDLOCK, ST_NOATIME,
ST_NODEV, ST_NODIRATIME, ST_NOEXEC, ST_NOSUID, ST_RDONLY, ST_RELATIME,
ST_SYNCHRONOUS constants.
* doc/ref/posix.texi (File System): Document statvfs.
* test-suite/tests/posix.test ("statvfs"): New tests.
---
 doc/ref/posix.texi          |  50 +++++++++++++++++
 libguile/filesys.c          | 109 ++++++++++++++++++++++++++++++++++++
 libguile/filesys.h          |   1 +
 libguile/posix.c            |  29 ++++++++++
 libguile/syscalls.h         |   4 ++
 module/ice-9/posix.scm      |  12 ++++
 test-suite/tests/posix.test |  39 +++++++++++++
 7 files changed, 244 insertions(+)
---
Hello Guile,

This patch adds bindings for statvfs(3).  The API is similar to that of `stat`.
It can be used to implement e.g. `df` in Guile.

I added "long names" for the various getters, instead of following the "POSIX
identifiers" (block-size instead of bsize, etc).  That may not have been a wise
decision.  Feedback wanted!

diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index 5653d3758..8c9109257 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -794,6 +794,56 @@ referred to by the file port @var{dir} instead.  The optional argument
 @var{filename} will not be dereferenced even if it is a symbolic link.
 @end deffn
 
+@deffn {Scheme Procedure} statvfs object [exception-on-error?]
+@deffnx {C Function} scm_statvfs (object, exception_on_error)
+Return an object containing various information about the file system
+determined by @var{object}.  @var{object} can be a string containing
+a file name or a port or integer file descriptor which is open
+on a file (in which case @code{fstatvfs} is used as the underlying
+system call).
+
+@c TODO: Under which circumstances can statvfs return error?
+If the optional @var{exception_on_error} argument is true, which
+is the default, an exception will be raised if the underlying
+system call returns an error. Otherwise, an error will cause
+@code{statvfs} to return @code{#f}.
+
+The object returned by @code{statvfs} can be passed as a single
+parameter to the following procedures, all of which return
+integers:
+
+@deffn {Scheme Procedure} statvfs:block-size st
+The file system block size.
+@end deffn
+@deffn {Scheme Procedure} statvfs:fragment-size st
+The file system fragment size.
+@end deffn
+@deffn {Scheme Procedure} statvfs:blocks st
+The size of the file system in @code{fragment-size} units.
+@end deffn
+@deffn {Scheme Procedure} statvfs:blocks-free st
+The number of free blocks on the file system.
+@end deffn
+@deffn {Scheme Procedure} statvfs:blocks-available st
+The number of free blocks available for unprivileged users.
+@end deffn
+@deffn {Scheme Procedure} statvfs:files st
+The total number of inodes.
+@end deffn
+@deffn {Scheme Procedure} statvfs:files-free st
+The number of free inodes.
+@end deffn
+@deffn {Scheme Procedure} statvfs:files-available st
+The number of free inodes available for unprivileged users.
+@end deffn
+@deffn {Scheme Procedure} statvfs:fsid st
+The file system identifier.
+@end deffn
+@deffn {Scheme Procedure} statvfs:name-max st
+The maximum supported file name length.
+@end deffn
+@end deffn
+
 @deffn {Scheme Procedure} readlink path
 @deffnx {C Function} scm_readlink (path)
 Return the value of the symbolic link named by @var{path} (a string, or
diff --git a/libguile/filesys.c b/libguile/filesys.c
index 1f0bba556..5a8e58c4f 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -42,6 +42,7 @@
 #include <stdio.h>
 #include <stdlib.h>
 #include <sys/stat.h>
+#include <sys/statvfs.h>
 #include <sys/types.h>
 #include <unistd.h>
 #include <string.h>
@@ -709,6 +710,114 @@ SCM_DEFINE (scm_lstat, "lstat", 1, 0, 0,
 \f
 #ifdef HAVE_POSIX
 
+/* {Mount points}
+ */
+
+static SCM
+scm_statvfs2scm (struct statvfs_or_statvfs64 *statvfs_temp)
+{
+  SCM ans = scm_c_make_vector (11, SCM_UNSPECIFIED);
+
+  SCM_SIMPLE_VECTOR_SET(ans, 0, scm_from_ulong (statvfs_temp->f_bsize));
+  SCM_SIMPLE_VECTOR_SET(ans, 1, scm_from_ulong (statvfs_temp->f_frsize));
+  SCM_SIMPLE_VECTOR_SET(ans, 2, scm_from_fsblkcnt_t_or_fsblkcnt64_t (statvfs_temp->f_blocks));
+  SCM_SIMPLE_VECTOR_SET(ans, 3, scm_from_fsblkcnt_t_or_fsblkcnt64_t (statvfs_temp->f_bfree));
+  SCM_SIMPLE_VECTOR_SET(ans, 4, scm_from_fsblkcnt_t_or_fsblkcnt64_t (statvfs_temp->f_bavail));
+  SCM_SIMPLE_VECTOR_SET(ans, 5, scm_from_fsfilcnt_t_or_fsfilcnt64_t (statvfs_temp->f_files));
+  SCM_SIMPLE_VECTOR_SET(ans, 6, scm_from_fsfilcnt_t_or_fsfilcnt64_t (statvfs_temp->f_ffree));
+  SCM_SIMPLE_VECTOR_SET(ans, 7, scm_from_fsfilcnt_t_or_fsfilcnt64_t (statvfs_temp->f_favail));
+  SCM_SIMPLE_VECTOR_SET(ans, 8, scm_from_ulong (statvfs_temp->f_fsid));
+  SCM_SIMPLE_VECTOR_SET(ans, 9, scm_from_ulong (statvfs_temp->f_flag));
+  SCM_SIMPLE_VECTOR_SET(ans, 10, scm_from_ulong (statvfs_temp->f_namemax));
+  {
+    return ans;
+  }
+}
+
+SCM_DEFINE (scm_statvfs, "statvfs", 1, 1, 0,
+            (SCM object, SCM exception_on_error),
+            "Return an object containing information about the file system\n"
+	    "determined by @var{object}.  @var{object} can be a string containing\n"
+	    "a file name or a port or integer file descriptor which is open\n"
+	    "on a file (in which case @code{fstat} is used as the underlying\n"
+	    "system call).\n"
+	    "\n"
+            "If the optional @var{exception_on_error} argument is true, which\n"
+            "is the default, an exception will be raised if the underlying\n"
+            "system call returns an error, for example if the file system is not\n"
+            "readable. Otherwise, an error will cause\n"
+            "@code{statvfs} to return @code{#f}."
+	    "\n"
+	    "The object returned by a successful call to @code{statvfs} can be\n"
+            "passed as a single parameter to the following procedures, all of\n"
+            "which return integers:\n"
+	    "\n"
+	    "@table @code\n"
+	    "@item statvfs:block-size\n"
+	    "The block size of the file system.\n"
+	    "@item statvfs:fragment-size\n"
+	    "The fragment size.\n"
+	    "@item statvfs:blocks\n"
+	    "The size of the file system in @code{fragment-size} units.\n"
+	    "@item statvfs:blocks-free\n"
+	    "The number of free blocks.\n"
+	    "@item statvfs:blocks-available\n"
+	    "The number of free blocks available for unprivileged users.\n"
+	    "@item statvfs:files\n"
+	    "The number of inodes.\n"
+	    "@item statvfs:files-free\n"
+	    "Number of free inodes\n"
+	    "@item statvfs:files-available\n"
+	    "The number of inodes available for unprivileged users.\n"
+	    "@item statvfs:fsid\n"
+	    "The file system ID.\n"
+	    "@item statvfs:flags\n"
+	    "Mount flags.\n"
+	    "@item statvfs:name-max\n"
+	    "Maximum file name length\n"
+	    "@end table\n"
+	    "\n")
+#define FUNC_NAME s_scm_statvfs
+{
+  int rv;
+  int fdes;
+  struct statvfs_or_statvfs64 statvfs_temp;
+
+  if (scm_is_integer (object))
+    {
+      SCM_SYSCALL (rv = fstatvfs_or_fstatvfs64 (scm_to_int (object), &statvfs_temp));
+    }
+  else if (scm_is_string (object))
+    {
+      char *file = scm_to_locale_string (object);
+      SCM_SYSCALL (rv = statvfs_or_statvfs64 (file, &statvfs_temp));
+      free (file);
+    }
+  else
+    {
+      object = SCM_COERCE_OUTPORT (object);
+      SCM_VALIDATE_OPFPORT (1, object);
+      fdes = SCM_FPORT_FDES (object);
+      SCM_SYSCALL (rv = fstatvfs_or_fstatvfs64 (fdes, &statvfs_temp));
+    }
+
+  if (rv == -1)
+    {
+      if (SCM_UNBNDP (exception_on_error) || scm_is_true (exception_on_error))
+        {
+          int en = errno;
+          SCM_SYSERROR_MSG ("~A: ~S",
+                            scm_list_2 (scm_strerror (scm_from_int (en)),
+                                        object),
+                            en);
+        }
+      else
+        return SCM_BOOL_F;
+    }
+  return scm_statvfs2scm (&statvfs_temp);
+}
+#undef FUNC_NAME
+
 /* {Modifying Directories}
  */
 
diff --git a/libguile/filesys.h b/libguile/filesys.h
index 1ce50d30e..95ac407f8 100644
--- a/libguile/filesys.h
+++ b/libguile/filesys.h
@@ -51,6 +51,7 @@ SCM_API SCM scm_close (SCM fd_or_port);
 SCM_API SCM scm_close_fdes (SCM fd);
 SCM_API SCM scm_stat (SCM object, SCM exception_on_error);
 SCM_API SCM scm_statat (SCM dir, SCM filename, SCM flags);
+SCM_API SCM scm_statvfs (SCM object, SCM exception_on_error);
 SCM_API SCM scm_link (SCM oldpath, SCM newpath);
 SCM_API SCM scm_rename (SCM oldname, SCM newname);
 SCM_API SCM scm_renameat (SCM olddir, SCM oldname, SCM newdir, SCM newname);
diff --git a/libguile/posix.c b/libguile/posix.c
index 4cf4ef383..06740a410 100644
--- a/libguile/posix.c
+++ b/libguile/posix.c
@@ -31,6 +31,7 @@
 #include <stdlib.h>
 #include <string.h>
 #include <sys/stat.h>
+#include <sys/statvfs.h>
 #include <sys/types.h>
 #include <uniconv.h>
 #include <unistd.h>
@@ -2682,6 +2683,34 @@ scm_init_posix ()
   scm_c_define ("AT_EACCESS", scm_from_int (AT_EACCESS));
 #endif
 
+#ifdef ST_MANDLOCK
+  scm_c_define ("ST_MANDLOCK", scm_from_int (ST_MANDLOCK));
+#endif
+#ifdef ST_NOATIME
+  scm_c_define ("ST_NOATIME", scm_from_int (ST_NOATIME));
+#endif
+#ifdef ST_NODEV
+  scm_c_define ("ST_NODEV", scm_from_int (ST_NODEV));
+#endif
+#ifdef ST_NODIRATIME
+  scm_c_define ("ST_NODIRATIME", scm_from_int (ST_NODIRATIME));
+#endif
+#ifdef ST_NOEXEC
+  scm_c_define ("ST_NOEXEC", scm_from_int (ST_NOEXEC));
+#endif
+#ifdef ST_NOSUID
+  scm_c_define ("ST_NOSUID", scm_from_int (ST_NOSUID));
+#endif
+#ifdef ST_RDONLY
+  scm_c_define ("ST_RDONLY", scm_from_int (ST_RDONLY));
+#endif
+#ifdef ST_RELATIME
+  scm_c_define ("ST_RELATIME", scm_from_int (ST_RELATIME));
+#endif
+#ifdef ST_SYNCHRONOUS
+  scm_c_define ("ST_SYNCHRONOUS", scm_from_int (ST_SYNCHRONOUS));
+#endif
+
 #include "cpp-SIG.c"
 #include "posix.x"
 
diff --git a/libguile/syscalls.h b/libguile/syscalls.h
index 6f4061138..4669e70c8 100644
--- a/libguile/syscalls.h
+++ b/libguile/syscalls.h
@@ -53,6 +53,7 @@
 # define dirent_or_dirent64             dirent
 #endif
 #define fstat_or_fstat64                CHOOSE_LARGEFILE(fstat,fstat64)
+#define fstatvfs_or_fstatvfs64          CHOOSE_LARGEFILE(fstatvfs,fstatvfs64)
 #define ftruncate_or_ftruncate64        CHOOSE_LARGEFILE(ftruncate,ftruncate64)
 #define lseek_or_lseek64                CHOOSE_LARGEFILE(lseek,lseek64)
 #define lstat_or_lstat64                CHOOSE_LARGEFILE(lstat,lstat64)
@@ -66,12 +67,15 @@
 # define readdir_r_or_readdir64_r       readdir_r
 #endif
 #define stat_or_stat64                  CHOOSE_LARGEFILE(stat,stat64)
+#define statvfs_or_statvfs64            CHOOSE_LARGEFILE(statvfs,statvfs64)
 #define fstatat_or_fstatat64            CHOOSE_LARGEFILE(fstatat,fstatat64)
 #define truncate_or_truncate64          CHOOSE_LARGEFILE(truncate,truncate64)
 #define scm_from_off_t_or_off64_t       CHOOSE_LARGEFILE(scm_from_off_t,scm_from_int64)
 #define scm_from_ino_t_or_ino64_t       CHOOSE_LARGEFILE(scm_from_ulong,scm_from_uint64)
 #define scm_from_blkcnt_t_or_blkcnt64_t CHOOSE_LARGEFILE(scm_from_ulong,scm_from_uint64)
 #define scm_to_off_t_or_off64_t         CHOOSE_LARGEFILE(scm_to_off_t,scm_to_int64)
+#define scm_from_fsblkcnt_t_or_fsblkcnt64_t CHOOSE_LARGEFILE(scm_from_ulong,scm_from_uint64)
+#define scm_from_fsfilcnt_t_or_fsfilcnt64_t CHOOSE_LARGEFILE(scm_from_ulong,scm_from_uint64)
 
 #if SIZEOF_OFF_T == 4
 #  define scm_to_off_t    scm_to_int32
diff --git a/module/ice-9/posix.scm b/module/ice-9/posix.scm
index b00267665..f6c913a27 100644
--- a/module/ice-9/posix.scm
+++ b/module/ice-9/posix.scm
@@ -41,6 +41,18 @@
 (define (stat:type f) (vector-ref f 13))
 (define (stat:perms f) (vector-ref f 14))
 
+(define (statvfs:block-size f) (vector-ref f 0))
+(define (statvfs:fragment-size f) (vector-ref f 1))
+(define (statvfs:blocks f) (vector-ref f 2))
+(define (statvfs:blocks-free f) (vector-ref f 3))
+(define (statvfs:blocks-available f) (vector-ref f 4))
+(define (statvfs:files f) (vector-ref f 5))
+(define (statvfs:files-free f) (vector-ref f 6))
+(define (statvfs:files-available f) (vector-ref f 7))
+(define (statvfs:fsid f) (vector-ref f 8))
+(define (statvfs:flags f) (vector-ref f 9))
+(define (statvfs:name-max f) (vector-ref f 10))
+
 (define (passwd:name obj) (vector-ref obj 0))
 (define (passwd:passwd obj) (vector-ref obj 1))
 (define (passwd:uid obj) (vector-ref obj 2))
diff --git a/test-suite/tests/posix.test b/test-suite/tests/posix.test
index 18dad8902..1ba9ff452 100644
--- a/test-suite/tests/posix.test
+++ b/test-suite/tests/posix.test
@@ -498,3 +498,42 @@
                ;; or not is system-defined, so it's possible it just works.
                (string? (crypt "pass" "$X$abc")))
              (lambda _ #t)))))
+
+;;
+;; statvfs
+;;
+
+(with-test-prefix "statvfs"
+
+  (pass-if "file system has available space"
+    (if (not (defined? 'statvfs))
+        (throw 'unsupported)
+        (let* ((dir (getcwd))
+               (vfs (statvfs dir)))
+          (positive? (- (statvfs:blocks vfs) (statvfs:blocks-available vfs))))))
+
+  (pass-if "file name, port, and fd are equal"
+    (if (not (defined? 'statvfs))
+        (throw 'unsupported)
+        (if (file-exists? "/proc/self/fd")   ;Linux
+            (let* ((file "/dev/null")
+                   (port (open-output-file file))
+                   (fd (fileno port))
+                   (stat-file (statvfs file))
+                   (stat-port (statvfs port))
+                   (stat-fd (statvfs fd)))
+              (close-port port)
+              (equal? stat-file stat-port stat-fd))
+            (throw 'unsupported))))
+
+  (pass-if-equal "file not found, exception"
+      ENOENT
+    (catch 'system-error
+      (lambda ()
+        (statvfs "i-dont-exist"))
+      (lambda args
+        (system-error-errno args))))
+
+  (pass-if-equal "file not found, no exception"
+      #f
+    (statvfs "its-gone" #f)))
-- 
2.39.1

[PATCH v2] Add statvfs bindings.

[Marius Bakke]

* libguile/filesys.c (scm_statvfs2scm): New function.
(scm_statvfs): New procedure.
* libguile/filesys.h: Add scm_statvfs.
* libguile/syscalls.h (fstatvfs_or_fstatvfs64, statvfs_or_statvfs64,
scm_from_fsblkcnt_t_or_fsblkcnt64_t,
scm_from_fsfilcnt_t_or_fsfilcnt64_t): New macros.
* module/ice-9/posix.scm (statvfs:block-size, statvfs:fragment-size,
statvfs:blocks, statvfs:blocks-free, statvfs:block-available,
statvfs:files, statvfs:files-free, statvfs:files-available,
statvfs:fsid, statvfs:flags, statvfs:name-max): New variables.
* libguile/posix.c (scm_init_posix): Add ST_MANDLOCK, ST_NOATIME,
ST_NODEV, ST_NODIRATIME, ST_NOEXEC, ST_NOSUID, ST_RDONLY, ST_RELATIME,
ST_SYNCHRONOUS constants.
* doc/ref/posix.texi (File System): Document statvfs.
* test-suite/tests/posix.test ("statvfs"): New tests.
---

Notes:
    Version 2:
    
    This is a revised patch that changes to short names for the statvfs:foo
    getters.  The rationale being:
    
    * "C"-like naming makes sense for wrappers.
    * Brings it in line with "stat:foo".
    * POSIX describes the frsize field as "fundamental size", whereas Linux uses
      "fragment size".  The semantics may vary among OS and even file systems.
    * Probably most users will want to match on the vector instead of using getters
      anyway (I discovered this in my original use case[0] for this patch).  :-)
    
    Also added an example on how to use (statvfs:flag ...), as well as a new test.
    
    [0] https://github.com/mbakke/goobar/blob/main/status/collector/disk.scm.in

 doc/ref/posix.texi          |  61 ++++++++++++++++++++
 libguile/filesys.c          | 109 ++++++++++++++++++++++++++++++++++++
 libguile/filesys.h          |   1 +
 libguile/posix.c            |  29 ++++++++++
 libguile/syscalls.h         |   4 ++
 module/ice-9/posix.scm      |  12 ++++
 test-suite/tests/posix.test |  48 ++++++++++++++++
 7 files changed, 264 insertions(+)

diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index 5653d3758..017078d1b 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -794,6 +794,67 @@ referred to by the file port @var{dir} instead.  The optional argument
 @var{filename} will not be dereferenced even if it is a symbolic link.
 @end deffn
 
+@deffn {Scheme Procedure} statvfs object [exception-on-error?]
+@deffnx {C Function} scm_statvfs (object, exception_on_error)
+Return an object containing various information about the file system
+determined by @var{object}.  @var{object} can be a string containing
+a file name or a port or integer file descriptor which is open
+on a file (in which case @code{fstatvfs} is used as the underlying
+system call).
+
+@c TODO: Under which circumstances can statvfs return error?
+If the optional @var{exception_on_error} argument is true, which
+is the default, an exception will be raised if the underlying
+system call returns an error. Otherwise, an error will cause
+@code{statvfs} to return @code{#f}.
+
+The object returned by @code{statvfs} can be passed as a single
+parameter to the following procedures, all of which return
+integers:
+
+@deffn {Scheme Procedure} statvfs:bsize st
+The file system block size.
+@end deffn
+@deffn {Scheme Procedure} statvfs:frsize st
+The \"fundamental\" or \"fragment\" block size.  On most systems this is
+identical with @code{bsize}.
+@end deffn
+@deffn {Scheme Procedure} statvfs:blocks st
+The size of the file system in @code{frsize} units.
+@end deffn
+@deffn {Scheme Procedure} statvfs:bfree st
+The number of free blocks on the file system.
+@end deffn
+@deffn {Scheme Procedure} statvfs:bavail st
+The number of free blocks available to unprivileged users.
+@end deffn
+@deffn {Scheme Procedure} statvfs:files st
+The total number of inodes.
+@end deffn
+@deffn {Scheme Procedure} statvfs:ffree st
+The number of free inodes.
+@end deffn
+@deffn {Scheme Procedure} statvfs:favail st
+The number of free inodes available to unprivileged users.
+@end deffn
+@deffn {Scheme Procedure} statvfs:fsid st
+The file system identifier.
+@end deffn
+@deffn {Scheme Procedure} statvfs:flag st
+Mount flags as a bitmask.  For example, to see if a file or directory
+is read-only, you can use:
+
+@example
+(define (read-only? file)
+  (let ((flags (statvfs:flag (statvfs file))))
+    (not (zero? (logand flags ST_RDONLY)))))
+@end example
+@end deffn
+@deffn {Scheme Procedure} statvfs:namemax st
+The maximum supported file name length.
+@end deffn
+@end deffn
+
 @deffn {Scheme Procedure} readlink path
 @deffnx {C Function} scm_readlink (path)
 Return the value of the symbolic link named by @var{path} (a string, or
diff --git a/libguile/filesys.c b/libguile/filesys.c
index 1f0bba556..81127036c 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -42,6 +42,7 @@
 #include <stdio.h>
 #include <stdlib.h>
 #include <sys/stat.h>
+#include <sys/statvfs.h>
 #include <sys/types.h>
 #include <unistd.h>
 #include <string.h>
@@ -709,6 +710,114 @@ SCM_DEFINE (scm_lstat, "lstat", 1, 0, 0,
 \f
 #ifdef HAVE_POSIX
 
+/* {Mount points}
+ */
+
+static SCM
+scm_statvfs2scm (struct statvfs_or_statvfs64 *statvfs_temp)
+{
+  SCM ans = scm_c_make_vector (11, SCM_UNSPECIFIED);
+
+  SCM_SIMPLE_VECTOR_SET(ans, 0, scm_from_ulong (statvfs_temp->f_bsize));
+  SCM_SIMPLE_VECTOR_SET(ans, 1, scm_from_ulong (statvfs_temp->f_frsize));
+  SCM_SIMPLE_VECTOR_SET(ans, 2, scm_from_fsblkcnt_t_or_fsblkcnt64_t (statvfs_temp->f_blocks));
+  SCM_SIMPLE_VECTOR_SET(ans, 3, scm_from_fsblkcnt_t_or_fsblkcnt64_t (statvfs_temp->f_bfree));
+  SCM_SIMPLE_VECTOR_SET(ans, 4, scm_from_fsblkcnt_t_or_fsblkcnt64_t (statvfs_temp->f_bavail));
+  SCM_SIMPLE_VECTOR_SET(ans, 5, scm_from_fsfilcnt_t_or_fsfilcnt64_t (statvfs_temp->f_files));
+  SCM_SIMPLE_VECTOR_SET(ans, 6, scm_from_fsfilcnt_t_or_fsfilcnt64_t (statvfs_temp->f_ffree));
+  SCM_SIMPLE_VECTOR_SET(ans, 7, scm_from_fsfilcnt_t_or_fsfilcnt64_t (statvfs_temp->f_favail));
+  SCM_SIMPLE_VECTOR_SET(ans, 8, scm_from_ulong (statvfs_temp->f_fsid));
+  SCM_SIMPLE_VECTOR_SET(ans, 9, scm_from_ulong (statvfs_temp->f_flag));
+  SCM_SIMPLE_VECTOR_SET(ans, 10, scm_from_ulong (statvfs_temp->f_namemax));
+  {
+    return ans;
+  }
+}
+
+SCM_DEFINE (scm_statvfs, "statvfs", 1, 1, 0,
+            (SCM object, SCM exception_on_error),
+            "Return an object containing information about the file system\n"
+            "determined by @var{object}.  @var{object} can be a string containing\n"
+            "a file name residing on the file system, or a port or integer file"
+            "descriptor which is open on a file (in which case @code{fstatvfs}"
+            "is used as the underlying system call).\n"
+            "\n"
+            "If the optional @var{exception_on_error} argument is true, which\n"
+            "is the default, an exception will be raised if the underlying\n"
+            "system call returns an error, for example if the file system is not\n"
+            "readable. Otherwise, an error will cause\n"
+            "@code{statvfs} to return @code{#f}."
+            "\n"
+            "The object returned by a successful call to @code{statvfs} can be\n"
+            "passed as a single parameter to the following procedures, all of\n"
+            "which return integers:\n"
+            "\n"
+            "@table @code\n"
+            "@item statvfs:bsize\n"
+            "The block size of the file system.\n"
+            "@item statvfs:frsize\n"
+            "The \"fragment\" or \"fundamental\" block size.\n"
+            "@item statvfs:blocks\n"
+            "The size of the file system in @code{frsize} units.\n"
+            "@item statvfs:bfree\n"
+            "The number of free blocks.\n"
+            "@item statvfs:bavail\n"
+            "The number of free blocks available for unprivileged users.\n"
+            "@item statvfs:files\n"
+            "The number of inodes.\n"
+            "@item statvfs:ffree\n"
+            "Number of free inodes\n"
+            "@item statvfs:favail\n"
+            "The number of inodes available for unprivileged users.\n"
+            "@item statvfs:fsid\n"
+            "The file system ID.\n"
+            "@item statvfs:flag\n"
+            "Mount flags as a bitmask.\n"
+            "@item statvfs:namemax\n"
+            "Maximum file name length\n"
+            "@end table\n"
+            "\n")
+#define FUNC_NAME s_scm_statvfs
+{
+  int rv;
+  int fdes;
+  struct statvfs_or_statvfs64 statvfs_temp;
+
+  if (scm_is_integer (object))
+    {
+      SCM_SYSCALL (rv = fstatvfs_or_fstatvfs64 (scm_to_int (object), &statvfs_temp));
+    }
+  else if (scm_is_string (object))
+    {
+      char *file = scm_to_locale_string (object);
+      SCM_SYSCALL (rv = statvfs_or_statvfs64 (file, &statvfs_temp));
+      free (file);
+    }
+  else
+    {
+      object = SCM_COERCE_OUTPORT (object);
+      SCM_VALIDATE_OPFPORT (1, object);
+      fdes = SCM_FPORT_FDES (object);
+      SCM_SYSCALL (rv = fstatvfs_or_fstatvfs64 (fdes, &statvfs_temp));
+    }
+
+  if (rv == -1)
+    {
+      if (SCM_UNBNDP (exception_on_error) || scm_is_true (exception_on_error))
+        {
+          int en = errno;
+          SCM_SYSERROR_MSG ("~A: ~S",
+                            scm_list_2 (scm_strerror (scm_from_int (en)),
+                                        object),
+                            en);
+        }
+      else
+        return SCM_BOOL_F;
+    }
+  return scm_statvfs2scm (&statvfs_temp);
+}
+#undef FUNC_NAME
+
 /* {Modifying Directories}
  */
 
diff --git a/libguile/filesys.h b/libguile/filesys.h
index 1ce50d30e..95ac407f8 100644
--- a/libguile/filesys.h
+++ b/libguile/filesys.h
@@ -51,6 +51,7 @@ SCM_API SCM scm_close (SCM fd_or_port);
 SCM_API SCM scm_close_fdes (SCM fd);
 SCM_API SCM scm_stat (SCM object, SCM exception_on_error);
 SCM_API SCM scm_statat (SCM dir, SCM filename, SCM flags);
+SCM_API SCM scm_statvfs (SCM object, SCM exception_on_error);
 SCM_API SCM scm_link (SCM oldpath, SCM newpath);
 SCM_API SCM scm_rename (SCM oldname, SCM newname);
 SCM_API SCM scm_renameat (SCM olddir, SCM oldname, SCM newdir, SCM newname);
diff --git a/libguile/posix.c b/libguile/posix.c
index 4cf4ef383..06740a410 100644
--- a/libguile/posix.c
+++ b/libguile/posix.c
@@ -31,6 +31,7 @@
 #include <stdlib.h>
 #include <string.h>
 #include <sys/stat.h>
+#include <sys/statvfs.h>
 #include <sys/types.h>
 #include <uniconv.h>
 #include <unistd.h>
@@ -2682,6 +2683,34 @@ scm_init_posix ()
   scm_c_define ("AT_EACCESS", scm_from_int (AT_EACCESS));
 #endif
 
+#ifdef ST_MANDLOCK
+  scm_c_define ("ST_MANDLOCK", scm_from_int (ST_MANDLOCK));
+#endif
+#ifdef ST_NOATIME
+  scm_c_define ("ST_NOATIME", scm_from_int (ST_NOATIME));
+#endif
+#ifdef ST_NODEV
+  scm_c_define ("ST_NODEV", scm_from_int (ST_NODEV));
+#endif
+#ifdef ST_NODIRATIME
+  scm_c_define ("ST_NODIRATIME", scm_from_int (ST_NODIRATIME));
+#endif
+#ifdef ST_NOEXEC
+  scm_c_define ("ST_NOEXEC", scm_from_int (ST_NOEXEC));
+#endif
+#ifdef ST_NOSUID
+  scm_c_define ("ST_NOSUID", scm_from_int (ST_NOSUID));
+#endif
+#ifdef ST_RDONLY
+  scm_c_define ("ST_RDONLY", scm_from_int (ST_RDONLY));
+#endif
+#ifdef ST_RELATIME
+  scm_c_define ("ST_RELATIME", scm_from_int (ST_RELATIME));
+#endif
+#ifdef ST_SYNCHRONOUS
+  scm_c_define ("ST_SYNCHRONOUS", scm_from_int (ST_SYNCHRONOUS));
+#endif
+
 #include "cpp-SIG.c"
 #include "posix.x"
 
diff --git a/libguile/syscalls.h b/libguile/syscalls.h
index 6f4061138..4669e70c8 100644
--- a/libguile/syscalls.h
+++ b/libguile/syscalls.h
@@ -53,6 +53,7 @@
 # define dirent_or_dirent64             dirent
 #endif
 #define fstat_or_fstat64                CHOOSE_LARGEFILE(fstat,fstat64)
+#define fstatvfs_or_fstatvfs64          CHOOSE_LARGEFILE(fstatvfs,fstatvfs64)
 #define ftruncate_or_ftruncate64        CHOOSE_LARGEFILE(ftruncate,ftruncate64)
 #define lseek_or_lseek64                CHOOSE_LARGEFILE(lseek,lseek64)
 #define lstat_or_lstat64                CHOOSE_LARGEFILE(lstat,lstat64)
@@ -66,12 +67,15 @@
 # define readdir_r_or_readdir64_r       readdir_r
 #endif
 #define stat_or_stat64                  CHOOSE_LARGEFILE(stat,stat64)
+#define statvfs_or_statvfs64            CHOOSE_LARGEFILE(statvfs,statvfs64)
 #define fstatat_or_fstatat64            CHOOSE_LARGEFILE(fstatat,fstatat64)
 #define truncate_or_truncate64          CHOOSE_LARGEFILE(truncate,truncate64)
 #define scm_from_off_t_or_off64_t       CHOOSE_LARGEFILE(scm_from_off_t,scm_from_int64)
 #define scm_from_ino_t_or_ino64_t       CHOOSE_LARGEFILE(scm_from_ulong,scm_from_uint64)
 #define scm_from_blkcnt_t_or_blkcnt64_t CHOOSE_LARGEFILE(scm_from_ulong,scm_from_uint64)
 #define scm_to_off_t_or_off64_t         CHOOSE_LARGEFILE(scm_to_off_t,scm_to_int64)
+#define scm_from_fsblkcnt_t_or_fsblkcnt64_t CHOOSE_LARGEFILE(scm_from_ulong,scm_from_uint64)
+#define scm_from_fsfilcnt_t_or_fsfilcnt64_t CHOOSE_LARGEFILE(scm_from_ulong,scm_from_uint64)
 
 #if SIZEOF_OFF_T == 4
 #  define scm_to_off_t    scm_to_int32
diff --git a/module/ice-9/posix.scm b/module/ice-9/posix.scm
index b00267665..45069ecb2 100644
--- a/module/ice-9/posix.scm
+++ b/module/ice-9/posix.scm
@@ -41,6 +41,18 @@
 (define (stat:type f) (vector-ref f 13))
 (define (stat:perms f) (vector-ref f 14))
 
+(define (statvfs:bsize f) (vector-ref f 0))
+(define (statvfs:frsize f) (vector-ref f 1))
+(define (statvfs:blocks f) (vector-ref f 2))
+(define (statvfs:bfree f) (vector-ref f 3))
+(define (statvfs:bavail f) (vector-ref f 4))
+(define (statvfs:files f) (vector-ref f 5))
+(define (statvfs:ffree f) (vector-ref f 6))
+(define (statvfs:favail f) (vector-ref f 7))
+(define (statvfs:fsid f) (vector-ref f 8))
+(define (statvfs:flag f) (vector-ref f 9))
+(define (statvfs:namemax f) (vector-ref f 10))
+
 (define (passwd:name obj) (vector-ref obj 0))
 (define (passwd:passwd obj) (vector-ref obj 1))
 (define (passwd:uid obj) (vector-ref obj 2))
diff --git a/test-suite/tests/posix.test b/test-suite/tests/posix.test
index 18dad8902..cbf0f925b 100644
--- a/test-suite/tests/posix.test
+++ b/test-suite/tests/posix.test
@@ -498,3 +498,51 @@
                ;; or not is system-defined, so it's possible it just works.
                (string? (crypt "pass" "$X$abc")))
              (lambda _ #t)))))
+
+;;
+;; statvfs
+;;
+
+(with-test-prefix "statvfs"
+
+  (pass-if "file system has free space"
+    (if (not (defined? 'statvfs))
+        (throw 'unsupported)
+        (let ((vfs (statvfs (getcwd))))
+          (> (statvfs:blocks vfs) (statvfs:bfree vfs)))))
+
+  (pass-if "test directory is writeable"
+    (if (not (defined? 'statvfs))
+        (throw 'unsupported)
+        (let ((vfs (statvfs (getcwd))))
+          (zero? (logand (statvfs:flag vfs) ST_RDONLY)))))
+
+  (pass-if "file name, port, and fd are equal"
+    (if (not (defined? 'statvfs))
+        (throw 'unsupported)
+        (if (file-exists? "/proc/self/fd")   ;Linux
+            (let* ((file "/dev/null")
+                   (port (open-output-file file))
+                   (fd (fileno port))
+                   (stat-file (statvfs file))
+                   (stat-port (statvfs port))
+                   (stat-fd (statvfs fd)))
+              (close-port port)
+              (equal? stat-file stat-port stat-fd))
+            (throw 'unsupported))))
+
+  (pass-if-equal "file not found, exception"
+      ENOENT
+    (if (not (defined? 'statvfs))
+        (throw 'unsupported)
+        (catch 'system-error
+          (lambda ()
+            (statvfs "i-dont-exist"))
+          (lambda args
+            (system-error-errno args)))))
+
+  (pass-if-equal "file not found, no exception"
+      #f
+    (if (not (defined? 'statvfs))
+        (throw 'unsupported)
+        (statvfs "its-gone" #f))))
-- 
2.39.1

Re: [PATCH] Add statvfs bindings.

[Maxime Devos]

[-- Attachment #1.1.1: Type: text/plain, Size: 2861 bytes --]

Op 06-07-2023 om 08:17 schreef Marius Bakke:
> * libguile/filesys.c (scm_statvfs2scm): New function.
> (scm_statvfs): New procedure.
> * libguile/filesys.h: Add scm_statvfs.
> * libguile/syscalls.h (fstatvfs_or_fstatvfs64, statvfs_or_statvfs64,
> scm_from_fsblkcnt_t_or_fsblkcnt64_t,
> scm_from_fsfilcnt_t_or_fsfilcnt64_t): New macros.
> * module/ice-9/posix.scm (statvfs:block-size, statvfs:fragment-size,
> statvfs:blocks, statvfs:blocks-free, statvfs:block-available,
> statvfs:files, statvfs:files-free, statvfs:files-available,
> statvfs:fsid, statvfs:flags, statvfs:name-max): New variables.
> * libguile/posix.c (scm_init_posix): Add ST_MANDLOCK, ST_NOATIME,
> ST_NODEV, ST_NODIRATIME, ST_NOEXEC, ST_NOSUID, ST_RDONLY, ST_RELATIME,
> ST_SYNCHRONOUS constants.
> * doc/ref/posix.texi (File System): Document statvfs.
> * test-suite/tests/posix.test ("statvfs"): New tests.
> ---
>   doc/ref/posix.texi          |  50 +++++++++++++++++
>   libguile/filesys.c          | 109 ++++++++++++++++++++++++++++++++++++
>   libguile/filesys.h          |   1 +
>   libguile/posix.c            |  29 ++++++++++
>   libguile/syscalls.h         |   4 ++
>   module/ice-9/posix.scm      |  12 ++++
>   test-suite/tests/posix.test |  39 +++++++++++++
>   7 files changed, 244 insertions(+)
> ---
> Hello Guile,
> 
> This patch adds bindings for statvfs(3).  The API is similar to that of `stat`.
> It can be used to implement e.g. `df` in Guile.
> 
> I added "long names" for the various getters, instead of following the "POSIX
> identifiers" (block-size instead of bsize, etc).  That may not have been a wise
> decision.  Feedback wanted!

Maybe it's POSIX, but I would use AC_CHECK_FUNCS for this instead of the 
'#ifdef POSIX' anyways -- e.g. in case some new OS wants to mostly 
implement POSIX but isn't all the way there yet.

The long names seem fine to me -- I see no reason to limit ourselves to 
the suboptimal naming choices of POSIX.  And if someone really likes the 
short and less clear names, they could just rename it with a simple 
'define'.

 > +static SCM
 > +scm_statvfs2scm (struct statvfs_or_statvfs64 *statvfs_temp)
 > +{
 > +  SCM ans = scm_c_make_vector (11, SCM_UNSPECIFIED);

This is an ad-hoc record type, you could use define-record-type instead 
which exists for exactly this kind of thing.

For this ad-hoc thing, there's precedent for that with 'scm_stat', but 
IMO it's not good precedent, and in case of scm_stat no reason at all 
appears is given for why not use a record type.

As I understand it, the record type would be defined in posix.scm, and 
the C code would access the constructor with (the C equivalent of) a 
'module-ref', or by the method used in libguile/goops.c.

I haven't really looked at the documentation or implementation.

Best regards,
Maxime Devos

[-- Attachment #1.1.2: OpenPGP public key --]
[-- Type: application/pgp-keys, Size: 929 bytes --]

[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 236 bytes --]