diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2018-11-04 22:05:32 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2018-11-06 23:21:24 +0100 |
| commit | 72dc64f8f720268930eed448abfc15d2a0eca3cf (patch) | |
| tree | 25ba24f00fc197f9b53a5921faa09d8f16f0c85f /guix/build | |
| parent | 1ff53787dbd4b1846ae523aef86ada3996de5e6d (diff) | |
| download | gnu-guix-72dc64f8f720268930eed448abfc15d2a0eca3cf.tar gnu-guix-72dc64f8f720268930eed448abfc15d2a0eca3cf.tar.gz | |
store-copy: Canonicalize the mtime and permissions of the store copy.
Fixes a bug whereby directories in the output of 'guix pack -f tarball'
would not be read-only.
* guix/build/store-copy.scm (reset-permissions): New procedure.
(populate-store): Pass #:keep-mtime? #t to 'copy-recursively'. Call
'reset-permissions'.
* tests/pack.scm ("self-contained-tarball"): In CHECK, define
'canonical?' and use it to check that every file has an mtime of 1 and
is read-only.
* tests/guix-pack.sh: Invoke "chmod -Rf +w" before "rm -rf" in trap.
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))))) |