summaryrefslogtreecommitdiff
path: root/guix/scripts/challenge.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2021-12-11 16:10:08 +0100
committerLudovic Courtès <ludo@gnu.org>2021-12-12 00:27:53 +0100
commit4dca1bae2767b049532e7434151686fdb7fab256 (patch)
treecd83cfd85ec2f66f74e562a109338b670ddab216 /guix/scripts/challenge.scm
parentc6903e156fff67ea43bf11443562a8e4f780a54d (diff)
downloadguix-patches-4dca1bae2767b049532e7434151686fdb7fab256.tar
guix-patches-4dca1bae2767b049532e7434151686fdb7fab256.tar.gz
challenge: Store item contents are returned in canonical order.
This allows the 'delete-duplicates' call in 'differing-files' to have the intended effect. Before that, a "guix challenge" invocation with three builds of a store item, two of which are identical, would lead 'differing-files' to not print anything, as in this example: $ ./pre-inst-env guix challenge python-numpy /gnu/store/…-python-numpy-1.17.3 contents differ: local hash: 07var0wn8fywxchldz5pjqpnlavrlbc8s81aqwsqyi0i7qlh6ka7 https://ci.guix.gnu.org/nar/lzip/…-python-numpy-1.17.3: 07var0wn8fywxchldz5pjqpnlavrlbc8s81aqwsqyi0i7qlh6ka7 https://bordeaux.guix.gnu.org/nar/lzip/…-python-numpy-1.17.3: 0cbl3q19bshb6ddz8xkcrjzkcmillsqii4z852ybzixyp7rg40qa 1 store items were analyzed: - 0 (0.0%) were identical - 1 (100.0%) differed - 0 (0.0%) were inconclusive With this change, 'differing-files' prints additional info as intended: differing file: /lib/python3.8/site-packages/numpy/distutils/fcompiler/__pycache__/vast.cpython-38.pyc * guix/scripts/challenge.scm (archive-contents): Add tail call to 'reverse'. (store-item-contents): Rewrite to use 'scandir' and recursive calls instead of 'file-system-fold'.
Diffstat (limited to 'guix/scripts/challenge.scm')
-rw-r--r--guix/scripts/challenge.scm87
1 files changed, 46 insertions, 41 deletions
diff --git a/guix/scripts/challenge.scm b/guix/scripts/challenge.scm
index 57ffe88235..c29d5105ae 100644
--- a/guix/scripts/challenge.scm
+++ b/guix/scripts/challenge.scm
@@ -202,51 +202,56 @@ taken since we do not import the archives."
(get)))
(define (archive-contents port)
- "Return a list representing the files contained in the nar read from PORT."
- (fold-archive (lambda (file type contents result)
- (match type
- ((or 'regular 'executable)
- (match contents
- ((port . size)
- (cons `(,file ,type ,(port-sha256* port size))
- result))))
- ('directory result)
- ('directory-complete result)
- ('symlink
- (cons `(,file ,type ,contents) result))))
- '()
- port
- ""))
+ "Return a list representing the files contained in the nar read from PORT.
+The list is sorted in canonical order--i.e., the order in which entries appear
+in the nar."
+ (reverse
+ (fold-archive (lambda (file type contents result)
+ (match type
+ ((or 'regular 'executable)
+ (match contents
+ ((port . size)
+ (cons `(,file ,type ,(port-sha256* port size))
+ result))))
+ ('directory result)
+ ('directory-complete result)
+ ('symlink
+ (cons `(,file ,type ,contents) result))))
+ '()
+ port
+ "")))
(define (store-item-contents item)
"Return a list of files and contents for ITEM in the same format as
'archive-contents'."
- (file-system-fold (const #t) ;enter?
- (lambda (file stat result) ;leaf
- (define short
- (string-drop file (string-length item)))
-
- (match (stat:type stat)
- ('regular
- (let ((size (stat:size stat))
- (type (if (zero? (logand (stat:mode stat)
- #o100))
- 'regular
- 'executable)))
- (cons `(,short ,type
- ,(call-with-input-file file
- (cut port-sha256* <> size)))
- result)))
- ('symlink
- (cons `(,short symlink ,(readlink file))
- result))))
- (lambda (directory stat result) result) ;down
- (lambda (directory stat result) result) ;up
- (lambda (file stat result) result) ;skip
- (lambda (file stat errno result) result) ;error
- '()
- item
- lstat))
+ (let loop ((file item))
+ (define stat
+ (lstat file))
+
+ (define short
+ (string-drop file (string-length item)))
+
+ (match (stat:type stat)
+ ('regular
+ (let ((size (stat:size stat))
+ (type (if (zero? (logand (stat:mode stat)
+ #o100))
+ 'regular
+ 'executable)))
+ `((,short ,type
+ ,(call-with-input-file file
+ (cut port-sha256* <> size))))))
+ ('symlink
+ `((,short symlink ,(readlink file))))
+ ('directory
+ (append-map (match-lambda
+ ((or "." "..")
+ '())
+ (entry
+ (loop (string-append file "/" entry))))
+ ;; Traverse entries in canonical order, the same as the
+ ;; order of entries in nars.
+ (scandir file (const #t) string<?))))))
(define (call-with-nar narinfo proc)
"Call PROC with an input port from which it can read the nar pointed to by