summary refs log tree commit diff
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
parentc6903e156fff67ea43bf11443562a8e4f780a54d (diff)
downloadguix-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'.
-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