diff options
| -rw-r--r-- | doc/guix.texi | 24 | ||||
| -rw-r--r-- | guix/scripts/challenge.scm | 70 | ||||
| -rw-r--r-- | tests/challenge.scm | 51 |
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) |