From: Romain GARBAGE <romain.garbage@inria.fr>
To: 68406@debbugs.gnu.org
Cc: Romain GARBAGE <romain.garbage@inria.fr>
Subject: [bug#68406] [PATCH core-updates] guix: build: Expand `copy-recursively'.
Date: Fri, 12 Jan 2024 16:24:04 +0100 [thread overview]
Message-ID: <20240112152407.5691-1-romain.garbage@inria.fr> (raw)
* guix/build/utils.scm (copy-recursively): Add `select?' key.
Change-Id: Icfe226164bb88dfede58ae24c15a98db9b696c3b
---
guix/build/utils.scm | 42 ++++++++++++++++++++++++------------------
1 file changed, 24 insertions(+), 18 deletions(-)
diff --git a/guix/build/utils.scm b/guix/build/utils.scm
index 2352a627e9..7567eb9e4d 100644
--- a/guix/build/utils.scm
+++ b/guix/build/utils.scm
@@ -430,32 +430,38 @@ (define* (copy-recursively source destination
(log (current-output-port))
(follow-symlinks? #f)
(copy-file copy-file)
- keep-mtime? keep-permissions?)
- "Copy SOURCE directory to DESTINATION. Follow symlinks if FOLLOW-SYMLINKS?
-is true; otherwise, just preserve them. Call COPY-FILE to copy regular files.
-When KEEP-MTIME? is true, keep the modification time of the files in SOURCE on
-those of DESTINATION. When KEEP-PERMISSIONS? is true, preserve file
-permissions. Write verbose output to the LOG port."
+ keep-mtime? keep-permissions?
+ (select? (const #t)))
+ "Copy SOURCE directory to DESTINATION. Follow symlinks if FOLLOW-SYMLINKS? is
+true; otherwise, just preserve them. Call COPY-FILE to copy regular files. When
+KEEP-MTIME? is true, keep the modification time of the files in SOURCE on those of
+DESTINATION. When KEEP-PERMISSIONS? is true, preserve file permissions. Write
+verbose output to the LOG port. Call (SELECT? FILE STAT) for each entry in source,
+where FILE is the entry's absolute file name and STAT is the result of 'lstat' (or
+'stat' if FOLLOW-SYMLINKS? is true); exclude entries for which SELECT? does not
+return true."
(define strip-source
(let ((len (string-length source)))
(lambda (file)
(substring file len))))
- (file-system-fold (const #t) ; enter?
+ (file-system-fold (lambda (file stat result) ; enter?
+ (select? file stat))
(lambda (file stat result) ; leaf
(let ((dest (string-append destination
(strip-source file))))
- (format log "`~a' -> `~a'~%" file dest)
- (case (stat:type stat)
- ((symlink)
- (let ((target (readlink file)))
- (symlink target dest)))
- (else
- (copy-file file dest)
- (when keep-permissions?
- (chmod dest (stat:perms stat)))))
- (when keep-mtime?
- (set-file-time dest stat))))
+ (when (select? file stat)
+ (format log "`~a' -> `~a'~%" file dest)
+ (case (stat:type stat)
+ ((symlink)
+ (let ((target (readlink file)))
+ (symlink target dest)))
+ (else
+ (copy-file file dest)
+ (when keep-permissions?
+ (chmod dest (stat:perms stat)))))
+ (when keep-mtime?
+ (set-file-time dest stat)))))
(lambda (dir stat result) ; down
(let ((target (string-append destination
(strip-source dir))))
--
2.41.0
next reply other threads:[~2024-01-12 15:25 UTC|newest]
Thread overview: 4+ messages / expand[flat|nested] mbox.gz Atom feed top
2024-01-12 15:24 Romain GARBAGE [this message]
2024-01-19 4:20 ` [bug#68406] [PATCH core-updates] guix: build: Expand `copy-recursively' Maxim Cournoyer
2024-01-21 22:57 ` bug#68406: " Maxim Cournoyer
2024-01-22 11:30 ` [bug#68406] " Ludovic Courtès
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://guix.gnu.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20240112152407.5691-1-romain.garbage@inria.fr \
--to=romain.garbage@inria.fr \
--cc=68406@debbugs.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).