From: Marius Bakke <marius@gnu.org>
To: guile-devel@gnu.org
Subject: [PATCH] Add statvfs bindings.
Date: Thu, 6 Jul 2023 14:17:43 +0800 [thread overview]
Message-ID: <20230706061743.14026-1-marius@gnu.org> (raw)
* 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
next reply other threads:[~2023-07-06 6:17 UTC|newest]
Thread overview: 3+ messages / expand[flat|nested] mbox.gz Atom feed top
2023-07-06 6:17 Marius Bakke [this message]
2023-07-08 4:19 ` [PATCH v2] Add statvfs bindings Marius Bakke
2023-07-09 21:36 ` [PATCH] " Maxime Devos
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://www.gnu.org/software/guile/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20230706061743.14026-1-marius@gnu.org \
--to=marius@gnu.org \
--cc=guile-devel@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.
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).