From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Marius Bakke Newsgroups: gmane.lisp.guile.devel Subject: [PATCH] Add statvfs bindings. Date: Thu, 6 Jul 2023 14:17:43 +0800 Message-ID: <20230706061743.14026-1-marius@gnu.org> Mime-Version: 1.0 Content-Transfer-Encoding: 8bit Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="8615"; mail-complaints-to="usenet@ciao.gmane.io" To: guile-devel@gnu.org Original-X-From: guile-devel-bounces+guile-devel=m.gmane-mx.org@gnu.org Thu Jul 06 08:18:37 2023 Return-path: Envelope-to: guile-devel@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1qHIK5-00025a-Jt for guile-devel@m.gmane-mx.org; Thu, 06 Jul 2023 08:18:37 +0200 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1qHIJj-0001j5-AM; Thu, 06 Jul 2023 02:18:15 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1qHIJL-0001fC-FZ for guile-devel@gnu.org; Thu, 06 Jul 2023 02:17:52 -0400 Original-Received: from fencepost.gnu.org ([2001:470:142:3::e]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1qHIJJ-0001VE-Md for guile-devel@gnu.org; Thu, 06 Jul 2023 02:17:50 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:Date:Subject:To:From:in-reply-to: references; bh=ElPMC6U/SQvcj27Ra66HSCkt2X72oTFYPUtTGqgyrcs=; b=GlV4GVotLxLhkh 7Z638aejQE1AG1XFDKz144PaAN1aKEPvWly7xbgzdBw4Pqf4VvsQfQYLBQ0i2uQXbLwl+htiqVz+Y ZiUSpChGDtSWVjVsMinH+K38dcWnyovRdMKYK4DZmEl0sLuBlGrNy/z00RVkWKfHlcXMHWDzea9n4 9Wv2tZT2ZZnveg3FeKRSqdKwydEB2Kw7odKsY2Edtz+M0YqOT8v7m2A5XenFSKy3vsnCTBnhR5YBx HONgvoL6iS8olP88T/Y0d7x9pOTTtqLP1pvZvo9+6a4piVQMrviwFPnSE3uFgtRda0CmBwYxBkFyl dWDscBOsCId5tfc9332w==; Original-Received: from [101.128.96.217] (helo=localhost) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1qHIJG-0007WT-Ts for guile-devel@gnu.org; Thu, 06 Jul 2023 02:17:48 -0400 X-Mailer: git-send-email 2.39.1 X-BeenThere: guile-devel@gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: "Developers list for Guile, the GNU extensibility library" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guile-devel-bounces+guile-devel=m.gmane-mx.org@gnu.org Original-Sender: guile-devel-bounces+guile-devel=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.lisp.guile.devel:21891 Archived-At: * 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 #include #include +#include #include #include #include @@ -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 #include #include +#include #include #include #include @@ -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