nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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.
This commit is contained in:
Ludovic Courtès 2013-03-05 19:03:39 +01:00
parent e65df6a63a
commit 12761f48ea
1 changed files with 16 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
guix/build/utils.scm
View File

@ -122,8 +122,11 @@ return values of applying PROC to the port."
(() #t)))) (() #t))))
(define* (copy-recursively source destination (define* (copy-recursively source destination
#:optional (log (current-output-port))) #:key
"Copy SOURCE directory to DESTINATION." (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 (define strip-source
(let ((len (string-length source))) (let ((len (string-length source)))
(lambda (file) (lambda (file)
@ -134,7 +137,12 @@ return values of applying PROC to the port."
(let ((dest (string-append destination (let ((dest (string-append destination
(strip-source file)))) (strip-source file))))
(format log "`~a' -> `~a'~%" file dest) (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 (lambda (dir stat result) ; down
(mkdir-p (string-append destination (mkdir-p (string-append destination
(strip-source dir)))) (strip-source dir))))
@ -146,7 +154,11 @@ return values of applying PROC to the port."
file (strerror errno)) file (strerror errno))
#f) #f)
#t #t
source)) source
(if follow-symlinks?
stat
lstat)))
(define (delete-file-recursively dir) (define (delete-file-recursively dir)
"Delete DIR recursively, like `rm -rf', without following symlinks. Report "Delete DIR recursively, like `rm -rf', without following symlinks. Report