summaryrefslogtreecommitdiff
path: root/guix/scripts/challenge.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2019-12-07 17:37:08 +0100
committerLudovic Courtès <ludo@gnu.org>2019-12-12 17:56:58 +0100
commit828a39da68a9169ef1d9f9ff02a1c66b1bcbe884 (patch)
tree7b92b771e08dc03dc408eacbbe41de2c5df34304 /guix/scripts/challenge.scm
parent5208db3a526e3fcdb8473d9bab8afe498c5f3f76 (diff)
challenge: Support "--diff=diffoscope".
* guix/scripts/challenge.scm (call-with-nar): New procedure. (narinfo-contents): Express in terms of 'call-with-nar'. (call-with-mismatches, report-differing-files/external): New procedures. (%diffoscope-command): New variable. (%options): Support "diffoscope" and a string starting with "/". * tests/challenge.scm (call-mismatch-test): New procedure. ("differing-files"): Rewrite in terms of 'call-mismatch-test'. ("call-with-mismatches"): New test. * doc/guix.texi (Invoking guix challenge): Document it.
Diffstat (limited to 'guix/scripts/challenge.scm')
-rw-r--r--guix/scripts/challenge.scm70
1 files changed, 66 insertions, 4 deletions
diff --git a/guix/scripts/challenge.scm b/guix/scripts/challenge.scm
index 277eec9a5d..51e8d3e4e3 100644
--- a/guix/scripts/challenge.scm
+++ b/guix/scripts/challenge.scm
@@ -56,6 +56,7 @@
comparison-report-inconclusive?
differing-files
+ call-with-mismatches
guix-challenge))
@@ -248,9 +249,9 @@ taken since we do not import the archives."
item
lstat))
-(define (narinfo-contents narinfo)
- "Fetch the nar described by NARINFO and return a list representing the file
-it contains."
+(define (call-with-nar narinfo proc)
+ "Call PROC with an input port from which it can read the nar pointed to by
+NARINFO."
(let*-values (((uri compression size)
(narinfo-best-uri narinfo))
((port response)
@@ -262,12 +263,17 @@ it contains."
(define result
(call-with-decompressed-port (string->symbol compression)
(progress-report-port reporter port)
- archive-contents))
+ proc))
(close-port port)
(erase-current-line (current-output-port))
result))
+(define (narinfo-contents narinfo)
+ "Fetch the nar described by NARINFO and return a list representing the file
+it contains."
+ (call-with-nar narinfo archive-contents))
+
(define (differing-files comparison-report)
"Return a list of files that differ among the nars and possibly the local
store item specified in COMPARISON-REPORT."
@@ -300,6 +306,58 @@ specified in COMPARISON-REPORT."
(length files)))
(format #t "~{ ~a~%~}" files))))
+(define (call-with-mismatches comparison-report proc)
+ "Call PROC with two directories containing the mismatching store items."
+ (define local-hash
+ (comparison-report-local-sha256 comparison-report))
+
+ (define narinfos
+ (comparison-report-narinfos comparison-report))
+
+ (call-with-temporary-directory
+ (lambda (directory1)
+ (call-with-temporary-directory
+ (lambda (directory2)
+ (define narinfo1
+ (if local-hash
+ (find (lambda (narinfo)
+ (not (string=? (narinfo-hash narinfo)
+ local-hash)))
+ narinfos)
+ (first (comparison-report-narinfos comparison-report))))
+
+ (define narinfo2
+ (and (not local-hash)
+ (find (lambda (narinfo)
+ (not (eq? narinfo narinfo1)))
+ narinfos)))
+
+ (rmdir directory1)
+ (call-with-nar narinfo1 (cut restore-file <> directory1))
+ (when narinfo2
+ (rmdir directory2)
+ (call-with-nar narinfo2 (cut restore-file <> directory2)))
+ (proc directory1
+ (if local-hash
+ (comparison-report-item comparison-report)
+ directory2)))))))
+
+(define %diffoscope-command
+ ;; Default external diff command. Pass "--exclude-directory-metadata" so
+ ;; that the mtime/ctime differences are ignored.
+ '("diffoscope" "--exclude-directory-metadata=yes"))
+
+(define* (report-differing-files/external comparison-report
+ #:optional
+ (command %diffoscope-command))
+ "Run COMMAND to show the file-level differences for the mismatches in
+COMPARISON-REPORT."
+ (call-with-mismatches comparison-report
+ (lambda (directory1 directory2)
+ (apply system*
+ (append command
+ (list directory1 directory2))))))
+
(define* (summarize-report comparison-report
#:key
(report-differences (const #f))
@@ -386,6 +444,10 @@ Challenge the substitutes for PACKAGE... provided by one or more servers.\n"))
(match arg
("none" (const #t))
("simple" report-differing-files)
+ ("diffoscope" report-differing-files/external)
+ ((and (? (cut string-prefix? "/" <>)) command)
+ (cute report-differing-files/external <>
+ (string-tokenize command)))
(_ (leave (G_ "~a: unknown diff mode~%") arg))))
(apply values