mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2025-01-11 21:59:08 -05:00
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:
parent
5208db3a52
commit
828a39da68
3 changed files with 128 additions and 17 deletions
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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)
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue