summary refs log tree commit diff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2020-11-19 22:16:44 +0100
committerLudovic Courtès <ludo@gnu.org>2020-11-19 22:36:03 +0100
commit55d095c653e8fda73ad111c067dece66c31a49e0 (patch)
tree7d11fc4ee0502492cc38b21d19fb0a3da27291b3
parentedbd8f3f7eeb0e49c03ca611e43b5a777bd0c762 (diff)
downloadguix-55d095c653e8fda73ad111c067dece66c31a49e0.tar.gz
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.
-rw-r--r--doc/guix.texi5
-rw-r--r--guix/build/utils.scm19
2 files changed, 15 insertions, 9 deletions
diff --git a/doc/guix.texi b/doc/guix.texi
index 84e5691cf1..19c43211f8 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 470e5cf001..11ac6a8a7b 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~%"