diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2013-03-05 19:03:39 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2013-03-05 19:03:39 +0100 |
| commit | 12761f48eaa4801beb3b49aa94f2e8891869d186 (patch) | |
| tree | a8549f2a95978b94b022641202d8f945730eb1bf | |
| parent | e65df6a63a49666edb4e57a68369b8e2ef02f1a0 (diff) | |
| download | gnu-guix-12761f48eaa4801beb3b49aa94f2e8891869d186.tar gnu-guix-12761f48eaa4801beb3b49aa94f2e8891869d186.tar.gz | |
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.
| -rw-r--r-- | guix/build/utils.scm | 20 |
1 files changed, 16 insertions, 4 deletions
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 @@ return values of applying PROC to the port." (() #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 @@ return values of applying PROC to the port." (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 @@ return values of applying PROC to the port." 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 |