From patchwork Sun Mar 20 21:50:31 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: M X-Patchwork-Id: 37966 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id A2EF427BBEA; Sun, 20 Mar 2022 21:52:24 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-3.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,FREEMAIL_FROM,MAILING_LIST_MULTI,RCVD_IN_MSPIKE_H5, RCVD_IN_MSPIKE_WL,SPF_HELO_PASS autolearn=unavailable autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id BACB727BBE9 for ; Sun, 20 Mar 2022 21:52:21 +0000 (GMT) Received: from localhost ([::1]:55294 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1nW3TI-0007I5-Sq for patchwork@mira.cbaines.net; Sun, 20 Mar 2022 17:52:20 -0400 Received: from eggs.gnu.org ([209.51.188.92]:48676) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1nW3T1-0007FA-3b for guix-patches@gnu.org; Sun, 20 Mar 2022 17:52:03 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:41346) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1nW3T0-0007Py-Qj for guix-patches@gnu.org; Sun, 20 Mar 2022 17:52:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1nW3T0-0008TY-IB for guix-patches@gnu.org; Sun, 20 Mar 2022 17:52:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#54485] [PATCH] gnu: Add guile-with-openat. Resent-From: Maxime Devos Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sun, 20 Mar 2022 21:52:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 54485 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 54485@debbugs.gnu.org Cc: Maxime Devos X-Debbugs-Original-To: guix-patches@gnu.org Received: via spool by submit@debbugs.gnu.org id=B.164781306732513 (code B ref -1); Sun, 20 Mar 2022 21:52:02 +0000 Received: (at submit) by debbugs.gnu.org; 20 Mar 2022 21:51:07 +0000 Received: from localhost ([127.0.0.1]:35244 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1nW3S7-0008SL-Px for submit@debbugs.gnu.org; Sun, 20 Mar 2022 17:51:07 -0400 Received: from lists.gnu.org ([209.51.188.17]:60264) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1nW3S6-0008S9-I9 for submit@debbugs.gnu.org; Sun, 20 Mar 2022 17:51:06 -0400 Received: from eggs.gnu.org ([209.51.188.92]:48572) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1nW3S6-0006mG-1V for guix-patches@gnu.org; Sun, 20 Mar 2022 17:51:06 -0400 Received: from [2a02:1800:110:4::f00:1a] (port=43906 helo=albert.telenet-ops.be) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1nW3S0-0006Tj-ID for guix-patches@gnu.org; Sun, 20 Mar 2022 17:51:05 -0400 Received: from localhost.localdomain ([IPv6:2a02:1811:8c09:9d00:3c5f:2eff:feb0:ba5a]) by albert.telenet-ops.be with bizsmtp id 8lqw2700F4UW6Th06lqwFY; Sun, 20 Mar 2022 22:50:57 +0100 From: Maxime Devos Date: Sun, 20 Mar 2022 21:50:31 +0000 Message-Id: <20220320215031.306710-1-maximedevos@telenet.be> X-Mailer: git-send-email 2.34.0 MIME-Version: 1.0 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=telenet.be; s=r22; t=1647813057; bh=rSriJoGtdNaL9qEhJ9h/P2+KUDvK8MAzCdUn+/HzB9s=; h=From:To:Cc:Subject:Date; b=Ex7YhDpO3XqE6GWq5/ovV8XembRerMdP/wDRfILvYzCoyA+zqgKUVBDYbOrqEsqCk KwSfFjrFgSXB0bPWEmUoMl0Wp1l3AuZzYrNSEXTRYWqFGhUHHHEk/rNtMcooW71V7t n8O6r6n59mi2BtWmiON5s1lOeJTgiT8Q0nGibJrM1VHQP9iwaSyx8r+QWrPsGICjU9 u6gvjOqgNQiPLyYuz72/FprS61DuQnfrXMBXhfVkGoylbcdZslEAxL1EiEni6r7kPV LDX0XpBWMTpu1AsZ0eR+PPOpJdpqKgHzuuK6IKOGqsvBKdjDl2d18LZnK6xp7d+ERX KOSpE5V8tmcIw== X-Host-Lookup-Failed: Reverse DNS lookup failed for 2a02:1800:110:4::f00:1a (failed) Received-SPF: pass client-ip=2a02:1800:110:4::f00:1a; envelope-from=maximedevos@telenet.be; helo=albert.telenet-ops.be X-Spam_score_int: -15 X-Spam_score: -1.6 X-Spam_bar: - X-Spam_report: (-1.6 / 5.0 requ) BAYES_00=-1.9, DKIM_INVALID=0.1, DKIM_SIGNED=0.1, FREEMAIL_FROM=0.001, RCVD_IN_DNSWL_LOW=-0.7, RDNS_NONE=0.793, SPF_HELO_NONE=0.001, SPF_PASS=-0.001, T_SCC_BODY_TEXT_LINE=-0.01 autolearn=no autolearn_force=no X-Spam_action: no action X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches 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 . * 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 base-commit: 29091731a0c6cb649cdfd72297575fe2bb2a9591 prerequisite-patch-id: e2faf5cdf72f293aca0aff5c89cc1f0dd874d29c prerequisite-patch-id: 72285c2232e09bc1637c174b4489e13bb76c0427 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 # Copyright © 2022 Daniel Meißner # Copyright © 2022 Remco van 't Veer +# Copyright © 2022 Maxime Devos # # 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 ;;; Copyright © 2019 Taylan Kammer ;;; Copyright © 2020, 2021 Efraim Flashner -;;; Copyright © 2021 Maxime Devos +;;; Copyright © 2021, 2022 Maxime Devos ;;; Copyright © 2021 Timothy Sample ;;; ;;; 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 +;; and . +(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 +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 + @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 + + 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 + ;;;; + ;;;; 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 +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: ++ ;; . ++ (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 +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 ]]) +diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi +index cd23240c4..b6deffd43 100644 +--- a/doc/ref/posix.texi ++++ b/doc/ref/posix.texi +@@ -796,14 +796,16 @@ the new permissions as a decimal number, e.g., @code{(chmod "foo" #o755)}. + The return value is unspecified. + @end deffn + +-@deffn {Scheme Procedure} utime pathname [actime [modtime [actimens [modtimens [flags]]]]] +-@deffnx {C Function} scm_utime (pathname, actime, modtime, actimens, modtimens, flags) ++@deffn {Scheme Procedure} utime object [actime [modtime [actimens [modtimens [flags]]]]] ++@deffnx {C Function} scm_utime (object, actime, modtime, actimens, modtimens, flags) + @code{utime} sets the access and modification times for the +-file named by @var{pathname}. If @var{actime} or @var{modtime} is ++file named by @var{object}. If @var{actime} or @var{modtime} is + not supplied, then the current time is used. @var{actime} and + @var{modtime} must be integer time values as returned by the + @code{current-time} procedure. + ++@var{object} must be a file name or a port (if supported by the system). ++ + The optional @var{actimens} and @var{modtimens} are nanoseconds + to add @var{actime} and @var{modtime}. Nanosecond precision is + only supported on some combinations of file systems and operating +@@ -817,9 +819,14 @@ modification time to the current time. + @vindex AT_SYMLINK_NOFOLLOW + Last, @var{flags} may be either @code{0} or the + @code{AT_SYMLINK_NOFOLLOW} constant, to set the time of +-@var{pathname} even if it is a symbolic link. ++@var{object} even if it is a symbolic link. + @end deffn + ++On GNU/Linux systems, at least when using the Linux kernel 5.10.46, ++if @var{object} is a port, it may not be a symbolic link, ++even if @code{AT_SYMLINK_NOFOLLOW} is set. This is either a bug ++in Linux or Guile's wrappers. The exact cause is unclear. ++ + @findex unlink + @deffn {Scheme Procedure} delete-file str + @deffnx {C Function} scm_delete_file (str) +diff --git a/libguile/posix.c b/libguile/posix.c +index 3ab12b99e..bd7f40ca8 100644 +--- a/libguile/posix.c ++++ b/libguile/posix.c +@@ -1,5 +1,6 @@ + /* Copyright 1995-2014,2016-2019,2021 + Free Software Foundation, Inc. ++ Copyright 2021 Maxime Devos + + This file is part of Guile. + +@@ -1648,13 +1649,14 @@ SCM_DEFINE (scm_tmpfile, "tmpfile", 0, 0, 0, + #undef FUNC_NAME + + SCM_DEFINE (scm_utime, "utime", 1, 5, 0, +- (SCM pathname, SCM actime, SCM modtime, SCM actimens, SCM modtimens, ++ (SCM object, SCM actime, SCM modtime, SCM actimens, SCM modtimens, + SCM flags), + "@code{utime} sets the access and modification times for the\n" +- "file named by @var{pathname}. If @var{actime} or @var{modtime} is\n" ++ "file named by @var{object}. If @var{actime} or @var{modtime} is\n" + "not supplied, then the current time is used. @var{actime} and\n" + "@var{modtime} must be integer time values as returned by the\n" + "@code{current-time} procedure.\n\n" ++ "@var{object} must be a file name or a port (if supported by the system).\n\n" + "The optional @var{actimens} and @var{modtimens} are nanoseconds\n" + "to add @var{actime} and @var{modtime}. Nanosecond precision is\n" + "only supported on some combinations of file systems and operating\n" +@@ -1666,7 +1668,11 @@ SCM_DEFINE (scm_utime, "utime", 1, 5, 0, + "modification time to the current time.\n\n" + "Last, @var{flags} may be either @code{0} or the\n" + "@code{AT_SYMLINK_NOFOLLOW} constant, to set the time of\n" +- "@var{pathname} even if it is a symbolic link.\n") ++ "@var{pathname} even if it is a symbolic link.\n\n" ++ "On GNU/Linux systems, at least when using the Linux kernel\n" ++ "5.10.46, if @var{object} is a port, it may not be a symbolic\n" ++ "link, even if @code{AT_SYMLINK_NOFOLLOW} is set. This is either\n" ++ "a bug in Linux or Guile's wrappers. The exact cause is unclear.") + #define FUNC_NAME s_scm_utime + { + int rv; +@@ -1725,8 +1731,18 @@ SCM_DEFINE (scm_utime, "utime", 1, 5, 0, + times[1].tv_sec = mtim_sec; + times[1].tv_nsec = mtim_nsec; + +- STRING_SYSCALL (pathname, c_pathname, +- rv = utimensat (AT_FDCWD, c_pathname, times, f)); ++ if (SCM_OPFPORTP (object)) ++ { ++ int fd; ++ fd = SCM_FPORT_FDES (object); ++ SCM_SYSCALL (rv = futimens (fd, times)); ++ scm_remember_upto_here_1 (object); ++ } ++ else ++ { ++ STRING_SYSCALL (object, c_pathname, ++ rv = utimensat (AT_FDCWD, c_pathname, times, f)); ++ } + } + #else + { +@@ -1740,7 +1756,7 @@ SCM_DEFINE (scm_utime, "utime", 1, 5, 0, + if (f != 0) + scm_out_of_range(FUNC_NAME, flags); + +- STRING_SYSCALL (pathname, c_pathname, ++ STRING_SYSCALL (object, c_pathname, + rv = utime (c_pathname, &utm)); + } + #endif +diff --git a/libguile/posix.h b/libguile/posix.h +index ff3bec9ea..dda8013a5 100644 +--- a/libguile/posix.h ++++ b/libguile/posix.h +@@ -69,7 +69,7 @@ SCM_API SCM scm_tmpfile (void); + SCM_API SCM scm_open_pipe (SCM pipestr, SCM modes); + SCM_API SCM scm_close_pipe (SCM port); + SCM_API SCM scm_system_star (SCM cmds); +-SCM_API SCM scm_utime (SCM pathname, SCM actime, SCM modtime, ++SCM_API SCM scm_utime (SCM object, SCM actime, SCM modtime, + SCM actimens, SCM modtimens, SCM flags); + SCM_API SCM scm_access (SCM path, SCM how); + SCM_API SCM scm_getpid (void); +diff --git a/test-suite/tests/posix.test b/test-suite/tests/posix.test +index 1e552d16f..8e32251b5 100644 +--- a/test-suite/tests/posix.test ++++ b/test-suite/tests/posix.test +@@ -2,6 +2,7 @@ + ;;;; + ;;;; Copyright 2003-2004,2006-2007,2010,2012,2015,2017-2019,2021 + ;;;; Free Software Foundation, Inc. ++;;;; Copyright 2021 Maxime Devos + ;;;; + ;;;; This library is free software; you can redistribute it and/or + ;;;; modify it under the terms of the GNU Lesser General Public +@@ -201,7 +202,75 @@ + (list (stat:atime info) (stat:mtime info)))) + (lambda () + (delete-file file)))) +- (throw 'unsupported)))) ++ (throw 'unsupported))) ++ ++ (define (utime-unless-unsupported oops . arguments) ++ (catch 'system-error ++ (lambda () ++ (catch 'wrong-type-arg ++ (lambda () ++ (apply utime arguments)) ++ (lambda _ ++ ;; 'futimens' is not supported on all platforms. ++ (oops)))) ++ (lambda args ++ ;; On some platforms, 'futimens' returns ENOSYS according to Gnulib. ++ (if (= (system-error-errno args) ENOSYS) ++ (oops) ++ (apply throw args))))) ++ ++ (pass-if-equal "file port" ++ '(1 1) ++ (let ((file "posix.test-utime")) ++ (false-if-exception (delete-file file)) ++ (close-port (open-output-file file)) ++ (define (delete) ++ (delete-file file)) ++ (define (oops) ++ (delete) ++ (throw 'unsupported)) ++ (call-with-input-file file ++ (lambda (port) ++ (utime-unless-unsupported oops port 1 1 0 0) ++ (define info (stat file)) ++ (delete) ++ (list (stat:atime info) (stat:mtime info)))))) ++ ++ ;; This causes an EBADF system error on GNU/Linux with the 5.10.46 kernel. ++ #; ++ (pass-if-equal "file port (port representing symbolic link)" ++ '(1 1) ++ (let ((file "posix.test-utime")) ++ (unless (false-if-exception ++ (begin (symlink "/should-be-irrelevant" file) ++ #t)) ++ (display "cannot create symlink, a utime test skipped\n") ++ (throw 'unresolved)) ++ (unless (and (defined? 'O_NOFOLLOW) ++ (defined? 'O_PATH) ++ (not (= 0 O_NOFOLLOW)) ++ (not (= 0 O_PATH))) ++ (display "cannot open symlinks, a utime test skipped\n") ++ (throw 'unresolved)) ++ (define (delete) ++ (when port (close-port port)) ++ (false-if-exception (delete-file file))) ++ (define (oops) ++ (delete) ++ (throw 'unsupported)) ++ (define port #f) ++ (catch #t ++ (lambda () ++ (set! port ++ (open file (logior O_NOFOLLOW O_PATH))) ++ (utime-unless-unsupported oops port 1 1 0 0)) ++ (lambda args ++ (pk 'deleting file) ++ (delete) ++ (apply throw args))) ++ (define info (lstat file)) ++ (delete) ++ (list (stat:mtime info) (stat:atime info))))) + + ;; + ;; affinity +-- +2.30.2 + + + 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 +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 +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 +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 +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 +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 +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 +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 +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 +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 ]]) +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 +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 + +