diff options
| author | Marius Bakke <mbakke@fastmail.com> | 2018-11-07 21:09:57 +0100 |
|---|---|---|
| committer | Marius Bakke <mbakke@fastmail.com> | 2018-11-07 21:09:57 +0100 |
| commit | 55174e668f2985d1c4efda4fbf58f4061dde0db2 (patch) | |
| tree | f55f7e50fff1a1c3d1e6d2e932a7ef19347e5011 /guix/build | |
| parent | 1badc85068ee0be2a028c1b94a3dd285901bc391 (diff) | |
| parent | b31e1561611ebe4916890183b24e6e13cb83bf59 (diff) | |
Merge branch 'master' into core-updates
Diffstat (limited to 'guix/build')
| -rw-r--r-- | guix/build/store-copy.scm | 28 |
1 files changed, 28 insertions, 0 deletions
diff --git a/guix/build/store-copy.scm b/guix/build/store-copy.scm index 64ade7885c..549aa4f28b 100644 --- a/guix/build/store-copy.scm +++ b/guix/build/store-copy.scm @@ -168,6 +168,28 @@ REFERENCE-GRAPHS, a list of reference-graph files." (reduce + 0 (map file-size items))) +(define (reset-permissions file) + "Reset the permissions on FILE and its sub-directories so that they are all +read-only." + ;; XXX: This procedure exists just to work around the inability of + ;; 'copy-recursively' to preserve permissions. + (file-system-fold (const #t) ;enter? + (lambda (file stat _) ;leaf + (unless (eq? 'symlink (stat:type stat)) + (chmod file + (if (zero? (logand (stat:mode stat) + #o100)) + #o444 + #o555)))) + (const #t) ;down + (lambda (directory stat _) ;up + (chmod directory #o555)) + (const #f) ;skip + (const #f) ;error + #t + file + lstat)) + (define* (populate-store reference-graphs target #:key (log-port (current-error-port))) "Populate the store under directory TARGET with the items specified in @@ -197,7 +219,13 @@ REFERENCE-GRAPHS, a list of reference-graph files." (for-each (lambda (thing) (copy-recursively thing (string-append target thing) + #:keep-mtime? #t #:log (%make-void-port "w")) + + ;; XXX: Since 'copy-recursively' doesn't allow us to + ;; preserve permissions, we have to traverse TARGET to + ;; make sure everything is read-only. + (reset-permissions (string-append target thing)) (report)) things))))) |