ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 07:26:13 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

utils: Add a #:follow-symlinks? parameter to `copy-recursively'.

Browse source 
* 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 @@ (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