mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-07 07:26:13 -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
|
||||
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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
||||
|
|
Loading…
Reference in a new issue