From patchwork Sun Dec 8 11:26:31 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 16412 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id F145117869; Sun, 8 Dec 2019 11:27:15 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.0 (2014-02-07) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00 autolearn=unavailable autolearn_force=no version=3.4.0 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTP id 7E90D177CB for ; Sun, 8 Dec 2019 11:27:15 +0000 (GMT) Received: from localhost ([::1]:57726 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1iduiZ-0004kp-2e for patchwork@mira.cbaines.net; Sun, 08 Dec 2019 06:27:15 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]:34231) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1iduiN-0004c9-K8 for guix-patches@gnu.org; Sun, 08 Dec 2019 06:27:05 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1iduiL-0004n9-Ro for guix-patches@gnu.org; Sun, 08 Dec 2019 06:27:03 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:44611) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1iduiL-0004m8-NW for guix-patches@gnu.org; Sun, 08 Dec 2019 06:27:01 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1iduiL-0007sq-Is for guix-patches@gnu.org; Sun, 08 Dec 2019 06:27:01 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#38518] [PATCH 1/7] serialization: Add 'fold-archive'. References: <20191207214230.25653-1-ludo@gnu.org> In-Reply-To: <20191207214230.25653-1-ludo@gnu.org> Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sun, 08 Dec 2019 11:27:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 38518 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 38518@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 38518-submit@debbugs.gnu.org id=B38518.157580441930262 (code B ref 38518); Sun, 08 Dec 2019 11:27:01 +0000 Received: (at 38518) by debbugs.gnu.org; 8 Dec 2019 11:26:59 +0000 Received: from localhost ([127.0.0.1]:50576 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1iduiI-0007s1-GP for submit@debbugs.gnu.org; Sun, 08 Dec 2019 06:26:58 -0500 Received: from eggs.gnu.org ([209.51.188.92]:52645) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1iduiF-0007rk-F1 for 38518@debbugs.gnu.org; Sun, 08 Dec 2019 06:26:55 -0500 Received: from fencepost.gnu.org ([2001:470:142:3::e]:43961) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1iduiA-0003vI-6V; Sun, 08 Dec 2019 06:26:50 -0500 Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=55006 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:DHE_RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1idui8-0003cW-Nm; Sun, 08 Dec 2019 06:26:49 -0500 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Sun, 8 Dec 2019 12:26:31 +0100 Message-Id: <20191208112637.5534-1-ludo@gnu.org> X-Mailer: git-send-email 2.24.0 MIME-Version: 1.0 X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 209.51.188.43 X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * guix/serialization.scm (read-contents): Remove. (read-file-type, fold-archive): New procedures. (restore-file): Rewrite in terms of 'fold-archive'. * tests/nar.scm ("write-file-tree + fold-archive") ("write-file-tree + fold-archive, flat file"): New tests. --- guix/serialization.scm | 134 ++++++++++++++++++++++++----------------- tests/nar.scm | 74 +++++++++++++++++++++++ 2 files changed, 153 insertions(+), 55 deletions(-) diff --git a/guix/serialization.scm b/guix/serialization.scm index e14b7d1b9f..cf263d321e 100644 --- a/guix/serialization.scm +++ b/guix/serialization.scm @@ -48,6 +48,7 @@ write-file write-file-tree + fold-archive restore-file)) ;;; Comment: @@ -226,38 +227,25 @@ substitute invalid byte sequences with question marks. This is a (dump input output size)) (write-padding size output)) -(define (read-contents in out) - "Read the contents of a file from the Nar at IN, write it to OUT, and return -the size in bytes." - (define executable? - (match (read-string in) - ("contents" - #f) - ("executable" - (match (list (read-string in) (read-string in)) - (("" "contents") #t) - (x (raise - (condition (&message - (message "unexpected executable file marker")) - (&nar-read-error (port in) - (file #f) - (token x)))))) - #t) - (x - (raise - (condition (&message (message "unsupported nar file type")) - (&nar-read-error (port in) (file #f) (token x))))))) - - (let ((size (read-long-long in))) - ;; Note: `sendfile' cannot be used here because of port buffering on IN. - (dump in out size) - - (when executable? - (chmod out #o755)) - (let ((m (modulo size 8))) - (unless (zero? m) - (get-bytevector-n* in (- 8 m)))) - size)) +(define (read-file-type port) + "Read the file type tag from PORT, and return either 'regular or +'executable." + (match (read-string port) + ("contents" + 'regular) + ("executable" + (match (list (read-string port) (read-string port)) + (("" "contents") 'executable) + (x (raise + (condition (&message + (message "unexpected executable file marker")) + (&nar-read-error (port port) + (file #f) + (token x))))))) + (x + (raise + (condition (&message (message "unsupported nar file type")) + (&nar-read-error (port port) (file #f) (token x))))))) (define %archive-version-1 ;; Magic cookie for Nix archives. @@ -383,9 +371,14 @@ which case you can use 'identity'." (define port-conversion-strategy (fluid->parameter %default-port-conversion-strategy)) -(define (restore-file port file) - "Read a file (possibly a directory structure) in Nar format from PORT. -Restore it as FILE." +(define (fold-archive proc seed port file) + "Read a file (possibly a directory structure) in Nar format from PORT. Call +PROC on each file or directory read from PORT using: + + (PROC FILE TYPE CONTENTS RESULT) + +using SEED as the first RESULT. TYPE is a symbol like 'regular, and CONTENTS +depends on TYPE." (parameterize ((currently-restored-file file) ;; Error out if we can convert file names to the current @@ -401,7 +394,8 @@ Restore it as FILE." (token signature) (file #f)))))) - (let restore ((file file)) + (let read ((file file) + (result seed)) (define (read-eof-marker) (match (read-string port) (")" #t) @@ -414,40 +408,49 @@ Restore it as FILE." (match (list (read-string port) (read-string port) (read-string port)) (("(" "type" "regular") - (call-with-output-file file (cut read-contents port <>)) - (read-eof-marker)) + (let* ((type (read-file-type port)) + (size (read-long-long port)) + + ;; The caller must read exactly SIZE bytes from PORT. + (result (proc file type `(,port . ,size) result))) + (let ((m (modulo size 8))) + (unless (zero? m) + (get-bytevector-n* port (- 8 m)))) + (read-eof-marker) + result)) (("(" "type" "symlink") (match (list (read-string port) (read-string port)) (("target" target) - (symlink target file) - (read-eof-marker)) + (let ((result (proc file 'symlink target result))) + (read-eof-marker) + result)) (x (raise (condition (&message (message "invalid symlink tokens")) (&nar-read-error (port port) (file file) (token x))))))) (("(" "type" "directory") (let ((dir file)) - (mkdir dir) - (let loop ((prefix (read-string port))) + (let loop ((prefix (read-string port)) + (result (proc file 'directory #f result))) (match prefix ("entry" (match (list (read-string port) (read-string port) (read-string port) (read-string port)) (("(" "name" file "node") - (restore (string-append dir "/" file)) - (match (read-string port) - (")" #t) - (x - (raise - (condition - (&message - (message "unexpected directory entry termination")) - (&nar-read-error (port port) - (file file) - (token x)))))) - (loop (read-string port))))) - (")" #t) ; done with DIR + (let ((result (read (string-append dir "/" file) result))) + (match (read-string port) + (")" #f) + (x + (raise + (condition + (&message + (message "unexpected directory entry termination")) + (&nar-read-error (port port) + (file file) + (token x)))))) + (loop (read-string port) result))))) + (")" result) ;done with DIR (x (raise (condition @@ -459,6 +462,27 @@ Restore it as FILE." (&message (message "unsupported nar entry type")) (&nar-read-error (port port) (file file) (token x))))))))) +(define (restore-file port file) + "Read a file (possibly a directory structure) in Nar format from PORT. +Restore it as FILE." + (fold-archive (lambda (file type content result) + (match type + ('directory + (mkdir file)) + ('symlink + (symlink content file)) + ((or 'regular 'executable) + (match content + ((input . size) + (call-with-output-file file + (lambda (output) + (dump input output size) + (when (eq? type 'executable) + (chmod output #o755))))))))) + #t + port + file)) + ;;; Local Variables: ;;; eval: (put 'call-with-binary-input-file 'scheme-indent-function 1) ;;; End: diff --git a/tests/nar.scm b/tests/nar.scm index bfc71c69a8..aeff3d3330 100644 --- a/tests/nar.scm +++ b/tests/nar.scm @@ -214,6 +214,80 @@ (lambda () (false-if-exception (rm-rf %test-dir)))))) +(test-equal "write-file-tree + fold-archive" + '(("R" directory #f) + ("R/dir" directory #f) + ("R/dir/exe" executable "1234") + ("R/foo" regular "abcdefg") + ("R/lnk" symlink "foo")) + + (let () + (define-values (port get-bytevector) + (open-bytevector-output-port)) + (write-file-tree "root" port + #:file-type+size + (match-lambda + ("root" + (values 'directory 0)) + ("root/foo" + (values 'regular 7)) + ("root/lnk" + (values 'symlink 0)) + ("root/dir" + (values 'directory 0)) + ("root/dir/exe" + (values 'executable 4))) + #:file-port + (match-lambda + ("root/foo" (open-input-string "abcdefg")) + ("root/dir/exe" (open-input-string "1234"))) + #:symlink-target + (match-lambda + ("root/lnk" "foo")) + #:directory-entries + (match-lambda + ("root" '("foo" "dir" "lnk")) + ("root/dir" '("exe")))) + (close-port port) + + (reverse + (fold-archive (lambda (file type contents result) + (let ((contents (if (memq type '(regular executable)) + (utf8->string + (get-bytevector-n (car contents) + (cdr contents))) + contents))) + (cons `(,file ,type ,contents) + result))) + '() + (open-bytevector-input-port (get-bytevector)) + "R")))) + +(test-equal "write-file-tree + fold-archive, flat file" + '(("R" regular "abcdefg")) + + (let () + (define-values (port get-bytevector) + (open-bytevector-output-port)) + (write-file-tree "root" port + #:file-type+size + (match-lambda + ("root" (values 'regular 7))) + #:file-port + (match-lambda + ("root" (open-input-string "abcdefg")))) + (close-port port) + + (reverse + (fold-archive (lambda (file type contents result) + (let ((contents (utf8->string + (get-bytevector-n (car contents) + (cdr contents))))) + (cons `(,file ,type ,contents) result))) + '() + (open-bytevector-input-port (get-bytevector)) + "R")))) + (test-assert "write-file supports non-file output ports" (let ((input (string-append (dirname (search-path %load-path "guix.scm")) "/guix")) From patchwork Sun Dec 8 11:26:32 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 16411 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id B7B9A17869; Sun, 8 Dec 2019 11:27:11 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.0 (2014-02-07) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00,URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.0 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTP id 52A08177CB for ; Sun, 8 Dec 2019 11:27:11 +0000 (GMT) Received: from localhost ([::1]:57724 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1iduiU-0004dJ-Pw for patchwork@mira.cbaines.net; Sun, 08 Dec 2019 06:27:10 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]:34230) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1iduiN-0004c8-KL for guix-patches@gnu.org; Sun, 08 Dec 2019 06:27:04 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1iduiM-0004qD-9F for guix-patches@gnu.org; Sun, 08 Dec 2019 06:27:03 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:44612) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1iduiM-0004oa-3i for guix-patches@gnu.org; Sun, 08 Dec 2019 06:27:02 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1iduiL-0007t1-Vq for guix-patches@gnu.org; Sun, 08 Dec 2019 06:27:01 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#38518] [PATCH 2/7] guix archive: Add '--list'. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sun, 08 Dec 2019 11:27:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 38518 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 38518@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 38518-submit@debbugs.gnu.org id=B38518.157580442030289 (code B ref 38518); Sun, 08 Dec 2019 11:27:01 +0000 Received: (at 38518) by debbugs.gnu.org; 8 Dec 2019 11:27:00 +0000 Received: from localhost ([127.0.0.1]:50581 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1iduiJ-0007sN-Uw for submit@debbugs.gnu.org; Sun, 08 Dec 2019 06:27:00 -0500 Received: from eggs.gnu.org ([209.51.188.92]:52704) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1iduiI-0007rn-L7 for 38518@debbugs.gnu.org; Sun, 08 Dec 2019 06:26:59 -0500 Received: from fencepost.gnu.org ([2001:470:142:3::e]:43962) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1iduiB-00042M-Dy; Sun, 08 Dec 2019 06:26:51 -0500 Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=55006 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:DHE_RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1iduiA-0003cW-IJ; Sun, 08 Dec 2019 06:26:51 -0500 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Sun, 8 Dec 2019 12:26:32 +0100 Message-Id: <20191208112637.5534-2-ludo@gnu.org> X-Mailer: git-send-email 2.24.0 In-Reply-To: <20191208112637.5534-1-ludo@gnu.org> References: <20191208112637.5534-1-ludo@gnu.org> MIME-Version: 1.0 X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 209.51.188.43 X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * guix/scripts/archive.scm (show-help, %options): Add '--list'. (list-contents): New procedure. (guix-archive): Honor the '--list' option. * tests/guix-archive.sh: Test it. * doc/guix.texi (Invoking guix archive): Document it. --- doc/guix.texi | 12 +++++++++++ guix/scripts/archive.scm | 45 +++++++++++++++++++++++++++++++++++++++- tests/guix-archive.sh | 7 ++++++- 3 files changed, 62 insertions(+), 2 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index 446534c576..7b9aa7f7c3 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -4598,6 +4598,18 @@ unsafe. The primary purpose of this operation is to facilitate inspection of archive contents coming from possibly untrusted substitute servers. +@item --list +@itemx -t +Read a single-item archive as served by substitute servers +(@pxref{Substitutes}) and print the list of files it contains, as in +this example: + +@example +$ wget -O - \ + https://@value{SUBSTITUTE-SERVER}/nar/lzip/@dots{}-emacs-26.3 \ + | lzip -d | guix archive -t +@end example + @end table diff --git a/guix/scripts/archive.scm b/guix/scripts/archive.scm index 3318ef0889..2b4d39c7b8 100644 --- a/guix/scripts/archive.scm +++ b/guix/scripts/archive.scm @@ -21,7 +21,8 @@ #:use-module (guix utils) #:use-module (guix combinators) #:use-module ((guix build utils) #:select (mkdir-p)) - #:use-module ((guix serialization) #:select (restore-file)) + #:use-module ((guix serialization) + #:select (fold-archive restore-file)) #:use-module (guix store) #:use-module ((guix status) #:select (with-status-verbosity)) #:use-module (guix grafts) @@ -43,6 +44,7 @@ #:use-module (srfi srfi-26) #:use-module (srfi srfi-37) #:use-module (ice-9 binary-ports) + #:use-module (rnrs bytevectors) #:export (guix-archive options->derivations+files)) @@ -76,6 +78,8 @@ Export/import one or more packages from/to the store.\n")) --missing print the files from stdin that are missing")) (display (G_ " -x, --extract=DIR extract the archive on stdin to DIR")) + (display (G_ " + -t, --list list the files in the archive on stdin")) (newline) (display (G_ " --generate-key[=PARAMETERS] @@ -137,6 +141,9 @@ Export/import one or more packages from/to the store.\n")) (option '("extract" #\x) #t #f (lambda (opt name arg result) (alist-cons 'extract arg result))) + (option '("list" #\t) #f #f + (lambda (opt name arg result) + (alist-cons 'list #t result))) (option '("generate-key") #f #t (lambda (opt name arg result) (catch 'gcry-error @@ -319,6 +326,40 @@ the input port." (with-atomic-file-output %acl-file (cut write-acl acl <>))))) +(define (list-contents port) + "Read a nar from PORT and print the list of files it contains to the current +output port." + (define (consume-input port size) + (let ((bv (make-bytevector 32768))) + (let loop ((total size)) + (unless (zero? total) + (let ((n (get-bytevector-n! port bv 0 + (min total (bytevector-length bv))))) + (loop (- total n))))))) + + (fold-archive (lambda (file type content result) + (match type + ('directory + (format #t "D ~a~%" file)) + ('symlink + (format #t "S ~a -> ~a~%" file content)) + ((or 'regular 'executable) + (match content + ((input . size) + (format #t "~a ~60a ~10h B~%" + (if (eq? type 'executable) + "x" "r") + file size) + (consume-input input size)))))) + #t + port + "")) + + +;;; +;;; Entry point. +;;; + (define (guix-archive . args) (define (lines port) ;; Return lines read from PORT. @@ -353,6 +394,8 @@ the input port." (missing (remove (cut valid-path? store <>) files))) (format #t "~{~a~%~}" missing))) + ((assoc-ref opts 'list) + (list-contents (current-input-port))) ((assoc-ref opts 'extract) => (lambda (target) diff --git a/tests/guix-archive.sh b/tests/guix-archive.sh index fdaeb98ad2..4c5eea05cf 100644 --- a/tests/guix-archive.sh +++ b/tests/guix-archive.sh @@ -1,5 +1,5 @@ # GNU Guix --- Functional package management for GNU -# Copyright © 2013, 2014, 2015 Ludovic Courtès +# Copyright © 2013, 2014, 2015, 2019 Ludovic Courtès # # This file is part of GNU Guix. # @@ -74,5 +74,10 @@ guix archive -x "$tmpdir" < "$archive" test -x "$tmpdir/bin/guile" test -d "$tmpdir/lib/guile" +# Check '--list'. +guix archive -t < "$archive" | grep "^D /share/guile" +guix archive -t < "$archive" | grep "^x /bin/guile" +guix archive -t < "$archive" | grep "^r /share/guile.*/boot-9\.scm" + if echo foo | guix archive --authorize then false; else true; fi From patchwork Sun Dec 8 11:26:33 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 16410 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 432D917869; Sun, 8 Dec 2019 11:27:10 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.0 (2014-02-07) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00 autolearn=unavailable autolearn_force=no version=3.4.0 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTP id 050D9177CB for ; Sun, 8 Dec 2019 11:27:10 +0000 (GMT) Received: from localhost ([::1]:57722 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1iduiT-0004cR-HY for patchwork@mira.cbaines.net; Sun, 08 Dec 2019 06:27:09 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]:34233) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1iduiN-0004cA-KR for guix-patches@gnu.org; Sun, 08 Dec 2019 06:27:04 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1iduiM-0004sW-Kr for guix-patches@gnu.org; Sun, 08 Dec 2019 06:27:03 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:44613) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1iduiM-0004rJ-GC for guix-patches@gnu.org; Sun, 08 Dec 2019 06:27:02 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1iduiM-0007t8-Cv for guix-patches@gnu.org; Sun, 08 Dec 2019 06:27:02 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#38518] [PATCH 3/7] challenge: Report the best narinfo URI. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sun, 08 Dec 2019 11:27:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 38518 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 38518@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 38518-submit@debbugs.gnu.org id=B38518.157580442030296 (code B ref 38518); Sun, 08 Dec 2019 11:27:02 +0000 Received: (at 38518) by debbugs.gnu.org; 8 Dec 2019 11:27:00 +0000 Received: from localhost ([127.0.0.1]:50583 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1iduiK-0007sU-Bf for submit@debbugs.gnu.org; Sun, 08 Dec 2019 06:27:00 -0500 Received: from eggs.gnu.org ([209.51.188.92]:52778) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1iduiI-0007rp-WF for 38518@debbugs.gnu.org; Sun, 08 Dec 2019 06:26:59 -0500 Received: from fencepost.gnu.org ([2001:470:142:3::e]:43963) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1iduiC-0004Au-RY; Sun, 08 Dec 2019 06:26:52 -0500 Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=55006 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:DHE_RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1iduiB-0003cW-Pc; Sun, 08 Dec 2019 06:26:52 -0500 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Sun, 8 Dec 2019 12:26:33 +0100 Message-Id: <20191208112637.5534-3-ludo@gnu.org> X-Mailer: git-send-email 2.24.0 In-Reply-To: <20191208112637.5534-1-ludo@gnu.org> References: <20191208112637.5534-1-ludo@gnu.org> MIME-Version: 1.0 X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 209.51.188.43 X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * guix/scripts/substitute.scm (select-uri): Rename to... (narinfo-best-uri): ... this, and make public. Update callers. * guix/scripts/challenge.scm (summarize-report): Use 'narinfo-best-uri' instead of (first (narinfo-uris ...)). --- guix/scripts/challenge.scm | 2 +- guix/scripts/substitute.scm | 7 ++++--- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/guix/scripts/challenge.scm b/guix/scripts/challenge.scm index 17e87f0291..aabb2ee549 100644 --- a/guix/scripts/challenge.scm +++ b/guix/scripts/challenge.scm @@ -192,7 +192,7 @@ inconclusive reports." (report (G_ " no local build for '~a'~%") item)) (for-each (lambda (narinfo) (report (G_ " ~50a: ~a~%") - (uri->string (first (narinfo-uris narinfo))) + (uri->string (narinfo-best-uri narinfo)) (hash->string (narinfo-hash->sha256 (narinfo-hash narinfo))))) narinfos)) diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm index b6034a75d2..4802fbd1fe 100755 --- a/guix/scripts/substitute.scm +++ b/guix/scripts/substitute.scm @@ -80,6 +80,7 @@ narinfo-signature narinfo-hash->sha256 + narinfo-best-uri lookup-narinfos lookup-narinfos/diverse @@ -913,7 +914,7 @@ expected by the daemon." (for-each (cute format #t "~a/~a~%" (%store-prefix) <>) (narinfo-references narinfo)) - (let-values (((uri compression file-size) (select-uri narinfo))) + (let-values (((uri compression file-size) (narinfo-best-uri narinfo))) (format #t "~a\n~a\n" (or file-size 0) (or (narinfo-size narinfo) 0)))) @@ -967,7 +968,7 @@ this is a rough approximation." (_ (or (string=? compression2 "none") (string=? compression2 "gzip"))))) -(define (select-uri narinfo) +(define (narinfo-best-uri narinfo) "Select the \"best\" URI to download NARINFO's nar, and return three values: the URI, its compression method (a string), and the compressed file size." (define choices @@ -1008,7 +1009,7 @@ DESTINATION as a nar file. Verify the substitute against ACL." store-item)) (let-values (((uri compression file-size) - (select-uri narinfo))) + (narinfo-best-uri narinfo))) ;; Tell the daemon what the expected hash of the Nar itself is. (format #t "~a~%" (narinfo-hash narinfo)) From patchwork Sun Dec 8 11:26:34 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 16413 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 4AF1517869; Sun, 8 Dec 2019 11:28:10 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.0 (2014-02-07) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00 autolearn=unavailable autolearn_force=no version=3.4.0 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTP id 15FD7177CB for ; Sun, 8 Dec 2019 11:28:10 +0000 (GMT) Received: from localhost ([::1]:57732 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1idujR-0004uT-JM for patchwork@mira.cbaines.net; Sun, 08 Dec 2019 06:28:09 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]:36896) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1idujK-0004u2-Uo for guix-patches@gnu.org; Sun, 08 Dec 2019 06:28:03 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1idujK-0000Vl-0A for guix-patches@gnu.org; Sun, 08 Dec 2019 06:28:02 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:44624) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1idujJ-0000Uw-Qn for guix-patches@gnu.org; Sun, 08 Dec 2019 06:28:01 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1idujJ-0007v9-OI for guix-patches@gnu.org; Sun, 08 Dec 2019 06:28:01 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#38518] [PATCH 4/7] serialization: Remove unused procedure. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sun, 08 Dec 2019 11:28:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 38518 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 38518@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 38518-submit@debbugs.gnu.org id=B38518.157580442430352 (code B ref 38518); Sun, 08 Dec 2019 11:28:01 +0000 Received: (at 38518) by debbugs.gnu.org; 8 Dec 2019 11:27:04 +0000 Received: from localhost ([127.0.0.1]:50589 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1iduiN-0007tS-ME for submit@debbugs.gnu.org; Sun, 08 Dec 2019 06:27:03 -0500 Received: from eggs.gnu.org ([209.51.188.92]:52894) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1iduiJ-0007rr-Q1 for 38518@debbugs.gnu.org; Sun, 08 Dec 2019 06:26:59 -0500 Received: from fencepost.gnu.org ([2001:470:142:3::e]:43965) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1iduiE-0004Jt-KK; Sun, 08 Dec 2019 06:26:54 -0500 Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=55006 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:DHE_RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1iduiD-0003cW-4K; Sun, 08 Dec 2019 06:26:53 -0500 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Sun, 8 Dec 2019 12:26:34 +0100 Message-Id: <20191208112637.5534-4-ludo@gnu.org> X-Mailer: git-send-email 2.24.0 In-Reply-To: <20191208112637.5534-1-ludo@gnu.org> References: <20191208112637.5534-1-ludo@gnu.org> MIME-Version: 1.0 X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 209.51.188.43 X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * guix/serialization.scm (write-contents): Remove. --- guix/serialization.scm | 18 ------------------ 1 file changed, 18 deletions(-) diff --git a/guix/serialization.scm b/guix/serialization.scm index cf263d321e..f793feb53d 100644 --- a/guix/serialization.scm +++ b/guix/serialization.scm @@ -199,24 +199,6 @@ substitute invalid byte sequences with question marks. This is a (put-bytevector out buf 0 read) (loop (- left read)))))))) -(define (write-contents file p size) - "Write SIZE bytes from FILE to output port P." - (define (call-with-binary-input-file file proc) - ;; Open FILE as a binary file. This avoids scan-for-encoding, and thus - ;; avoids any initial buffering. Disable file name canonicalization to - ;; avoid stat'ing like crazy. - (with-fluids ((%file-port-name-canonicalization #f)) - (let ((port (open-file file "rb"))) - (dynamic-wind - (const #t) - (cut proc port) - (lambda () - (close-port port)))))) - - (call-with-binary-input-file file - (lambda (input) - (write-contents-from-port input p size)))) - (define (write-contents-from-port input output size) "Write SIZE bytes from port INPUT to port OUTPUT." (write-string "contents" output) From patchwork Sun Dec 8 11:26:35 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 16414 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 802CE17869; Sun, 8 Dec 2019 11:28:11 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.0 (2014-02-07) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00 autolearn=unavailable autolearn_force=no version=3.4.0 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTP id 40E80177CB for ; Sun, 8 Dec 2019 11:28:11 +0000 (GMT) Received: from localhost ([::1]:57734 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1idujS-0004vc-O9 for patchwork@mira.cbaines.net; Sun, 08 Dec 2019 06:28:10 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]:36932) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1idujL-0004u3-Oo for guix-patches@gnu.org; Sun, 08 Dec 2019 06:28:04 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1idujK-0000Xv-BL for guix-patches@gnu.org; Sun, 08 Dec 2019 06:28:03 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:44625) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1idujK-0000Wo-7b for guix-patches@gnu.org; Sun, 08 Dec 2019 06:28:02 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1idujK-0007vG-4V for guix-patches@gnu.org; Sun, 08 Dec 2019 06:28:02 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#38518] [PATCH 5/7] progress: Add 'progress-report-port'. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sun, 08 Dec 2019 11:28:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 38518 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 38518@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 38518-submit@debbugs.gnu.org id=B38518.157580442430358 (code B ref 38518); Sun, 08 Dec 2019 11:28:02 +0000 Received: (at 38518) by debbugs.gnu.org; 8 Dec 2019 11:27:04 +0000 Received: from localhost ([127.0.0.1]:50591 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1iduiN-0007tV-Sh for submit@debbugs.gnu.org; Sun, 08 Dec 2019 06:27:04 -0500 Received: from eggs.gnu.org ([209.51.188.92]:52968) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1iduiL-0007rz-4H for 38518@debbugs.gnu.org; Sun, 08 Dec 2019 06:27:01 -0500 Received: from fencepost.gnu.org ([2001:470:142:3::e]:43966) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1iduiF-0004QF-Uq; Sun, 08 Dec 2019 06:26:55 -0500 Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=55006 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:DHE_RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1iduiE-0003cW-Vl; Sun, 08 Dec 2019 06:26:55 -0500 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Sun, 8 Dec 2019 12:26:35 +0100 Message-Id: <20191208112637.5534-5-ludo@gnu.org> X-Mailer: git-send-email 2.24.0 In-Reply-To: <20191208112637.5534-1-ludo@gnu.org> References: <20191208112637.5534-1-ludo@gnu.org> MIME-Version: 1.0 X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 209.51.188.43 X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * guix/scripts/substitute.scm (progress-report-port): Move to... * guix/progress.scm (progress-report-port): ... here. New procedure. --- guix/progress.scm | 31 +++++++++++++++++++++++++++++++ guix/scripts/substitute.scm | 29 ----------------------------- 2 files changed, 31 insertions(+), 29 deletions(-) diff --git a/guix/progress.scm b/guix/progress.scm index 349637dbcf..c7567a35fd 100644 --- a/guix/progress.scm +++ b/guix/progress.scm @@ -40,6 +40,7 @@ progress-reporter/file progress-reporter/bar progress-reporter/trace + progress-report-port display-download-progress erase-current-line @@ -342,3 +343,33 @@ should be a object." (put-bytevector out buffer 0 bytes) (report total) (loop total (get-bytevector-n! in buffer 0 buffer-size)))))))) + +(define (progress-report-port reporter port) + "Return a port that continuously reports the bytes read from PORT using +REPORTER, which should be a object." + (match reporter + (($ start report stop) + (let* ((total 0) + (read! (lambda (bv start count) + (let ((n (match (get-bytevector-n! port bv start count) + ((? eof-object?) 0) + (x x)))) + (set! total (+ total n)) + (report total) + n)))) + (start) + (make-custom-binary-input-port "progress-port-proc" + read! #f #f + (lambda () + ;; XXX: Kludge! When used through + ;; 'decompressed-port', this port ends + ;; up being closed twice: once in a + ;; child process early on, and at the + ;; end in the parent process. Ignore + ;; the early close so we don't output + ;; a spurious "download-succeeded" + ;; trace. + (unless (zero? total) + (stop)) + (close-port port))))))) + diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm index 4802fbd1fe..7eca2c6874 100755 --- a/guix/scripts/substitute.scm +++ b/guix/scripts/substitute.scm @@ -823,35 +823,6 @@ was found." (= (string-length file) 32))))) (narinfo-cache-directories directory))) -(define (progress-report-port reporter port) - "Return a port that continuously reports the bytes read from PORT using -REPORTER, which should be a object." - (match reporter - (($ start report stop) - (let* ((total 0) - (read! (lambda (bv start count) - (let ((n (match (get-bytevector-n! port bv start count) - ((? eof-object?) 0) - (x x)))) - (set! total (+ total n)) - (report total) - n)))) - (start) - (make-custom-binary-input-port "progress-port-proc" - read! #f #f - (lambda () - ;; XXX: Kludge! When used through - ;; 'decompressed-port', this port ends - ;; up being closed twice: once in a - ;; child process early on, and at the - ;; end in the parent process. Ignore - ;; the early close so we don't output - ;; a spurious "download-succeeded" - ;; trace. - (unless (zero? total) - (stop)) - (close-port port))))))) - (define-syntax with-networking (syntax-rules () "Catch DNS lookup errors and TLS errors and gracefully exit." From patchwork Sun Dec 8 11:26:36 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 16415 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id CA6DC17869; Sun, 8 Dec 2019 11:28:22 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.0 (2014-02-07) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00,URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.0 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTP id 29370177CB for ; Sun, 8 Dec 2019 11:28:22 +0000 (GMT) Received: from localhost ([::1]:57736 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1idujc-000532-CG for patchwork@mira.cbaines.net; Sun, 08 Dec 2019 06:28:20 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]:37018) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1idujN-0004uS-K7 for guix-patches@gnu.org; Sun, 08 Dec 2019 06:28:08 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1idujL-0000d8-6C for guix-patches@gnu.org; Sun, 08 Dec 2019 06:28:05 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:44627) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1idujL-0000cE-19 for guix-patches@gnu.org; Sun, 08 Dec 2019 06:28:03 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1idujK-0007vV-U3 for guix-patches@gnu.org; Sun, 08 Dec 2019 06:28:02 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#38518] [PATCH 6/7] challenge: Add "--diff". Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sun, 08 Dec 2019 11:28:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 38518 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 38518@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 38518-submit@debbugs.gnu.org id=B38518.157580442730385 (code B ref 38518); Sun, 08 Dec 2019 11:28:02 +0000 Received: (at 38518) by debbugs.gnu.org; 8 Dec 2019 11:27:07 +0000 Received: from localhost ([127.0.0.1]:50597 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1iduiQ-0007u0-Rl for submit@debbugs.gnu.org; Sun, 08 Dec 2019 06:27:07 -0500 Received: from eggs.gnu.org ([209.51.188.92]:53136) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1iduiO-0007sM-Q7 for 38518@debbugs.gnu.org; Sun, 08 Dec 2019 06:27:05 -0500 Received: from fencepost.gnu.org ([2001:470:142:3::e]:43968) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1iduiJ-0004b5-Gz; Sun, 08 Dec 2019 06:26:59 -0500 Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=55006 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:DHE_RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1iduiG-0003cW-AN; Sun, 08 Dec 2019 06:26:56 -0500 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Sun, 8 Dec 2019 12:26:36 +0100 Message-Id: <20191208112637.5534-6-ludo@gnu.org> X-Mailer: git-send-email 2.24.0 In-Reply-To: <20191208112637.5534-1-ludo@gnu.org> References: <20191208112637.5534-1-ludo@gnu.org> MIME-Version: 1.0 X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 209.51.188.43 X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * 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". --- doc/guix.texi | 24 ++++++ guix/scripts/challenge.scm | 156 +++++++++++++++++++++++++++++++++++-- guix/tests/http.scm | 6 +- tests/challenge.scm | 67 +++++++++++++++- 4 files changed, 242 insertions(+), 11 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index 7b9aa7f7c3..9587cfad9d 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -10297,14 +10297,23 @@ updating list of substitutes from 'https://guix.example.org'... 100.0% local hash: 0725l22r5jnzazaacncwsvp9kgf42266ayyp814v7djxs7nk963q https://@value{SUBSTITUTE-SERVER}/nar/@dots{}-openssl-1.0.2d: 0725l22r5jnzazaacncwsvp9kgf42266ayyp814v7djxs7nk963q https://guix.example.org/nar/@dots{}-openssl-1.0.2d: 1zy4fmaaqcnjrzzajkdn3f5gmjk754b43qkq47llbyak9z0qjyim + differing files: + /lib/libcrypto.so.1.1 + /lib/libssl.so.1.1 + /gnu/store/@dots{}-git-2.5.0 contents differ: local hash: 00p3bmryhjxrhpn2gxs2fy0a15lnip05l97205pgbk5ra395hyha https://@value{SUBSTITUTE-SERVER}/nar/@dots{}-git-2.5.0: 069nb85bv4d4a6slrwjdy8v1cn4cwspm3kdbmyb81d6zckj3nq9f https://guix.example.org/nar/@dots{}-git-2.5.0: 0mdqa9w1p6cmli6976v4wi0sw9r4p5prkj7lzfd1877wk11c9c73 + differing file: + /libexec/git-core/git-fsck + /gnu/store/@dots{}-pius-2.1.1 contents differ: local hash: 0k4v3m9z1zp8xzzizb7d8kjj72f9172xv078sq4wl73vnq9ig3ax https://@value{SUBSTITUTE-SERVER}/nar/@dots{}-pius-2.1.1: 0k4v3m9z1zp8xzzizb7d8kjj72f9172xv078sq4wl73vnq9ig3ax https://guix.example.org/nar/@dots{}-pius-2.1.1: 1cy25x1a4fzq5rk0pmvc8xhwyffnqz95h2bpvqsz2mpvlbccy0gs + differing file: + /share/man/man1/pius.1.gz @dots{} @@ -10390,6 +10399,21 @@ The one option that matters is: Consider @var{urls} the whitespace-separated list of substitute source URLs to compare to. +@item --diff=@var{mode} +Upon mismatches, show differences according to @var{mode}, one of: + +@table @asis +@item @code{simple} (the default) +Show the list of files that differ. + +@item @code{none} +Do not show further details about the differences. +@end table + +Thus, unless @code{--diff=none} is passed, @command{guix challenge} +downloads the store items from the given substitute servers so that it +can compare them. + @item --verbose @itemx -v Show details about matches (identical contents) in addition to diff --git a/guix/scripts/challenge.scm b/guix/scripts/challenge.scm index aabb2ee549..277eec9a5d 100644 --- a/guix/scripts/challenge.scm +++ b/guix/scripts/challenge.scm @@ -25,17 +25,23 @@ #:use-module (guix monads) #:use-module (guix base32) #:use-module (guix packages) + #:use-module (guix progress) #:use-module (guix serialization) #:use-module (guix scripts substitute) #:use-module (rnrs bytevectors) + #:autoload (guix http-client) (http-fetch) + #:use-module ((guix build syscalls) #:select (terminal-columns)) + #:use-module (gcrypt hash) #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) + #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) #:use-module (srfi srfi-37) #:use-module (ice-9 match) #:use-module (ice-9 vlist) #:use-module (ice-9 format) + #:use-module (ice-9 ftw) #:use-module (web uri) #:export (compare-contents @@ -49,6 +55,8 @@ comparison-report-mismatch? comparison-report-inconclusive? + differing-files + guix-challenge)) ;;; Commentary: @@ -179,13 +187,128 @@ taken since we do not import the archives." items local)))) + +;;; +;;; Reporting. +;;; + +(define dump-port* ;FIXME: deduplicate + (@@ (guix serialization) dump)) + +(define (port-sha256* port size) + ;; Like 'port-sha256', but limited to SIZE bytes. + (let-values (((out get) (open-sha256-port))) + (dump-port* port out size) + (close-port out) + (get))) + +(define (archive-contents port) + "Return a list representing the files contained in the nar read from PORT." + (fold-archive (lambda (file type contents result) + (match type + ((or 'regular 'executable) + (match contents + ((port . size) + (cons `(,file ,type ,(port-sha256* port size)) + result)))) + ('directory result) + ('symlink + (cons `(,file ,type ,contents) result)))) + '() + port + "")) + +(define (store-item-contents item) + "Return a list of files and contents for ITEM in the same format as +'archive-contents'." + (file-system-fold (const #t) ;enter? + (lambda (file stat result) ;leaf + (define short + (string-drop file (string-length item))) + + (match (stat:type stat) + ('regular + (let ((size (stat:size stat)) + (type (if (zero? (logand (stat:mode stat) + #o100)) + 'regular + 'executable))) + (cons `(,short ,type + ,(call-with-input-file file + (cut port-sha256* <> size))) + result))) + ('symlink + (cons `(,short symlink ,(readlink file)) + result)))) + (lambda (directory stat result) result) ;down + (lambda (directory stat result) result) ;up + (lambda (file stat result) result) ;skip + (lambda (file stat errno result) result) ;error + '() + item + lstat)) + +(define (narinfo-contents narinfo) + "Fetch the nar described by NARINFO and return a list representing the file +it contains." + (let*-values (((uri compression size) + (narinfo-best-uri narinfo)) + ((port response) + (http-fetch uri))) + (define reporter + (progress-reporter/file (narinfo-path narinfo) size + #:abbreviation (const (uri-host uri)))) + + (define result + (call-with-decompressed-port (string->symbol compression) + (progress-report-port reporter port) + archive-contents)) + + (close-port port) + (erase-current-line (current-output-port)) + result)) + +(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." + (define contents + (map narinfo-contents + (comparison-report-narinfos comparison-report))) + + (define local-contents + (and (comparison-report-local-sha256 comparison-report) + (store-item-contents (comparison-report-item comparison-report)))) + + (match (apply lset-difference equal? + (take (delete-duplicates + (if local-contents + (cons local-contents contents) + contents)) + 2)) + (((files _ ...) ...) + files))) + +(define (report-differing-files comparison-report) + "Report differences among the nars and possibly the local store item +specified in COMPARISON-REPORT." + (match (differing-files comparison-report) + (() + #t) + ((files ...) + (format #t (N_ " differing file:~%" + " differing files:~%" + (length files))) + (format #t "~{ ~a~%~}" files)))) + (define* (summarize-report comparison-report #:key + (report-differences (const #f)) (hash->string bytevector->nix-base32-string) verbose?) - "Write to the current error port a summary of REPORT, a -object. When VERBOSE?, display matches in addition to mismatches and -inconclusive reports." + "Write to the current error port a summary of COMPARISON-REPORT, a + object. When VERBOSE?, display matches in addition to +mismatches and inconclusive reports. Upon mismatch, call REPORT-DIFFERENCES +with COMPARISON-REPORT." (define (report-hashes item local narinfos) (if local (report (G_ " local hash: ~a~%") (hash->string local)) @@ -200,7 +323,8 @@ inconclusive reports." (match comparison-report (($ item 'mismatch local (narinfos ...)) (report (G_ "~a contents differ:~%") item) - (report-hashes item local narinfos)) + (report-hashes item local narinfos) + (report-differences comparison-report)) (($ item 'inconclusive #f narinfos) (warning (G_ "could not challenge '~a': no local build~%") item)) (($ item 'inconclusive locals ()) @@ -237,6 +361,8 @@ Challenge the substitutes for PACKAGE... provided by one or more servers.\n")) compare build results with those at URLS")) (display (G_ " -v, --verbose show details about successful comparisons")) + (display (G_ " + --diff=MODE show differences according to MODE")) (newline) (display (G_ " -h, --help display this help and exit")) @@ -254,6 +380,18 @@ Challenge the substitutes for PACKAGE... provided by one or more servers.\n")) (lambda args (show-version-and-exit "guix challenge"))) + (option '("diff") #t #f + (lambda (opt name arg result . rest) + (define mode + (match arg + ("none" (const #t)) + ("simple" report-differing-files) + (_ (leave (G_ "~a: unknown diff mode~%") arg)))) + + (apply values + (alist-cons 'difference-report mode result) + rest))) + (option '("substitute-urls") #t #f (lambda (opt name arg result . rest) (apply values @@ -269,7 +407,8 @@ Challenge the substitutes for PACKAGE... provided by one or more servers.\n")) (define %default-options `((system . ,(%current-system)) - (substitute-urls . ,%default-substitute-urls))) + (substitute-urls . ,%default-substitute-urls) + (difference-report . ,report-differing-files))) ;;; @@ -286,12 +425,14 @@ Challenge the substitutes for PACKAGE... provided by one or more servers.\n")) opts)) (system (assoc-ref opts 'system)) (urls (assoc-ref opts 'substitute-urls)) + (diff (assoc-ref opts 'difference-report)) (verbose? (assoc-ref opts 'verbose?))) (leave-on-EPIPE (with-store store ;; Disable grafts since substitute servers normally provide only ;; ungrafted stuff. - (parameterize ((%graft? #f)) + (parameterize ((%graft? #f) + (current-terminal-columns (terminal-columns))) (let ((files (match files (() (filter (cut locally-built? store <>) @@ -305,7 +446,8 @@ Challenge the substitutes for PACKAGE... provided by one or more servers.\n")) (mlet* %store-monad ((items (mapm %store-monad ensure-store-item files)) (reports (compare-contents items urls))) - (for-each (cut summarize-report <> #:verbose? verbose?) + (for-each (cut summarize-report <> #:verbose? verbose? + #:report-differences diff) reports) (report "\n") (summarize-report-list reports) diff --git a/guix/tests/http.scm b/guix/tests/http.scm index 05ce39bca2..4119e9ce01 100644 --- a/guix/tests/http.scm +++ b/guix/tests/http.scm @@ -65,14 +65,14 @@ needed." (close-port socket) #t))) -(define (%local-url) +(define* (%local-url #:optional (port (%http-server-port))) ;; URL to use for 'home-page' tests. - (string-append "http://localhost:" (number->string (%http-server-port)) + (string-append "http://localhost:" (number->string port) "/foo/bar")) (define* (call-with-http-server responses+data thunk) "Call THUNK with an HTTP server running and returning RESPONSES+DATA on HTTP -requests. Each elements of RESPONSES+DATA must be a tuple containing a +requests. Each element of RESPONSES+DATA must be a tuple containing a response and a string, or an HTTP response code and a string." (define responses (map (match-lambda diff --git a/tests/challenge.scm b/tests/challenge.scm index c962800f3f..a2782abcbd 100644 --- a/tests/challenge.scm +++ b/tests/challenge.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2015, 2017 Ludovic Courtès +;;; Copyright © 2015, 2017, 2019 Ludovic Courtès ;;; ;;; 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) From patchwork Sun Dec 8 11:26:37 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 16416 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id D1B3717869; Sun, 8 Dec 2019 11:28:33 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.0 (2014-02-07) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00,URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.0 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTP id 545C3177CB for ; Sun, 8 Dec 2019 11:28:33 +0000 (GMT) Received: from localhost ([::1]:57742 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1idujo-00055E-TA for patchwork@mira.cbaines.net; Sun, 08 Dec 2019 06:28:32 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]:36995) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1idujM-0004u9-R2 for guix-patches@gnu.org; Sun, 08 Dec 2019 06:28:06 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1idujK-0000ao-Pm for guix-patches@gnu.org; Sun, 08 Dec 2019 06:28:04 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:44626) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1idujK-0000ZY-L6 for guix-patches@gnu.org; Sun, 08 Dec 2019 06:28:02 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1idujK-0007vN-Hm for guix-patches@gnu.org; Sun, 08 Dec 2019 06:28:02 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#38518] [PATCH 7/7] challenge: Support "--diff=diffoscope". Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sun, 08 Dec 2019 11:28:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 38518 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 38518@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 38518-submit@debbugs.gnu.org id=B38518.157580442530376 (code B ref 38518); Sun, 08 Dec 2019 11:28:02 +0000 Received: (at 38518) by debbugs.gnu.org; 8 Dec 2019 11:27:05 +0000 Received: from localhost ([127.0.0.1]:50595 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1iduiP-0007tn-Br for submit@debbugs.gnu.org; Sun, 08 Dec 2019 06:27:05 -0500 Received: from eggs.gnu.org ([209.51.188.92]:53048) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1iduiO-0007s9-36 for 38518@debbugs.gnu.org; Sun, 08 Dec 2019 06:27:04 -0500 Received: from fencepost.gnu.org ([2001:470:142:3::e]:43967) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1iduiI-0004Wa-T2; Sun, 08 Dec 2019 06:26:58 -0500 Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=55006 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:DHE_RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1iduiH-0003cW-Qr; Sun, 08 Dec 2019 06:26:58 -0500 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Sun, 8 Dec 2019 12:26:37 +0100 Message-Id: <20191208112637.5534-7-ludo@gnu.org> X-Mailer: git-send-email 2.24.0 In-Reply-To: <20191208112637.5534-1-ludo@gnu.org> References: <20191208112637.5534-1-ludo@gnu.org> MIME-Version: 1.0 X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 209.51.188.43 X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * 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 9587cfad9d..b576a9fc1b 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -10342,8 +10342,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 \ @@ -10406,6 +10418,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 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)