(address . guix-patches@gnu.org)(name . Maxime Devos)(address . maximedevos@telenet.be)
20220320215031.306710-1-maximedevos@telenet.be
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
Toggle diff (459 lines)
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-p
This message was truncated. Download the full message here.