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'.master
parent
c6903e156f
commit
4dca1bae27
|
@ -202,51 +202,56 @@ taken since we do not import the archives."
|
||||||
(get)))
|
(get)))
|
||||||
|
|
||||||
(define (archive-contents port)
|
(define (archive-contents port)
|
||||||
"Return a list representing the files contained in the nar read from PORT."
|
"Return a list representing the files contained in the nar read from PORT.
|
||||||
(fold-archive (lambda (file type contents result)
|
The list is sorted in canonical order--i.e., the order in which entries appear
|
||||||
(match type
|
in the nar."
|
||||||
((or 'regular 'executable)
|
(reverse
|
||||||
(match contents
|
(fold-archive (lambda (file type contents result)
|
||||||
((port . size)
|
(match type
|
||||||
(cons `(,file ,type ,(port-sha256* port size))
|
((or 'regular 'executable)
|
||||||
result))))
|
(match contents
|
||||||
('directory result)
|
((port . size)
|
||||||
('directory-complete result)
|
(cons `(,file ,type ,(port-sha256* port size))
|
||||||
('symlink
|
result))))
|
||||||
(cons `(,file ,type ,contents) result))))
|
('directory result)
|
||||||
'()
|
('directory-complete result)
|
||||||
port
|
('symlink
|
||||||
""))
|
(cons `(,file ,type ,contents) result))))
|
||||||
|
'()
|
||||||
|
port
|
||||||
|
"")))
|
||||||
|
|
||||||
(define (store-item-contents item)
|
(define (store-item-contents item)
|
||||||
"Return a list of files and contents for ITEM in the same format as
|
"Return a list of files and contents for ITEM in the same format as
|
||||||
'archive-contents'."
|
'archive-contents'."
|
||||||
(file-system-fold (const #t) ;enter?
|
(let loop ((file item))
|
||||||
(lambda (file stat result) ;leaf
|
(define stat
|
||||||
(define short
|
(lstat file))
|
||||||
(string-drop file (string-length item)))
|
|
||||||
|
|
||||||
(match (stat:type stat)
|
(define short
|
||||||
('regular
|
(string-drop file (string-length item)))
|
||||||
(let ((size (stat:size stat))
|
|
||||||
(type (if (zero? (logand (stat:mode stat)
|
(match (stat:type stat)
|
||||||
#o100))
|
('regular
|
||||||
'regular
|
(let ((size (stat:size stat))
|
||||||
'executable)))
|
(type (if (zero? (logand (stat:mode stat)
|
||||||
(cons `(,short ,type
|
#o100))
|
||||||
,(call-with-input-file file
|
'regular
|
||||||
(cut port-sha256* <> size)))
|
'executable)))
|
||||||
result)))
|
`((,short ,type
|
||||||
('symlink
|
,(call-with-input-file file
|
||||||
(cons `(,short symlink ,(readlink file))
|
(cut port-sha256* <> size))))))
|
||||||
result))))
|
('symlink
|
||||||
(lambda (directory stat result) result) ;down
|
`((,short symlink ,(readlink file))))
|
||||||
(lambda (directory stat result) result) ;up
|
('directory
|
||||||
(lambda (file stat result) result) ;skip
|
(append-map (match-lambda
|
||||||
(lambda (file stat errno result) result) ;error
|
((or "." "..")
|
||||||
'()
|
'())
|
||||||
item
|
(entry
|
||||||
lstat))
|
(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)
|
(define (call-with-nar narinfo proc)
|
||||||
"Call PROC with an input port from which it can read the nar pointed to by
|
"Call PROC with an input port from which it can read the nar pointed to by
|
||||||
|
|
Reference in New Issue