guile-devel
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[PATCH] Add statvfs bindings.


From: Marius Bakke
Subject: [PATCH] Add statvfs bindings.
Date: Thu, 6 Jul 2023 14:17:43 +0800

* 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,
 
 #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




reply via email to

[Prev in Thread] Current Thread [Next in Thread]