08/09: challenge: Support "--diff=diffoscope".

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit 828a39da68a9169ef1d9f9ff02a1c66b1bcbe884
Author: Ludovic Courtès <address@hidden>
Date:   Sat Dec 7 17:37:08 2019 +0100

    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.
---
 doc/guix.texi              | 24 ++++++++++++++--
 guix/scripts/challenge.scm | 70 +++++++++++++++++++++++++++++++++++++++++++---
 tests/challenge.scm        | 51 +++++++++++++++++++++++++--------
 3 files changed, 128 insertions(+), 17 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 80d67a4..a5cff4c 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 277eec9..51e8d3e 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 a2782ab..bb5633a 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)