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.
This commit is contained in:
Ludovic Courtès 2019-12-07 17:37:08 +01:00
parent 5208db3a52
commit 828a39da68
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
3 changed files with 128 additions and 17 deletions

View file

@ -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

View file

@ -56,6 +56,7 @@ (define-module (guix scripts challenge)
comparison-report-inconclusive?
differing-files
call-with-mismatches
guix-challenge))
@ -248,9 +249,9 @@ (define short
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 @@ (define reporter
(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 @@ (define (report-differing-files 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 @@ (define mode
(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

View file

@ -29,6 +29,7 @@ (define-module (test-challenge)
#: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 @@ (define (make-narinfo item size hash)
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 @@ (define (make-narinfo item size 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 @@ (define (make-narinfo item size 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 @@ (define (make-narinfo item size 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)