* [bug#54485] [PATCH] gnu: Add guile-with-openat.
@ 2022-03-20 21:50 Maxime Devos
2022-03-20 22:39 ` Maxime Devos
` (3 more replies)
0 siblings, 4 replies; 7+ messages in thread
From: Maxime Devos @ 2022-03-20 21:50 UTC (permalink / raw)
To: 54485; +Cc: Maxime Devos
XXX Don't apply yet, let's wait for
"./pre-inst-env guix build guile-with-openat" to complete first.
This will allow us to work on resolving the >1 year publicly
known privilege escalation, see <https://issues.guix.gnu.org/47584>.
* gnu/packages/guile.scm (guile-with-openat): New variable.
---
gnu/local.mk | 14 +
gnu/packages/guile.scm | 33 +-
.../patches/guile-openat-and-friends-01.patch | 193 +++++++++++
.../patches/guile-openat-and-friends-02.patch | 219 ++++++++++++
.../patches/guile-openat-and-friends-03.patch | 269 +++++++++++++++
.../patches/guile-openat-and-friends-04.patch | 142 ++++++++
.../patches/guile-openat-and-friends-05.patch | 159 +++++++++
.../patches/guile-openat-and-friends-06.patch | 37 +++
.../patches/guile-openat-and-friends-07.patch | 40 +++
.../patches/guile-openat-and-friends-08.patch | 240 +++++++++++++
.../patches/guile-openat-and-friends-09.patch | 173 ++++++++++
.../patches/guile-openat-and-friends-10.patch | 204 ++++++++++++
.../patches/guile-openat-and-friends-11.patch | 130 ++++++++
.../patches/guile-openat-and-friends-12.patch | 238 +++++++++++++
.../patches/guile-openat-and-friends-13.patch | 314 ++++++++++++++++++
15 files changed, 2404 insertions(+), 1 deletion(-)
create mode 100644 gnu/packages/patches/guile-openat-and-friends-01.patch
create mode 100644 gnu/packages/patches/guile-openat-and-friends-02.patch
create mode 100644 gnu/packages/patches/guile-openat-and-friends-03.patch
create mode 100644 gnu/packages/patches/guile-openat-and-friends-04.patch
create mode 100644 gnu/packages/patches/guile-openat-and-friends-05.patch
create mode 100644 gnu/packages/patches/guile-openat-and-friends-06.patch
create mode 100644 gnu/packages/patches/guile-openat-and-friends-07.patch
create mode 100644 gnu/packages/patches/guile-openat-and-friends-08.patch
create mode 100644 gnu/packages/patches/guile-openat-and-friends-09.patch
create mode 100644 gnu/packages/patches/guile-openat-and-friends-10.patch
create mode 100644 gnu/packages/patches/guile-openat-and-friends-11.patch
create mode 100644 gnu/packages/patches/guile-openat-and-friends-12.patch
create mode 100644 gnu/packages/patches/guile-openat-and-friends-13.patch
diff --git a/gnu/local.mk b/gnu/local.mk
index 1252643dc0..40dd8c9c55 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -49,6 +49,7 @@
# Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com>
# Copyright © 2022 Daniel Meißner <daniel.meissner-i4k@ruhr-uni-bochum.de>
# Copyright © 2022 Remco van 't Veer <remco@remworks.net>
+# Copyright © 2022 Maxime Devos <maximedevos@telenet.be>
#
# This file is part of GNU Guix.
#
@@ -1235,6 +1236,19 @@ dist_patch_DATA = \
%D%/packages/patches/guile-fibers-wait-for-io-readiness.patch \
%D%/packages/patches/guile-gdbm-ffi-support-gdbm-1.14.patch \
%D%/packages/patches/guile-git-adjust-for-libgit2-1.2.0.patch \
+ %D%/packages/patches/guile-openat-and-friends-01.patch \
+ %D%/packages/patches/guile-openat-and-friends-02.patch \
+ %D%/packages/patches/guile-openat-and-friends-03.patch \
+ %D%/packages/patches/guile-openat-and-friends-04.patch \
+ %D%/packages/patches/guile-openat-and-friends-05.patch \
+ %D%/packages/patches/guile-openat-and-friends-06.patch \
+ %D%/packages/patches/guile-openat-and-friends-07.patch \
+ %D%/packages/patches/guile-openat-and-friends-08.patch \
+ %D%/packages/patches/guile-openat-and-friends-09.patch \
+ %D%/packages/patches/guile-openat-and-friends-10.patch \
+ %D%/packages/patches/guile-openat-and-friends-11.patch \
+ %D%/packages/patches/guile-openat-and-friends-12.patch \
+ %D%/packages/patches/guile-openat-and-friends-13.patch \
%D%/packages/patches/guile-present-coding.patch \
%D%/packages/patches/guile-rsvg-pkgconfig.patch \
%D%/packages/patches/guile-emacs-fix-configure.patch \
diff --git a/gnu/packages/guile.scm b/gnu/packages/guile.scm
index f74a389da5..640e065422 100644
--- a/gnu/packages/guile.scm
+++ b/gnu/packages/guile.scm
@@ -16,7 +16,7 @@
;;; Copyright © 2018 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2019 Taylan Kammer <taylan.kammer@gmail.com>
;;; Copyright © 2020, 2021 Efraim Flashner <efraim@flashner.co.il>
-;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
+;;; Copyright © 2021, 2022 Maxime Devos <maximedevos@telenet.be>
;;; Copyright © 2021 Timothy Sample <samplet@ngyro.com>
;;;
;;; This file is part of GNU Guix.
@@ -388,6 +388,37 @@ (define-public guile-3.0
(files '("lib/guile/3.0/site-ccache"
"share/guile/site/3.0")))))))
+;; (A static variant of) this package will be used to implement
+;; TOCTOU-free behaviour in <https://issues.guix.gnu.org/54309>
+;; and <https://issues.guix.gnu.org/47584>.
+(define-public guile-with-openat
+ (package
+ (inherit
+ (package-with-extra-patches guile-3.0
+ (search-patches
+ "guile-openat-and-friends-01.patch"
+ "guile-openat-and-friends-02.patch"
+ "guile-openat-and-friends-03.patch"
+ "guile-openat-and-friends-04.patch"
+ "guile-openat-and-friends-05.patch"
+ "guile-openat-and-friends-06.patch"
+ "guile-openat-and-friends-07.patch"
+ "guile-openat-and-friends-08.patch"
+ "guile-openat-and-friends-09.patch"
+ "guile-openat-and-friends-10.patch"
+ "guile-openat-and-friends-11.patch"
+ "guile-openat-and-friends-12.patch"
+ "guile-openat-and-friends-13.patch")))
+ (name "guile-with-openat")
+ (synopsis "Guile, with support for @code{openat} and friends")
+ (description "This is a variant of the Guile package, extending the
+file system interface to support more directory-relative operations.
+
+More concretely, it adds a procedure @code{openat} that can be used
+to open a file in a directory that has been opened (as a port), without
+@acronym{TOCTOU,time-of-check to time-of-use} issues, and a few other
+procedures of a similar nature.")))
+
(define-public guile-3.0-latest
(package
(inherit guile-3.0)
diff --git a/gnu/packages/patches/guile-openat-and-friends-01.patch b/gnu/packages/patches/guile-openat-and-friends-01.patch
new file mode 100644
index 0000000000..d430fb99e3
--- /dev/null
+++ b/gnu/packages/patches/guile-openat-and-friends-01.patch
@@ -0,0 +1,193 @@
+Guix-Upstream: https://lists.gnu.org/archive/html/guile-devel/2021-11/msg00005.html
+From: Maxime Devos <maximedevos@telenet.be>
+Subject: [PATCH v2 01/14]
+ =?UTF-8?q?Allow=20file=20ports=20in=20=E2=80=98c?=
+ =?UTF-8?q?hdir=E2=80=99=20when=20supported.?=
+Date: Tue, 16 Nov 2021 11:06:24 +0000
+Message-Id: <20211116110637.125579-2-maximedevos@telenet.be>
+In-Reply-To: <20211116110637.125579-1-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
+
+* configure.ac: Check for ‘fchdir’.
+* libguile/filesys.c
+(scm_chdir): Support file ports.
+(scm_init_filesys): Report support of file ports.
+* doc/ref/posix.texi (Processes): Update accordingly.
+* doc/ref/guile.texi: Add copyright line for new documentation in this
+patch and later patches.
+* test-suite/tests/filesys.test ("chdir"): Test it.
+---
+ configure.ac | 3 ++-
+ doc/ref/guile.texi | 3 ++-
+ doc/ref/posix.texi | 5 ++++-
+ libguile/filesys.c | 23 +++++++++++++++++++-
+ test-suite/tests/filesys.test | 41 +++++++++++++++++++++++++++++++++++
+ 5 files changed, 71 insertions(+), 4 deletions(-)
+
+diff --git a/configure.ac b/configure.ac
+index bd49bf162..b7e4663f7 100644
+--- a/configure.ac
++++ b/configure.ac
+@@ -484,7 +484,8 @@ AC_CHECK_HEADERS([assert.h crt_externs.h])
+ # sendfile - non-POSIX, found in glibc
+ #
+ AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid \
+- fesetround ftime ftruncate fchown fchmod getcwd geteuid getsid \
++ fesetround ftime ftruncate fchown fchmod fchdir \
++ 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/guile.texi b/doc/ref/guile.texi
+index 660b1ae90..48af1f820 100644
+--- a/doc/ref/guile.texi
++++ b/doc/ref/guile.texi
+@@ -14,7 +14,8 @@
+ This manual documents Guile version @value{VERSION}.
+
+ Copyright (C) 1996-1997, 2000-2005, 2009-2021 Free Software Foundation,
+-Inc.
++Inc. \\
++Copyright (C) 2021 Maxime Devos
+
+ Permission is granted to copy, distribute and/or modify this document
+ under the terms of the GNU Free Documentation License, Version 1.3 or
+diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
+index 7633bd5a3..7555f9319 100644
+--- a/doc/ref/posix.texi
++++ b/doc/ref/posix.texi
+@@ -2,6 +2,7 @@
+ @c This is part of the GNU Guile Reference Manual.
+ @c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2006, 2007,
+ @c 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2017, 2021 Free Software Foundation, Inc.
++@c Copyright (C) 2021 Maxime Devos <maximedevos@telenet.be>
+ @c See the file guile.texi for copying conditions.
+
+ @node POSIX
+@@ -1605,7 +1606,9 @@ The return value is unspecified.
+ @deffn {Scheme Procedure} chdir str
+ @deffnx {C Function} scm_chdir (str)
+ @cindex current directory
+-Change the current working directory to @var{str}.
++Change the current working directory to @var{str}. @var{str} can be a
++string containing a file name, or a port if supported by the system.
++@code{(provided? 'chdir-port)} reports whether ports are supported.
+ The return value is unspecified.
+ @end deffn
+
+diff --git a/libguile/filesys.c b/libguile/filesys.c
+index 6247734e8..2a9c36a12 100644
+--- a/libguile/filesys.c
++++ b/libguile/filesys.c
+@@ -1,5 +1,6 @@
+ /* Copyright 1996-2002,2004,2006,2009-2019,2021
+ Free Software Foundation, Inc.
++ Copyright 2021 Maxime Devos <maximedevos@telenet.be>
+
+ This file is part of Guile.
+
+@@ -621,12 +622,28 @@ SCM_DEFINE (scm_link, "link", 2, 0, 0,
+ SCM_DEFINE (scm_chdir, "chdir", 1, 0, 0,
+ (SCM str),
+ "Change the current working directory to @var{str}.\n"
++ "@var{str} can be a string containing a file name,\n"
++ "or a port if supported by the system.\n"
++ "@code{(provided? 'chdir-port)} reports whether ports "
++ "are supported."
+ "The return value is unspecified.")
+ #define FUNC_NAME s_scm_chdir
+ {
+ int ans;
+
+- STRING_SYSCALL (str, c_str, ans = chdir (c_str));
++#ifdef HAVE_FCHDIR
++ if (SCM_OPFPORTP (str))
++ {
++ int fdes;
++ fdes = SCM_FPORT_FDES (str);
++ SCM_SYSCALL (ans = fchdir (fdes));
++ scm_remember_upto_here_1 (str);
++ }
++ else
++#endif
++ {
++ STRING_SYSCALL (str, c_str, ans = chdir (c_str));
++ }
+ if (ans != 0)
+ SCM_SYSERROR;
+ return SCM_UNSPECIFIED;
+@@ -2066,5 +2083,9 @@ scm_init_filesys ()
+
+ scm_dot_string = scm_from_utf8_string (".");
+
++#ifdef HAVE_FCHDIR
++ scm_add_feature("chdir-port");
++#endif
++
+ #include "filesys.x"
+ }
+diff --git a/test-suite/tests/filesys.test b/test-suite/tests/filesys.test
+index 6fed981e5..6b09a2ba0 100644
+--- a/test-suite/tests/filesys.test
++++ b/test-suite/tests/filesys.test
+@@ -1,6 +1,7 @@
+ ;;;; filesys.test --- test file system functions -*- scheme -*-
+ ;;;;
+ ;;;; Copyright (C) 2004, 2006, 2013, 2019, 2021 Free Software Foundation, Inc.
++;;;; Copyright (C) 2021 Maxime Devos <maximedevos@telenet.be>
+ ;;;;
+ ;;;; This library is free software; you can redistribute it and/or
+ ;;;; modify it under the terms of the GNU Lesser General Public
+@@ -265,3 +266,43 @@
+ (result (eqv? 'directory (stat:type _stat))))
+ (false-if-exception (rmdir name))
+ result)))))
++
++(with-test-prefix "chdir"
++ (pass-if-equal "current directory" (getcwd)
++ (begin (chdir ".") (getcwd)))
++ (define file (search-path %load-path "ice-9/boot-9.scm"))
++
++
++ (pass-if-equal "test directory" (dirname file)
++ (let ((olddir (getcwd))
++ (dir #f))
++ (chdir (dirname file))
++ (set! dir (getcwd))
++ (chdir olddir)
++ dir))
++
++ (pass-if-equal "test directory, via port" (dirname file)
++ (unless (provided? 'chdir-port)
++ (throw 'unresolved))
++ (let ((olddir (getcwd))
++ (port (open (dirname file) O_RDONLY))
++ (dir #f))
++ (chdir port)
++ (set! dir (getcwd))
++ (chdir olddir)
++ dir))
++
++ (pass-if-exception "closed port" exception:wrong-type-arg
++ (unless (provided? 'chdir-port)
++ (throw 'unresolved))
++ (let ((port (open (dirname file) O_RDONLY))
++ (olddir (getcwd)))
++ (close-port port)
++ (chdir port)
++ (chdir olddir))) ; should not be reached
++
++ (pass-if-exception "not a port or file name" exception:wrong-type-arg
++ (chdir '(stuff)))
++
++ (pass-if-exception "non-file port" exception:wrong-type-arg
++ (chdir (open-input-string ""))))
+--
+2.30.2
+
+
+
diff --git a/gnu/packages/patches/guile-openat-and-friends-02.patch b/gnu/packages/patches/guile-openat-and-friends-02.patch
new file mode 100644
index 0000000000..211e0a4f4c
--- /dev/null
+++ b/gnu/packages/patches/guile-openat-and-friends-02.patch
@@ -0,0 +1,219 @@
+Guix-Upstream: https://lists.gnu.org/archive/html/guile-devel/2021-11/msg00005.html
+From: Maxime Devos <maximedevos@telenet.be>
+Subject: [PATCH v2 02/14]
+ =?UTF-8?q?Allow=20file=20ports=20in=20=E2=80=98r?=
+ =?UTF-8?q?eadlink=E2=80=99.?=
+Date: Tue, 16 Nov 2021 11:06:25 +0000
+Message-Id: <20211116110637.125579-3-maximedevos@telenet.be>
+In-Reply-To: <20211116110637.125579-1-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
+
+* configure.ac: Detect whether ‘readlinkat’ is defined.
+* libguile/filesys.c (scm_readlink): Support file ports
+ when ‘readlinkat’ exists.
+ (scm_init_filesys): Provide ‘chdir-ports’ when it exists.
+* doc/ref/posix.texi (File System): Document it.
+* test-suite/tests/filesys.test ("readlink"): Test it.
+---
+ configure.ac | 2 +-
+ doc/ref/posix.texi | 9 ++++--
+ libguile/filesys.c | 52 +++++++++++++++++++++++------
+ test-suite/tests/filesys.test | 61 +++++++++++++++++++++++++++++++++++
+ 4 files changed, 112 insertions(+), 12 deletions(-)
+
+diff --git a/configure.ac b/configure.ac
+index b7e4663f7..4888f880d 100644
+--- a/configure.ac
++++ b/configure.ac
+@@ -484,7 +484,7 @@ AC_CHECK_HEADERS([assert.h crt_externs.h])
+ # sendfile - non-POSIX, found in glibc
+ #
+ AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid \
+- fesetround ftime ftruncate fchown fchmod fchdir \
++ fesetround ftime ftruncate fchown fchmod fchdir readlinkat \
+ getcwd geteuid getsid \
+ gettimeofday getuid getgid gmtime_r ioctl lstat mkdir mkdtemp mknod \
+ nice readlink rename rmdir setegid seteuid \
+diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
+index 7555f9319..cd23240c4 100644
+--- a/doc/ref/posix.texi
++++ b/doc/ref/posix.texi
+@@ -757,8 +757,13 @@ file it points to. @var{path} must be a string.
+
+ @deffn {Scheme Procedure} readlink path
+ @deffnx {C Function} scm_readlink (path)
+-Return the value of the symbolic link named by @var{path} (a
+-string), i.e., the file that the link points to.
++Return the value of the symbolic link named by @var{path} (a string, or
++a port if supported by the system), i.e., the file that the link points
++to.
++
++To read a symbolic link represented by a port, the symbolic link must
++have been opened with the @code{O_NOFOLLOW} and @code{O_PATH} flags.
++@code{(provided? 'readlink-port)} reports whether ports are supported.
+ @end deffn
+
+ @findex fchown
+diff --git a/libguile/filesys.c b/libguile/filesys.c
+index 2a9c36a12..c5bedec07 100644
+--- a/libguile/filesys.c
++++ b/libguile/filesys.c
+@@ -1045,10 +1045,30 @@ SCM_DEFINE (scm_symlink, "symlink", 2, 0, 0,
+ #undef FUNC_NAME
+ #endif /* HAVE_SYMLINK */
+
+-SCM_DEFINE (scm_readlink, "readlink", 1, 0, 0,
++/* Static helper function for choosing between readlink
++ and readlinkat. */
++static int
++do_readlink (int fd, const char *c_path, char *buf, size_t size)
++{
++#ifdef HAVE_READLINKAT
++ if (fd != -1)
++ return readlinkat (fd, c_path, buf, size);
++#else
++ (void) fd;
++#endif
++ return readlink (c_path, buf, size);
++}
++
++SCM_DEFINE (scm_readlink, "readlink", 1, 0, 0,
+ (SCM path),
+- "Return the value of the symbolic link named by @var{path} (a\n"
+- "string), i.e., the file that the link points to.")
++ "Return the value of the symbolic link named by @var{path} (a\n"
++ "string, or a port if supported by the system),\n"
++ "i.e., the file that the link points to.\n"
++ "To read a symbolic link represented by a port, the symbolic\n"
++ "link must have been opened with the @code{O_NOFOLLOW} and\n"
++ "@code{O_PATH} flags."
++ "@code{(provided? 'readlink-port)} reports whether ports are\n"
++ "supported.")
+ #define FUNC_NAME s_scm_readlink
+ {
+ int rv;
+@@ -1056,20 +1076,31 @@ SCM_DEFINE (scm_readlink, "readlink", 1, 0, 0,
+ char *buf;
+ SCM result;
+ char *c_path;
+-
+- scm_dynwind_begin (0);
+-
+- c_path = scm_to_locale_string (path);
+- scm_dynwind_free (c_path);
++ int fdes;
+
++ scm_dynwind_begin (0);
++#ifdef HAVE_READLINKAT
++ if (SCM_OPFPORTP (path))
++ {
++ c_path = "";
++ fdes = SCM_FPORT_FDES (path);
++ }
++ else
++#endif
++ {
++ fdes = -1;
++ c_path = scm_to_locale_string (path);
++ scm_dynwind_free (c_path);
++ }
+ buf = scm_malloc (size);
+
+- while ((rv = readlink (c_path, buf, size)) == size)
++ while ((rv = do_readlink (fdes, c_path, buf, size)) == size)
+ {
+ free (buf);
+ size *= 2;
+ buf = scm_malloc (size);
+ }
++ scm_remember_upto_here_1 (path);
+ if (rv == -1)
+ {
+ int save_errno = errno;
+@@ -2086,6 +2117,9 @@ scm_init_filesys ()
+ #ifdef HAVE_FCHDIR
+ scm_add_feature("chdir-port");
+ #endif
++#ifdef HAVE_READLINKAT
++ scm_add_feature("readlink-port");
++#endif
+
+ #include "filesys.x"
+ }
+diff --git a/test-suite/tests/filesys.test b/test-suite/tests/filesys.test
+index 6b09a2ba0..7feb3492f 100644
+--- a/test-suite/tests/filesys.test
++++ b/test-suite/tests/filesys.test
+@@ -306,3 +306,64 @@
+
+ (pass-if-exception "non-file port" exception:wrong-type-arg
+ (chdir (open-input-string ""))))
++
++(with-test-prefix "readlink"
++ (false-if-exception (delete-file (test-symlink)))
++ (false-if-exception (delete-file (test-file)))
++ (call-with-output-file (test-file)
++ (lambda (port)
++ (display "hello" port)))
++ (if (not (false-if-exception
++ (begin (symlink (test-file) (test-symlink)) #t)))
++ (display "cannot create symlink, some readlink tests skipped\n")
++ (let ()
++ (pass-if-equal "file name of symlink" (test-file)
++ (readlink (test-symlink)))
++
++ (pass-if-equal "port representing a symlink" (test-file)
++ (let ()
++ (unless (and (provided? 'readlink-port)
++ (defined? 'O_NOFOLLOW)
++ (defined? 'O_PATH)
++ (not (= 0 O_NOFOLLOW))
++ (not (= 0 O_PATH)))
++ (throw 'unsupported))
++ (define port (open (test-symlink) (logior O_NOFOLLOW O_PATH)))
++ (define points-to (false-if-exception (readlink port)))
++ (close-port port)
++ points-to))
++
++ (pass-if-exception "not a port or file name" exception:wrong-type-arg
++ (readlink '(stuff)))))
++
++ (pass-if-equal "port representing a regular file" EINVAL
++ (call-with-input-file (test-file)
++ (lambda (port)
++ (unless (provided? 'readlink-port)
++ (throw 'unsupported))
++ (catch 'system-error
++ (lambda ()
++ (readlink port)
++ (close-port port) ; should be unreachable
++ #f)
++ (lambda args
++ (close-port port)
++ ;; At least Linux 5.10.46 returns ENOENT instead of EINVAL.
++ ;; Possibly surprising, but it is documented in some man
++ ;; pages and it doesn't appear to be an accident:
++ ;; <https://elixir.bootlin.com/linux/v5.10.46/source/fs/stat.c#L419>.
++ (define error (system-error-errno args))
++ (if (= error ENOENT)
++ EINVAL
++ error))))))
++
++ (pass-if-exception "non-file port" exception:wrong-type-arg
++ (readlink (open-input-string "")))
++
++ (pass-if-exception "closed port" exception:wrong-type-arg
++ (let ((port (open-file (test-file) "r")))
++ (close-port port)
++ (readlink port)))
++
++ (false-if-exception (delete-file (test-symlink)))
++ (false-if-exception (delete-file (test-file))))
+--
+2.30.2
+
+
diff --git a/gnu/packages/patches/guile-openat-and-friends-03.patch b/gnu/packages/patches/guile-openat-and-friends-03.patch
new file mode 100644
index 0000000000..8cdc9b1771
--- /dev/null
+++ b/gnu/packages/patches/guile-openat-and-friends-03.patch
@@ -0,0 +1,269 @@
+Guix-Upstream: https://lists.gnu.org/archive/html/guile-devel/2021-11/msg00005.html
+From: Maxime Devos <maximedevos@telenet.be>
+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>
+In-Reply-To: <20211116110637.125579-1-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
+
+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 <langinfo.h>]])
+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 <maximedevos@telenet.be>
+
+ 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 <maximedevos@telenet.be>
+ ;;;;
+ ;;;; 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
+
+
+
diff --git a/gnu/packages/patches/guile-openat-and-friends-04.patch b/gnu/packages/patches/guile-openat-and-friends-04.patch
new file mode 100644
index 0000000000..71d12316af
--- /dev/null
+++ b/gnu/packages/patches/guile-openat-and-friends-04.patch
@@ -0,0 +1,142 @@
+Guix-Upstream: https://lists.gnu.org/archive/html/guile-devel/2021-11/msg00005.html
+From: Maxime Devos <maximedevos@telenet.be>
+Subject: [PATCH v2 04/14] =?UTF-8?q?Define=20=E2=80=98symlinkat=E2=80=99?=
+ =?UTF-8?q?=20wrapper=20when=20supported.?=
+Date: Tue, 16 Nov 2021 11:06:27 +0000
+Message-Id: <20211116110637.125579-5-maximedevos@telenet.be>
+In-Reply-To: <20211116110637.125579-1-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
+
+* configure.ac: Detect whether ‘symlinkat’ exists.
+* libguile/filesys.c (scm_symlinkat): Define a Scheme binding
+ when it exists.
+* libguile/filesys.h: Make the binding part of the public C API.
+* doc/ref/posix.texi (File System): Document the binding.
+* test-suite/tests/filesys.test ("symlinkat"): Test it.
+---
+ configure.ac | 2 +-
+ doc/ref/posix.texi | 6 ++++++
+ libguile/filesys.c | 23 +++++++++++++++++++++++
+ libguile/filesys.h | 1 +
+ test-suite/tests/filesys.test | 27 +++++++++++++++++++++++++++
+ 5 files changed, 58 insertions(+), 1 deletion(-)
+
+diff --git a/configure.ac b/configure.ac
+index ddf330d96..b2e9ef3e9 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 \
+- getcwd geteuid getsid \
++ symlinkat 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 b6deffd43..a329eec39 100644
+--- a/doc/ref/posix.texi
++++ b/doc/ref/posix.texi
+@@ -891,6 +891,12 @@ Create a symbolic link named @var{newpath} with the value (i.e., pointing to)
+ @var{oldpath}. The return value is unspecified.
+ @end deffn
+
++@deffn {Scheme Procedure} symlinkat dir oldpath newpath
++@deffnx {C Function} scm_symlinkat (dir, oldpath, newpath)
++Like @code{symlink}, but resolve @var{newpath} relative to
++the directory referred to by the file port @var{dir}.
++@end deffn
++
+ @deffn {Scheme Procedure} mkdir path [mode]
+ @deffnx {C Function} scm_mkdir (path, mode)
+ Create a new directory named by @var{path}. If @var{mode} is omitted
+diff --git a/libguile/filesys.c b/libguile/filesys.c
+index c5bedec07..bfd223434 100644
+--- a/libguile/filesys.c
++++ b/libguile/filesys.c
+@@ -1045,6 +1045,29 @@ SCM_DEFINE (scm_symlink, "symlink", 2, 0, 0,
+ #undef FUNC_NAME
+ #endif /* HAVE_SYMLINK */
+
++#ifdef HAVE_SYMLINKAT
++SCM_DEFINE (scm_symlinkat, "symlinkat", 3, 0, 0,
++ (SCM dir, SCM oldpath, SCM newpath),
++ "Like @code{symlink}, but resolve @var{newpath} relative\n"
++ "to the directory referred to by the file port @var{dir}.")
++#define FUNC_NAME s_scm_symlinkat
++{
++ int val;
++ int fdes;
++
++ SCM_VALIDATE_OPFPORT (SCM_ARG1, dir);
++ fdes = SCM_FPORT_FDES (dir);
++ STRING2_SYSCALL (oldpath, c_oldpath,
++ newpath, c_newpath,
++ val = symlinkat (c_oldpath, fdes, c_newpath));
++ scm_remember_upto_here_1 (dir);
++ if (val != 0)
++ SCM_SYSERROR;
++ return SCM_UNSPECIFIED;
++}
++#undef FUNC_NAME
++#endif /* HAVE_SYMLINKAT */
++
+ /* Static helper function for choosing between readlink
+ and readlinkat. */
+ static int
+diff --git a/libguile/filesys.h b/libguile/filesys.h
+index a3b257c12..d181aca52 100644
+--- a/libguile/filesys.h
++++ b/libguile/filesys.h
+@@ -62,6 +62,7 @@ SCM_API SCM scm_select (SCM reads, SCM writes, SCM excepts, SCM secs, SCM msecs)
+ SCM_API SCM scm_fcntl (SCM object, SCM cmd, SCM value);
+ SCM_API SCM scm_fsync (SCM object);
+ SCM_API SCM scm_symlink (SCM oldpath, SCM newpath);
++SCM_API SCM scm_symlinkat (SCM dir, SCM oldpath, SCM newpath);
+ SCM_API SCM scm_readlink (SCM path);
+ SCM_API SCM scm_lstat (SCM str);
+ SCM_API SCM scm_copy_file (SCM oldfile, SCM newfile);
+diff --git a/test-suite/tests/filesys.test b/test-suite/tests/filesys.test
+index 7feb3492f..64bf92333 100644
+--- a/test-suite/tests/filesys.test
++++ b/test-suite/tests/filesys.test
+@@ -367,3 +367,30 @@
+
+ (false-if-exception (delete-file (test-symlink)))
+ (false-if-exception (delete-file (test-file))))
++
++(with-test-prefix "symlinkat"
++ (pass-if-equal "create" (test-file)
++ (unless (defined? 'symlinkat)
++ (throw 'unsupported))
++ (call-with-port
++ (open "." O_RDONLY)
++ (lambda (port)
++ (symlinkat port (test-file) (test-symlink))
++ (readlink (test-symlink)))))
++ (false-if-exception (delete-file (test-symlink)))
++
++ (pass-if-exception "not a port" exception:wrong-type-arg
++ (unless (defined? 'symlinkat)
++ (throw 'unsupported))
++ (symlinkat "bogus" (test-file) (test-symlink)))
++
++ (pass-if-exception "not a file port" exception:wrong-type-arg
++ (unless (defined? 'symlinkat)
++ (throw 'unsupported))
++ (symlinkat (open-input-string "") (test-file) (test-symlink)))
++
++ (pass-if-exception "closed port" exception:wrong-type-arg
++ (unless (defined? 'symlinkat)
++ (throw 'unsupported))
++ (symlinkat (call-with-port (open "." O_RDONLY) identity)
++ (test-file) (test-symlink))))
+--
+2.30.2
+
+
diff --git a/gnu/packages/patches/guile-openat-and-friends-05.patch b/gnu/packages/patches/guile-openat-and-friends-05.patch
new file mode 100644
index 0000000000..0cbc76004e
--- /dev/null
+++ b/gnu/packages/patches/guile-openat-and-friends-05.patch
@@ -0,0 +1,159 @@
+Guix-Upstream: https://lists.gnu.org/archive/html/guile-devel/2021-11/msg00005.html
+From: Maxime Devos <maximedevos@telenet.be>
+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
+
+* 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
+
+
diff --git a/gnu/packages/patches/guile-openat-and-friends-06.patch b/gnu/packages/patches/guile-openat-and-friends-06.patch
new file mode 100644
index 0000000000..04f8900986
--- /dev/null
+++ b/gnu/packages/patches/guile-openat-and-friends-06.patch
@@ -0,0 +1,37 @@
+Guix-Upstream: https://lists.gnu.org/archive/html/guile-devel/2021-11/msg00005.html
+From: Maxime Devos <maximedevos@telenet.be>
+Subject: [PATCH v2 06/14] =?UTF-8?q?Correct=20documentation=20of=20?=
+ =?UTF-8?q?=E2=80=98mkdir=E2=80=99=20w.r.t.=20the=20umask.?=
+Date: Tue, 16 Nov 2021 11:06:29 +0000
+Message-Id: <20211116110637.125579-7-maximedevos@telenet.be>
+In-Reply-To: <20211116110637.125579-1-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
+
+* doc/ref/posix.texi (mkdir): Note that the umask is applied even if the
+ mode argument is set.
+---
+ doc/ref/posix.texi | 3 ++-
+ 1 file changed, 2 insertions(+), 1 deletion(-)
+
+diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
+index d261ac8da..7f136376b 100644
+--- a/doc/ref/posix.texi
++++ b/doc/ref/posix.texi
+@@ -902,7 +902,8 @@ the directory referred to by the file port @var{dir}.
+ Create a new directory named by @var{path}. If @var{mode} is omitted
+ then the permissions of the directory are set to @code{#o777}
+ masked with the current umask (@pxref{Processes, @code{umask}}).
+-Otherwise they are set to the value specified with @var{mode}.
++Otherwise they are set to the value specified with @var{mode}
++masked with the current umask.
+ The return value is unspecified.
+ @end deffn
+
+--
+2.30.2
+
+
diff --git a/gnu/packages/patches/guile-openat-and-friends-07.patch b/gnu/packages/patches/guile-openat-and-friends-07.patch
new file mode 100644
index 0000000000..00bce2205a
--- /dev/null
+++ b/gnu/packages/patches/guile-openat-and-friends-07.patch
@@ -0,0 +1,40 @@
+Guix-Upstream: https://lists.gnu.org/archive/html/guile-devel/2021-11/msg00005.html
+From: Maxime Devos <maximedevos@telenet.be>
+Subject: [PATCH v2 07/14] Define AT_REMOVEDIR and others when available.
+Date: Tue, 16 Nov 2021 11:06:30 +0000
+Message-Id: <20211116110637.125579-8-maximedevos@telenet.be>
+In-Reply-To: <20211116110637.125579-1-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
+
+* libguile/posix.c (scm_init_posix): Define (in Scheme)
+ AT_REMOVEDIR and AT_EACCESS when defined (in C).
+---
+ libguile/posix.c | 6 ++++++
+ 1 file changed, 6 insertions(+)
+
+diff --git a/libguile/posix.c b/libguile/posix.c
+index bd7f40ca8..a6f7c9a0d 100644
+--- a/libguile/posix.c
++++ b/libguile/posix.c
+@@ -2503,6 +2503,12 @@ scm_init_posix ()
+ #ifdef AT_EMPTY_PATH
+ scm_c_define ("AT_EMPTY_PATH", scm_from_int (AT_EMPTY_PATH));
+ #endif
++#ifdef AT_REMOVEDIR
++ scm_c_define ("AT_REMOVEDIR", scm_from_int (AT_REMOVEDIR));
++#endif
++#ifdef AT_EACCESS
++ scm_c_define ("AT_EACCESS", scm_from_int (AT_EACCESS));
++#endif
+
+ #include "cpp-SIG.c"
+ #include "posix.x"
+--
+2.30.2
+
+
+
diff --git a/gnu/packages/patches/guile-openat-and-friends-08.patch b/gnu/packages/patches/guile-openat-and-friends-08.patch
new file mode 100644
index 0000000000..e922b0aeb5
--- /dev/null
+++ b/gnu/packages/patches/guile-openat-and-friends-08.patch
@@ -0,0 +1,240 @@
+Guix-Upstream: https://lists.gnu.org/archive/html/guile-devel/2021-11/msg00005.html
+From: Maxime Devos <maximedevos@telenet.be>
+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>
+In-Reply-To: <20211116110637.125579-1-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
+
+* 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
+
+
diff --git a/gnu/packages/patches/guile-openat-and-friends-09.patch b/gnu/packages/patches/guile-openat-and-friends-09.patch
new file mode 100644
index 0000000000..9762ac56c4
--- /dev/null
+++ b/gnu/packages/patches/guile-openat-and-friends-09.patch
@@ -0,0 +1,173 @@
+Guix-Upstream: https://lists.gnu.org/archive/html/guile-devel/2021-11/msg00005.html
+From: Maxime Devos <maximedevos@telenet.be>
+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>
+In-Reply-To: <20211116110637.125579-1-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
+
+* 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
+
+
diff --git a/gnu/packages/patches/guile-openat-and-friends-10.patch b/gnu/packages/patches/guile-openat-and-friends-10.patch
new file mode 100644
index 0000000000..3f50b1d7d5
--- /dev/null
+++ b/gnu/packages/patches/guile-openat-and-friends-10.patch
@@ -0,0 +1,204 @@
+Guix-Upstream: https://lists.gnu.org/archive/html/guile-devel/2021-11/msg00005.html
+From: Maxime Devos <maximedevos@telenet.be>
+Subject: [PATCH v2 10/14] =?UTF-8?q?Define=20a=20Scheme=20binding=20to=20?=
+ =?UTF-8?q?=E2=80=98unlinkat=E2=80=99=20when=20it=20exists.?=
+Date: Tue, 16 Nov 2021 11:06:33 +0000
+Message-Id: <20211116110637.125579-11-maximedevos@telenet.be>
+In-Reply-To: <20211116110637.125579-1-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
+
+‘unlinkat’ is used for both unlinking regular files
+and removing empty directories.
+
+* configure.ac: Detect if ‘unlinkat’ exists.
+* doc/ref/posix.texi (File System): Document why there is no
+ ‘rmdirat’ procedure, and document the ‘delete-file-at’ procedure.
+* libguile/filesys.c
+ (scm_rmdir): Adjust the docstring here as well.
+ (scm_delete_file_at): Define a Scheme binding to ‘unlinkat’.
+* libguile/filesys.h (scm_delete_file_at): Make ‘scm_delete_file_at’
+ part of the C API.
+---
+ configure.ac | 5 +--
+ doc/ref/posix.texi | 12 +++++++
+ libguile/filesys.c | 32 +++++++++++++++++++
+ libguile/filesys.h | 1 +
+ test-suite/tests/filesys.test | 59 +++++++++++++++++++++++++++++++++++
+ 5 files changed, 107 insertions(+), 2 deletions(-)
+
+diff --git a/configure.ac b/configure.ac
+index 2a5485990..e1c090321 100644
+--- a/configure.ac
++++ b/configure.ac
+@@ -477,7 +477,8 @@ 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, fchmodat - POSIX.1-2008
++# strcoll_l, newlocale, uselocale, utimensat, futimens, fchmodat,
++# unlinkat - POSIX.1-2008
+ # strtol_l - non-POSIX, found in glibc
+ # fork - unavailable on Windows
+ # sched_getaffinity, sched_setaffinity - GNU extensions (glibc)
+@@ -485,7 +486,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 \
+- fchmodat symlinkat mkdirat renameat getcwd geteuid getsid \
++ fchmodat symlinkat mkdirat renameat unlinkat 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 ebb001581..ad10585d9 100644
+--- a/doc/ref/posix.texi
++++ b/doc/ref/posix.texi
+@@ -834,6 +834,18 @@ Deletes (or ``unlinks'') the file whose path is specified by
+ @var{str}.
+ @end deffn
+
++@findex unlinkat
++@deffn {Scheme Procedure} delete-file-at dir str [flags]
++@deffnx {C Function} scm_delete_file_at (dir, str, flags)
++Like @code{unlink}, but resolve @var{str} relative to the
++directory referred to by the file port @var{dir} instead.
++
++The optional @var{flags} argument can be @code{AT_REMOVEDIR},
++in which case @code{delete-file-at} will act like @code{rmdir} instead
++of @code{delete-file}. Why doesn't POSIX have a @code{rmdirat} function
++for this instead? No idea!
++@end deffn
++
+ @deffn {Scheme Procedure} copy-file oldfile newfile
+ @deffnx {C Function} scm_copy_file (oldfile, newfile)
+ Copy the file specified by @var{oldfile} to @var{newfile}.
+diff --git a/libguile/filesys.c b/libguile/filesys.c
+index 4dd9c7b48..7e6d89626 100644
+--- a/libguile/filesys.c
++++ b/libguile/filesys.c
+@@ -1469,6 +1469,38 @@ SCM_DEFINE (scm_delete_file, "delete-file", 1, 0, 0,
+ }
+ #undef FUNC_NAME
+
++#ifdef HAVE_UNLINKAT
++SCM_DEFINE (scm_delete_file_at, "delete-file-at", 2, 1, 0,
++ (SCM dir, SCM str, SCM flags),
++ "Like @code{unlink}, but resolve @var{str} relative to the\n"
++ "directory referred to by the file port @var{dir} instead.\n\n"
++ "The optional @var{flags} argument can be @code{AT_REMOVEDIR},\n"
++ "in which case @code{delete-file-at} will act like @code{rmdir} instead\n"
++ "of @code{delete-file}. Why doesn't POSIX have a @code{rmdirat} function\n"
++ "for this instead? No idea!")
++#define FUNC_NAME s_scm_delete_file_at
++{
++ int ans;
++ int dir_fdes;
++ int c_flags;
++
++ 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 (str, c_str, ans = unlinkat (dir_fdes, c_str, c_flags));
++ scm_remember_upto_here_1 (dir);
++ if (ans != 0)
++ SCM_SYSERROR;
++ return SCM_UNSPECIFIED;
++}
++#undef FUNC_NAME
++#endif
++
+ SCM_DEFINE (scm_access, "access?", 2, 0, 0,
+ (SCM path, SCM how),
+ "Test accessibility of a file under the real UID and GID of the\n"
+diff --git a/libguile/filesys.h b/libguile/filesys.h
+index 377a3795e..37d084cd5 100644
+--- a/libguile/filesys.h
++++ b/libguile/filesys.h
+@@ -51,6 +51,7 @@ 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_delete_file_at (SCM dir, SCM str, SCM flags);
+ 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);
+diff --git a/test-suite/tests/filesys.test b/test-suite/tests/filesys.test
+index 204f3414c..33b68e16d 100644
+--- a/test-suite/tests/filesys.test
++++ b/test-suite/tests/filesys.test
+@@ -589,3 +589,62 @@
+ (pass-if-exception "not a string (2)" exception:wrong-type-arg
+ (skip-if-unsupported)
+ (rename-file-at #f "some" #f 'what)))
++
++(with-test-prefix "delete-file-at"
++ (define (skip-if-unsupported)
++ (when (not (and (defined? 'delete-file-at)
++ (defined? 'AT_REMOVEDIR)))
++ (throw 'unsupported)))
++ (define (create-test-file)
++ (call-with-output-file (test-file) identity))
++ (define (create-test-directory)
++ (mkdir (test-directory)))
++ (define (delete-test-file)
++ (when (file-exists? (test-file))
++ (delete-file (test-file))))
++ (define (delete-test-directory)
++ (when (file-exists? (test-directory))
++ (rmdir (test-directory))))
++
++ (pass-if-equal "regular file" #f
++ (skip-if-unsupported)
++ (create-test-file)
++ (call-with-port
++ (open (dirname (test-file)) O_RDONLY)
++ (lambda (port)
++ (delete-file-at port (basename (test-file)))))
++ (file-exists? (test-file)))
++ (delete-test-file)
++
++ (pass-if-equal "regular file, explicit flags" #f
++ (skip-if-unsupported)
++ (create-test-file)
++ (call-with-port
++ (open (dirname (test-file)) O_RDONLY)
++ (lambda (port)
++ (delete-file-at port (basename (test-file)) 0)))
++ (file-exists? (test-file)))
++ (delete-test-file)
++
++ (pass-if-equal "directory, explicit flags" #f
++ (skip-if-unsupported)
++ (create-test-directory)
++ (call-with-port
++ (open (dirname (test-directory)) O_RDONLY)
++ (lambda (port)
++ (delete-file-at port (basename (test-directory)) AT_REMOVEDIR)))
++ (file-exists? (test-directory)))
++ (delete-test-directory)
++
++ (pass-if-exception "not a port" exception:wrong-type-arg
++ (skip-if-unsupported)
++ (delete-file-at 'bogus "irrelevant"))
++
++ (pass-if-exception "not a file port" exception:wrong-type-arg
++ (skip-if-unsupported)
++ (delete-file-at (open-input-string "") "irrelevant"))
++
++ (pass-if-exception "closed port" exception:wrong-type-arg
++ (skip-if-unsupported)
++ (delete-file-at (call-with-port (open "." O_RDONLY) identity)
++ "irrelevant")))
+--
+2.30.2
+
+
diff --git a/gnu/packages/patches/guile-openat-and-friends-11.patch b/gnu/packages/patches/guile-openat-and-friends-11.patch
new file mode 100644
index 0000000000..37c52ebadc
--- /dev/null
+++ b/gnu/packages/patches/guile-openat-and-friends-11.patch
@@ -0,0 +1,130 @@
+Guix-Upstream: https://lists.gnu.org/archive/html/guile-devel/2021-11/msg00005.html
+From: Maxime Devos <maximedevos@telenet.be>
+Subject: [PATCH v2 11/14] =?UTF-8?q?Define=20a=20Scheme=20binding=20to=20?=
+ =?UTF-8?q?=E2=80=98fchownat=E2=80=99=20when=20it=20exists.?=
+Date: Tue, 16 Nov 2021 11:06:34 +0000
+Message-Id: <20211116110637.125579-12-maximedevos@telenet.be>
+In-Reply-To: <20211116110637.125579-1-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
+
+* configure.ac: Detect whether ‘fchownat’ is available.
+* libguile/filesys.c (scm_chownat): Define a Scheme binding to
+ ‘fchownat’ when available.
+* libguile/filesys.h (scm_chownat): Make it part of the API.
+* doc/ref/posix.texi (File System): Document it.
+---
+ configure.ac | 4 ++--
+ doc/ref/posix.texi | 11 +++++++++++
+ libguile/filesys.c | 35 +++++++++++++++++++++++++++++++++++
+ libguile/filesys.h | 1 +
+ 4 files changed, 49 insertions(+), 2 deletions(-)
+
+diff --git a/configure.ac b/configure.ac
+index e1c090321..dcb6bceb5 100644
+--- a/configure.ac
++++ b/configure.ac
+@@ -478,14 +478,14 @@ 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 - POSIX.1-2008
++# unlinkat, fchownat - POSIX.1-2008
+ # strtol_l - non-POSIX, found in glibc
+ # fork - unavailable on Windows
+ # sched_getaffinity, sched_setaffinity - GNU extensions (glibc)
+ # sendfile - non-POSIX, found in glibc
+ #
+ AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid \
+- fesetround ftime ftruncate fchown fchmod fchdir readlinkat \
++ fesetround ftime ftruncate fchown fchownat fchmod fchdir readlinkat \
+ fchmodat symlinkat mkdirat renameat unlinkat getcwd geteuid getsid \
+ gettimeofday getuid getgid gmtime_r ioctl lstat mkdir mkdtemp mknod \
+ nice readlink rename rmdir setegid seteuid \
+diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
+index ad10585d9..3d06f1c73 100644
+--- a/doc/ref/posix.texi
++++ b/doc/ref/posix.texi
+@@ -784,6 +784,17 @@ unsupported at present). If @var{owner} or @var{group} is specified
+ as @code{-1}, then that ID is not changed.
+ @end deffn
+
++@findex fchownat
++@deffn {Scheme Procedure} chownat dir name owner group [flags]
++@deffnx {C Function} scm_chownat (dir, name, owner, group, flags)
++Like @code{chown}, but modify the owner and/or group of
++the file named @var{name} in the directory referred to
++by the file port @var{dir} instead. The optional argument
++@var{flags} is a bitmask. If @code{AT_SYMLINK_NOFOLLOW} is
++present, then @var{name} will not be dereferenced if it is a
++symbolic link.
++@end deffn
++
+ @findex fchmod
+ @deffn {Scheme Procedure} chmod object mode
+ @deffnx {C Function} scm_chmod (object, mode)
+diff --git a/libguile/filesys.c b/libguile/filesys.c
+index 7e6d89626..c257bb59c 100644
+--- a/libguile/filesys.c
++++ b/libguile/filesys.c
+@@ -193,6 +193,41 @@ SCM_DEFINE (scm_chown, "chown", 3, 0, 0,
+ #undef FUNC_NAME
+ #endif /* HAVE_CHOWN */
+
++#ifdef HAVE_FCHOWNAT
++SCM_DEFINE (scm_chownat, "chown-at", 4, 1, 0,
++ (SCM dir, SCM name, SCM owner, SCM group, SCM flags),
++ "Like @code{chown}, but modify the owner and/or group of\n"
++ "the file named @var{name} in the directory referred to\n"
++ "by the file port @var{dir} instead. The optional argument\n"
++ "@var{flags} is a bitmask. If @code{AT_SYMLINK_NOFOLLOW} is\n"
++ "present, then @var{name} will not be dereferenced if it is a\n"
++ "symbolic link.")
++#define FUNC_NAME s_scm_chownat
++{
++ int rv;
++ int dir_fdes;
++ int c_flags;
++
++ 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 (name, c_name,
++ rv = fchownat (dir_fdes, c_name,
++ scm_to_int (owner), scm_to_int (group),
++ c_flags));
++ scm_remember_upto_here_1 (dir);
++ if (rv == -1)
++ SCM_SYSERROR;
++ return SCM_UNSPECIFIED;
++}
++#undef FUNC_NAME
++#endif /* HAVE_FCHOWNAT */
++
+ \f
+
+ SCM_DEFINE (scm_open_fdes, "open-fdes", 2, 1, 0,
+diff --git a/libguile/filesys.h b/libguile/filesys.h
+index 37d084cd5..7673c8051 100644
+--- a/libguile/filesys.h
++++ b/libguile/filesys.h
+@@ -39,6 +39,7 @@ SCM_API scm_t_bits scm_tc16_dir;
+ \f
+
+ SCM_API SCM scm_chown (SCM object, SCM owner, SCM group);
++SCM_API SCM scm_chownat (SCM dir, SCM object, SCM owner, SCM group, SCM flags);
+ 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);
+--
+2.30.2
+
+
diff --git a/gnu/packages/patches/guile-openat-and-friends-12.patch b/gnu/packages/patches/guile-openat-and-friends-12.patch
new file mode 100644
index 0000000000..845e836b03
--- /dev/null
+++ b/gnu/packages/patches/guile-openat-and-friends-12.patch
@@ -0,0 +1,238 @@
+Guix-Upstream: https://lists.gnu.org/archive/html/guile-devel/2021-11/msg00005.html
+From: Maxime Devos <maximedevos@telenet.be>
+Subject: [PATCH v2 12/14] =?UTF-8?q?Define=20a=20Scheme=20binding=20to=20?=
+ =?UTF-8?q?=E2=80=98fstatat=E2=80=99=20when=20available.?=
+Date: Tue, 16 Nov 2021 11:06:35 +0000
+Message-Id: <20211116110637.125579-13-maximedevos@telenet.be>
+In-Reply-To: <20211116110637.125579-1-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
+
+* configure.ac: Detect if ‘fstatat’ is defined.
+* libguile/filesys.c (scm_statat): Define a Scheme binding to ‘fstatat’.
+* libguile/filesys.h (scm_statat): Make it part of the C API.
+* doc/ref/posix.texi (File System): Document it.
+* libguile/syscalls.h (fstatat_or_fstatat64): Choose between ‘fstatat’
+ and ‘fstatat64’.
+---
+ configure.ac | 4 +-
+ doc/ref/posix.texi | 8 ++++
+ libguile/filesys.c | 39 +++++++++++++++++
+ libguile/filesys.h | 1 +
+ libguile/syscalls.h | 1 +
+ test-suite/tests/filesys.test | 80 +++++++++++++++++++++++++++++++++++
+ 6 files changed, 131 insertions(+), 2 deletions(-)
+
+diff --git a/configure.ac b/configure.ac
+index dcb6bceb5..e073e04f4 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 - POSIX.1-2008
++# unlinkat, fchownat, fstatat - POSIX.1-2008
+ # strtol_l - non-POSIX, found in glibc
+ # fork - unavailable on Windows
+ # sched_getaffinity, sched_setaffinity - GNU extensions (glibc)
+@@ -495,7 +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 \
+- futimens sched_getaffinity sched_setaffinity sendfile])
++ fstatat futimens sched_getaffinity sched_setaffinity sendfile])
+
+ # The newlib C library uses _NL_ prefixed locale langinfo constants.
+ AC_CHECK_DECLS([_NL_NUMERIC_GROUPING], [], [], [[#include <langinfo.h>]])
+diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
+index 3d06f1c73..cdd03f141 100644
+--- a/doc/ref/posix.texi
++++ b/doc/ref/posix.texi
+@@ -755,6 +755,14 @@ it will return information about a symbolic link itself, not the
+ file it points to. @var{path} must be a string.
+ @end deffn
+
++@deffn {Scheme Procedure} statat dir filename [flags]
++@deffnx {C Function} scm_statat dir filename flags
++Like @code{stat}, but resolve @var{filename} relative to the directory
++referred to by the file port @var{dir} instead. The optional argument
++@var{flags} argument can be @code{AT_SYMLINK_NOFOLLOW}, in which case
++@var{filename} will not be dereferenced even if it is a symbolic link.
++@end deffn
++
+ @deffn {Scheme Procedure} readlink path
+ @deffnx {C Function} scm_readlink (path)
+ Return the value of the symbolic link named by @var{path} (a string, or
+diff --git a/libguile/filesys.c b/libguile/filesys.c
+index c257bb59c..d045a672f 100644
+--- a/libguile/filesys.c
++++ b/libguile/filesys.c
+@@ -601,6 +601,45 @@ SCM_DEFINE (scm_stat, "stat", 1, 1, 0,
+ }
+ #undef FUNC_NAME
+
++#ifdef HAVE_FSTATAT
++SCM_DEFINE (scm_statat, "statat", 2, 1, 0,
++ (SCM dir, SCM filename, SCM flags),
++ "Like @code{stat}, but resolve @var{filename} relative to the\n"
++ "directory referred to by the file port @var{dir} instead.\n\n"
++ "The optional argument @var{flags} argument can be\n"
++ "@code{AT_SYMLINK_NOFOLLOW}, in which case @var{filename} will\n"
++ "not be dereferenced even if it is a symbolic link.")
++#define FUNC_NAME s_scm_statat
++{
++ int rv;
++ int dir_fdes;
++ int c_flags;
++ struct stat_or_stat64 stat_temp;
++
++ 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 (filename, c_filename,
++ rv = fstatat_or_fstatat64 (dir_fdes, c_filename,
++ &stat_temp, c_flags));
++ scm_remember_upto_here_1 (dir);
++ if (rv != 0)
++ {
++ int en = errno;
++ SCM_SYSERROR_MSG ("~A: ~S",
++ scm_list_2 (scm_strerror (scm_from_int (en)), filename),
++ en);
++ }
++ return scm_stat2scm (&stat_temp);
++}
++#undef FUNC_NAME
++#endif /* HAVE_FSTATAT */
++
+ SCM_DEFINE (scm_lstat, "lstat", 1, 0, 0,
+ (SCM str),
+ "Similar to @code{stat}, but does not follow symbolic links, i.e.,\n"
+diff --git a/libguile/filesys.h b/libguile/filesys.h
+index 7673c8051..8af0f989a 100644
+--- a/libguile/filesys.h
++++ b/libguile/filesys.h
+@@ -48,6 +48,7 @@ SCM_API SCM scm_open (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);
++SCM_API SCM scm_statat (SCM dir, SCM filename, SCM flags);
+ 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);
+diff --git a/libguile/syscalls.h b/libguile/syscalls.h
+index 30b99c193..37d532e60 100644
+--- a/libguile/syscalls.h
++++ b/libguile/syscalls.h
+@@ -65,6 +65,7 @@
+ # define readdir_r_or_readdir64_r readdir_r
+ #endif
+ #define stat_or_stat64 CHOOSE_LARGEFILE(stat,stat64)
++#define fstatat_or_fstatat64 CHOOSE_LARGEFILE(fstatat,fstatat64)
+ #define truncate_or_truncate64 CHOOSE_LARGEFILE(truncate,truncate64)
+ #define scm_from_off_t_or_off64_t CHOOSE_LARGEFILE(scm_from_off_t,scm_from_int64)
+ #define scm_from_ino_t_or_ino64_t CHOOSE_LARGEFILE(scm_from_ulong,scm_from_uint64)
+diff --git a/test-suite/tests/filesys.test b/test-suite/tests/filesys.test
+index 33b68e16d..b794b07b3 100644
+--- a/test-suite/tests/filesys.test
++++ b/test-suite/tests/filesys.test
+@@ -134,6 +134,86 @@
+ (close-port port)
+ (eqv? 5 (stat:size st))))))
+
++(with-test-prefix "statat"
++ ;; file-exists? from (ice-9 boot) dereferences symbolic links
++ ;; (a bug?).
++ (define (file-exists? filename)
++ (catch 'system-error
++ (lambda () (lstat filename) #t)
++ (lambda args
++ (if (= (system-error-errno args) ENOENT)
++ ;; For the purposes of the following tests,
++ ;; it is safe to ignore errors like EPERM, but a correct
++ ;; implementation would return #t for that error.
++ #f
++ (apply throw args)))))
++ (define (maybe-delete-directory)
++ (when (file-exists? (test-directory))
++ (for-each
++ (lambda (filename)
++ (define full-name (in-vicinity (test-directory) filename))
++ (when (file-exists? full-name)
++ (delete-file full-name)))
++ '("test-file" "test-symlink"))
++ (rmdir (test-directory))))
++ (define (skip-unless-defined . things)
++ (for-each (lambda (thing)
++ (unless (defined? thing)
++ (throw 'unsupported)))
++ things))
++ (maybe-delete-directory)
++ (mkdir (test-directory))
++ (call-with-output-file (in-vicinity (test-directory) "test-file")
++ (lambda (port)
++ (display "hello" port)))
++
++ ;; Return #true if the symlink was created, #false otherwise.
++ (define (maybe-create-symlink)
++ (if (file-exists? (in-vicinity (test-directory) "test-symlink"))
++ #t
++ (false-if-exception
++ (symlink "test-file"
++ (in-vicinity (test-directory) "test-symlink")))))
++
++ (pass-if-equal "regular file" 5
++ (skip-unless-defined 'statat)
++ (call-with-port
++ (open (test-directory) O_RDONLY)
++ (lambda (port)
++ (stat:size (statat port "test-file")))))
++
++ (pass-if-equal "regular file, AT_SYMLINK_NOFOLLOW" 5
++ (skip-unless-defined 'statat 'AT_SYMLINK_NOFOLLOW)
++ (call-with-port
++ (open (test-directory) O_RDONLY)
++ (lambda (port)
++ (stat:size (statat port "test-file" AT_SYMLINK_NOFOLLOW)))))
++
++ (pass-if-equal "symbolic links are dereferenced" '(regular 5)
++ ;; Not all systems support symlinks.
++ (skip-unless-defined 'statat 'symlink)
++ (unless (maybe-create-symlink)
++ (throw 'unresolved))
++ (call-with-port
++ (open (test-directory) O_RDONLY)
++ (lambda (port)
++ (define result (statat port "test-symlink"))
++ (list (stat:type result) (stat:size result)))))
++
++ (pass-if-equal "symbolic links are not dereferenced"
++ `(symlink ,(string-length "test-file"))
++ ;; Not all systems support symlinks.
++ (skip-unless-defined 'statat 'symlink)
++ (unless (maybe-create-symlink)
++ (throw 'unresolved))
++ (call-with-port
++ (open (test-directory) O_RDONLY)
++ (lambda (port)
++ (define result (statat port "test-symlink" AT_SYMLINK_NOFOLLOW))
++ (list (stat:type result) (stat:size result)))))
++
++ (maybe-delete-directory))
++
+ (with-test-prefix "sendfile"
+
+ (let* ((file (search-path %load-path "ice-9/boot-9.scm"))
+--
+2.30.2
+
+
diff --git a/gnu/packages/patches/guile-openat-and-friends-13.patch b/gnu/packages/patches/guile-openat-and-friends-13.patch
new file mode 100644
index 0000000000..6f9c2c5b4e
--- /dev/null
+++ b/gnu/packages/patches/guile-openat-and-friends-13.patch
@@ -0,0 +1,314 @@
+Guix-Upstream: https://lists.gnu.org/archive/html/guile-devel/2021-11/msg00005.html
+From: Maxime Devos <maximedevos@telenet.be>
+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>
+In-Reply-To: <20211116110637.125579-1-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
+
+* 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
+
+
base-commit: 29091731a0c6cb649cdfd72297575fe2bb2a9591
prerequisite-patch-id: e2faf5cdf72f293aca0aff5c89cc1f0dd874d29c
prerequisite-patch-id: 72285c2232e09bc1637c174b4489e13bb76c0427
--
2.34.0
^ permalink raw reply related [flat|nested] 7+ messages in thread* [bug#54485] [PATCH] gnu: Add guile-with-openat. 2022-03-20 21:50 [bug#54485] [PATCH] gnu: Add guile-with-openat Maxime Devos @ 2022-03-20 22:39 ` Maxime Devos 2022-03-21 14:24 ` Maxime Devos 2022-03-24 11:37 ` Ludovic Courtès ` (2 subsequent siblings) 3 siblings, 1 reply; 7+ messages in thread From: Maxime Devos @ 2022-03-20 22:39 UTC (permalink / raw) To: 54485 [-- Attachment #1: Type: text/plain, Size: 259 bytes --] Maxime Devos schreef op zo 20-03-2022 om 21:50 [+0000]: > XXX Don't apply yet, let's wait for > "./pre-inst-env guix build guile-with-openat" to complete first. Looks like it fails because 'texinfo' is missing from the 'native-inputs', let's retry ... [-- Attachment #2: This is a digitally signed message part --] [-- Type: application/pgp-signature, Size: 260 bytes --] ^ permalink raw reply [flat|nested] 7+ messages in thread
* [bug#54485] [PATCH] gnu: Add guile-with-openat. 2022-03-20 22:39 ` Maxime Devos @ 2022-03-21 14:24 ` Maxime Devos 0 siblings, 0 replies; 7+ messages in thread From: Maxime Devos @ 2022-03-21 14:24 UTC (permalink / raw) To: 54485 [-- Attachment #1.1: Type: text/plain, Size: 474 bytes --] Maxime Devos schreef op zo 20-03-2022 om 23:39 [+0100]: > Maxime Devos schreef op zo 20-03-2022 om 21:50 [+0000]: > > XXX Don't apply yet, let's wait for > > "./pre-inst-env guix build guile-with-openat" to complete first. > > Looks like it fails because 'texinfo' is missing from the > 'native-inputs', let's retry ... See attachment. Next step: modify 'mkdir-p/perms' to be race-free, using 'openat', 'chownat' and perhaps 'statat' ... Greetings, Maxime. [-- Attachment #1.2: 0001-gnu-Add-guile-with-openat.patch --] [-- Type: text/x-patch, Size: 102281 bytes --] From aac29b952e558e20ac97a95713b15ac453e59742 Mon Sep 17 00:00:00 2001 From: Maxime Devos <maximedevos@telenet.be> Date: Sun, 20 Mar 2022 21:29:29 +0000 Subject: [PATCH] gnu: Add guile-with-openat. This will allow us to work on resolving the >1 year publicly known privilege escalation, see <https://issues.guix.gnu.org/47584>. * gnu/packages/guile.scm (guile-with-openat): New variable. --- gnu/local.mk | 14 + gnu/packages/guile.scm | 47 ++- .../patches/guile-openat-and-friends-01.patch | 193 +++++++++++ .../patches/guile-openat-and-friends-02.patch | 219 ++++++++++++ .../patches/guile-openat-and-friends-03.patch | 269 +++++++++++++++ .../patches/guile-openat-and-friends-04.patch | 142 ++++++++ .../patches/guile-openat-and-friends-05.patch | 159 +++++++++ .../patches/guile-openat-and-friends-06.patch | 37 +++ .../patches/guile-openat-and-friends-07.patch | 40 +++ .../patches/guile-openat-and-friends-08.patch | 240 +++++++++++++ .../patches/guile-openat-and-friends-09.patch | 173 ++++++++++ .../patches/guile-openat-and-friends-10.patch | 204 ++++++++++++ .../patches/guile-openat-and-friends-11.patch | 130 ++++++++ .../patches/guile-openat-and-friends-12.patch | 238 +++++++++++++ .../patches/guile-openat-and-friends-13.patch | 314 ++++++++++++++++++ 15 files changed, 2417 insertions(+), 2 deletions(-) create mode 100644 gnu/packages/patches/guile-openat-and-friends-01.patch create mode 100644 gnu/packages/patches/guile-openat-and-friends-02.patch create mode 100644 gnu/packages/patches/guile-openat-and-friends-03.patch create mode 100644 gnu/packages/patches/guile-openat-and-friends-04.patch create mode 100644 gnu/packages/patches/guile-openat-and-friends-05.patch create mode 100644 gnu/packages/patches/guile-openat-and-friends-06.patch create mode 100644 gnu/packages/patches/guile-openat-and-friends-07.patch create mode 100644 gnu/packages/patches/guile-openat-and-friends-08.patch create mode 100644 gnu/packages/patches/guile-openat-and-friends-09.patch create mode 100644 gnu/packages/patches/guile-openat-and-friends-10.patch create mode 100644 gnu/packages/patches/guile-openat-and-friends-11.patch create mode 100644 gnu/packages/patches/guile-openat-and-friends-12.patch create mode 100644 gnu/packages/patches/guile-openat-and-friends-13.patch diff --git a/gnu/local.mk b/gnu/local.mk index 1252643dc0..40dd8c9c55 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -49,6 +49,7 @@ # Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com> # Copyright © 2022 Daniel Meißner <daniel.meissner-i4k@ruhr-uni-bochum.de> # Copyright © 2022 Remco van 't Veer <remco@remworks.net> +# Copyright © 2022 Maxime Devos <maximedevos@telenet.be> # # This file is part of GNU Guix. # @@ -1235,6 +1236,19 @@ dist_patch_DATA = \ %D%/packages/patches/guile-fibers-wait-for-io-readiness.patch \ %D%/packages/patches/guile-gdbm-ffi-support-gdbm-1.14.patch \ %D%/packages/patches/guile-git-adjust-for-libgit2-1.2.0.patch \ + %D%/packages/patches/guile-openat-and-friends-01.patch \ + %D%/packages/patches/guile-openat-and-friends-02.patch \ + %D%/packages/patches/guile-openat-and-friends-03.patch \ + %D%/packages/patches/guile-openat-and-friends-04.patch \ + %D%/packages/patches/guile-openat-and-friends-05.patch \ + %D%/packages/patches/guile-openat-and-friends-06.patch \ + %D%/packages/patches/guile-openat-and-friends-07.patch \ + %D%/packages/patches/guile-openat-and-friends-08.patch \ + %D%/packages/patches/guile-openat-and-friends-09.patch \ + %D%/packages/patches/guile-openat-and-friends-10.patch \ + %D%/packages/patches/guile-openat-and-friends-11.patch \ + %D%/packages/patches/guile-openat-and-friends-12.patch \ + %D%/packages/patches/guile-openat-and-friends-13.patch \ %D%/packages/patches/guile-present-coding.patch \ %D%/packages/patches/guile-rsvg-pkgconfig.patch \ %D%/packages/patches/guile-emacs-fix-configure.patch \ diff --git a/gnu/packages/guile.scm b/gnu/packages/guile.scm index f74a389da5..efee96e662 100644 --- a/gnu/packages/guile.scm +++ b/gnu/packages/guile.scm @@ -16,7 +16,7 @@ ;;; Copyright © 2018 Eric Bavier <bavier@member.fsf.org> ;;; Copyright © 2019 Taylan Kammer <taylan.kammer@gmail.com> ;;; Copyright © 2020, 2021 Efraim Flashner <efraim@flashner.co.il> -;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be> +;;; Copyright © 2021, 2022 Maxime Devos <maximedevos@telenet.be> ;;; Copyright © 2021 Timothy Sample <samplet@ngyro.com> ;;; ;;; This file is part of GNU Guix. @@ -60,6 +60,7 @@ #:use-module (gnu packages version-control) #:use-module (guix packages) #:use-module (guix download) + #:use-module (guix gexp) #:use-module (guix git-download) #:use-module (guix build-system gnu) #:use-module (guix build-system guile) @@ -163,7 +164,6 @@ without requiring the source code to be rewritten.") ("pkgconfig" ,pkg-config))) (inputs `(("libffi" ,libffi) ,@(libiconv-if-needed) - ;; We need Bash when cross-compiling because some of the scripts ;; in bin/ refer to it. Use 'bash-minimal' because we don't need ;; an interactive Bash with Readline and all. @@ -388,6 +388,49 @@ without requiring the source code to be rewritten.") (files '("lib/guile/3.0/site-ccache" "share/guile/site/3.0"))))))) +;; (A static variant of) this package will be used to implement +;; TOCTOU-free behaviour in <https://issues.guix.gnu.org/54309> +;; and <https://issues.guix.gnu.org/47584>. +(define-public guile-with-openat + (package + (inherit + (package-with-extra-patches guile-3.0 + (search-patches + "guile-openat-and-friends-01.patch" + "guile-openat-and-friends-02.patch" + "guile-openat-and-friends-03.patch" + "guile-openat-and-friends-04.patch" + "guile-openat-and-friends-05.patch" + "guile-openat-and-friends-06.patch" + "guile-openat-and-friends-07.patch" + "guile-openat-and-friends-08.patch" + "guile-openat-and-friends-09.patch" + "guile-openat-and-friends-10.patch" + "guile-openat-and-friends-11.patch" + "guile-openat-and-friends-12.patch" + "guile-openat-and-friends-13.patch"))) + (name "guile-with-openat") + (arguments + (substitute-keyword-arguments (package-arguments guile-3.0) + ((#:phases phases) + #~(modify-phases #$phases + (add-after 'unpack 'reconfigure + (lambda _ + ;; Avoid using the out-of-date configure, such that 'openat' + ;; and friends will be detected. + (delete-file "configure"))))))) + (native-inputs + (modify-inputs (package-native-inputs guile-3.0) + (prepend autoconf automake gnu-gettext libtool texinfo))) + (synopsis "Guile, with support for @code{openat} and friends") + (description "This is a variant of the Guile package, extending the +file system interface to support more directory-relative operations. + +More concretely, it adds a procedure @code{openat} that can be used +to open a file in a directory that has been opened (as a port), without +@acronym{TOCTOU,time-of-check to time-of-use} issues, and a few other +procedures of a similar nature."))) + (define-public guile-3.0-latest (package (inherit guile-3.0) diff --git a/gnu/packages/patches/guile-openat-and-friends-01.patch b/gnu/packages/patches/guile-openat-and-friends-01.patch new file mode 100644 index 0000000000..d430fb99e3 --- /dev/null +++ b/gnu/packages/patches/guile-openat-and-friends-01.patch @@ -0,0 +1,193 @@ +Guix-Upstream: https://lists.gnu.org/archive/html/guile-devel/2021-11/msg00005.html +From: Maxime Devos <maximedevos@telenet.be> +Subject: [PATCH v2 01/14] + =?UTF-8?q?Allow=20file=20ports=20in=20=E2=80=98c?= + =?UTF-8?q?hdir=E2=80=99=20when=20supported.?= +Date: Tue, 16 Nov 2021 11:06:24 +0000 +Message-Id: <20211116110637.125579-2-maximedevos@telenet.be> +In-Reply-To: <20211116110637.125579-1-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 + +* configure.ac: Check for ‘fchdir’. +* libguile/filesys.c +(scm_chdir): Support file ports. +(scm_init_filesys): Report support of file ports. +* doc/ref/posix.texi (Processes): Update accordingly. +* doc/ref/guile.texi: Add copyright line for new documentation in this +patch and later patches. +* test-suite/tests/filesys.test ("chdir"): Test it. +--- + configure.ac | 3 ++- + doc/ref/guile.texi | 3 ++- + doc/ref/posix.texi | 5 ++++- + libguile/filesys.c | 23 +++++++++++++++++++- + test-suite/tests/filesys.test | 41 +++++++++++++++++++++++++++++++++++ + 5 files changed, 71 insertions(+), 4 deletions(-) + +diff --git a/configure.ac b/configure.ac +index bd49bf162..b7e4663f7 100644 +--- a/configure.ac ++++ b/configure.ac +@@ -484,7 +484,8 @@ AC_CHECK_HEADERS([assert.h crt_externs.h]) + # sendfile - non-POSIX, found in glibc + # + AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid \ +- fesetround ftime ftruncate fchown fchmod getcwd geteuid getsid \ ++ fesetround ftime ftruncate fchown fchmod fchdir \ ++ 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/guile.texi b/doc/ref/guile.texi +index 660b1ae90..48af1f820 100644 +--- a/doc/ref/guile.texi ++++ b/doc/ref/guile.texi +@@ -14,7 +14,8 @@ + This manual documents Guile version @value{VERSION}. + + Copyright (C) 1996-1997, 2000-2005, 2009-2021 Free Software Foundation, +-Inc. ++Inc. \\ ++Copyright (C) 2021 Maxime Devos + + Permission is granted to copy, distribute and/or modify this document + under the terms of the GNU Free Documentation License, Version 1.3 or +diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi +index 7633bd5a3..7555f9319 100644 +--- a/doc/ref/posix.texi ++++ b/doc/ref/posix.texi +@@ -2,6 +2,7 @@ + @c This is part of the GNU Guile Reference Manual. + @c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2006, 2007, + @c 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2017, 2021 Free Software Foundation, Inc. ++@c Copyright (C) 2021 Maxime Devos <maximedevos@telenet.be> + @c See the file guile.texi for copying conditions. + + @node POSIX +@@ -1605,7 +1606,9 @@ The return value is unspecified. + @deffn {Scheme Procedure} chdir str + @deffnx {C Function} scm_chdir (str) + @cindex current directory +-Change the current working directory to @var{str}. ++Change the current working directory to @var{str}. @var{str} can be a ++string containing a file name, or a port if supported by the system. ++@code{(provided? 'chdir-port)} reports whether ports are supported. + The return value is unspecified. + @end deffn + +diff --git a/libguile/filesys.c b/libguile/filesys.c +index 6247734e8..2a9c36a12 100644 +--- a/libguile/filesys.c ++++ b/libguile/filesys.c +@@ -1,5 +1,6 @@ + /* Copyright 1996-2002,2004,2006,2009-2019,2021 + Free Software Foundation, Inc. ++ Copyright 2021 Maxime Devos <maximedevos@telenet.be> + + This file is part of Guile. + +@@ -621,12 +622,28 @@ SCM_DEFINE (scm_link, "link", 2, 0, 0, + SCM_DEFINE (scm_chdir, "chdir", 1, 0, 0, + (SCM str), + "Change the current working directory to @var{str}.\n" ++ "@var{str} can be a string containing a file name,\n" ++ "or a port if supported by the system.\n" ++ "@code{(provided? 'chdir-port)} reports whether ports " ++ "are supported." + "The return value is unspecified.") + #define FUNC_NAME s_scm_chdir + { + int ans; + +- STRING_SYSCALL (str, c_str, ans = chdir (c_str)); ++#ifdef HAVE_FCHDIR ++ if (SCM_OPFPORTP (str)) ++ { ++ int fdes; ++ fdes = SCM_FPORT_FDES (str); ++ SCM_SYSCALL (ans = fchdir (fdes)); ++ scm_remember_upto_here_1 (str); ++ } ++ else ++#endif ++ { ++ STRING_SYSCALL (str, c_str, ans = chdir (c_str)); ++ } + if (ans != 0) + SCM_SYSERROR; + return SCM_UNSPECIFIED; +@@ -2066,5 +2083,9 @@ scm_init_filesys () + + scm_dot_string = scm_from_utf8_string ("."); + ++#ifdef HAVE_FCHDIR ++ scm_add_feature("chdir-port"); ++#endif ++ + #include "filesys.x" + } +diff --git a/test-suite/tests/filesys.test b/test-suite/tests/filesys.test +index 6fed981e5..6b09a2ba0 100644 +--- a/test-suite/tests/filesys.test ++++ b/test-suite/tests/filesys.test +@@ -1,6 +1,7 @@ + ;;;; filesys.test --- test file system functions -*- scheme -*- + ;;;; + ;;;; Copyright (C) 2004, 2006, 2013, 2019, 2021 Free Software Foundation, Inc. ++;;;; Copyright (C) 2021 Maxime Devos <maximedevos@telenet.be> + ;;;; + ;;;; This library is free software; you can redistribute it and/or + ;;;; modify it under the terms of the GNU Lesser General Public +@@ -265,3 +266,43 @@ + (result (eqv? 'directory (stat:type _stat)))) + (false-if-exception (rmdir name)) + result))))) ++ ++(with-test-prefix "chdir" ++ (pass-if-equal "current directory" (getcwd) ++ (begin (chdir ".") (getcwd))) ++ (define file (search-path %load-path "ice-9/boot-9.scm")) ++ ++ ++ (pass-if-equal "test directory" (dirname file) ++ (let ((olddir (getcwd)) ++ (dir #f)) ++ (chdir (dirname file)) ++ (set! dir (getcwd)) ++ (chdir olddir) ++ dir)) ++ ++ (pass-if-equal "test directory, via port" (dirname file) ++ (unless (provided? 'chdir-port) ++ (throw 'unresolved)) ++ (let ((olddir (getcwd)) ++ (port (open (dirname file) O_RDONLY)) ++ (dir #f)) ++ (chdir port) ++ (set! dir (getcwd)) ++ (chdir olddir) ++ dir)) ++ ++ (pass-if-exception "closed port" exception:wrong-type-arg ++ (unless (provided? 'chdir-port) ++ (throw 'unresolved)) ++ (let ((port (open (dirname file) O_RDONLY)) ++ (olddir (getcwd))) ++ (close-port port) ++ (chdir port) ++ (chdir olddir))) ; should not be reached ++ ++ (pass-if-exception "not a port or file name" exception:wrong-type-arg ++ (chdir '(stuff))) ++ ++ (pass-if-exception "non-file port" exception:wrong-type-arg ++ (chdir (open-input-string "")))) +-- +2.30.2 + + + diff --git a/gnu/packages/patches/guile-openat-and-friends-02.patch b/gnu/packages/patches/guile-openat-and-friends-02.patch new file mode 100644 index 0000000000..211e0a4f4c --- /dev/null +++ b/gnu/packages/patches/guile-openat-and-friends-02.patch @@ -0,0 +1,219 @@ +Guix-Upstream: https://lists.gnu.org/archive/html/guile-devel/2021-11/msg00005.html +From: Maxime Devos <maximedevos@telenet.be> +Subject: [PATCH v2 02/14] + =?UTF-8?q?Allow=20file=20ports=20in=20=E2=80=98r?= + =?UTF-8?q?eadlink=E2=80=99.?= +Date: Tue, 16 Nov 2021 11:06:25 +0000 +Message-Id: <20211116110637.125579-3-maximedevos@telenet.be> +In-Reply-To: <20211116110637.125579-1-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 + +* configure.ac: Detect whether ‘readlinkat’ is defined. +* libguile/filesys.c (scm_readlink): Support file ports + when ‘readlinkat’ exists. + (scm_init_filesys): Provide ‘chdir-ports’ when it exists. +* doc/ref/posix.texi (File System): Document it. +* test-suite/tests/filesys.test ("readlink"): Test it. +--- + configure.ac | 2 +- + doc/ref/posix.texi | 9 ++++-- + libguile/filesys.c | 52 +++++++++++++++++++++++------ + test-suite/tests/filesys.test | 61 +++++++++++++++++++++++++++++++++++ + 4 files changed, 112 insertions(+), 12 deletions(-) + +diff --git a/configure.ac b/configure.ac +index b7e4663f7..4888f880d 100644 +--- a/configure.ac ++++ b/configure.ac +@@ -484,7 +484,7 @@ AC_CHECK_HEADERS([assert.h crt_externs.h]) + # sendfile - non-POSIX, found in glibc + # + AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid \ +- fesetround ftime ftruncate fchown fchmod fchdir \ ++ fesetround ftime ftruncate fchown fchmod fchdir readlinkat \ + getcwd geteuid getsid \ + gettimeofday getuid getgid gmtime_r ioctl lstat mkdir mkdtemp mknod \ + nice readlink rename rmdir setegid seteuid \ +diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi +index 7555f9319..cd23240c4 100644 +--- a/doc/ref/posix.texi ++++ b/doc/ref/posix.texi +@@ -757,8 +757,13 @@ file it points to. @var{path} must be a string. + + @deffn {Scheme Procedure} readlink path + @deffnx {C Function} scm_readlink (path) +-Return the value of the symbolic link named by @var{path} (a +-string), i.e., the file that the link points to. ++Return the value of the symbolic link named by @var{path} (a string, or ++a port if supported by the system), i.e., the file that the link points ++to. ++ ++To read a symbolic link represented by a port, the symbolic link must ++have been opened with the @code{O_NOFOLLOW} and @code{O_PATH} flags. ++@code{(provided? 'readlink-port)} reports whether ports are supported. + @end deffn + + @findex fchown +diff --git a/libguile/filesys.c b/libguile/filesys.c +index 2a9c36a12..c5bedec07 100644 +--- a/libguile/filesys.c ++++ b/libguile/filesys.c +@@ -1045,10 +1045,30 @@ SCM_DEFINE (scm_symlink, "symlink", 2, 0, 0, + #undef FUNC_NAME + #endif /* HAVE_SYMLINK */ + +-SCM_DEFINE (scm_readlink, "readlink", 1, 0, 0, ++/* Static helper function for choosing between readlink ++ and readlinkat. */ ++static int ++do_readlink (int fd, const char *c_path, char *buf, size_t size) ++{ ++#ifdef HAVE_READLINKAT ++ if (fd != -1) ++ return readlinkat (fd, c_path, buf, size); ++#else ++ (void) fd; ++#endif ++ return readlink (c_path, buf, size); ++} ++ ++SCM_DEFINE (scm_readlink, "readlink", 1, 0, 0, + (SCM path), +- "Return the value of the symbolic link named by @var{path} (a\n" +- "string), i.e., the file that the link points to.") ++ "Return the value of the symbolic link named by @var{path} (a\n" ++ "string, or a port if supported by the system),\n" ++ "i.e., the file that the link points to.\n" ++ "To read a symbolic link represented by a port, the symbolic\n" ++ "link must have been opened with the @code{O_NOFOLLOW} and\n" ++ "@code{O_PATH} flags." ++ "@code{(provided? 'readlink-port)} reports whether ports are\n" ++ "supported.") + #define FUNC_NAME s_scm_readlink + { + int rv; +@@ -1056,20 +1076,31 @@ SCM_DEFINE (scm_readlink, "readlink", 1, 0, 0, + char *buf; + SCM result; + char *c_path; +- +- scm_dynwind_begin (0); +- +- c_path = scm_to_locale_string (path); +- scm_dynwind_free (c_path); ++ int fdes; + ++ scm_dynwind_begin (0); ++#ifdef HAVE_READLINKAT ++ if (SCM_OPFPORTP (path)) ++ { ++ c_path = ""; ++ fdes = SCM_FPORT_FDES (path); ++ } ++ else ++#endif ++ { ++ fdes = -1; ++ c_path = scm_to_locale_string (path); ++ scm_dynwind_free (c_path); ++ } + buf = scm_malloc (size); + +- while ((rv = readlink (c_path, buf, size)) == size) ++ while ((rv = do_readlink (fdes, c_path, buf, size)) == size) + { + free (buf); + size *= 2; + buf = scm_malloc (size); + } ++ scm_remember_upto_here_1 (path); + if (rv == -1) + { + int save_errno = errno; +@@ -2086,6 +2117,9 @@ scm_init_filesys () + #ifdef HAVE_FCHDIR + scm_add_feature("chdir-port"); + #endif ++#ifdef HAVE_READLINKAT ++ scm_add_feature("readlink-port"); ++#endif + + #include "filesys.x" + } +diff --git a/test-suite/tests/filesys.test b/test-suite/tests/filesys.test +index 6b09a2ba0..7feb3492f 100644 +--- a/test-suite/tests/filesys.test ++++ b/test-suite/tests/filesys.test +@@ -306,3 +306,64 @@ + + (pass-if-exception "non-file port" exception:wrong-type-arg + (chdir (open-input-string "")))) ++ ++(with-test-prefix "readlink" ++ (false-if-exception (delete-file (test-symlink))) ++ (false-if-exception (delete-file (test-file))) ++ (call-with-output-file (test-file) ++ (lambda (port) ++ (display "hello" port))) ++ (if (not (false-if-exception ++ (begin (symlink (test-file) (test-symlink)) #t))) ++ (display "cannot create symlink, some readlink tests skipped\n") ++ (let () ++ (pass-if-equal "file name of symlink" (test-file) ++ (readlink (test-symlink))) ++ ++ (pass-if-equal "port representing a symlink" (test-file) ++ (let () ++ (unless (and (provided? 'readlink-port) ++ (defined? 'O_NOFOLLOW) ++ (defined? 'O_PATH) ++ (not (= 0 O_NOFOLLOW)) ++ (not (= 0 O_PATH))) ++ (throw 'unsupported)) ++ (define port (open (test-symlink) (logior O_NOFOLLOW O_PATH))) ++ (define points-to (false-if-exception (readlink port))) ++ (close-port port) ++ points-to)) ++ ++ (pass-if-exception "not a port or file name" exception:wrong-type-arg ++ (readlink '(stuff))))) ++ ++ (pass-if-equal "port representing a regular file" EINVAL ++ (call-with-input-file (test-file) ++ (lambda (port) ++ (unless (provided? 'readlink-port) ++ (throw 'unsupported)) ++ (catch 'system-error ++ (lambda () ++ (readlink port) ++ (close-port port) ; should be unreachable ++ #f) ++ (lambda args ++ (close-port port) ++ ;; At least Linux 5.10.46 returns ENOENT instead of EINVAL. ++ ;; Possibly surprising, but it is documented in some man ++ ;; pages and it doesn't appear to be an accident: ++ ;; <https://elixir.bootlin.com/linux/v5.10.46/source/fs/stat.c#L419>. ++ (define error (system-error-errno args)) ++ (if (= error ENOENT) ++ EINVAL ++ error)))))) ++ ++ (pass-if-exception "non-file port" exception:wrong-type-arg ++ (readlink (open-input-string ""))) ++ ++ (pass-if-exception "closed port" exception:wrong-type-arg ++ (let ((port (open-file (test-file) "r"))) ++ (close-port port) ++ (readlink port))) ++ ++ (false-if-exception (delete-file (test-symlink))) ++ (false-if-exception (delete-file (test-file)))) +-- +2.30.2 + + diff --git a/gnu/packages/patches/guile-openat-and-friends-03.patch b/gnu/packages/patches/guile-openat-and-friends-03.patch new file mode 100644 index 0000000000..8cdc9b1771 --- /dev/null +++ b/gnu/packages/patches/guile-openat-and-friends-03.patch @@ -0,0 +1,269 @@ +Guix-Upstream: https://lists.gnu.org/archive/html/guile-devel/2021-11/msg00005.html +From: Maxime Devos <maximedevos@telenet.be> +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> +In-Reply-To: <20211116110637.125579-1-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 + +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 <langinfo.h>]]) +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 <maximedevos@telenet.be> + + 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 <maximedevos@telenet.be> + ;;;; + ;;;; 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 + + + diff --git a/gnu/packages/patches/guile-openat-and-friends-04.patch b/gnu/packages/patches/guile-openat-and-friends-04.patch new file mode 100644 index 0000000000..71d12316af --- /dev/null +++ b/gnu/packages/patches/guile-openat-and-friends-04.patch @@ -0,0 +1,142 @@ +Guix-Upstream: https://lists.gnu.org/archive/html/guile-devel/2021-11/msg00005.html +From: Maxime Devos <maximedevos@telenet.be> +Subject: [PATCH v2 04/14] =?UTF-8?q?Define=20=E2=80=98symlinkat=E2=80=99?= + =?UTF-8?q?=20wrapper=20when=20supported.?= +Date: Tue, 16 Nov 2021 11:06:27 +0000 +Message-Id: <20211116110637.125579-5-maximedevos@telenet.be> +In-Reply-To: <20211116110637.125579-1-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 + +* configure.ac: Detect whether ‘symlinkat’ exists. +* libguile/filesys.c (scm_symlinkat): Define a Scheme binding + when it exists. +* libguile/filesys.h: Make the binding part of the public C API. +* doc/ref/posix.texi (File System): Document the binding. +* test-suite/tests/filesys.test ("symlinkat"): Test it. +--- + configure.ac | 2 +- + doc/ref/posix.texi | 6 ++++++ + libguile/filesys.c | 23 +++++++++++++++++++++++ + libguile/filesys.h | 1 + + test-suite/tests/filesys.test | 27 +++++++++++++++++++++++++++ + 5 files changed, 58 insertions(+), 1 deletion(-) + +diff --git a/configure.ac b/configure.ac +index ddf330d96..b2e9ef3e9 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 \ +- getcwd geteuid getsid \ ++ symlinkat 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 b6deffd43..a329eec39 100644 +--- a/doc/ref/posix.texi ++++ b/doc/ref/posix.texi +@@ -891,6 +891,12 @@ Create a symbolic link named @var{newpath} with the value (i.e., pointing to) + @var{oldpath}. The return value is unspecified. + @end deffn + ++@deffn {Scheme Procedure} symlinkat dir oldpath newpath ++@deffnx {C Function} scm_symlinkat (dir, oldpath, newpath) ++Like @code{symlink}, but resolve @var{newpath} relative to ++the directory referred to by the file port @var{dir}. ++@end deffn ++ + @deffn {Scheme Procedure} mkdir path [mode] + @deffnx {C Function} scm_mkdir (path, mode) + Create a new directory named by @var{path}. If @var{mode} is omitted +diff --git a/libguile/filesys.c b/libguile/filesys.c +index c5bedec07..bfd223434 100644 +--- a/libguile/filesys.c ++++ b/libguile/filesys.c +@@ -1045,6 +1045,29 @@ SCM_DEFINE (scm_symlink, "symlink", 2, 0, 0, + #undef FUNC_NAME + #endif /* HAVE_SYMLINK */ + ++#ifdef HAVE_SYMLINKAT ++SCM_DEFINE (scm_symlinkat, "symlinkat", 3, 0, 0, ++ (SCM dir, SCM oldpath, SCM newpath), ++ "Like @code{symlink}, but resolve @var{newpath} relative\n" ++ "to the directory referred to by the file port @var{dir}.") ++#define FUNC_NAME s_scm_symlinkat ++{ ++ int val; ++ int fdes; ++ ++ SCM_VALIDATE_OPFPORT (SCM_ARG1, dir); ++ fdes = SCM_FPORT_FDES (dir); ++ STRING2_SYSCALL (oldpath, c_oldpath, ++ newpath, c_newpath, ++ val = symlinkat (c_oldpath, fdes, c_newpath)); ++ scm_remember_upto_here_1 (dir); ++ if (val != 0) ++ SCM_SYSERROR; ++ return SCM_UNSPECIFIED; ++} ++#undef FUNC_NAME ++#endif /* HAVE_SYMLINKAT */ ++ + /* Static helper function for choosing between readlink + and readlinkat. */ + static int +diff --git a/libguile/filesys.h b/libguile/filesys.h +index a3b257c12..d181aca52 100644 +--- a/libguile/filesys.h ++++ b/libguile/filesys.h +@@ -62,6 +62,7 @@ SCM_API SCM scm_select (SCM reads, SCM writes, SCM excepts, SCM secs, SCM msecs) + SCM_API SCM scm_fcntl (SCM object, SCM cmd, SCM value); + SCM_API SCM scm_fsync (SCM object); + SCM_API SCM scm_symlink (SCM oldpath, SCM newpath); ++SCM_API SCM scm_symlinkat (SCM dir, SCM oldpath, SCM newpath); + SCM_API SCM scm_readlink (SCM path); + SCM_API SCM scm_lstat (SCM str); + SCM_API SCM scm_copy_file (SCM oldfile, SCM newfile); +diff --git a/test-suite/tests/filesys.test b/test-suite/tests/filesys.test +index 7feb3492f..64bf92333 100644 +--- a/test-suite/tests/filesys.test ++++ b/test-suite/tests/filesys.test +@@ -367,3 +367,30 @@ + + (false-if-exception (delete-file (test-symlink))) + (false-if-exception (delete-file (test-file)))) ++ ++(with-test-prefix "symlinkat" ++ (pass-if-equal "create" (test-file) ++ (unless (defined? 'symlinkat) ++ (throw 'unsupported)) ++ (call-with-port ++ (open "." O_RDONLY) ++ (lambda (port) ++ (symlinkat port (test-file) (test-symlink)) ++ (readlink (test-symlink))))) ++ (false-if-exception (delete-file (test-symlink))) ++ ++ (pass-if-exception "not a port" exception:wrong-type-arg ++ (unless (defined? 'symlinkat) ++ (throw 'unsupported)) ++ (symlinkat "bogus" (test-file) (test-symlink))) ++ ++ (pass-if-exception "not a file port" exception:wrong-type-arg ++ (unless (defined? 'symlinkat) ++ (throw 'unsupported)) ++ (symlinkat (open-input-string "") (test-file) (test-symlink))) ++ ++ (pass-if-exception "closed port" exception:wrong-type-arg ++ (unless (defined? 'symlinkat) ++ (throw 'unsupported)) ++ (symlinkat (call-with-port (open "." O_RDONLY) identity) ++ (test-file) (test-symlink)))) +-- +2.30.2 + + diff --git a/gnu/packages/patches/guile-openat-and-friends-05.patch b/gnu/packages/patches/guile-openat-and-friends-05.patch new file mode 100644 index 0000000000..0cbc76004e --- /dev/null +++ b/gnu/packages/patches/guile-openat-and-friends-05.patch @@ -0,0 +1,159 @@ +Guix-Upstream: https://lists.gnu.org/archive/html/guile-devel/2021-11/msg00005.html +From: Maxime Devos <maximedevos@telenet.be> +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 + +* 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 + + diff --git a/gnu/packages/patches/guile-openat-and-friends-06.patch b/gnu/packages/patches/guile-openat-and-friends-06.patch new file mode 100644 index 0000000000..04f8900986 --- /dev/null +++ b/gnu/packages/patches/guile-openat-and-friends-06.patch @@ -0,0 +1,37 @@ +Guix-Upstream: https://lists.gnu.org/archive/html/guile-devel/2021-11/msg00005.html +From: Maxime Devos <maximedevos@telenet.be> +Subject: [PATCH v2 06/14] =?UTF-8?q?Correct=20documentation=20of=20?= + =?UTF-8?q?=E2=80=98mkdir=E2=80=99=20w.r.t.=20the=20umask.?= +Date: Tue, 16 Nov 2021 11:06:29 +0000 +Message-Id: <20211116110637.125579-7-maximedevos@telenet.be> +In-Reply-To: <20211116110637.125579-1-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 + +* doc/ref/posix.texi (mkdir): Note that the umask is applied even if the + mode argument is set. +--- + doc/ref/posix.texi | 3 ++- + 1 file changed, 2 insertions(+), 1 deletion(-) + +diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi +index d261ac8da..7f136376b 100644 +--- a/doc/ref/posix.texi ++++ b/doc/ref/posix.texi +@@ -902,7 +902,8 @@ the directory referred to by the file port @var{dir}. + Create a new directory named by @var{path}. If @var{mode} is omitted + then the permissions of the directory are set to @code{#o777} + masked with the current umask (@pxref{Processes, @code{umask}}). +-Otherwise they are set to the value specified with @var{mode}. ++Otherwise they are set to the value specified with @var{mode} ++masked with the current umask. + The return value is unspecified. + @end deffn + +-- +2.30.2 + + diff --git a/gnu/packages/patches/guile-openat-and-friends-07.patch b/gnu/packages/patches/guile-openat-and-friends-07.patch new file mode 100644 index 0000000000..00bce2205a --- /dev/null +++ b/gnu/packages/patches/guile-openat-and-friends-07.patch @@ -0,0 +1,40 @@ +Guix-Upstream: https://lists.gnu.org/archive/html/guile-devel/2021-11/msg00005.html +From: Maxime Devos <maximedevos@telenet.be> +Subject: [PATCH v2 07/14] Define AT_REMOVEDIR and others when available. +Date: Tue, 16 Nov 2021 11:06:30 +0000 +Message-Id: <20211116110637.125579-8-maximedevos@telenet.be> +In-Reply-To: <20211116110637.125579-1-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 + +* libguile/posix.c (scm_init_posix): Define (in Scheme) + AT_REMOVEDIR and AT_EACCESS when defined (in C). +--- + libguile/posix.c | 6 ++++++ + 1 file changed, 6 insertions(+) + +diff --git a/libguile/posix.c b/libguile/posix.c +index bd7f40ca8..a6f7c9a0d 100644 +--- a/libguile/posix.c ++++ b/libguile/posix.c +@@ -2503,6 +2503,12 @@ scm_init_posix () + #ifdef AT_EMPTY_PATH + scm_c_define ("AT_EMPTY_PATH", scm_from_int (AT_EMPTY_PATH)); + #endif ++#ifdef AT_REMOVEDIR ++ scm_c_define ("AT_REMOVEDIR", scm_from_int (AT_REMOVEDIR)); ++#endif ++#ifdef AT_EACCESS ++ scm_c_define ("AT_EACCESS", scm_from_int (AT_EACCESS)); ++#endif + + #include "cpp-SIG.c" + #include "posix.x" +-- +2.30.2 + + + diff --git a/gnu/packages/patches/guile-openat-and-friends-08.patch b/gnu/packages/patches/guile-openat-and-friends-08.patch new file mode 100644 index 0000000000..e922b0aeb5 --- /dev/null +++ b/gnu/packages/patches/guile-openat-and-friends-08.patch @@ -0,0 +1,240 @@ +Guix-Upstream: https://lists.gnu.org/archive/html/guile-devel/2021-11/msg00005.html +From: Maxime Devos <maximedevos@telenet.be> +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> +In-Reply-To: <20211116110637.125579-1-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 + +* 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 + + diff --git a/gnu/packages/patches/guile-openat-and-friends-09.patch b/gnu/packages/patches/guile-openat-and-friends-09.patch new file mode 100644 index 0000000000..9762ac56c4 --- /dev/null +++ b/gnu/packages/patches/guile-openat-and-friends-09.patch @@ -0,0 +1,173 @@ +Guix-Upstream: https://lists.gnu.org/archive/html/guile-devel/2021-11/msg00005.html +From: Maxime Devos <maximedevos@telenet.be> +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> +In-Reply-To: <20211116110637.125579-1-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 + +* 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 + + diff --git a/gnu/packages/patches/guile-openat-and-friends-10.patch b/gnu/packages/patches/guile-openat-and-friends-10.patch new file mode 100644 index 0000000000..3f50b1d7d5 --- /dev/null +++ b/gnu/packages/patches/guile-openat-and-friends-10.patch @@ -0,0 +1,204 @@ +Guix-Upstream: https://lists.gnu.org/archive/html/guile-devel/2021-11/msg00005.html +From: Maxime Devos <maximedevos@telenet.be> +Subject: [PATCH v2 10/14] =?UTF-8?q?Define=20a=20Scheme=20binding=20to=20?= + =?UTF-8?q?=E2=80=98unlinkat=E2=80=99=20when=20it=20exists.?= +Date: Tue, 16 Nov 2021 11:06:33 +0000 +Message-Id: <20211116110637.125579-11-maximedevos@telenet.be> +In-Reply-To: <20211116110637.125579-1-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 + +‘unlinkat’ is used for both unlinking regular files +and removing empty directories. + +* configure.ac: Detect if ‘unlinkat’ exists. +* doc/ref/posix.texi (File System): Document why there is no + ‘rmdirat’ procedure, and document the ‘delete-file-at’ procedure. +* libguile/filesys.c + (scm_rmdir): Adjust the docstring here as well. + (scm_delete_file_at): Define a Scheme binding to ‘unlinkat’. +* libguile/filesys.h (scm_delete_file_at): Make ‘scm_delete_file_at’ + part of the C API. +--- + configure.ac | 5 +-- + doc/ref/posix.texi | 12 +++++++ + libguile/filesys.c | 32 +++++++++++++++++++ + libguile/filesys.h | 1 + + test-suite/tests/filesys.test | 59 +++++++++++++++++++++++++++++++++++ + 5 files changed, 107 insertions(+), 2 deletions(-) + +diff --git a/configure.ac b/configure.ac +index 2a5485990..e1c090321 100644 +--- a/configure.ac ++++ b/configure.ac +@@ -477,7 +477,8 @@ 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, fchmodat - POSIX.1-2008 ++# strcoll_l, newlocale, uselocale, utimensat, futimens, fchmodat, ++# unlinkat - POSIX.1-2008 + # strtol_l - non-POSIX, found in glibc + # fork - unavailable on Windows + # sched_getaffinity, sched_setaffinity - GNU extensions (glibc) +@@ -485,7 +486,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 \ +- fchmodat symlinkat mkdirat renameat getcwd geteuid getsid \ ++ fchmodat symlinkat mkdirat renameat unlinkat 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 ebb001581..ad10585d9 100644 +--- a/doc/ref/posix.texi ++++ b/doc/ref/posix.texi +@@ -834,6 +834,18 @@ Deletes (or ``unlinks'') the file whose path is specified by + @var{str}. + @end deffn + ++@findex unlinkat ++@deffn {Scheme Procedure} delete-file-at dir str [flags] ++@deffnx {C Function} scm_delete_file_at (dir, str, flags) ++Like @code{unlink}, but resolve @var{str} relative to the ++directory referred to by the file port @var{dir} instead. ++ ++The optional @var{flags} argument can be @code{AT_REMOVEDIR}, ++in which case @code{delete-file-at} will act like @code{rmdir} instead ++of @code{delete-file}. Why doesn't POSIX have a @code{rmdirat} function ++for this instead? No idea! ++@end deffn ++ + @deffn {Scheme Procedure} copy-file oldfile newfile + @deffnx {C Function} scm_copy_file (oldfile, newfile) + Copy the file specified by @var{oldfile} to @var{newfile}. +diff --git a/libguile/filesys.c b/libguile/filesys.c +index 4dd9c7b48..7e6d89626 100644 +--- a/libguile/filesys.c ++++ b/libguile/filesys.c +@@ -1469,6 +1469,38 @@ SCM_DEFINE (scm_delete_file, "delete-file", 1, 0, 0, + } + #undef FUNC_NAME + ++#ifdef HAVE_UNLINKAT ++SCM_DEFINE (scm_delete_file_at, "delete-file-at", 2, 1, 0, ++ (SCM dir, SCM str, SCM flags), ++ "Like @code{unlink}, but resolve @var{str} relative to the\n" ++ "directory referred to by the file port @var{dir} instead.\n\n" ++ "The optional @var{flags} argument can be @code{AT_REMOVEDIR},\n" ++ "in which case @code{delete-file-at} will act like @code{rmdir} instead\n" ++ "of @code{delete-file}. Why doesn't POSIX have a @code{rmdirat} function\n" ++ "for this instead? No idea!") ++#define FUNC_NAME s_scm_delete_file_at ++{ ++ int ans; ++ int dir_fdes; ++ int c_flags; ++ ++ 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 (str, c_str, ans = unlinkat (dir_fdes, c_str, c_flags)); ++ scm_remember_upto_here_1 (dir); ++ if (ans != 0) ++ SCM_SYSERROR; ++ return SCM_UNSPECIFIED; ++} ++#undef FUNC_NAME ++#endif ++ + SCM_DEFINE (scm_access, "access?", 2, 0, 0, + (SCM path, SCM how), + "Test accessibility of a file under the real UID and GID of the\n" +diff --git a/libguile/filesys.h b/libguile/filesys.h +index 377a3795e..37d084cd5 100644 +--- a/libguile/filesys.h ++++ b/libguile/filesys.h +@@ -51,6 +51,7 @@ 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_delete_file_at (SCM dir, SCM str, SCM flags); + 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); +diff --git a/test-suite/tests/filesys.test b/test-suite/tests/filesys.test +index 204f3414c..33b68e16d 100644 +--- a/test-suite/tests/filesys.test ++++ b/test-suite/tests/filesys.test +@@ -589,3 +589,62 @@ + (pass-if-exception "not a string (2)" exception:wrong-type-arg + (skip-if-unsupported) + (rename-file-at #f "some" #f 'what))) ++ ++(with-test-prefix "delete-file-at" ++ (define (skip-if-unsupported) ++ (when (not (and (defined? 'delete-file-at) ++ (defined? 'AT_REMOVEDIR))) ++ (throw 'unsupported))) ++ (define (create-test-file) ++ (call-with-output-file (test-file) identity)) ++ (define (create-test-directory) ++ (mkdir (test-directory))) ++ (define (delete-test-file) ++ (when (file-exists? (test-file)) ++ (delete-file (test-file)))) ++ (define (delete-test-directory) ++ (when (file-exists? (test-directory)) ++ (rmdir (test-directory)))) ++ ++ (pass-if-equal "regular file" #f ++ (skip-if-unsupported) ++ (create-test-file) ++ (call-with-port ++ (open (dirname (test-file)) O_RDONLY) ++ (lambda (port) ++ (delete-file-at port (basename (test-file))))) ++ (file-exists? (test-file))) ++ (delete-test-file) ++ ++ (pass-if-equal "regular file, explicit flags" #f ++ (skip-if-unsupported) ++ (create-test-file) ++ (call-with-port ++ (open (dirname (test-file)) O_RDONLY) ++ (lambda (port) ++ (delete-file-at port (basename (test-file)) 0))) ++ (file-exists? (test-file))) ++ (delete-test-file) ++ ++ (pass-if-equal "directory, explicit flags" #f ++ (skip-if-unsupported) ++ (create-test-directory) ++ (call-with-port ++ (open (dirname (test-directory)) O_RDONLY) ++ (lambda (port) ++ (delete-file-at port (basename (test-directory)) AT_REMOVEDIR))) ++ (file-exists? (test-directory))) ++ (delete-test-directory) ++ ++ (pass-if-exception "not a port" exception:wrong-type-arg ++ (skip-if-unsupported) ++ (delete-file-at 'bogus "irrelevant")) ++ ++ (pass-if-exception "not a file port" exception:wrong-type-arg ++ (skip-if-unsupported) ++ (delete-file-at (open-input-string "") "irrelevant")) ++ ++ (pass-if-exception "closed port" exception:wrong-type-arg ++ (skip-if-unsupported) ++ (delete-file-at (call-with-port (open "." O_RDONLY) identity) ++ "irrelevant"))) +-- +2.30.2 + + diff --git a/gnu/packages/patches/guile-openat-and-friends-11.patch b/gnu/packages/patches/guile-openat-and-friends-11.patch new file mode 100644 index 0000000000..37c52ebadc --- /dev/null +++ b/gnu/packages/patches/guile-openat-and-friends-11.patch @@ -0,0 +1,130 @@ +Guix-Upstream: https://lists.gnu.org/archive/html/guile-devel/2021-11/msg00005.html +From: Maxime Devos <maximedevos@telenet.be> +Subject: [PATCH v2 11/14] =?UTF-8?q?Define=20a=20Scheme=20binding=20to=20?= + =?UTF-8?q?=E2=80=98fchownat=E2=80=99=20when=20it=20exists.?= +Date: Tue, 16 Nov 2021 11:06:34 +0000 +Message-Id: <20211116110637.125579-12-maximedevos@telenet.be> +In-Reply-To: <20211116110637.125579-1-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 + +* configure.ac: Detect whether ‘fchownat’ is available. +* libguile/filesys.c (scm_chownat): Define a Scheme binding to + ‘fchownat’ when available. +* libguile/filesys.h (scm_chownat): Make it part of the API. +* doc/ref/posix.texi (File System): Document it. +--- + configure.ac | 4 ++-- + doc/ref/posix.texi | 11 +++++++++++ + libguile/filesys.c | 35 +++++++++++++++++++++++++++++++++++ + libguile/filesys.h | 1 + + 4 files changed, 49 insertions(+), 2 deletions(-) + +diff --git a/configure.ac b/configure.ac +index e1c090321..dcb6bceb5 100644 +--- a/configure.ac ++++ b/configure.ac +@@ -478,14 +478,14 @@ 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 - POSIX.1-2008 ++# unlinkat, fchownat - POSIX.1-2008 + # strtol_l - non-POSIX, found in glibc + # fork - unavailable on Windows + # sched_getaffinity, sched_setaffinity - GNU extensions (glibc) + # sendfile - non-POSIX, found in glibc + # + AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid \ +- fesetround ftime ftruncate fchown fchmod fchdir readlinkat \ ++ fesetround ftime ftruncate fchown fchownat fchmod fchdir readlinkat \ + fchmodat symlinkat mkdirat renameat unlinkat getcwd geteuid getsid \ + gettimeofday getuid getgid gmtime_r ioctl lstat mkdir mkdtemp mknod \ + nice readlink rename rmdir setegid seteuid \ +diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi +index ad10585d9..3d06f1c73 100644 +--- a/doc/ref/posix.texi ++++ b/doc/ref/posix.texi +@@ -784,6 +784,17 @@ unsupported at present). If @var{owner} or @var{group} is specified + as @code{-1}, then that ID is not changed. + @end deffn + ++@findex fchownat ++@deffn {Scheme Procedure} chownat dir name owner group [flags] ++@deffnx {C Function} scm_chownat (dir, name, owner, group, flags) ++Like @code{chown}, but modify the owner and/or group of ++the file named @var{name} in the directory referred to ++by the file port @var{dir} instead. The optional argument ++@var{flags} is a bitmask. If @code{AT_SYMLINK_NOFOLLOW} is ++present, then @var{name} will not be dereferenced if it is a ++symbolic link. ++@end deffn ++ + @findex fchmod + @deffn {Scheme Procedure} chmod object mode + @deffnx {C Function} scm_chmod (object, mode) +diff --git a/libguile/filesys.c b/libguile/filesys.c +index 7e6d89626..c257bb59c 100644 +--- a/libguile/filesys.c ++++ b/libguile/filesys.c +@@ -193,6 +193,41 @@ SCM_DEFINE (scm_chown, "chown", 3, 0, 0, + #undef FUNC_NAME + #endif /* HAVE_CHOWN */ + ++#ifdef HAVE_FCHOWNAT ++SCM_DEFINE (scm_chownat, "chown-at", 4, 1, 0, ++ (SCM dir, SCM name, SCM owner, SCM group, SCM flags), ++ "Like @code{chown}, but modify the owner and/or group of\n" ++ "the file named @var{name} in the directory referred to\n" ++ "by the file port @var{dir} instead. The optional argument\n" ++ "@var{flags} is a bitmask. If @code{AT_SYMLINK_NOFOLLOW} is\n" ++ "present, then @var{name} will not be dereferenced if it is a\n" ++ "symbolic link.") ++#define FUNC_NAME s_scm_chownat ++{ ++ int rv; ++ int dir_fdes; ++ int c_flags; ++ ++ 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 (name, c_name, ++ rv = fchownat (dir_fdes, c_name, ++ scm_to_int (owner), scm_to_int (group), ++ c_flags)); ++ scm_remember_upto_here_1 (dir); ++ if (rv == -1) ++ SCM_SYSERROR; ++ return SCM_UNSPECIFIED; ++} ++#undef FUNC_NAME ++#endif /* HAVE_FCHOWNAT */ ++ + \f + + SCM_DEFINE (scm_open_fdes, "open-fdes", 2, 1, 0, +diff --git a/libguile/filesys.h b/libguile/filesys.h +index 37d084cd5..7673c8051 100644 +--- a/libguile/filesys.h ++++ b/libguile/filesys.h +@@ -39,6 +39,7 @@ SCM_API scm_t_bits scm_tc16_dir; + \f + + SCM_API SCM scm_chown (SCM object, SCM owner, SCM group); ++SCM_API SCM scm_chownat (SCM dir, SCM object, SCM owner, SCM group, SCM flags); + 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); +-- +2.30.2 + + diff --git a/gnu/packages/patches/guile-openat-and-friends-12.patch b/gnu/packages/patches/guile-openat-and-friends-12.patch new file mode 100644 index 0000000000..845e836b03 --- /dev/null +++ b/gnu/packages/patches/guile-openat-and-friends-12.patch @@ -0,0 +1,238 @@ +Guix-Upstream: https://lists.gnu.org/archive/html/guile-devel/2021-11/msg00005.html +From: Maxime Devos <maximedevos@telenet.be> +Subject: [PATCH v2 12/14] =?UTF-8?q?Define=20a=20Scheme=20binding=20to=20?= + =?UTF-8?q?=E2=80=98fstatat=E2=80=99=20when=20available.?= +Date: Tue, 16 Nov 2021 11:06:35 +0000 +Message-Id: <20211116110637.125579-13-maximedevos@telenet.be> +In-Reply-To: <20211116110637.125579-1-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 + +* configure.ac: Detect if ‘fstatat’ is defined. +* libguile/filesys.c (scm_statat): Define a Scheme binding to ‘fstatat’. +* libguile/filesys.h (scm_statat): Make it part of the C API. +* doc/ref/posix.texi (File System): Document it. +* libguile/syscalls.h (fstatat_or_fstatat64): Choose between ‘fstatat’ + and ‘fstatat64’. +--- + configure.ac | 4 +- + doc/ref/posix.texi | 8 ++++ + libguile/filesys.c | 39 +++++++++++++++++ + libguile/filesys.h | 1 + + libguile/syscalls.h | 1 + + test-suite/tests/filesys.test | 80 +++++++++++++++++++++++++++++++++++ + 6 files changed, 131 insertions(+), 2 deletions(-) + +diff --git a/configure.ac b/configure.ac +index dcb6bceb5..e073e04f4 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 - POSIX.1-2008 ++# unlinkat, fchownat, fstatat - POSIX.1-2008 + # strtol_l - non-POSIX, found in glibc + # fork - unavailable on Windows + # sched_getaffinity, sched_setaffinity - GNU extensions (glibc) +@@ -495,7 +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 \ +- futimens sched_getaffinity sched_setaffinity sendfile]) ++ fstatat futimens sched_getaffinity sched_setaffinity sendfile]) + + # The newlib C library uses _NL_ prefixed locale langinfo constants. + AC_CHECK_DECLS([_NL_NUMERIC_GROUPING], [], [], [[#include <langinfo.h>]]) +diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi +index 3d06f1c73..cdd03f141 100644 +--- a/doc/ref/posix.texi ++++ b/doc/ref/posix.texi +@@ -755,6 +755,14 @@ it will return information about a symbolic link itself, not the + file it points to. @var{path} must be a string. + @end deffn + ++@deffn {Scheme Procedure} statat dir filename [flags] ++@deffnx {C Function} scm_statat dir filename flags ++Like @code{stat}, but resolve @var{filename} relative to the directory ++referred to by the file port @var{dir} instead. The optional argument ++@var{flags} argument can be @code{AT_SYMLINK_NOFOLLOW}, in which case ++@var{filename} will not be dereferenced even if it is a symbolic link. ++@end deffn ++ + @deffn {Scheme Procedure} readlink path + @deffnx {C Function} scm_readlink (path) + Return the value of the symbolic link named by @var{path} (a string, or +diff --git a/libguile/filesys.c b/libguile/filesys.c +index c257bb59c..d045a672f 100644 +--- a/libguile/filesys.c ++++ b/libguile/filesys.c +@@ -601,6 +601,45 @@ SCM_DEFINE (scm_stat, "stat", 1, 1, 0, + } + #undef FUNC_NAME + ++#ifdef HAVE_FSTATAT ++SCM_DEFINE (scm_statat, "statat", 2, 1, 0, ++ (SCM dir, SCM filename, SCM flags), ++ "Like @code{stat}, but resolve @var{filename} relative to the\n" ++ "directory referred to by the file port @var{dir} instead.\n\n" ++ "The optional argument @var{flags} argument can be\n" ++ "@code{AT_SYMLINK_NOFOLLOW}, in which case @var{filename} will\n" ++ "not be dereferenced even if it is a symbolic link.") ++#define FUNC_NAME s_scm_statat ++{ ++ int rv; ++ int dir_fdes; ++ int c_flags; ++ struct stat_or_stat64 stat_temp; ++ ++ 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 (filename, c_filename, ++ rv = fstatat_or_fstatat64 (dir_fdes, c_filename, ++ &stat_temp, c_flags)); ++ scm_remember_upto_here_1 (dir); ++ if (rv != 0) ++ { ++ int en = errno; ++ SCM_SYSERROR_MSG ("~A: ~S", ++ scm_list_2 (scm_strerror (scm_from_int (en)), filename), ++ en); ++ } ++ return scm_stat2scm (&stat_temp); ++} ++#undef FUNC_NAME ++#endif /* HAVE_FSTATAT */ ++ + SCM_DEFINE (scm_lstat, "lstat", 1, 0, 0, + (SCM str), + "Similar to @code{stat}, but does not follow symbolic links, i.e.,\n" +diff --git a/libguile/filesys.h b/libguile/filesys.h +index 7673c8051..8af0f989a 100644 +--- a/libguile/filesys.h ++++ b/libguile/filesys.h +@@ -48,6 +48,7 @@ SCM_API SCM scm_open (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); ++SCM_API SCM scm_statat (SCM dir, SCM filename, SCM flags); + 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); +diff --git a/libguile/syscalls.h b/libguile/syscalls.h +index 30b99c193..37d532e60 100644 +--- a/libguile/syscalls.h ++++ b/libguile/syscalls.h +@@ -65,6 +65,7 @@ + # define readdir_r_or_readdir64_r readdir_r + #endif + #define stat_or_stat64 CHOOSE_LARGEFILE(stat,stat64) ++#define fstatat_or_fstatat64 CHOOSE_LARGEFILE(fstatat,fstatat64) + #define truncate_or_truncate64 CHOOSE_LARGEFILE(truncate,truncate64) + #define scm_from_off_t_or_off64_t CHOOSE_LARGEFILE(scm_from_off_t,scm_from_int64) + #define scm_from_ino_t_or_ino64_t CHOOSE_LARGEFILE(scm_from_ulong,scm_from_uint64) +diff --git a/test-suite/tests/filesys.test b/test-suite/tests/filesys.test +index 33b68e16d..b794b07b3 100644 +--- a/test-suite/tests/filesys.test ++++ b/test-suite/tests/filesys.test +@@ -134,6 +134,86 @@ + (close-port port) + (eqv? 5 (stat:size st)))))) + ++(with-test-prefix "statat" ++ ;; file-exists? from (ice-9 boot) dereferences symbolic links ++ ;; (a bug?). ++ (define (file-exists? filename) ++ (catch 'system-error ++ (lambda () (lstat filename) #t) ++ (lambda args ++ (if (= (system-error-errno args) ENOENT) ++ ;; For the purposes of the following tests, ++ ;; it is safe to ignore errors like EPERM, but a correct ++ ;; implementation would return #t for that error. ++ #f ++ (apply throw args))))) ++ (define (maybe-delete-directory) ++ (when (file-exists? (test-directory)) ++ (for-each ++ (lambda (filename) ++ (define full-name (in-vicinity (test-directory) filename)) ++ (when (file-exists? full-name) ++ (delete-file full-name))) ++ '("test-file" "test-symlink")) ++ (rmdir (test-directory)))) ++ (define (skip-unless-defined . things) ++ (for-each (lambda (thing) ++ (unless (defined? thing) ++ (throw 'unsupported))) ++ things)) ++ (maybe-delete-directory) ++ (mkdir (test-directory)) ++ (call-with-output-file (in-vicinity (test-directory) "test-file") ++ (lambda (port) ++ (display "hello" port))) ++ ++ ;; Return #true if the symlink was created, #false otherwise. ++ (define (maybe-create-symlink) ++ (if (file-exists? (in-vicinity (test-directory) "test-symlink")) ++ #t ++ (false-if-exception ++ (symlink "test-file" ++ (in-vicinity (test-directory) "test-symlink"))))) ++ ++ (pass-if-equal "regular file" 5 ++ (skip-unless-defined 'statat) ++ (call-with-port ++ (open (test-directory) O_RDONLY) ++ (lambda (port) ++ (stat:size (statat port "test-file"))))) ++ ++ (pass-if-equal "regular file, AT_SYMLINK_NOFOLLOW" 5 ++ (skip-unless-defined 'statat 'AT_SYMLINK_NOFOLLOW) ++ (call-with-port ++ (open (test-directory) O_RDONLY) ++ (lambda (port) ++ (stat:size (statat port "test-file" AT_SYMLINK_NOFOLLOW))))) ++ ++ (pass-if-equal "symbolic links are dereferenced" '(regular 5) ++ ;; Not all systems support symlinks. ++ (skip-unless-defined 'statat 'symlink) ++ (unless (maybe-create-symlink) ++ (throw 'unresolved)) ++ (call-with-port ++ (open (test-directory) O_RDONLY) ++ (lambda (port) ++ (define result (statat port "test-symlink")) ++ (list (stat:type result) (stat:size result))))) ++ ++ (pass-if-equal "symbolic links are not dereferenced" ++ `(symlink ,(string-length "test-file")) ++ ;; Not all systems support symlinks. ++ (skip-unless-defined 'statat 'symlink) ++ (unless (maybe-create-symlink) ++ (throw 'unresolved)) ++ (call-with-port ++ (open (test-directory) O_RDONLY) ++ (lambda (port) ++ (define result (statat port "test-symlink" AT_SYMLINK_NOFOLLOW)) ++ (list (stat:type result) (stat:size result))))) ++ ++ (maybe-delete-directory)) ++ + (with-test-prefix "sendfile" + + (let* ((file (search-path %load-path "ice-9/boot-9.scm")) +-- +2.30.2 + + diff --git a/gnu/packages/patches/guile-openat-and-friends-13.patch b/gnu/packages/patches/guile-openat-and-friends-13.patch new file mode 100644 index 0000000000..6f9c2c5b4e --- /dev/null +++ b/gnu/packages/patches/guile-openat-and-friends-13.patch @@ -0,0 +1,314 @@ +Guix-Upstream: https://lists.gnu.org/archive/html/guile-devel/2021-11/msg00005.html +From: Maxime Devos <maximedevos@telenet.be> +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> +In-Reply-To: <20211116110637.125579-1-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 + +* 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 + + base-commit: 29091731a0c6cb649cdfd72297575fe2bb2a9591 prerequisite-patch-id: e2faf5cdf72f293aca0aff5c89cc1f0dd874d29c prerequisite-patch-id: 72285c2232e09bc1637c174b4489e13bb76c0427 -- 2.30.2 [-- Attachment #2: This is a digitally signed message part --] [-- Type: application/pgp-signature, Size: 260 bytes --] ^ permalink raw reply related [flat|nested] 7+ messages in thread
* [bug#54485] [PATCH] gnu: Add guile-with-openat. 2022-03-20 21:50 [bug#54485] [PATCH] gnu: Add guile-with-openat Maxime Devos 2022-03-20 22:39 ` Maxime Devos @ 2022-03-24 11:37 ` Ludovic Courtès 2022-03-24 11:55 ` Maxime Devos 2022-06-13 0:31 ` Tobias Geerinckx-Rice via Guix-patches via 2023-02-24 22:57 ` Ludovic Courtès 3 siblings, 1 reply; 7+ messages in thread From: Ludovic Courtès @ 2022-03-24 11:37 UTC (permalink / raw) To: Maxime Devos; +Cc: 54485 Hi, Maxime Devos <maximedevos@telenet.be> skribis: > XXX Don't apply yet, let's wait for > "./pre-inst-env guix build guile-with-openat" to complete first. > > This will allow us to work on resolving the >1 year publicly > known privilege escalation, see <https://issues.guix.gnu.org/47584>. > > * gnu/packages/guile.scm (guile-with-openat): New variable. It’s a clever way to remind me (and other interested Guile committers) of how late we are when it comes to patch review. I’d rather avoid carrying this many patches in a package, be it Guile or anything else; that’s not something we usually do. Instead, I would prefer to actually review and apply the patches upstream. I’ve been meaning to do that, really, but it requires a chunk of time and focus, which keeps leading me to postpone. Is the latest patch set on guile-devel? It’s not mentioned at <https://issues.guix.gnu.org/46258>. Thanks, Ludo’. ^ permalink raw reply [flat|nested] 7+ messages in thread
* [bug#54485] [PATCH] gnu: Add guile-with-openat. 2022-03-24 11:37 ` Ludovic Courtès @ 2022-03-24 11:55 ` Maxime Devos 0 siblings, 0 replies; 7+ messages in thread From: Maxime Devos @ 2022-03-24 11:55 UTC (permalink / raw) To: Ludovic Courtès; +Cc: 46258, 54485 [-- Attachment #1: Type: text/plain, Size: 542 bytes --] Ludovic Courtès schreef op do 24-03-2022 om 12:37 [+0100]: > Instead, I would prefer to actually review and apply the patches > upstream. I’ve been meaning to do that, really, but it requires a chunk > of time and focus, which keeps leading me to postpone. OK. I can relate, w.r.t. the IPFS substitution patches. > Is the latest patch set on guile-devel? It’s not mentioned at > <https://issues.guix.gnu.org/46258>. It's at <https://lists.gnu.org/archive/html/guile-devel/2021-11/msg00005.html>. Greetings, Maxime. [-- Attachment #2: This is a digitally signed message part --] [-- Type: application/pgp-signature, Size: 260 bytes --] ^ permalink raw reply [flat|nested] 7+ messages in thread
* [bug#54485] [PATCH] gnu: Add guile-with-openat. 2022-03-20 21:50 [bug#54485] [PATCH] gnu: Add guile-with-openat Maxime Devos 2022-03-20 22:39 ` Maxime Devos 2022-03-24 11:37 ` Ludovic Courtès @ 2022-06-13 0:31 ` Tobias Geerinckx-Rice via Guix-patches via 2023-02-24 22:57 ` Ludovic Courtès 3 siblings, 0 replies; 7+ messages in thread From: Tobias Geerinckx-Rice via Guix-patches via @ 2022-06-13 0:31 UTC (permalink / raw) To: 54485, Ludovic Courtès, Maxime Devos [-- Attachment #1: Type: text/plain, Size: 598 bytes --] Hi Ludo'! > Instead, I would prefer to actually review and apply the patches > upstream. Sadly, the sleepy town of guile-devel seems not to have taken notice so far[0]. I know you're busy and pulling more than your weight in Guix — no rest for the retired — but with staging merged, I hope you'll have some spare cycles to review that series. Ideally they are perfect and ready to merge, but at this point any reply to that thread would help get things moving again. Kind regards, T G-R [0]: https://lists.gnu.org/archive/html/guile-devel/2021-11/msg00005.html [-- Attachment #2: signature.asc --] [-- Type: application/pgp-signature, Size: 247 bytes --] ^ permalink raw reply [flat|nested] 7+ messages in thread
* [bug#54485] [PATCH] gnu: Add guile-with-openat. 2022-03-20 21:50 [bug#54485] [PATCH] gnu: Add guile-with-openat Maxime Devos ` (2 preceding siblings ...) 2022-06-13 0:31 ` Tobias Geerinckx-Rice via Guix-patches via @ 2023-02-24 22:57 ` Ludovic Courtès 3 siblings, 0 replies; 7+ messages in thread From: Ludovic Courtès @ 2023-02-24 22:57 UTC (permalink / raw) To: Maxime Devos; +Cc: 54485 Hi, Maxime Devos <maximedevos@telenet.be> skribis: > +;; (A static variant of) this package will be used to implement > +;; TOCTOU-free behaviour in <https://issues.guix.gnu.org/54309> > +;; and <https://issues.guix.gnu.org/47584>. > +(define-public guile-with-openat > + (package > + (inherit > + (package-with-extra-patches guile-3.0 > + (search-patches > + "guile-openat-and-friends-01.patch" > + "guile-openat-and-friends-02.patch" > + "guile-openat-and-friends-03.patch" > + "guile-openat-and-friends-04.patch" > + "guile-openat-and-friends-05.patch" > + "guile-openat-and-friends-06.patch" > + "guile-openat-and-friends-07.patch" > + "guile-openat-and-friends-08.patch" > + "guile-openat-and-friends-09.patch" > + "guile-openat-and-friends-10.patch" > + "guile-openat-and-friends-11.patch" > + "guile-openat-and-friends-12.patch" > + "guile-openat-and-friends-13.patch"))) > + (name "guile-with-openat") Closing now that ‘guile-3.0-latest’ is at 3.0.9, which includes ‘openat’ and friends. At last! Ludo’. ^ permalink raw reply [flat|nested] 7+ messages in thread
end of thread, other threads:[~2023-02-24 22:58 UTC | newest] Thread overview: 7+ messages (download: mbox.gz follow: Atom feed -- links below jump to the message on this page -- 2022-03-20 21:50 [bug#54485] [PATCH] gnu: Add guile-with-openat Maxime Devos 2022-03-20 22:39 ` Maxime Devos 2022-03-21 14:24 ` Maxime Devos 2022-03-24 11:37 ` Ludovic Courtès 2022-03-24 11:55 ` Maxime Devos 2022-06-13 0:31 ` Tobias Geerinckx-Rice via Guix-patches via 2023-02-24 22:57 ` Ludovic Courtès
Code repositories for project(s) associated with this external index https://git.savannah.gnu.org/cgit/guix.git This is an external index of several public inboxes, see mirroring instructions on how to clone and mirror all data and code used by this external index.