03/07: build: install: Ignore chown exceptions.

[guix-commits]

mothacehe pushed a commit to branch master
in repository guix.

commit 5990e95b607b888edd862a2ccb5ca69dcd17d801
Author: Mathieu Othacehe <address@hidden>
AuthorDate: Tue Apr 28 14:16:33 2020 +0200

    build: install: Ignore chown exceptions.
    
    Changing ownership may require root permissions. As image can now be 
generated
    without root permissions (no VM involved), ignore those exceptions.
    
    * gnu/build/install.scm (evaluate-populate-directive): Ignore chown
    exceptions.
---
 gnu/build/install.scm | 16 +++++++++++++---
 1 file changed, 13 insertions(+), 3 deletions(-)

diff --git a/gnu/build/install.scm b/gnu/build/install.scm
index c0d4d44..9753792 100644
--- a/gnu/build/install.scm
+++ b/gnu/build/install.scm
@@ -51,9 +51,14 @@ that the fonts, background images, etc. referred to by 
BOOTCFG are not GC'd."
     (copy-file bootcfg pivot)
     (rename-file pivot target)))
 
-(define (evaluate-populate-directive directive target)
+(define* (evaluate-populate-directive directive target
+                                      #:key
+                                      (default-gid 0)
+                                      (default-uid 0))
   "Evaluate DIRECTIVE, an sexp describing a file or directory to create under
-directory TARGET."
+directory TARGET.  DEFAULT-UID and DEFAULT-GID are the default UID and GID in
+the context of the caller.  If the directive matches those defaults then,
+'chown' won't be run."
   (let loop ((directive directive))
     (catch 'system-error
       (lambda ()
@@ -63,7 +68,12 @@ directory TARGET."
           (('directory name uid gid)
            (let ((dir (string-append target name)))
              (mkdir-p dir)
-             (chown dir uid gid)))
+             ;; If called from a context without "root" permissions, "chown"
+             ;; to root will fail.  In that case, do not try to run "chown"
+             ;; and assume that the file will be chowned elsewhere (when
+             ;; interned in the store for instance).
+             (or (and (= uid default-uid) (= gid default-gid))
+                 (chown dir uid gid))))
           (('directory name uid gid mode)
            (loop `(directory ,name ,uid ,gid))
            (chmod (string-append target name) mode))