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 by inode number. See @uref{https://reproducible-builds.org/docs/}, for
more information. more information.
To find out what is wrong with this Git binary, we can do something along To find out what is wrong with this Git binary, the easiest approach is
these lines (@pxref{Invoking guix archive}): 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 @example
$ wget -q -O - https://@value{SUBSTITUTE-SERVER}/nar/@dots{}-git-2.5.0 \ $ 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) @item @code{simple} (the default)
Show the list of files that differ. 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} @item @code{none}
Do not show further details about the differences. Do not show further details about the differences.
@end table @end table

View file

@ -56,6 +56,7 @@ (define-module (guix scripts challenge)
comparison-report-inconclusive? comparison-report-inconclusive?
differing-files differing-files
call-with-mismatches
guix-challenge)) guix-challenge))
@ -248,9 +249,9 @@ (define short
item item
lstat)) lstat))
(define (narinfo-contents narinfo) (define (call-with-nar narinfo proc)
"Fetch the nar described by NARINFO and return a list representing the file "Call PROC with an input port from which it can read the nar pointed to by
it contains." NARINFO."
(let*-values (((uri compression size) (let*-values (((uri compression size)
(narinfo-best-uri narinfo)) (narinfo-best-uri narinfo))
((port response) ((port response)
@ -262,12 +263,17 @@ (define reporter
(define result (define result
(call-with-decompressed-port (string->symbol compression) (call-with-decompressed-port (string->symbol compression)
(progress-report-port reporter port) (progress-report-port reporter port)
archive-contents)) proc))
(close-port port) (close-port port)
(erase-current-line (current-output-port)) (erase-current-line (current-output-port))
result)) 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) (define (differing-files comparison-report)
"Return a list of files that differ among the nars and possibly the local "Return a list of files that differ among the nars and possibly the local
store item specified in COMPARISON-REPORT." store item specified in COMPARISON-REPORT."
@ -300,6 +306,58 @@ (define (report-differing-files comparison-report)
(length files))) (length files)))
(format #t "~{ ~a~%~}" 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 (define* (summarize-report comparison-report
#:key #:key
(report-differences (const #f)) (report-differences (const #f))
@ -386,6 +444,10 @@ (define mode
(match arg (match arg
("none" (const #t)) ("none" (const #t))
("simple" report-differing-files) ("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)))) (_ (leave (G_ "~a: unknown diff mode~%") arg))))
(apply values (apply values

View file

@ -29,6 +29,7 @@ (define-module (test-challenge)
#:use-module (guix base32) #:use-module (guix base32)
#:use-module (guix scripts challenge) #:use-module (guix scripts challenge)
#:use-module (guix scripts substitute) #:use-module (guix scripts substitute)
#:use-module ((guix build utils) #:select (find-files))
#:use-module (gnu packages bootstrap) #:use-module (gnu packages bootstrap)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
@ -156,10 +157,12 @@ (define (make-narinfo item size hash)
NarHash: sha256:~a NarHash: sha256:~a
References: ~%" item size (bytevector->nix-base32-string hash))) References: ~%" item size (bytevector->nix-base32-string hash)))
(test-assertm "differing-files" (define (call-mismatch-test proc)
;; Pretend we have two different results for the same store item, ITEM, "Pass PROC a <comparison-report> for a mismatch and return its return
;; with "/bin/guile" differing between the two nars, and make sure value."
;; 'differing-files' returns it.
;; Pretend we have two different results for the same store item, ITEM, with
;; "/bin/guile" differing between the two nars.
(mlet* %store-monad (mlet* %store-monad
((drv1 (package->derivation %bootstrap-guile)) ((drv1 (package->derivation %bootstrap-guile))
(drv2 (gexp->derivation (drv2 (gexp->derivation
@ -178,7 +181,10 @@ (define (make-narinfo item size hash)
(out1 -> (derivation->output-path drv1)) (out1 -> (derivation->output-path drv1))
(out2 -> (derivation->output-path drv2)) (out2 -> (derivation->output-path drv2))
(item -> (string-append (%store-prefix) "/" (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 (mbegin %store-monad
(built-derivations (list drv1 drv2)) (built-derivations (list drv1 drv2))
(mlet* %store-monad ((size1 (query-path-size out1)) (mlet* %store-monad ((size1 (query-path-size out1))
@ -186,11 +192,11 @@ (define (make-narinfo item size hash)
(hash1 (query-path-hash* out1)) (hash1 (query-path-hash* out1))
(hash2 (query-path-hash* out2)) (hash2 (query-path-hash* out2))
(nar1 -> (call-with-bytevector-output-port (nar1 -> (call-with-bytevector-output-port
(lambda (port) (lambda (port)
(write-file out1 port)))) (write-file out1 port))))
(nar2 -> (call-with-bytevector-output-port (nar2 -> (call-with-bytevector-output-port
(lambda (port) (lambda (port)
(write-file out2 port))))) (write-file out2 port)))))
(parameterize ((%http-server-port 9000)) (parameterize ((%http-server-port 9000))
(with-http-server `((200 ,(make-narinfo item size1 hash1)) (with-http-server `((200 ,(make-narinfo item size1 hash1))
(200 ,nar1)) (200 ,nar1))
@ -202,8 +208,31 @@ (define (make-narinfo item size hash)
(reports (compare-contents (list item) (reports (compare-contents (list item)
urls))) urls)))
(pk 'report reports) (pk 'report reports)
(return (equal? (differing-files (car reports)) (return (proc (car reports))))))))))))
'("/bin/guile"))))))))))))
(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) (test-end)