summaryrefslogtreecommitdiff
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
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.
-rw-r--r--doc/guix.texi24
-rw-r--r--guix/scripts/challenge.scm70
-rw-r--r--tests/challenge.scm51
3 files changed, 128 insertions, 17 deletions
diff --git a/doc/guix.texi b/doc/guix.texi
index 80d67a44fa..a5cff4cab2 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -10366,8 +10366,20 @@ results, the inclusion of random numbers, and directory listings sorted
by inode number. See @uref{https://reproducible-builds.org/docs/}, for
more information.
-To find out what is wrong with this Git binary, we can do something along
-these lines (@pxref{Invoking guix archive}):
+To find out what is wrong with this Git binary, the easiest approach is
+to run:
+
+@example
+guix challenge git \
+ --diff=diffoscope \
+ --substitute-urls="https://@value{SUBSTITUTE-SERVER} https://guix.example.org"
+@end example
+
+This automatically invokes @command{diffoscope}, which displays detailed
+information about files that differ.
+
+Alternately, we can do something along these lines (@pxref{Invoking guix
+archive}):
@example
$ wget -q -O - https://@value{SUBSTITUTE-SERVER}/nar/@dots{}-git-2.5.0 \
@@ -10430,6 +10442,14 @@ Upon mismatches, show differences according to @var{mode}, one of:
@item @code{simple} (the default)
Show the list of files that differ.
+@item @code{diffoscope}
+@itemx @var{command}
+Invoke @uref{https://diffoscope.org/, Diffoscope}, passing it
+two directories whose contents do not match.
+
+When @var{command} is an absolute file name, run @var{command} instead
+of Diffoscope.
+
@item @code{none}
Do not show further details about the differences.
@end table
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
diff --git a/tests/challenge.scm b/tests/challenge.scm
index a2782abcbd..bb5633a3eb 100644
--- a/tests/challenge.scm
+++ b/tests/challenge.scm
@@ -29,6 +29,7 @@
#:use-module (guix base32)
#:use-module (guix scripts challenge)
#:use-module (guix scripts substitute)
+ #:use-module ((guix build utils) #:select (find-files))
#:use-module (gnu packages bootstrap)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
@@ -156,10 +157,12 @@ NarSize: ~d
NarHash: sha256:~a
References: ~%" item size (bytevector->nix-base32-string hash)))
-(test-assertm "differing-files"
- ;; Pretend we have two different results for the same store item, ITEM,
- ;; with "/bin/guile" differing between the two nars, and make sure
- ;; 'differing-files' returns it.
+(define (call-mismatch-test proc)
+ "Pass PROC a <comparison-report> for a mismatch and return its return
+value."
+
+ ;; Pretend we have two different results for the same store item, ITEM, with
+ ;; "/bin/guile" differing between the two nars.
(mlet* %store-monad
((drv1 (package->derivation %bootstrap-guile))
(drv2 (gexp->derivation
@@ -178,7 +181,10 @@ References: ~%" item size (bytevector->nix-base32-string hash)))
(out1 -> (derivation->output-path drv1))
(out2 -> (derivation->output-path drv2))
(item -> (string-append (%store-prefix) "/"
- (make-string 32 #\a) "-foo")))
+ (bytevector->nix-base32-string
+ (random-bytevector 32))
+ "-foo"
+ (number->string (current-time) 16))))
(mbegin %store-monad
(built-derivations (list drv1 drv2))
(mlet* %store-monad ((size1 (query-path-size out1))
@@ -186,11 +192,11 @@ References: ~%" item size (bytevector->nix-base32-string hash)))
(hash1 (query-path-hash* out1))
(hash2 (query-path-hash* out2))
(nar1 -> (call-with-bytevector-output-port
- (lambda (port)
- (write-file out1 port))))
+ (lambda (port)
+ (write-file out1 port))))
(nar2 -> (call-with-bytevector-output-port
- (lambda (port)
- (write-file out2 port)))))
+ (lambda (port)
+ (write-file out2 port)))))
(parameterize ((%http-server-port 9000))
(with-http-server `((200 ,(make-narinfo item size1 hash1))
(200 ,nar1))
@@ -202,8 +208,31 @@ References: ~%" item size (bytevector->nix-base32-string hash)))
(reports (compare-contents (list item)
urls)))
(pk 'report reports)
- (return (equal? (differing-files (car reports))
- '("/bin/guile"))))))))))))
+ (return (proc (car reports))))))))))))
+
+(test-assertm "differing-files"
+ (call-mismatch-test
+ (lambda (report)
+ (equal? (differing-files report) '("/bin/guile")))))
+
+(test-assertm "call-with-mismatches"
+ (call-mismatch-test
+ (lambda (report)
+ (call-with-mismatches
+ report
+ (lambda (directory1 directory2)
+ (let* ((files1 (find-files directory1))
+ (files2 (find-files directory2))
+ (files (map (cute string-drop <> (string-length directory1))
+ files1)))
+ (and (equal? files
+ (map (cute string-drop <> (string-length directory2))
+ files2))
+ (equal? (remove (lambda (file)
+ (file=? (string-append directory1 "/" file)
+ (string-append directory2 "/" file)))
+ files)
+ '("/bin/guile")))))))))
(test-end)