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 13/14] =?UTF-8?q?Define=20Scheme=20bindings=20to=20?= =?UTF-8?q?=E2=80=98openat=E2=80=99=20when=20available.?= Date: Tue, 16 Nov 2021 11:06:36 +0000 Message-ID: <20211116110637.125579-14-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="27505"; 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:16:13 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 1mmwRh-0006vi-90 for guile-devel@m.gmane-mx.org; Tue, 16 Nov 2021 12:16:13 +0100 Original-Received: from localhost ([::1]:47454 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1mmwRg-00075K-C9 for guile-devel@m.gmane-mx.org; Tue, 16 Nov 2021 06:16:12 -0500 Original-Received: from eggs.gnu.org ([209.51.188.92]:34346) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1mmwRM-00070H-F5 for guile-devel@gnu.org; Tue, 16 Nov 2021 06:15:52 -0500 Original-Received: from [2a02:1800:110:4::f00:d] (port=52472 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 1mmwRJ-0006Wb-Ow for guile-devel@gnu.org; Tue, 16 Nov 2021 06:15:52 -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 4Htjtg2L8RzMrHtN 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 Jz6j2600Q4UW6Th01z6rJN; Tue, 16 Nov 2021 12:06:51 +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=1637060811; bh=oee5fZQC+yvMBbyxX6yxxARH4k5vocJe8sQ4vA4rdCQ=; h=From:To:Cc:Subject:Date:In-Reply-To:References; b=sm1Eq4rN5NAWAEQnGK0DpntxtA0KW5k22+DFqpMEu+9U1oOFuoRYzyN9jlM8PNRJy TRheFfbGeU0yV/lVh3LK9dtgzpaXBfAbRMXmuD1X/S9BYCayiZwsOfuNiVIoOdmZQ1 ndvJOjTPpayVR0LUYGVXJvbsBaMY1Su7xreW7lBCpNsu5wCxQO42yFm0j44mmyv2dQ A+TmsjKHSZ08u6lFaRt2VGutVq5Vnec/bXRTBJD/gV+lJWyXguE2qJ/9EUQGCFi3+J 59QGQ6xfwB8RahkrGjiu+V6VCrERbFrUeq3YXw9tiOKj95MFKfxoAPEbZZOeHa1Xgn 9/xSUXGo1xLfQ== 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:20944 Archived-At: * configure.ac: Detect if ‘openat’ is defined. * libguile/filesys.c (flags_to_mode): Extract from ... (scm_mode): ... here. (scm_open_fdes_at, scm_openat): Define the Scheme bindings. * libguile/filesys.h (scm_open_fdes_at, scm_openat): Make them part of the API. * doc/ref/posix.texi (File System): Document them. * test-suite/tests/filesys.test ("openat"): Test ‘openat’. * libguile/syscalls.h (openat_or_openat64): Decide between ‘openat’ and ‘openat64’. --- configure.ac | 3 +- doc/ref/posix.texi | 13 +++++ libguile/filesys.c | 96 +++++++++++++++++++++++++++-------- libguile/filesys.h | 2 + libguile/syscalls.h | 1 + test-suite/tests/filesys.test | 73 ++++++++++++++++++++++++++ 6 files changed, 167 insertions(+), 21 deletions(-) diff --git a/configure.ac b/configure.ac index e073e04f4..905e4d465 100644 --- a/configure.ac +++ b/configure.ac @@ -478,7 +478,7 @@ AC_CHECK_HEADERS([assert.h crt_externs.h]) # isblank - available as a GNU extension or in C99 # _NSGetEnviron - Darwin specific # strcoll_l, newlocale, uselocale, utimensat, futimens, fchmodat, -# unlinkat, fchownat, fstatat - POSIX.1-2008 +# unlinkat, fchownat, fstatat, openat - POSIX.1-2008 # strtol_l - non-POSIX, found in glibc # fork - unavailable on Windows # sched_getaffinity, sched_setaffinity - GNU extensions (glibc) @@ -495,6 +495,7 @@ AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid \ getgrent kill getppid getpgrp fork setitimer getitimer strchr strcmp \ index bcopy memcpy rindex truncate isblank _NSGetEnviron \ strcoll strcoll_l strtod_l strtol_l newlocale uselocale utimensat \ + openat \ fstatat futimens sched_getaffinity sched_setaffinity sendfile]) # The newlib C library uses _NL_ prefixed locale langinfo constants. diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi index cdd03f141..3619ee2c3 100644 --- a/doc/ref/posix.texi +++ b/doc/ref/posix.texi @@ -296,12 +296,25 @@ Create the file if it does not already exist. for additional flags. @end deffn +@deffn {Scheme Procedure} openat dir path flags [mode] +@deffnx {C Function} scm_openat (dir, path, flags, mode) +Similar to @code{open}, but resolve the file name @var{path} +relative to the directory referred to by the file port @var{dir} +instead. +@end deffn + @deffn {Scheme Procedure} open-fdes path flags [mode] @deffnx {C Function} scm_open_fdes (path, flags, mode) Similar to @code{open} but return a file descriptor instead of a port. @end deffn +@deffn {Scheme Procedure} open-fdes-at dir path flags [mode] +@deffnx {C Function} scm_open_fdes_at (dir, path, flags, mode) +Similar to @code{openat}, but return a file descriptor instead +of a port. +@end deffn + @deffn {Scheme Procedure} close fd_or_port @deffnx {C Function} scm_close (fd_or_port) Similar to @code{close-port} (@pxref{Ports, close-port}), diff --git a/libguile/filesys.c b/libguile/filesys.c index d045a672f..dadbe3393 100644 --- a/libguile/filesys.c +++ b/libguile/filesys.c @@ -249,6 +249,60 @@ SCM_DEFINE (scm_open_fdes, "open-fdes", 2, 1, 0, } #undef FUNC_NAME +#ifdef HAVE_OPENAT +SCM_DEFINE (scm_open_fdes_at, "open-fdes-at", 3, 1, 0, + (SCM dir, SCM path, SCM flags, SCM mode), + "Similar to @code{openat}, but return a file descriptor instead\n" + "of a port.") +#define FUNC_NAME s_scm_open_fdes_at +{ + int dir_fdes; + int fd; + int iflags; + int imode; + + iflags = SCM_NUM2INT (SCM_ARG2, flags); + imode = SCM_NUM2INT_DEF (3, mode, 0666); + SCM_VALIDATE_OPFPORT (SCM_ARG1, dir); + dir_fdes = SCM_FPORT_FDES (dir); + + STRING_SYSCALL (path, c_path, + fd = openat_or_openat64 (dir_fdes, c_path, iflags, imode)); + scm_remember_upto_here_1 (dir); + if (fd == -1) + SCM_SYSERROR; + return scm_from_int (fd); +} +#undef FUNC_NAME +#endif /* HAVE_OPENAT */ + +/* A helper function for converting some open flags to + what scm_fdes_to_port expects. */ +static char * +flags_to_mode (int iflags) +{ + if ((iflags & O_RDWR) == O_RDWR) + { + /* Opened read-write. */ + if (iflags & O_APPEND) + return "a+"; + else if (iflags & O_CREAT) + return "w+"; + else + return "r+"; + } + else + { + /* Opened read-only or write-only. */ + if (iflags & O_APPEND) + return "a"; + else if (iflags & O_WRONLY) + return "w"; + else + return "r"; + } +} + SCM_DEFINE (scm_open, "open", 2, 1, 0, (SCM path, SCM flags, SCM mode), "Open the file named by @var{path} for reading and/or writing.\n" @@ -285,31 +339,33 @@ SCM_DEFINE (scm_open, "open", 2, 1, 0, fd = scm_to_int (scm_open_fdes (path, flags, mode)); iflags = SCM_NUM2INT (2, flags); - if ((iflags & O_RDWR) == O_RDWR) - { - /* Opened read-write. */ - if (iflags & O_APPEND) - port_mode = "a+"; - else if (iflags & O_CREAT) - port_mode = "w+"; - else - port_mode = "r+"; - } - else - { - /* Opened read-only or write-only. */ - if (iflags & O_APPEND) - port_mode = "a"; - else if (iflags & O_WRONLY) - port_mode = "w"; - else - port_mode = "r"; - } + port_mode = (char *) flags_to_mode (iflags); + newpt = scm_fdes_to_port (fd, port_mode, path); + return newpt; +} +#undef FUNC_NAME +#ifdef HAVE_OPENAT +SCM_DEFINE (scm_openat, "openat", 3, 1, 0, + (SCM dir, SCM path, SCM flags, SCM mode), + "Similar to @code{open}, but resolve the file name @var{path}\n" + "relative to the directory referred to by the file port @var{dir}\n" + "instead.") +#define FUNC_NAME s_scm_openat +{ + SCM newpt; + char *port_mode; + int fd; + int iflags; + + iflags = SCM_NUM2INT (2, flags); + port_mode = (char *) flags_to_mode (iflags); + fd = scm_to_int (scm_open_fdes_at (dir, path, flags, mode)); newpt = scm_fdes_to_port (fd, port_mode, path); return newpt; } #undef FUNC_NAME +#endif /* HAVE_OPENAT */ SCM_DEFINE (scm_close, "close", 1, 0, 0, (SCM fd_or_port), diff --git a/libguile/filesys.h b/libguile/filesys.h index 8af0f989a..1ce50d30e 100644 --- a/libguile/filesys.h +++ b/libguile/filesys.h @@ -44,7 +44,9 @@ 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_fdes_at (SCM dir, SCM path, SCM flags, SCM mode); SCM_API SCM scm_open (SCM path, SCM flags, SCM mode); +SCM_API SCM scm_openat (SCM dir, SCM path, SCM flags, SCM mode); 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); diff --git a/libguile/syscalls.h b/libguile/syscalls.h index 37d532e60..6f4061138 100644 --- a/libguile/syscalls.h +++ b/libguile/syscalls.h @@ -58,6 +58,7 @@ #define lstat_or_lstat64 CHOOSE_LARGEFILE(lstat,lstat64) #define off_t_or_off64_t CHOOSE_LARGEFILE(off_t,off64_t) #define open_or_open64 CHOOSE_LARGEFILE(open,open64) +#define openat_or_openat64 CHOOSE_LARGEFILE(openat,openat64) #define readdir_or_readdir64 CHOOSE_LARGEFILE(readdir,readdir64) #if SCM_HAVE_READDIR64_R == 1 # define readdir_r_or_readdir64_r CHOOSE_LARGEFILE(readdir_r,readdir64_r) diff --git a/test-suite/tests/filesys.test b/test-suite/tests/filesys.test index b794b07b3..45e77c823 100644 --- a/test-suite/tests/filesys.test +++ b/test-suite/tests/filesys.test @@ -728,3 +728,76 @@ (skip-if-unsupported) (delete-file-at (call-with-port (open "." O_RDONLY) identity) "irrelevant"))) + +(with-test-prefix "openat" + (define (skip-if-unsupported) + (unless (defined? 'openat) + (throw 'unsupported))) + + (define file (search-path %load-path "ice-9/boot-9.scm")) + + (define (call-with-relatively-opened-file directory-arguments file-arguments + proc) + (call-with-port + (apply open directory-arguments) + (lambda (directory) + (call-with-port + (apply openat directory file-arguments) + (lambda (port) + (proc port)))))) + + (pass-if-equal "mode read-only" "r" + (skip-if-unsupported) + (call-with-relatively-opened-file + (list (dirname file) O_RDONLY) + (list (basename file) O_RDONLY) + (lambda (port) (port-mode port)))) + + (pass-if-equal "port-revealed count" 0 + (skip-if-unsupported) + (call-with-relatively-opened-file + (list (dirname file) O_RDONLY) + (list (basename file) O_RDONLY) + (lambda (port) (port-revealed port)))) + + (when (file-exists? (test-file)) + (delete-file (test-file))) + + (pass-if-equal "O_CREAT/O_WRONLY" (list #t (logand (lognot (umask)) #o666) "w") + (skip-if-unsupported) + (call-with-relatively-opened-file + (list (dirname (test-file)) O_RDONLY) + (list (basename (test-file)) (logior O_WRONLY O_CREAT)) + (lambda (port) + (list (file-exists? (test-file)) + (stat:perms (stat (test-file))) + (port-mode port))))) + + (when (file-exists? (test-file)) + (delete-file (test-file))) + + (pass-if-equal "O_CREAT/O_WRONLY, non-default mode" + (list #t (logand (lognot (umask)) #o700) "w") + (skip-if-unsupported) + (call-with-relatively-opened-file + (list (dirname (test-file)) O_RDONLY) + (list (basename (test-file)) (logior O_WRONLY O_CREAT) #o700) + (lambda (port) + (list (file-exists? (test-file)) + (stat:perms (stat (test-file))) + (port-mode port))))) + + (pass-if-exception "closed port" exception:wrong-type-arg + (skip-if-unsupported) + (openat (call-with-port (open "." O_RDONLY) identity) "." O_RDONLY)) + + (pass-if-exception "non-file port" exception:wrong-type-arg + (skip-if-unsupported) + (openat (open-input-string "") "." O_RDONLY)) + + (pass-if-exception "not a port" exception:wrong-type-arg + (skip-if-unsupported) + (openat "not a port" "." O_RDONLY)) + + (when (file-exists? (test-file)) + (delete-file (test-file)))) -- 2.30.2