utils: Add #:keep-permissions? parameter to 'copy-recursively'.

* guix/build/utils.scm (copy-recursively): Add #:keep-permissions? and
honor it.
* doc/guix.texi (Build Utilities): Adjust accordingly.
This commit is contained in:
Ludovic Courtès 2020-11-19 22:16:44 +01:00
parent edbd8f3f7e
commit 55d095c653
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 15 additions and 9 deletions

View file

@ -7779,12 +7779,13 @@ Make @var{file} writable for its owner.
@deffn {Scheme Procedure} copy-recursively @var{source} @var{destination} @
[#:log (current-output-port)] [#:follow-symlinks? #f] @
[#:copy-file copy-file] [#:keep-mtime? #f]
[#:copy-file copy-file] [#:keep-mtime? #f] [#:keep-permissions? #t]
Copy @var{source} directory to @var{destination}. Follow symlinks if
@var{follow-symlinks?} is true; otherwise, just preserve them. Call
@var{copy-file} to copy regular files. When @var{keep-mtime?} is true,
keep the modification time of the files in @var{source} on those of
@var{destination}. Write verbose output to the @var{log} port.
@var{destination}. When @var{keep-permissions?} is true, preserve file
permissions. Write verbose output to the @var{log} port.
@end deffn
@deffn {Scheme Procedure} delete-file-recursively @var{dir} @

View file

@ -344,11 +344,12 @@ (define* (copy-recursively source destination
(log (current-output-port))
(follow-symlinks? #f)
(copy-file copy-file)
keep-mtime?)
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. Write verbose output to the LOG port."
those of DESTINATION. When KEEP-PERMISSIONS? is true, preserve file
permissions. Write verbose output to the LOG port."
(define strip-source
(let ((len (string-length source)))
(lambda (file)
@ -366,16 +367,20 @@ (define strip-source
(else
(copy-file file dest)
(when keep-mtime?
(set-file-time dest stat))))))
(set-file-time dest stat))
(when keep-permissions?
(chmod dest (stat:perms stat)))))))
(lambda (dir stat result) ; down
(let ((target (string-append destination
(strip-source dir))))
(mkdir-p target)))
(lambda (dir stat result) ; up
(when keep-mtime?
(let ((target (string-append destination
(strip-source dir))))
(set-file-time target stat))))
(let ((target (string-append destination
(strip-source dir))))
(when keep-mtime?
(set-file-time target stat))
(when keep-permissions?
(chmod target (stat:perms stat)))))
(const #t) ; skip
(lambda (file stat errno result)
(format (current-error-port) "i/o error: ~a: ~a~%"