From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Maxime Devos Newsgroups: gmane.lisp.guile.devel Subject: [PATCH v2 09/14] =?UTF-8?q?Define=20a=20Scheme=20binding=20to=20?= =?UTF-8?q?=E2=80=98fchmodat=E2=80=99=20when=20it=20exists.?= Date: Tue, 16 Nov 2021 11:06:32 +0000 Message-ID: <20211116110637.125579-10-maximedevos@telenet.be> References: <175c3a6572e832d84927937b309a3095cadf5702.camel@telenet.be> <20211116110637.125579-1-maximedevos@telenet.be> Mime-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="19905"; mail-complaints-to="usenet@ciao.gmane.io" Cc: Maxime Devos To: guile-devel@gnu.org Original-X-From: guile-devel-bounces+guile-devel=m.gmane-mx.org@gnu.org Tue Nov 16 12:14:48 2021 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 1mmwQK-00051m-1L for guile-devel@m.gmane-mx.org; Tue, 16 Nov 2021 12:14:48 +0100 Original-Received: from localhost ([::1]:44792 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1mmwQI-0005BR-VG for guile-devel@m.gmane-mx.org; Tue, 16 Nov 2021 06:14:46 -0500 Original-Received: from eggs.gnu.org ([209.51.188.92]:33652) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1mmwOr-0003tC-2X for guile-devel@gnu.org; Tue, 16 Nov 2021 06:13:17 -0500 Original-Received: from newton.telenet-ops.be ([195.130.132.45]:59650) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1mmwOl-0005yr-QV for guile-devel@gnu.org; Tue, 16 Nov 2021 06:13:16 -0500 Original-Received: from baptiste.telenet-ops.be (baptiste.telenet-ops.be [IPv6:2a02:1800:120:4::f00:13]) by newton.telenet-ops.be (Postfix) with ESMTPS id 4Htjtg6gkwzMvwBR for ; Tue, 16 Nov 2021 12:06:51 +0100 (CET) Original-Received: from localhost.localdomain ([IPv6:2a02:1811:8c09:9d00:3c5f:2eff:feb0:ba5a]) by baptiste.telenet-ops.be with bizsmtp id Jz6j2600Q4UW6Th01z6qJB; Tue, 16 Nov 2021 12:06:50 +0100 X-Mailer: git-send-email 2.30.2 In-Reply-To: <20211116110637.125579-1-maximedevos@telenet.be> DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=telenet.be; s=r21; t=1637060810; bh=7BWrNgGoLG+6In5ugF8EMFuuSzEW6gURBUC7EcjTCDE=; h=From:To:Cc:Subject:Date:In-Reply-To:References; b=m1cy9Mzpm8uazcGobfbxbA2X4ooiQ4EBz6+sIeR0+yuwFPkGoCp4PIZ+5OK0NpB3T BWn9ra8GMFOMe5UXygh8On0mMTQ8BIjb694tr2bypeMOQ/pXOC+6GftUgpbtOGGPGZ iDFhJW6eRmKpyBGvTsHUAaSHD5RZM08IhrpJx5uaZ2EYZFMBGbyQpSC/3BREWR6pWY eLh75WPZKJputM+O5B43b9Hj+XiJZ7IwC6DVJrzpMlYrKdzja+k514VtQym0JnFMv0 /Iv9Jj6k+MUneZzLvozvZXLDPbsi1xrMmJIVuSHvMWOX4UGsgwIe0vQ9yGy7UL/ytg Qb7WjEIvydkvg== Received-SPF: pass client-ip=195.130.132.45; envelope-from=maximedevos@telenet.be; helo=newton.telenet-ops.be X-Spam_score_int: -27 X-Spam_score: -2.8 X-Spam_bar: -- X-Spam_report: (-2.8 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, FREEMAIL_FROM=0.001, RCVD_IN_DNSWL_LOW=-0.7, RCVD_IN_MSPIKE_H2=-0.001, SPF_HELO_NONE=0.001, SPF_PASS=-0.001 autolearn=ham autolearn_force=no X-Spam_action: no action 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" Xref: news.gmane.io gmane.lisp.guile.devel:20941 Archived-At: * 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