[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[PATCH v2 09/14] Define a Scheme binding to ‘fchmodat’ when it exists.
From: |
Maxime Devos |
Subject: |
[PATCH v2 09/14] Define a Scheme binding to ‘fchmodat’ when it exists. |
Date: |
Tue, 16 Nov 2021 11:06:32 +0000 |
* configure.ac: Detect existence of fchmodat.
* libguile/filesys.c (scm_chmodat): New procedure.
* libguile/filesys.h (scm_chmodat): Make it part of the API.
* test-suite/tests/filesys.test ("chmodat"): Test it.
---
configure.ac | 4 +--
libguile/filesys.c | 36 ++++++++++++++++++++++++
libguile/filesys.h | 1 +
test-suite/tests/filesys.test | 53 +++++++++++++++++++++++++++++++++++
4 files changed, 92 insertions(+), 2 deletions(-)
diff --git a/configure.ac b/configure.ac
index e67892feb..2a5485990 100644
--- a/configure.ac
+++ b/configure.ac
@@ -477,7 +477,7 @@ AC_CHECK_HEADERS([assert.h crt_externs.h])
# truncate - not in mingw
# isblank - available as a GNU extension or in C99
# _NSGetEnviron - Darwin specific
-# strcoll_l, newlocale, uselocale, utimensat, futimens - POSIX.1-2008
+# strcoll_l, newlocale, uselocale, utimensat, futimens, fchmodat -
POSIX.1-2008
# strtol_l - non-POSIX, found in glibc
# fork - unavailable on Windows
# sched_getaffinity, sched_setaffinity - GNU extensions (glibc)
@@ -485,7 +485,7 @@ AC_CHECK_HEADERS([assert.h crt_externs.h])
#
AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid \
fesetround ftime ftruncate fchown fchmod fchdir readlinkat \
- symlinkat mkdirat renameat getcwd geteuid getsid
\
+ fchmodat symlinkat mkdirat renameat getcwd geteuid getsid \
gettimeofday getuid getgid gmtime_r ioctl lstat mkdir mkdtemp mknod \
nice readlink rename rmdir setegid seteuid \
setlocale setuid setgid setpgid setsid sigaction siginterrupt stat64 \
diff --git a/libguile/filesys.c b/libguile/filesys.c
index 9c63beaa8..4dd9c7b48 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -1561,6 +1561,42 @@ SCM_DEFINE (scm_chmod, "chmod", 2, 0, 0,
}
#undef FUNC_NAME
+#ifdef HAVE_FCHMODAT
+SCM_DEFINE (scm_chmodat, "chmodat", 3, 1, 0,
+ (SCM dir, SCM pathname, SCM mode, SCM flags),
+ "Like @var{chmod}, but modify the permissions of the file named\n"
+ "@var{pathname} in the directory referred to by the file port\n"
+ "@var{dir} instead.\n"
+ "The optional @var{flags} argument may be 0 or
@code{AT_SYMLINK_NOFOLLOW},\n"
+ "in which case @var{pathname} is not dereferenced if it is a
symbolic link,\n"
+ "i.e., the permissions of the symbolic link itself are
modified.\n\n"
+ "Note that @code{AT_SYMLINK_NOFOLLOW} is not supported on all
systems\n"
+ "and may result in @code{ENOTSUP}.")
+#define FUNC_NAME s_scm_chmodat
+{
+ int rv;
+ int c_flags;
+ int dir_fdes;
+
+ if (SCM_UNBNDP (flags))
+ c_flags = 0;
+ else
+ c_flags = scm_to_int (flags);
+
+ SCM_VALIDATE_OPFPORT (SCM_ARG1, dir);
+ dir_fdes = SCM_FPORT_FDES (dir);
+
+ STRING_SYSCALL (pathname, c_pathname,
+ rv = fchmodat (dir_fdes, c_pathname,
+ scm_to_int (mode), c_flags));
+ scm_remember_upto_here_1 (dir);
+ if (rv == -1)
+ SCM_SYSERROR;
+ return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+#endif
+
SCM_DEFINE (scm_umask, "umask", 0, 1, 0,
(SCM mode),
"If @var{mode} is omitted, returns a decimal number representing
the current\n"
diff --git a/libguile/filesys.h b/libguile/filesys.h
index 7e17cc585..377a3795e 100644
--- a/libguile/filesys.h
+++ b/libguile/filesys.h
@@ -40,6 +40,7 @@ SCM_API scm_t_bits scm_tc16_dir;
SCM_API SCM scm_chown (SCM object, SCM owner, SCM group);
SCM_API SCM scm_chmod (SCM object, SCM mode);
+SCM_API SCM scm_chmodat (SCM dir, SCM pathname, SCM mode, SCM flags);
SCM_API SCM scm_umask (SCM mode);
SCM_API SCM scm_open_fdes (SCM path, SCM flags, SCM mode);
SCM_API SCM scm_open (SCM path, SCM flags, SCM mode);
diff --git a/test-suite/tests/filesys.test b/test-suite/tests/filesys.test
index bbce2c858..204f3414c 100644
--- a/test-suite/tests/filesys.test
+++ b/test-suite/tests/filesys.test
@@ -271,6 +271,59 @@
(false-if-exception (rmdir name))
result)))))
+;;;
+;;; chmodat
+;;;
+
+(with-test-prefix "chmodat"
+ (call-with-output-file (test-file) (const #f))
+ (chmod (test-file) #o000)
+
+ (pass-if-equal "regular file"
+ #o300
+ (unless (defined? 'chmodat)
+ (throw 'unsupported))
+ (call-with-port
+ (open (dirname (test-file)) O_RDONLY)
+ (lambda (port)
+ (chmodat port (test-file) #o300)))
+ (stat:perms (stat (test-file))))
+
+ (chmod (test-file) #o000)
+
+ (pass-if-equal "regular file, AT_SYMLINK_NOFOLLOW"
+ #o300
+ (unless (and (defined? 'chmodat)
+ (defined? 'AT_SYMLINK_NOFOLLOW))
+ (throw 'unsupported))
+ (call-with-port
+ (open (dirname (test-file)) O_RDONLY)
+ (lambda (port)
+ (catch 'system-error
+ (lambda ()
+ (chmodat port (basename (test-file)) #o300 AT_SYMLINK_NOFOLLOW))
+ (lambda args
+ (close-port port)
+ ;; AT_SYMLINK_NOFOLLOW is not supported on Linux (at least Linux
+ ;; 5.11.2 with the btrfs file system), even for regular files.
+ (if (= ENOTSUP (system-error-errno args))
+ (begin
+ (display "fchmodat doesn't support AT_SYMLINK_NOFOLLOW\n")
+ (throw 'unresolved))
+ (apply throw args))))))
+ (stat:perms (stat (test-file))))
+
+ (pass-if-exception "not a port" exception:wrong-type-arg
+ (chmodat "bogus" (test-file) #o300))
+
+ (pass-if-exception "not a file port" exception:wrong-type-arg
+ (chmodat (open-input-string "") (test-file) #o300))
+
+ (pass-if-exception "closed port" exception:wrong-type-arg
+ (chmodat (call-with-port (open "." O_RDONLY) identity) (test-file) #o300))
+
+ (delete-file (test-file)))
+
(with-test-prefix "chdir"
(pass-if-equal "current directory" (getcwd)
(begin (chdir ".") (getcwd)))
--
2.30.2
- [PATCH v2 00/14] Bindings to *at functions, Maxime Devos, 2021/11/16
- [PATCH v2 02/14] Allow file ports in ‘readlink’., Maxime Devos, 2021/11/16
- [PATCH v2 09/14] Define a Scheme binding to ‘fchmodat’ when it exists.,
Maxime Devos <=
- [PATCH v2 11/14] Define a Scheme binding to ‘fchownat’ when it exists., Maxime Devos, 2021/11/16
- [PATCH v2 04/14] Define ‘symlinkat’ wrapper when supported., Maxime Devos, 2021/11/16
- [PATCH v2 10/14] Define a Scheme binding to ‘unlinkat’ when it exists., Maxime Devos, 2021/11/16
- [PATCH v2 06/14] Correct documentation of ‘mkdir’ w.r.t. the umask., Maxime Devos, 2021/11/16
- [PATCH v2 07/14] Define AT_REMOVEDIR and others when available., Maxime Devos, 2021/11/16
- [PATCH v2 05/14] Define bindings to ‘mkdirat’ when the C function exists., Maxime Devos, 2021/11/16
- [PATCH v2 03/14] Allow file ports in ‘utime’., Maxime Devos, 2021/11/16
- [PATCH v2 08/14] Define a Scheme binding to ‘renameat’ when it exists., Maxime Devos, 2021/11/16
- [PATCH v2 14/14] Update NEWS., Maxime Devos, 2021/11/16