1
0
mirror of https://git.savannah.gnu.org/git/guix.git synced 2026-05-28 03:51:53 +02:00

challenge: Add "--diff".

* guix/scripts/challenge.scm (dump-port*): New variable.
(archive-contents, store-item-contents, narinfo-contents)
(differing-files, report-differing-files): New procedures.
(summarize-report): Add #:report-differences and call it.
(show-help, %options): Add "--diff".
(%default-options): Add 'difference-report' key.
(report-differing-files): Parameterize CURRENT-TERMINAL-COLUMNS and pass
 #:report-differences to 'summarize-report'.
* guix/tests/http.scm (%local-url): Add optional argument.
(call-with-http-server): Fix docstring typo.
* tests/challenge.scm (query-path-size, make-narinfo): New procedures.
("differing-files"): New test.
* doc/guix.texi (Invoking guix challenge): Document "--diff".
This commit is contained in:
Ludovic Courtès
2019-12-07 15:10:39 +01:00
parent 22f06a2128
commit 5208db3a52
4 changed files with 242 additions and 11 deletions
+66 -1
View File
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015, 2017, 2019 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -18,22 +18,32 @@
(define-module (test-challenge)
#:use-module (guix tests)
#:use-module (guix tests http)
#:use-module (gcrypt hash)
#:use-module (guix store)
#:use-module (guix monads)
#:use-module (guix derivations)
#:use-module (guix serialization)
#:use-module (guix packages)
#:use-module (guix gexp)
#:use-module (guix base32)
#:use-module (guix scripts challenge)
#:use-module (guix scripts substitute)
#:use-module (gnu packages bootstrap)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-64)
#:use-module (rnrs bytevectors)
#:use-module (rnrs io ports)
#:use-module (ice-9 match))
(define query-path-hash*
(store-lift query-path-hash))
(define (query-path-size item)
(mlet %store-monad ((info (query-path-info* item)))
(return (path-info-nar-size info))))
(define* (call-with-derivation-narinfo* drv thunk hash)
(lambda (store)
(with-derivation-narinfo drv (sha256 => hash)
@@ -138,7 +148,62 @@
(bytevector=? (narinfo-hash->sha256
(narinfo-hash narinfo))
hash))))))))))))
(define (make-narinfo item size hash)
(format #f "StorePath: ~a
Compression: none
URL: nar/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo
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.
(mlet* %store-monad
((drv1 (package->derivation %bootstrap-guile))
(drv2 (gexp->derivation
"broken-guile"
(with-imported-modules '((guix build utils))
#~(begin
(use-modules (guix build utils))
(copy-recursively #$drv1 #$output)
(chmod (string-append #$output "/bin/guile")
#o755)
(call-with-output-file (string-append
#$output
"/bin/guile")
(lambda (port)
(display "corrupt!" port)))))))
(out1 -> (derivation->output-path drv1))
(out2 -> (derivation->output-path drv2))
(item -> (string-append (%store-prefix) "/"
(make-string 32 #\a) "-foo")))
(mbegin %store-monad
(built-derivations (list drv1 drv2))
(mlet* %store-monad ((size1 (query-path-size out1))
(size2 (query-path-size out2))
(hash1 (query-path-hash* out1))
(hash2 (query-path-hash* out2))
(nar1 -> (call-with-bytevector-output-port
(lambda (port)
(write-file out1 port))))
(nar2 -> (call-with-bytevector-output-port
(lambda (port)
(write-file out2 port)))))
(parameterize ((%http-server-port 9000))
(with-http-server `((200 ,(make-narinfo item size1 hash1))
(200 ,nar1))
(parameterize ((%http-server-port 9001))
(with-http-server `((200 ,(make-narinfo item size2 hash2))
(200 ,nar2))
(mlet* %store-monad ((urls -> (list (%local-url 9000)
(%local-url 9001)))
(reports (compare-contents (list item)
urls)))
(pk 'report reports)
(return (equal? (differing-files (car reports))
'("/bin/guile"))))))))))))
(test-end)