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'.
This commit is contained in:
Ludovic Courtès 2021-12-11 16:10:08 +01:00
parent c6903e156f
commit 4dca1bae27
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5

@ -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)))
(let loop ((file item))
(define stat
(lstat file))
(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))
(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