From 5d963ec336f64d2a973761669d424e3188b3f9c3 Mon Sep 17 00:00:00 2001 From: Romain GARBAGE Date: Fri, 12 Jan 2024 16:24:04 +0100 Subject: guix: build: Expand `copy-recursively'. * guix/build/utils.scm (copy-recursively): Add `select?' key. Change-Id: Icfe226164bb88dfede58ae24c15a98db9b696c3b Signed-off-by: Maxim Cournoyer --- guix/build/utils.scm | 42 ++++++++++++++++++++++++------------------ 1 file changed, 24 insertions(+), 18 deletions(-) (limited to 'guix/build/utils.scm') diff --git a/guix/build/utils.scm b/guix/build/utils.scm index 9c1e19f6d8..94714bf397 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -432,32 +432,38 @@ name." (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)))) -- cgit v1.2.3