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

[guix-commits]

civodul pushed a commit to branch core-updates
in repository guix.

commit 55d095c653e8fda73ad111c067dece66c31a49e0
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Thu Nov 19 22:16:44 2020 +0100

    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.
---
 doc/guix.texi        |  5 +++--
 guix/build/utils.scm | 19 ++++++++++++-------
 2 files changed, 15 insertions(+), 9 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 84e5691..19c4321 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -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} @
diff --git a/guix/build/utils.scm b/guix/build/utils.scm
index 470e5cf..11ac6a8 100644
--- a/guix/build/utils.scm
+++ b/guix/build/utils.scm
@@ -344,11 +344,12 @@ name."
                            (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 @@ those of DESTINATION.  Write verbose output to the LOG 
port."
                           (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~%"