summaryrefslogtreecommitdiff
path: root/guix/scripts
diff options
context:
space:
mode:
Diffstat (limited to 'guix/scripts')
-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