From debbugs-submit-bounces@debbugs.gnu.org Fri Dec 15 04:30:51 2017 Received: (at 28659) by debbugs.gnu.org; 15 Dec 2017 09:30:52 +0000 Received: from localhost ([127.0.0.1]:34613 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ePmKL-000313-M9 for submit@debbugs.gnu.org; Fri, 15 Dec 2017 04:30:51 -0500 Received: from hera.aquilenet.fr ([141.255.128.1]:54253) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ePmKJ-00030t-26 for 28659@debbugs.gnu.org; Fri, 15 Dec 2017 04:30:44 -0500 Received: from localhost (localhost [127.0.0.1]) by hera.aquilenet.fr (Postfix) with ESMTP id 794431024C; Fri, 15 Dec 2017 10:30:45 +0100 (CET) X-Virus-Scanned: Debian amavisd-new at aquilenet.fr Received: from hera.aquilenet.fr ([127.0.0.1]) by localhost (hera.aquilenet.fr [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id 6vEuX9Wi0SxA; Fri, 15 Dec 2017 10:30:43 +0100 (CET) Received: from ribbon (unknown [193.50.110.249]) by hera.aquilenet.fr (Postfix) with ESMTPSA id 8A940DA55; Fri, 15 Dec 2017 10:30:43 +0100 (CET) From: ludo@gnu.org (Ludovic =?utf-8?Q?Court=C3=A8s?=) To: Leo Famulari Subject: Always enable substitutes for fixed-output derivations References: <877ewf18d4.fsf@gnu.org> <87o9ppoabw.fsf@gnu.org> <20171002182208.GB10773@jasmine.lan> <878tgt721q.fsf@gnu.org> <20171020211700.GA32355@jasmine.lan> <87d1421qek.fsf@gnu.org> <874lot9rou.fsf@gnu.org> Date: Fri, 15 Dec 2017 10:30:39 +0100 In-Reply-To: <874lot9rou.fsf@gnu.org> ("Ludovic \=\?utf-8\?Q\?Court\=C3\=A8s\=22'\?\= \=\?utf-8\?Q\?s\?\= message of "Thu, 14 Dec 2017 17:53:37 +0100") Message-ID: <87a7ykmj7k.fsf_-_@gnu.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/25.3 (gnu/linux) MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Spam-Score: 1.0 (+) X-Debbugs-Envelope-To: 28659 Cc: 28659@debbugs.gnu.org, Jan Nieuwenhuizen X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: 1.0 (+) --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable ludo@gnu.org (Ludovic Court=C3=A8s) skribis: > So I think we have to communicate more info from the daemon to =E2=80=98g= uix > substitute=E2=80=99. The attached patch addresses that by simply calling out to the daemon to determine whether we=E2=80=99re dealing with a content-addressed item. To summarize, the new behavior is that substitutes are always enabled for fixed-output derivations. That way, people willing to build everything from source can still use =E2=80=98--no-substitutes=E2=80=99 and= yet be able to retrieve source code without being penalized compared to someone enabling substitutes wholesale. Of course, when substitutes are missing, we fall back to regular downloads or VCS checkouts. It is also still possible to choose where substitutes are downloaded from, using =E2=80=98--substitute-urls=E2=80=99,= or even to pass an empty list of URLs. Feedback welcome! Ludo=E2=80=99. --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-substitute-Always-allow-substitutes-for-fixed-output.patch From aab42bcb212698bc1f61beb9f321ffbd751f36f5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Fri, 15 Dec 2017 09:57:04 +0100 Subject: [PATCH 1/2] substitute: Always allow substitutes for fixed-output derivation results. Fixes . * guix/scripts/substitute.scm (content-addressed-item?): New procedure. (valid-narinfo?): Use it. * nix/libstore/build.cc (DerivationGoal::haveDerivation): Always make a substitution goal when 'fixedOutput' is true. * tests/substitute.scm ("query unsigned narinfo for content-addressed item"): New test. --- guix/scripts/substitute.scm | 31 ++++++++++++++++++++++++++++++- nix/libstore/build.cc | 6 ++++-- tests/substitute.scm | 24 +++++++++++++++++++++++- 3 files changed, 57 insertions(+), 4 deletions(-) diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm index 2fd2bf810..670a9b4dd 100755 --- a/guix/scripts/substitute.scm +++ b/guix/scripts/substitute.scm @@ -25,6 +25,9 @@ #:use-module (guix config) #:use-module (guix records) #:use-module ((guix serialization) #:select (restore-file)) + #:use-module ((guix derivations) + #:select (read-derivation-from-file + fixed-output-derivation?)) #:use-module (guix hash) #:use-module (guix base32) #:use-module (guix base64) @@ -406,10 +409,36 @@ No authentication and authorization checks are performed here!" (let ((above-signature (string-take contents index))) (sha256 (string->utf8 above-signature))))))) +(define* (content-addressed-item? item) + "Return true if ITEM is content-addressed---i.e., if ITEM is the result of a +fixed-output derivation." + (guard (c ((nix-connection-error? c) + ;; We failed to connect, maybe because we have the wrong + ;; GUIX_DAEMON_SOCKET? Let's conservatively assume that + ;; nothing's content-addressed. + #f)) + (with-store store + (match (valid-derivers store item) + (() + ;; If there are no valid derivers it's most likely because ITEM is a + ;; source (added with 'add-to-store' or similar). Nevertheless, + ;; since we can't be certain, return #f. + #f) + ((drv . _) + (fixed-output-derivation? + (read-derivation-from-file drv))))))) + (define* (valid-narinfo? narinfo #:optional (acl (current-acl)) #:key verbose?) - "Return #t if NARINFO's signature is not valid." + "Return #t if NARINFO is \"valid\"---signed by an authorized key, or +designating a content-addressed item." (or %allow-unauthenticated-substitutes? + + ;; If NARINFO designates a content-addressed item, there's no point + ;; authenticating it. Don't explicitly check 'narinfo-hash' for + ;; integrity: this will be done by the daemon once we've downloaded it. + (content-addressed-item? (narinfo-path narinfo)) + (let ((hash (narinfo-sha256 narinfo)) (signature (narinfo-signature narinfo)) (uri (uri->string (narinfo-uri narinfo)))) diff --git a/nix/libstore/build.cc b/nix/libstore/build.cc index d68e8b2bc..03a8f5080 100644 --- a/nix/libstore/build.cc +++ b/nix/libstore/build.cc @@ -1034,8 +1034,10 @@ void DerivationGoal::haveDerivation() /* We are first going to try to create the invalid output paths through substitutes. If that doesn't work, we'll build - them. */ - if (settings.useSubstitutes && substitutesAllowed(drv)) + them. Always enable substitutes for fixed-output derivations to + protect against disappearing files and in-place modifications on + upstream sites. */ + if ((fixedOutput || settings.useSubstitutes) && substitutesAllowed(drv)) foreach (PathSet::iterator, i, invalidOutputs) addWaitee(worker.makeSubstitutionGoal(*i, buildMode == bmRepair)); diff --git a/tests/substitute.scm b/tests/substitute.scm index 0ad624795..03579b9f1 100644 --- a/tests/substitute.scm +++ b/tests/substitute.scm @@ -21,15 +21,17 @@ #:use-module (guix scripts substitute) #:use-module (guix base64) #:use-module (guix hash) + #:use-module (guix derivations) #:use-module (guix serialization) #:use-module (guix pk-crypto) #:use-module (guix pki) #:use-module (guix config) #:use-module (guix base32) - #:use-module ((guix store) #:select (%store-prefix)) + #:use-module ((guix store) #:select (%store-prefix with-store)) #:use-module ((guix ui) #:select (guix-warning-port)) #:use-module ((guix build utils) #:select (mkdir-p delete-file-recursively)) + #:use-module (guix tests) #:use-module (guix tests http) #:use-module (rnrs bytevectors) #:use-module (rnrs io ports) @@ -241,6 +243,26 @@ a file for NARINFO." (lambda () (guix-substitute "--query")))))))) +(test-assert "query unsigned narinfo for content-addressed item" + (with-store store + (let* ((hash (sha256 (random-bytevector 128))) + (drv (derivation store "content-addressed" + "builtin:download" '() + #:hash-algo 'sha256 #:hash hash))) + (define output + (with-output-to-string + (lambda () + (with-derivation-narinfo drv (sha256 => hash) + (with-input-from-string (string-append "have " + (derivation->output-path drv)) + (lambda () + (set! (@@ (guix scripts substitute) + %allow-unauthenticated-substitutes?) + #f) + (guix-substitute "--query"))))))) + + (string=? (string-trim-both output) (derivation->output-path drv))))) + (test-quit "substitute, no signature" "no valid substitute" (with-narinfo %narinfo -- 2.15.1 --=-=-= Content-Type: text/x-patch; charset=utf-8 Content-Disposition: attachment; filename=0002-Revert-download-Download-a-nar-when-a-VCS-checkout-f.patch Content-Transfer-Encoding: quoted-printable From 9bcf90b99a79f9f3e126cde5fe1cf51b0dfa58aa Mon Sep 17 00:00:00 2001 From: =3D?UTF-8?q?Ludovic=3D20Court=3DC3=3DA8s?=3D Date: Fri, 15 Dec 2017 10:03:39 +0100 Subject: [PATCH 2/2] Revert "download: Download a nar when a VCS checkout fails." This reverts commit 37ce440dcffa9ff4f5401bacbc9619bd8ea561c1, which is useless now that substitutes are always enabled for content-addressed items. --- Makefile.am | 1 - guix/build/download-nar.scm | 125 ----------------------------------------= ---- guix/cvs-download.scm | 38 ++++---------- guix/git-download.scm | 37 +++---------- guix/hg-download.scm | 36 ++++--------- 5 files changed, 26 insertions(+), 211 deletions(-) delete mode 100644 guix/build/download-nar.scm diff --git a/Makefile.am b/Makefile.am index 85b9ab36d..d2660b0a7 100644 --- a/Makefile.am +++ b/Makefile.am @@ -110,7 +110,6 @@ MODULES =3D \ guix/ui.scm \ guix/build/ant-build-system.scm \ guix/build/download.scm \ - guix/build/download-nar.scm \ guix/build/cargo-build-system.scm \ guix/build/cmake-build-system.scm \ guix/build/dub-build-system.scm \ diff --git a/guix/build/download-nar.scm b/guix/build/download-nar.scm deleted file mode 100644 index 13f01fb1e..000000000 --- a/guix/build/download-nar.scm +++ /dev/null @@ -1,125 +0,0 @@ -;;; GNU Guix --- Functional package management for GNU -;;; Copyright =C2=A9 2017 Ludovic Court=C3=A8s -;;; -;;; This file is part of GNU Guix. -;;; -;;; GNU Guix is free software; you can redistribute it and/or modify it -;;; under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 3 of the License, or (at -;;; your option) any later version. -;;; -;;; GNU Guix is distributed in the hope that it will be useful, but -;;; WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with GNU Guix. If not, see . - -(define-module (guix build download-nar) - #:use-module (guix build download) - #:use-module (guix build utils) - #:use-module (guix serialization) - #:use-module (guix zlib) - #:use-module (guix progress) - #:use-module (web uri) - #:use-module (srfi srfi-11) - #:use-module (srfi srfi-26) - #:use-module (ice-9 format) - #:use-module (ice-9 match) - #:export (download-nar)) - -;;; Commentary: -;;; -;;; Download a normalized archive or "nar", similar to what 'guix substitu= te' -;;; does. The intent here is to use substitute servers as content-address= ed -;;; mirrors of VCS checkouts. This is mostly useful for users who have -;;; disabled substitutes. -;;; -;;; Code: - -(define (urls-for-item item) - "Return the fallback nar URL for ITEM--e.g., -\"/gnu/store/cabbag3=E2=80=A6-foo-1.2-checkout\"." - ;; Here we hard-code nar URLs without checking narinfos. That's probabl= y OK - ;; though. - ;; TODO: Use HTTPS? The downside is the extra dependency. - (let ((bases '("http://mirror.hydra.gnu.org/guix" - "http://berlin.guixsd.org")) - (item (basename item))) - (append (map (cut string-append <> "/nar/gzip/" item) bases) - (map (cut string-append <> "/nar/" item) bases)))) - -(define (restore-gzipped-nar port item size) - "Restore the gzipped nar read from PORT, of SIZE bytes (compressed), to -ITEM." - ;; Since PORT is typically a non-file port (for instance because 'http-g= et' - ;; returns a delimited port), create a child process so we're back to a = file - ;; port that can be passed to 'call-with-gzip-input-port'. - (match (pipe) - ((input . output) - (match (primitive-fork) - (0 - (dynamic-wind - (const #t) - (lambda () - (close-port output) - (close-port port) - (catch #t - (lambda () - (call-with-gzip-input-port input - (cut restore-file <> item))) - (lambda (key . args) - (print-exception (current-error-port) - (stack-ref (make-stack #t) 1) - key args) - (primitive-exit 1)))) - (lambda () - (primitive-exit 0)))) - (child - (close-port input) - (dump-port* port output - #:reporter (progress-reporter/file item size - #:abbreviation - store-path-abbrevia= tion)) - (close-port output) - (newline) - (match (waitpid child) - ((_ . status) - (unless (zero? status) - (error "nar decompression failed" status))))))))) - -(define (download-nar item) - "Download and extract the normalized archive for ITEM. Return #t on -success, #f otherwise." - ;; Let progress reports go through. - (setvbuf (current-error-port) _IONBF) - (setvbuf (current-output-port) _IONBF) - - (let loop ((urls (urls-for-item item))) - (match urls - ((url rest ...) - (format #t "Trying content-addressed mirror at ~a...~%" - (uri-host (string->uri url))) - (let-values (((port size) - (catch #t - (lambda () - (http-fetch (string->uri url))) - (lambda args - (values #f #f))))) - (if (not port) - (loop rest) - (begin - (if size - (format #t "Downloading from ~a (~,2h MiB)...~%" url - (/ size (expt 2 20.))) - (format #t "Downloading from ~a...~%" url)) - (if (string-contains url "/gzip") - (restore-gzipped-nar port item size) - (begin - ;; FIXME: Add progress report. - (restore-file port item) - (close-port port))) - #t)))) - (() - #f)))) diff --git a/guix/cvs-download.scm b/guix/cvs-download.scm index 8b46f8ef8..85744c5b5 100644 --- a/guix/cvs-download.scm +++ b/guix/cvs-download.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright =C2=A9 2014, 2015, 2016, 2017 Ludovic Court=C3=A8s +;;; Copyright =C2=A9 2014, 2015, 2016 Ludovic Court=C3=A8s ;;; Copyright =C2=A9 2014 Sree Harsha Totakura ;;; Copyright =C2=A9 2015 Mark H Weaver ;;; @@ -23,7 +23,6 @@ #:use-module (guix gexp) #:use-module (guix store) #:use-module (guix monads) - #:use-module (guix modules) #:use-module (guix packages) #:use-module (ice-9 match) #:export (cvs-reference @@ -60,35 +59,16 @@ "Return a fixed-output derivation that fetches REF, a object. The output is expected to have recursive hash HASH of type HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if #f." - (define zlib - (module-ref (resolve-interface '(gnu packages compression)) 'zlib)) - - (define config.scm - (scheme-file "config.scm" - #~(begin - (define-module (guix config) - #:export (%libz)) - - (define %libz - #+(file-append zlib "/lib/libz"))))) - - (define modules - (cons `((guix config) =3D> ,config.scm) - (delete '(guix config) - (source-module-closure '((guix build cvs) - (guix build download-nar)))))) (define build - (with-imported-modules modules + (with-imported-modules '((guix build cvs) + (guix build utils)) #~(begin - (use-modules (guix build cvs) - (guix build download-nar)) - - (or (cvs-fetch '#$(cvs-reference-root-directory ref) - '#$(cvs-reference-module ref) - '#$(cvs-reference-revision ref) - #$output - #:cvs-command (string-append #+cvs "/bin/cvs")) - (download-nar #$output))))) + (use-modules (guix build cvs)) + (cvs-fetch '#$(cvs-reference-root-directory ref) + '#$(cvs-reference-module ref) + '#$(cvs-reference-revision ref) + #$output + #:cvs-command (string-append #+cvs "/bin/cvs"))))) =20 (mlet %store-monad ((guile (package->derivation guile system))) (gexp->derivation (or name "cvs-checkout") build diff --git a/guix/git-download.scm b/guix/git-download.scm index 731e549b3..7397cbe7f 100644 --- a/guix/git-download.scm +++ b/guix/git-download.scm @@ -25,7 +25,6 @@ #:use-module (guix monads) #:use-module (guix records) #:use-module (guix packages) - #:use-module (guix modules) #:autoload (guix build-system gnu) (standard-packages) #:use-module (ice-9 match) #:use-module (ice-9 popen) @@ -78,31 +77,12 @@ HASH-ALGO (a symbol). Use NAME as the file name, or a = generic name if #f." (standard-packages) '())) =20 - (define zlib - (module-ref (resolve-interface '(gnu packages compression)) 'zlib)) - - (define config.scm - (scheme-file "config.scm" - #~(begin - (define-module (guix config) - #:export (%libz)) - - (define %libz - #+(file-append zlib "/lib/libz"))))) - - (define modules - (cons `((guix config) =3D> ,config.scm) - (delete '(guix config) - (source-module-closure '((guix build git) - (guix build utils) - (guix build download-nar)))))) - (define build - (with-imported-modules modules + (with-imported-modules '((guix build git) + (guix build utils)) #~(begin (use-modules (guix build git) (guix build utils) - (guix build download-nar) (ice-9 match)) =20 ;; The 'git submodule' commands expects Coreutils, sed, @@ -112,13 +92,12 @@ HASH-ALGO (a symbol). Use NAME as the file name, or a= generic name if #f." (((names dirs) ...) dirs))) =20 - (or (git-fetch (getenv "git url") (getenv "git commit") - #$output - #:recursive? (call-with-input-string - (getenv "git recursive?") - read) - #:git-command (string-append #+git "/bin/git")) - (download-nar #$output))))) + (git-fetch (getenv "git url") (getenv "git commit") + #$output + #:recursive? (call-with-input-string + (getenv "git recursive?") + read) + #:git-command (string-append #+git "/bin/git"))))) =20 (mlet %store-monad ((guile (package->derivation guile system))) (gexp->derivation (or name "git-checkout") build diff --git a/guix/hg-download.scm b/guix/hg-download.scm index 6b25b87b6..842098090 100644 --- a/guix/hg-download.scm +++ b/guix/hg-download.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright =C2=A9 2014, 2015, 2016, 2017 Ludovic Court=C3=A8s +;;; Copyright =C2=A9 2014, 2015, 2016 Ludovic Court=C3=A8s ;;; Copyright =C2=A9 2016 Ricardo Wurmus ;;; ;;; This file is part of GNU Guix. @@ -22,7 +22,6 @@ #:use-module (guix store) #:use-module (guix monads) #:use-module (guix records) - #:use-module (guix modules) #:use-module (guix packages) #:autoload (guix build-system gnu) (standard-packages) #:use-module (ice-9 match) @@ -60,35 +59,18 @@ "Return a fixed-output derivation that fetches REF, a object. The output is expected to have recursive hash HASH of type HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if #f." - (define zlib - (module-ref (resolve-interface '(gnu packages compression)) 'zlib)) - - (define config.scm - (scheme-file "config.scm" - #~(begin - (define-module (guix config) - #:export (%libz)) - - (define %libz - #+(file-append zlib "/lib/libz"))))) - - (define modules - (cons `((guix config) =3D> ,config.scm) - (delete '(guix config) - (source-module-closure '((guix build hg) - (guix build download-nar)))))) - (define build - (with-imported-modules modules + (with-imported-modules '((guix build hg) + (guix build utils)) #~(begin (use-modules (guix build hg) - (guix build download-nar)) + (guix build utils) + (ice-9 match)) =20 - (or (hg-fetch '#$(hg-reference-url ref) - '#$(hg-reference-changeset ref) - #$output - #:hg-command (string-append #+hg "/bin/hg")) - (download-nar #$output))))) + (hg-fetch '#$(hg-reference-url ref) + '#$(hg-reference-changeset ref) + #$output + #:hg-command (string-append #+hg "/bin/hg"))))) =20 (mlet %store-monad ((guile (package->derivation guile system))) (gexp->derivation (or name "hg-checkout") build --=20 2.15.1 --=-=-=--