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 08/14] =?UTF-8?q?Define=20a=20Scheme=20binding=20to=20?= =?UTF-8?q?=E2=80=98renameat=E2=80=99=20when=20it=20exists.?= Date: Tue, 16 Nov 2021 11:06:31 +0000 Message-ID: <20211116110637.125579-9-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="3480"; 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:19:24 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 1mmwUm-0000hV-3A for guile-devel@m.gmane-mx.org; Tue, 16 Nov 2021 12:19:24 +0100 Original-Received: from localhost ([::1]:55086 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1mmwUk-0003lZ-Tc for guile-devel@m.gmane-mx.org; Tue, 16 Nov 2021 06:19:22 -0500 Original-Received: from eggs.gnu.org ([209.51.188.92]:34312) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1mmwRK-0006va-S8 for guile-devel@gnu.org; Tue, 16 Nov 2021 06:15:50 -0500 Original-Received: from [2a02:1800:110:4::f00:d] (port=51822 helo=leibniz.telenet-ops.be) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1mmwRH-0006W5-RF for guile-devel@gnu.org; Tue, 16 Nov 2021 06:15:50 -0500 Original-Received: from baptiste.telenet-ops.be (baptiste.telenet-ops.be [IPv6:2a02:1800:120:4::f00:13]) by leibniz.telenet-ops.be (Postfix) with ESMTPS id 4Htjtg5Y9czMrHtV 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 Jz6j2600Q4UW6Th01z6qJ9; 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=Ue3T4mvRh03X3MatD6R6UjZFsBCZHIdqIhMY1pyWIRI=; h=From:To:Cc:Subject:Date:In-Reply-To:References; b=S/s5GmJe7Dy4wpNUH0S7z9mnerBdM3oew4Lg0FyPYM9ZS2VqRUWb1swjip91/BIRT 4/x72HLpBOltTgmKlXvBq6U3UWgLmTxV+C1G0EOO3XV8qtrNM2ZDQPTSXwnVKjKdoR pgfW4UNgfdvUosOg8d0XQRl81kj3gAvf+0MrxeITafuDpbmA+fPN9NDSdQ1xfXA5Zf wKApCCR3f1JDx+MQxx/fLnconQheOYy+edliEufHSzKnkNKQNv9kzhTS2EfHGzCdre 5Gt+NMw9k6Vfiq/9Fiv4KHZUOMwlryYzmt5uXpyDi868nh9simE7AQaZfY6N6WQJmj BiGF710br+V6w== X-Host-Lookup-Failed: Reverse DNS lookup failed for 2a02:1800:110:4::f00:d (failed) Received-SPF: pass client-ip=2a02:1800:110:4::f00:d; envelope-from=maximedevos@telenet.be; helo=leibniz.telenet-ops.be X-Spam_score_int: -12 X-Spam_score: -1.3 X-Spam_bar: - X-Spam_report: (-1.3 / 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, RDNS_NONE=0.793, SPF_HELO_NONE=0.001, SPF_PASS=-0.001 autolearn=no 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:20950 Archived-At: * configure.ac: Detect if ‘renameat’ is defined. * libguile/filesys.c (scm_renameat): Define a Scheme binding to the ‘renameat’ system call. * doc/ref/posix.texi (File System): Document it. * libguile/filesys.h (scm_renameat): Make it part of the C API. * test-suite/tests/filesys.test ("rename-file-at"): New tests. --- configure.ac | 2 +- doc/ref/posix.texi | 9 +++ libguile/filesys.c | 34 +++++++++++ libguile/filesys.h | 1 + test-suite/tests/filesys.test | 104 ++++++++++++++++++++++++++++++++++ 5 files changed, 149 insertions(+), 1 deletion(-) diff --git a/configure.ac b/configure.ac index da8dfadd0..e67892feb 100644 --- a/configure.ac +++ b/configure.ac @@ -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 getcwd geteuid getsid \ + 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/doc/ref/posix.texi b/doc/ref/posix.texi index 7f136376b..ebb001581 100644 --- a/doc/ref/posix.texi +++ b/doc/ref/posix.texi @@ -877,6 +877,15 @@ Renames the file specified by @var{oldname} to @var{newname}. The return value is unspecified. @end deffn +@findex renameat +@deffn {Scheme Procedure} rename-file-at olddir oldname newdir newname +@deffnx {C Function} scm_renameat (olddir, oldname, newdir, newname) +Like @code{rename-file}, but when @var{olddir} or @var{newdir} is true, +resolve @var{oldname} or @var{newname} relative to the directory +specified by the file port @var{olddir} or @var{newdir} instead of the +current working directory. +@end deffn + @deffn {Scheme Procedure} link oldpath newpath @deffnx {C Function} scm_link (oldpath, newpath) Creates a new name @var{newpath} in the file system for the diff --git a/libguile/filesys.c b/libguile/filesys.c index ee01b2e2c..9c63beaa8 100644 --- a/libguile/filesys.c +++ b/libguile/filesys.c @@ -1421,6 +1421,40 @@ SCM_DEFINE (scm_rename, "rename-file", 2, 0, 0, } #undef FUNC_NAME +#ifdef HAVE_RENAMEAT +SCM_DEFINE (scm_renameat, "rename-file-at", 4, 0, 0, + (SCM olddir, SCM oldname, SCM newdir, SCM newname), + "Like @code{rename-file}, but when @var{olddir} or @var{newdir}\n" + "is true, resolve @var{oldname} or @var{newname} relative to\n" + "the directory specified by file port @var{olddir} or\n" + "@var{newdir} instead of the current working directory.") +#define FUNC_NAME s_scm_renameat +{ + int rv; + int old_fdes, new_fdes; + + old_fdes = AT_FDCWD; + new_fdes = AT_FDCWD; + + if (scm_is_true (olddir)) { + SCM_VALIDATE_OPFPORT (SCM_ARG1, olddir); + old_fdes = SCM_FPORT_FDES (olddir); + } + if (scm_is_true (newdir)) { + SCM_VALIDATE_OPFPORT (SCM_ARG3, newdir); + new_fdes = SCM_FPORT_FDES (newdir); + } + + STRING2_SYSCALL (oldname, c_oldname, + newname, c_newname, + rv = renameat (old_fdes, c_oldname, new_fdes, c_newname)); + scm_remember_upto_here_2 (olddir, newdir); + if (rv != 0) + SCM_SYSERROR; + return SCM_UNSPECIFIED; +} +#undef FUNC_NAME +#endif SCM_DEFINE (scm_delete_file, "delete-file", 1, 0, 0, (SCM str), diff --git a/libguile/filesys.h b/libguile/filesys.h index f0dd35ede..7e17cc585 100644 --- a/libguile/filesys.h +++ b/libguile/filesys.h @@ -48,6 +48,7 @@ SCM_API SCM scm_close_fdes (SCM fd); SCM_API SCM scm_stat (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); SCM_API SCM scm_delete_file (SCM str); SCM_API SCM scm_mkdir (SCM path, SCM mode); SCM_API SCM scm_mkdirat (SCM dir, SCM path, SCM mode); diff --git a/test-suite/tests/filesys.test b/test-suite/tests/filesys.test index 4ea62d513..bbce2c858 100644 --- a/test-suite/tests/filesys.test +++ b/test-suite/tests/filesys.test @@ -31,6 +31,8 @@ (data-file-name "filesys-test-link.tmp")) (define (test-directory) (data-file-name "filesys-test-dir.tmp")) +(define (test-directory2) + (data-file-name "filesys-test-dir2.tmp")) ;;; @@ -432,3 +434,105 @@ (mkdirat port (test-directory)) (stat:perms (stat (test-directory)))))) (maybe-delete-directory)) + +(with-test-prefix "rename-file-at" + (define (skip-if-unsupported) + (unless (defined? 'rename-file-at) + (throw 'unsupported))) + (pass-if-equal "current working directory" '(#f "hello") + (skip-if-unsupported) + ;; Create a file in the test directory + (call-with-output-file "filesys-test-a.tmp" + (lambda (port) (display "hello" port))) + ;; Try to rename it + (rename-file-at #f "filesys-test-a.tmp" #f "filesys-test-b.tmp") + ;; Verify it exists under the new name, and not under the old name + (list (file-exists? "filesys-test-a.tmp") + (call-with-input-file "filesys-test-b.tmp" get-string-all))) + + (false-if-exception (delete-file "filesys-test-a.tmp")) + (false-if-exception (delete-file "filesys-test-b.tmp")) + + (pass-if-equal "two ports" '(#f "hello") + (skip-if-unsupported) + (mkdir (test-directory)) + (mkdir (test-directory2)) + ;; Create a file in the first directory + (call-with-output-file (in-vicinity (test-directory) "a") + (lambda (port) (display "hello" port))) + (let ((port1 (open (test-directory) O_RDONLY)) + (port2 (open (test-directory2) O_RDONLY))) + ;; Try to rename it + (rename-file-at port1 "a" port2 "b") + (close-port port1) + (close-port port2) + ;; Verify it exists under the new name, and not under the old name + (list (file-exists? (in-vicinity (test-directory) "a")) + (call-with-input-file (in-vicinity (test-directory2) "b") + get-string-all)))) + (false-if-exception (delete-file (in-vicinity (test-directory) "a"))) + (false-if-exception (delete-file (in-vicinity (test-directory2) "b"))) + (false-if-exception (rmdir (test-directory))) + (false-if-exception (rmdir (test-directory2))) + + (pass-if-equal "port and current working directory" '(#f "hello") + (skip-if-unsupported) + (mkdir (test-directory)) + ;; Create a file in (test-directory) + (call-with-output-file (in-vicinity (test-directory) "a") + (lambda (port) (display "hello" port))) + (let ((port (open (test-directory) O_RDONLY))) + ;; Try to rename it + (rename-file-at port "a" #f (basename (test-file))) + (close-port port) + ;; Verify it exists under the new name, and not under the old name. + (list (file-exists? (in-vicinity (test-directory) "a")) + (call-with-input-file (test-file) get-string-all)))) + (false-if-exception (delete-file (in-vicinity (test-directory) "a"))) + (false-if-exception (rmdir (test-directory))) + (false-if-exception (delete-file (test-file))) + + (pass-if-equal "current working directory and port" '(#f "hello") + (skip-if-unsupported) + (mkdir (test-directory)) + ;; Create a file in the working directory + (call-with-output-file (test-file) + (lambda (port) (display "hello" port))) + (let ((port (open (test-directory) O_RDONLY))) + ;; Try to rename it + (rename-file-at #f (basename (test-file)) port "b") + (close-port port) + ;; Verify it exists under the new name, and not under the old name. + (list (file-exists? (test-file)) + (call-with-input-file (in-vicinity (test-directory) "b") + get-string-all)))) + + (false-if-exception (delete-file (in-vicinity (test-directory) "b"))) + (false-if-exception (delete-file (test-file))) + (false-if-exception (rmdir (test-directory))) + + (pass-if-exception "not a file port (1)" exception:wrong-type-arg + (skip-if-unsupported) + (rename-file-at (open-input-string "") "some" #f "thing")) + + (pass-if-exception "not a file port (2)" exception:wrong-type-arg + (skip-if-unsupported) + (rename-file-at #f "some" (open-input-string "") "thing")) + + (pass-if-exception "closed port (1)" exception:wrong-type-arg + (skip-if-unsupported) + (rename-file-at (call-with-port (open "." O_RDONLY) identity) + "some" #f "thing")) + + (pass-if-exception "closed port (2)" exception:wrong-type-arg + (skip-if-unsupported) + (rename-file-at #f "some" (call-with-port (open "." O_RDONLY) identity) + "thing")) + + (pass-if-exception "not a string (1)" exception:wrong-type-arg + (skip-if-unsupported) + (rename-file-at #f 'what #f "thing")) + + (pass-if-exception "not a string (2)" exception:wrong-type-arg + (skip-if-unsupported) + (rename-file-at #f "some" #f 'what))) -- 2.30.2