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 03/14] =?UTF-8?q?Allow=20file=20ports=20in=20=E2=80=98u?= =?UTF-8?q?time=E2=80=99.?= Date: Tue, 16 Nov 2021 11:06:26 +0000 Message-ID: <20211116110637.125579-4-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="31508"; 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:17:00 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 1mmwSR-0007yF-S5 for guile-devel@m.gmane-mx.org; Tue, 16 Nov 2021 12:16:59 +0100 Original-Received: from localhost ([::1]:49144 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1mmwSQ-0008Fd-LV for guile-devel@m.gmane-mx.org; Tue, 16 Nov 2021 06:16:58 -0500 Original-Received: from eggs.gnu.org ([209.51.188.92]:34310) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1mmwRK-0006v9-Ov for guile-devel@gnu.org; Tue, 16 Nov 2021 06:15:50 -0500 Original-Received: from [2a02:1800:110:4::f00:d] (port=51826 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-0006W6-R7 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 4Htjtg5YzqzMrHtW 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 Jz6j2600Q4UW6Th01z6pHr; Tue, 16 Nov 2021 12:06:49 +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=1637060809; bh=x+xS7K04tNB4fEMFU1Zc/sQUyYus9BgAZ17DfPMXYGY=; h=From:To:Cc:Subject:Date:In-Reply-To:References; b=Lr9y25mPEKrbUrQHhHX7LF/tC29+XKPfPdloXxy8oJCs02R4N7VDZu4/g5yWtNQ3A TmtLpckhWtndb24aykYy2aIZ78rz88AEooUkmgFOOIe3lZk4Iz5KSKJsQSTYttzZAM CM/unMCSSp41GPOxYhgn6aRmXhVjJykFGEUQCdQ5qFLah2chQIBl4bJMHxuVnAaNL6 4cwhqnyLgkwD639BCdsbPIolJCzTKsC3KYwu1VboSgnHsXVZ+7mH8J7dCzerwuJkMj h/aH4y5rco1ZD3hsuNev/F6Sh/yEbJOEosUsV8vRTLUWwskJE/ClougdpJrVaeFTrk mZabV3buwLPGQ== 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:20945 Archived-At: Ports representing symbolic links are currently unsupported. * configure.ac: Detect 'futimens'. * doc/ref/posix.texi (utime): Update documentation. * libguile/posix.c (scm_utime): Support ports. * libguile/posix.h (scm_utime): Rename argument. * test-suite/tests/posix.test ("utime"): Add more tests. --- configure.ac | 4 +-- doc/ref/posix.texi | 15 +++++--- libguile/posix.c | 28 +++++++++++---- libguile/posix.h | 2 +- test-suite/tests/posix.test | 71 ++++++++++++++++++++++++++++++++++++- 5 files changed, 106 insertions(+), 14 deletions(-) diff --git a/configure.ac b/configure.ac index 4888f880d..ddf330d96 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 - POSIX.1-2008 +# strcoll_l, newlocale, uselocale, utimensat, futimens - POSIX.1-2008 # strtol_l - non-POSIX, found in glibc # fork - unavailable on Windows # sched_getaffinity, sched_setaffinity - GNU extensions (glibc) @@ -494,7 +494,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 \ - sched_getaffinity sched_setaffinity sendfile]) + futimens sched_getaffinity sched_setaffinity sendfile]) # The newlib C library uses _NL_ prefixed locale langinfo constants. AC_CHECK_DECLS([_NL_NUMERIC_GROUPING], [], [], [[#include ]]) diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi index cd23240c4..b6deffd43 100644 --- a/doc/ref/posix.texi +++ b/doc/ref/posix.texi @@ -796,14 +796,16 @@ the new permissions as a decimal number, e.g., @code{(chmod "foo" #o755)}. The return value is unspecified. @end deffn -@deffn {Scheme Procedure} utime pathname [actime [modtime [actimens [modtimens [flags]]]]] -@deffnx {C Function} scm_utime (pathname, actime, modtime, actimens, modtimens, flags) +@deffn {Scheme Procedure} utime object [actime [modtime [actimens [modtimens [flags]]]]] +@deffnx {C Function} scm_utime (object, actime, modtime, actimens, modtimens, flags) @code{utime} sets the access and modification times for the -file named by @var{pathname}. If @var{actime} or @var{modtime} is +file named by @var{object}. If @var{actime} or @var{modtime} is not supplied, then the current time is used. @var{actime} and @var{modtime} must be integer time values as returned by the @code{current-time} procedure. +@var{object} must be a file name or a port (if supported by the system). + The optional @var{actimens} and @var{modtimens} are nanoseconds to add @var{actime} and @var{modtime}. Nanosecond precision is only supported on some combinations of file systems and operating @@ -817,9 +819,14 @@ modification time to the current time. @vindex AT_SYMLINK_NOFOLLOW Last, @var{flags} may be either @code{0} or the @code{AT_SYMLINK_NOFOLLOW} constant, to set the time of -@var{pathname} even if it is a symbolic link. +@var{object} even if it is a symbolic link. @end deffn +On GNU/Linux systems, at least when using the Linux kernel 5.10.46, +if @var{object} is a port, it may not be a symbolic link, +even if @code{AT_SYMLINK_NOFOLLOW} is set. This is either a bug +in Linux or Guile's wrappers. The exact cause is unclear. + @findex unlink @deffn {Scheme Procedure} delete-file str @deffnx {C Function} scm_delete_file (str) diff --git a/libguile/posix.c b/libguile/posix.c index 3ab12b99e..bd7f40ca8 100644 --- a/libguile/posix.c +++ b/libguile/posix.c @@ -1,5 +1,6 @@ /* Copyright 1995-2014,2016-2019,2021 Free Software Foundation, Inc. + Copyright 2021 Maxime Devos This file is part of Guile. @@ -1648,13 +1649,14 @@ SCM_DEFINE (scm_tmpfile, "tmpfile", 0, 0, 0, #undef FUNC_NAME SCM_DEFINE (scm_utime, "utime", 1, 5, 0, - (SCM pathname, SCM actime, SCM modtime, SCM actimens, SCM modtimens, + (SCM object, SCM actime, SCM modtime, SCM actimens, SCM modtimens, SCM flags), "@code{utime} sets the access and modification times for the\n" - "file named by @var{pathname}. If @var{actime} or @var{modtime} is\n" + "file named by @var{object}. If @var{actime} or @var{modtime} is\n" "not supplied, then the current time is used. @var{actime} and\n" "@var{modtime} must be integer time values as returned by the\n" "@code{current-time} procedure.\n\n" + "@var{object} must be a file name or a port (if supported by the system).\n\n" "The optional @var{actimens} and @var{modtimens} are nanoseconds\n" "to add @var{actime} and @var{modtime}. Nanosecond precision is\n" "only supported on some combinations of file systems and operating\n" @@ -1666,7 +1668,11 @@ SCM_DEFINE (scm_utime, "utime", 1, 5, 0, "modification time to the current time.\n\n" "Last, @var{flags} may be either @code{0} or the\n" "@code{AT_SYMLINK_NOFOLLOW} constant, to set the time of\n" - "@var{pathname} even if it is a symbolic link.\n") + "@var{pathname} even if it is a symbolic link.\n\n" + "On GNU/Linux systems, at least when using the Linux kernel\n" + "5.10.46, if @var{object} is a port, it may not be a symbolic\n" + "link, even if @code{AT_SYMLINK_NOFOLLOW} is set. This is either\n" + "a bug in Linux or Guile's wrappers. The exact cause is unclear.") #define FUNC_NAME s_scm_utime { int rv; @@ -1725,8 +1731,18 @@ SCM_DEFINE (scm_utime, "utime", 1, 5, 0, times[1].tv_sec = mtim_sec; times[1].tv_nsec = mtim_nsec; - STRING_SYSCALL (pathname, c_pathname, - rv = utimensat (AT_FDCWD, c_pathname, times, f)); + if (SCM_OPFPORTP (object)) + { + int fd; + fd = SCM_FPORT_FDES (object); + SCM_SYSCALL (rv = futimens (fd, times)); + scm_remember_upto_here_1 (object); + } + else + { + STRING_SYSCALL (object, c_pathname, + rv = utimensat (AT_FDCWD, c_pathname, times, f)); + } } #else { @@ -1740,7 +1756,7 @@ SCM_DEFINE (scm_utime, "utime", 1, 5, 0, if (f != 0) scm_out_of_range(FUNC_NAME, flags); - STRING_SYSCALL (pathname, c_pathname, + STRING_SYSCALL (object, c_pathname, rv = utime (c_pathname, &utm)); } #endif diff --git a/libguile/posix.h b/libguile/posix.h index ff3bec9ea..dda8013a5 100644 --- a/libguile/posix.h +++ b/libguile/posix.h @@ -69,7 +69,7 @@ SCM_API SCM scm_tmpfile (void); SCM_API SCM scm_open_pipe (SCM pipestr, SCM modes); SCM_API SCM scm_close_pipe (SCM port); SCM_API SCM scm_system_star (SCM cmds); -SCM_API SCM scm_utime (SCM pathname, SCM actime, SCM modtime, +SCM_API SCM scm_utime (SCM object, SCM actime, SCM modtime, SCM actimens, SCM modtimens, SCM flags); SCM_API SCM scm_access (SCM path, SCM how); SCM_API SCM scm_getpid (void); diff --git a/test-suite/tests/posix.test b/test-suite/tests/posix.test index 1e552d16f..8e32251b5 100644 --- a/test-suite/tests/posix.test +++ b/test-suite/tests/posix.test @@ -2,6 +2,7 @@ ;;;; ;;;; Copyright 2003-2004,2006-2007,2010,2012,2015,2017-2019,2021 ;;;; Free Software Foundation, Inc. +;;;; Copyright 2021 Maxime Devos ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -201,7 +202,75 @@ (list (stat:atime info) (stat:mtime info)))) (lambda () (delete-file file)))) - (throw 'unsupported)))) + (throw 'unsupported))) + + (define (utime-unless-unsupported oops . arguments) + (catch 'system-error + (lambda () + (catch 'wrong-type-arg + (lambda () + (apply utime arguments)) + (lambda _ + ;; 'futimens' is not supported on all platforms. + (oops)))) + (lambda args + ;; On some platforms, 'futimens' returns ENOSYS according to Gnulib. + (if (= (system-error-errno args) ENOSYS) + (oops) + (apply throw args))))) + + (pass-if-equal "file port" + '(1 1) + (let ((file "posix.test-utime")) + (false-if-exception (delete-file file)) + (close-port (open-output-file file)) + (define (delete) + (delete-file file)) + (define (oops) + (delete) + (throw 'unsupported)) + (call-with-input-file file + (lambda (port) + (utime-unless-unsupported oops port 1 1 0 0) + (define info (stat file)) + (delete) + (list (stat:atime info) (stat:mtime info)))))) + + ;; This causes an EBADF system error on GNU/Linux with the 5.10.46 kernel. + #; + (pass-if-equal "file port (port representing symbolic link)" + '(1 1) + (let ((file "posix.test-utime")) + (unless (false-if-exception + (begin (symlink "/should-be-irrelevant" file) + #t)) + (display "cannot create symlink, a utime test skipped\n") + (throw 'unresolved)) + (unless (and (defined? 'O_NOFOLLOW) + (defined? 'O_PATH) + (not (= 0 O_NOFOLLOW)) + (not (= 0 O_PATH))) + (display "cannot open symlinks, a utime test skipped\n") + (throw 'unresolved)) + (define (delete) + (when port (close-port port)) + (false-if-exception (delete-file file))) + (define (oops) + (delete) + (throw 'unsupported)) + (define port #f) + (catch #t + (lambda () + (set! port + (open file (logior O_NOFOLLOW O_PATH))) + (utime-unless-unsupported oops port 1 1 0 0)) + (lambda args + (pk 'deleting file) + (delete) + (apply throw args))) + (define info (lstat file)) + (delete) + (list (stat:mtime info) (stat:atime info))))) ;; ;; affinity -- 2.30.2