From 12761f48eaa4801beb3b49aa94f2e8891869d186 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 5 Mar 2013 19:03:39 +0100 Subject: utils: Add a #:follow-symlinks? parameter to `copy-recursively'. * guix/build/utils.scm (copy-recursively): Turn `log' into a keyword parameter. Add the `follow-symlinks?' parameter and honor it. --- guix/build/utils.scm | 20 ++++++++++++++++---- 1 file changed, 16 insertions(+), 4 deletions(-) (limited to 'guix/build') diff --git a/guix/build/utils.scm b/guix/build/utils.scm index 7b49e9f4c7..ef215e60bb 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -122,8 +122,11 @@ (define not-slash (() #t)))) (define* (copy-recursively source destination - #:optional (log (current-output-port))) - "Copy SOURCE directory to DESTINATION." + #:key + (log (current-output-port)) + (follow-symlinks? #f)) + "Copy SOURCE directory to DESTINATION. Follow symlinks if FOLLOW-SYMLINKS? +is true; otherwise, just preserve them. Write verbose output to the LOG port." (define strip-source (let ((len (string-length source))) (lambda (file) @@ -134,7 +137,12 @@ (define strip-source (let ((dest (string-append destination (strip-source file)))) (format log "`~a' -> `~a'~%" file dest) - (copy-file file dest))) + (case (stat:type stat) + ((symlink) + (let ((target (readlink file))) + (symlink target dest))) + (else + (copy-file file dest))))) (lambda (dir stat result) ; down (mkdir-p (string-append destination (strip-source dir)))) @@ -146,7 +154,11 @@ (define strip-source file (strerror errno)) #f) #t - source)) + source + + (if follow-symlinks? + stat + lstat))) (define (delete-file-recursively dir) "Delete DIR recursively, like `rm -rf', without following symlinks. Report -- cgit v1.2.3