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 05/14] =?UTF-8?q?Define=20bindings=20to=20=E2=80=98mkdi?= =?UTF-8?q?rat=E2=80=99=20when=20the=20C=20function=20exists.?= Date: Tue, 16 Nov 2021 11:06:28 +0000 Message-ID: <20211116110637.125579-6-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="744"; 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:18:54 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 1mmwUH-000AY4-Sd for guile-devel@m.gmane-mx.org; Tue, 16 Nov 2021 12:18:54 +0100 Original-Received: from localhost ([::1]:54286 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1mmwUG-0003F1-Vx for guile-devel@m.gmane-mx.org; Tue, 16 Nov 2021 06:18:53 -0500 Original-Received: from eggs.gnu.org ([209.51.188.92]:34298) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1mmwRK-0006uN-GG for guile-devel@gnu.org; Tue, 16 Nov 2021 06:15:50 -0500 Original-Received: from [2a02:1800:110:4::f00:d] (port=51818 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-0006W3-DV 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 4Htjtg5FRQzMrHtH 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 Jz6j2600Q4UW6Th01z6qJ1; 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=8HN0Cr50AKGPcAPMaC72V8HeD4MPdgjsuw6yKSCNL10=; h=From:To:Cc:Subject:Date:In-Reply-To:References; b=WJn1wni5FHB7+ZcghkcVUqi0G8hKvaCXCG2eKTJxA532PIn3x52CyIjC/TBbtieRe xVlzeD57Mdt/6aDWdxNtfN5czV0bk5F7CHab8hqikt5k0LcmMQgIqlONbGs4NzsONv jpzUQJa5pHwsbpsvd+MD0DWY+WcqI029Kh3IUF9Yaq9ulkKQa8NnIEOZ2v9/RV6pHv i25WyPdlitgnrXmb3O0cthWk6XU8d349Njl5qvaGIXh2yc55taiDn4hHDGdW8LcFl9 p5okuO10Msc3EeSkLRi+RfCussse0OWFQUxxD62C8ca6wBrvVflIALg0JsO1bMTUYu q5HUpz5lTTcnw== 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:20949 Archived-At: * configure.ac: Detect if ‘mkdirat’ exists. * libguile/filesys.c (scm_mkdirat): Define the Scheme binding. * doc/ref/posix.texi (File System): Document it. --- configure.ac | 2 +- doc/ref/posix.texi | 6 ++++++ libguile/filesys.c | 25 +++++++++++++++++++++++ libguile/filesys.h | 1 + test-suite/tests/filesys.test | 38 +++++++++++++++++++++++++++++++++++ 5 files changed, 71 insertions(+), 1 deletion(-) diff --git a/configure.ac b/configure.ac index b2e9ef3e9..da8dfadd0 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 getcwd geteuid getsid \ + symlinkat mkdirat 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 a329eec39..d261ac8da 100644 --- a/doc/ref/posix.texi +++ b/doc/ref/posix.texi @@ -906,6 +906,12 @@ Otherwise they are set to the value specified with @var{mode}. The return value is unspecified. @end deffn +@deffn {Scheme Procedure} mkdirat dir path [mode] +@deffnx {C Function} scm_mkdirat (dir, path, mode) +Like @code{mkdir}, but resolve @var{path} relative to the directory +referred to by the file port @var{dir} instead. +@end deffn + @deffn {Scheme Procedure} rmdir path @deffnx {C Function} scm_rmdir (path) Remove the existing directory named by @var{path}. The directory must diff --git a/libguile/filesys.c b/libguile/filesys.c index bfd223434..ee01b2e2c 100644 --- a/libguile/filesys.c +++ b/libguile/filesys.c @@ -1364,6 +1364,31 @@ SCM_DEFINE (scm_mkdir, "mkdir", 1, 1, 0, } #undef FUNC_NAME +#ifdef HAVE_MKDIRAT +SCM_DEFINE (scm_mkdirat, "mkdirat", 2, 1, 0, + (SCM dir, SCM path, SCM mode), + "Like @code{mkdir}, but resolve @var{path} relative to the directory\n" + "referred to by the file port @var{dir} instead.") +#define FUNC_NAME s_scm_mkdirat +{ + int rv; + int dir_fdes; + mode_t c_mode; + + c_mode = SCM_UNBNDP (mode) ? 0777 : scm_to_uint (mode); + SCM_VALIDATE_OPFPORT (SCM_ARG1, dir); + dir_fdes = SCM_FPORT_FDES (dir); + + STRING_SYSCALL (path, c_path, rv = mkdirat (dir_fdes, c_path, c_mode)); + if (rv != 0) + SCM_SYSERROR; + + scm_remember_upto_here_1 (dir); + return SCM_UNSPECIFIED; +} +#undef FUNC_NAME +#endif + SCM_DEFINE (scm_rmdir, "rmdir", 1, 0, 0, (SCM path), "Remove the existing directory named by @var{path}. The directory must\n" diff --git a/libguile/filesys.h b/libguile/filesys.h index d181aca52..f0dd35ede 100644 --- a/libguile/filesys.h +++ b/libguile/filesys.h @@ -50,6 +50,7 @@ SCM_API SCM scm_link (SCM oldpath, SCM newpath); SCM_API SCM scm_rename (SCM oldname, 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); SCM_API SCM scm_rmdir (SCM path); SCM_API SCM scm_directory_stream_p (SCM obj); SCM_API SCM scm_opendir (SCM dirname); diff --git a/test-suite/tests/filesys.test b/test-suite/tests/filesys.test index 64bf92333..4ea62d513 100644 --- a/test-suite/tests/filesys.test +++ b/test-suite/tests/filesys.test @@ -29,6 +29,8 @@ (data-file-name "filesys-test.tmp")) (define (test-symlink) (data-file-name "filesys-test-link.tmp")) +(define (test-directory) + (data-file-name "filesys-test-dir.tmp")) ;;; @@ -394,3 +396,39 @@ (throw 'unsupported)) (symlinkat (call-with-port (open "." O_RDONLY) identity) (test-file) (test-symlink)))) + +(with-test-prefix "mkdirat" + (define (skip-if-unsupported) + (unless (defined? 'mkdirat) + (throw 'unsupported))) + (define (maybe-delete-directory) + (when (file-exists? (test-directory)) + (rmdir (test-directory)))) + (maybe-delete-directory) + + (pass-if-equal "create" 'directory + (skip-if-unsupported) + (call-with-port + (open "." O_RDONLY) + (lambda (port) + (mkdirat port (test-directory)) + (stat:type (stat (test-directory)))))) + (maybe-delete-directory) + + (pass-if-equal "explicit perms" (logand #o111 (lognot (umask))) + (skip-if-unsupported) + (call-with-port + (open "." O_RDONLY) + (lambda (port) + (mkdirat port (test-directory) #o111) + (stat:perms (stat (test-directory)))))) + (maybe-delete-directory) + + (pass-if-equal "create, implicit perms" (logand #o777 (lognot (umask))) + (skip-if-unsupported) + (call-with-port + (open "." O_RDONLY) + (lambda (port) + (mkdirat port (test-directory)) + (stat:perms (stat (test-directory)))))) + (maybe-delete-directory)) -- 2.30.2