[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[bug#54485] [PATCH] gnu: Add guile-with-openat.
|
From: |
Maxime Devos |
|
Subject: |
[bug#54485] [PATCH] gnu: Add guile-with-openat. |
|
Date: |
Sun, 20 Mar 2022 21:50:31 +0000 |
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 */
++
+
+
+ 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;
+
+
+ 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
- [bug#54485] [PATCH] gnu: Add guile-with-openat.,
Maxime Devos <=