02/15: challenge: Store item contents are returned in canonical order.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit 4dca1bae2767b049532e7434151686fdb7fab256
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Sat Dec 11 16:10:08 2021 +0100

    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'.
---
 guix/scripts/challenge.scm | 87 ++++++++++++++++++++++++----------------------
 1 file changed, 46 insertions(+), 41 deletions(-)

diff --git a/guix/scripts/challenge.scm b/guix/scripts/challenge.scm
index 57ffe88..c29d510 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