| Message ID | 3c42634cb47dd7eaa81a198bc2d097ca74a973ed.1694441831.git.ludo@gnu.org |
|---|---|
| State | New |
| Headers | show |
| Series | Add built-in builder for Git checkouts | expand |
Hello, Ludovic Courtès <ludo@gnu.org> writes: > From: Ludovic Courtès <ludovic.courtes@inria.fr> > > The new builder makes it possible to break cycles that occurs when the > fixed-output derivation for the source of a dependency of ‘git’ would > itself depend on ‘git’. > > * guix/scripts/perform-download.scm (perform-git-download): New > procedure. > (perform-download): Move fixed-output derivation check to… > (guix-perform-download): … here. Invoke ‘perform-download’ or > ‘perform-git-download’ depending on what ‘derivation-builder’ returns. > * nix/libstore/builtins.cc (builtins): Add “git-download”. > * tests/derivations.scm ("built-in-builders"): Update. > ("'git-download' built-in builder") > ("'git-download' built-in builder, invalid hash") > ("'git-download' built-in builder, invalid commit") > ("'git-download' built-in builder, not found"): New tests. > --- > guix/scripts/perform-download.scm | 52 +++++++++++++--- > nix/libstore/builtins.cc | 5 +- > tests/derivations.scm | 100 +++++++++++++++++++++++++++++- > 3 files changed, 145 insertions(+), 12 deletions(-) > > diff --git a/guix/scripts/perform-download.scm b/guix/scripts/perform-download.scm > index c8f044e82e..a287e97528 100644 > --- a/guix/scripts/perform-download.scm > +++ b/guix/scripts/perform-download.scm > @@ -1,5 +1,5 @@ > ;;; GNU Guix --- Functional package management for GNU > -;;; Copyright © 2016, 2017, 2018, 2020 Ludovic Courtès <ludo@gnu.org> > +;;; Copyright © 2016-2018, 2020, 2023 Ludovic Courtès <ludo@gnu.org> > ;;; > ;;; This file is part of GNU Guix. > ;;; > @@ -21,7 +21,8 @@ (define-module (guix scripts perform-download) > #:use-module (guix scripts) > #:use-module (guix derivations) > #:use-module ((guix store) #:select (derivation-path? store-path?)) > - #:use-module (guix build download) > + #:autoload (guix build download) (url-fetch) > + #:autoload (guix build git) (git-fetch-with-fallback) > #:use-module (ice-9 match) > #:export (guix-perform-download)) > > @@ -64,10 +65,6 @@ (define* (perform-download drv #:optional output > (drv-output (assoc-ref (derivation-outputs drv) "out")) > (algo (derivation-output-hash-algo drv-output)) > (hash (derivation-output-hash drv-output))) > - (unless (and algo hash) > - (leave (G_ "~a is not a fixed-output derivation~%") > - (derivation-file-name drv))) > - > ;; We're invoked by the daemon, which gives us write access to OUTPUT. > (when (url-fetch url output > #:print-build-trace? print-build-trace? > @@ -92,6 +89,33 @@ (define* (perform-download drv #:optional output > (when (and executable (string=? executable "1")) > (chmod output #o755)))))) > > +(define* (perform-git-download drv #:optional output > + #:key print-build-trace?) > + "Perform the download described by DRV, a fixed-output derivation, to > +OUTPUT. > + > +Note: Unless OUTPUT is #f, we don't read the value of 'out' in DRV since the > +actual output is different from that when we're doing a 'bmCheck' or I'd drop the 'we's and use impersonal imperative tense or at least 's/when we're doing/when doing/'. > +'bmRepair' build." > + (derivation-let drv ((output* "out") I'd name this variable just 'out', for consistency with the others. > + (url "url") > + (commit "commit") > + (recursive? "recursive?")) > + (unless url > + (leave (G_ "~a: missing Git URL~%") (derivation-file-name drv))) > + (unless commit > + (leave (G_ "~a: missing Git commit~%") (derivation-file-name drv))) > + > + (let* ((output (or output output*)) > > + (url (call-with-input-string url read)) > + (recursive? (and recursive? > + (call-with-input-string recursive? read))) > + (drv-output (assoc-ref (derivation-outputs drv) "out")) > + (algo (derivation-output-hash-algo drv-output)) > + (hash (derivation-output-hash drv-output))) > + (git-fetch-with-fallback url commit output > + #:recursive? recursive?)))) > + > (define (assert-low-privileges) > (when (zero? (getuid)) > (leave (G_ "refusing to run with elevated privileges (UID ~a)~%") > @@ -120,8 +144,20 @@ (define-command (guix-perform-download . args) > (match args > (((? derivation-path? drv) (? store-path? output)) > (assert-low-privileges) > - (let ((drv (read-derivation-from-file drv))) > - (perform-download drv output #:print-build-trace? print-build-trace?))) > + (let* ((drv (read-derivation-from-file drv)) > + (download (match (derivation-builder drv) > + ("builtin:download" perform-download) > + ("builtin:git-download" perform-git-download) > + (unknown (leave (G_ "~a: unknown builtin builder") > + unknown)))) > + (drv-output (assoc-ref (derivation-outputs drv) "out")) > + (algo (derivation-output-hash-algo drv-output)) > + (hash (derivation-output-hash drv-output))) > + (unless (and hash algo) > + (leave (G_ "~a is not a fixed-output derivation~%") > + (derivation-file-name drv))) > + > + (download drv output #:print-build-trace? print-build-trace?))) > (("--version") > (show-version-and-exit)) > (x > diff --git a/nix/libstore/builtins.cc b/nix/libstore/builtins.cc > index 4111ac4760..6bf467354a 100644 > --- a/nix/libstore/builtins.cc > +++ b/nix/libstore/builtins.cc > @@ -1,5 +1,5 @@ > /* GNU Guix --- Functional package management for GNU > - Copyright (C) 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> > + Copyright (C) 2016-2019, 2023 Ludovic Courtès <ludo@gnu.org> > > This file is part of GNU Guix. > > @@ -58,7 +58,8 @@ static void builtinDownload(const Derivation &drv, > > static const std::map<std::string, derivationBuilder> builtins = > { > - { "download", builtinDownload } > + { "download", builtinDownload }, > + { "git-download", builtinDownload } > }; > > derivationBuilder lookupBuiltinBuilder(const std::string & name) > diff --git a/tests/derivations.scm b/tests/derivations.scm > index 66c777cfe7..e1312bd46b 100644 > --- a/tests/derivations.scm > +++ b/tests/derivations.scm > @@ -24,10 +24,15 @@ (define-module (test-derivations) > #:use-module (guix utils) > #:use-module ((gcrypt hash) #:prefix gcrypt:) > #:use-module (guix base32) > + #:use-module ((guix git) #:select (with-repository)) > #:use-module (guix tests) > + #:use-module (guix tests git) > #:use-module (guix tests http) > #:use-module ((guix packages) #:select (package-derivation base32)) > - #:use-module ((guix build utils) #:select (executable-file?)) > + #:use-module ((guix build utils) #:select (executable-file? which)) > + #:use-module ((guix hash) #:select (file-hash*)) > + #:use-module ((git oid) #:select (oid->string)) > + #:use-module ((git reference) #:select (reference-name->oid)) > #:use-module (gnu packages bootstrap) > #:use-module ((gnu packages guile) #:select (guile-1.8)) > #:use-module (srfi srfi-1) > @@ -195,7 +200,7 @@ (define* (directory-contents dir #:optional (slurp get-bytevector-all)) > (stat:ino (lstat file2)))))))) > > (test-equal "built-in-builders" > - '("download") > + '("download" "git-download") > (built-in-builders %store)) > > (test-assert "unknown built-in builder" > @@ -290,6 +295,97 @@ (define* (directory-contents dir #:optional (slurp get-bytevector-all)) > get-string-all) > text)))))) > > +;; 'with-temporary-git-repository' relies on the 'git' command. > +(unless (which (git-command)) (test-skip 1)) I'd expect the 'git' command to now be required by Autoconf at build time, which should mean checking it here is not useful/required? > +(test-equal "'git-download' built-in builder" > + `(("/a.txt" . "AAA") > + ("/b.scm" . "#t")) > + (let ((nonce (random-text))) > + (with-temporary-git-repository directory > + `((add "a.txt" "AAA") > + (add "b.scm" "#t") > + (commit ,nonce)) > + (let* ((commit (with-repository directory repository > + (oid->string > + (reference-name->oid repository "HEAD")))) > + (drv (derivation %store "git-download" > + "builtin:git-download" '() > + #:env-vars > + `(("url" > + . ,(object->string > + (string-append "file://" directory))) > + ("commit" . ,commit)) > + #:hash-algo 'sha256 > + #:hash (file-hash* directory > + #:algorithm > + (gcrypt:hash-algorithm > + gcrypt:sha256) > + #:recursive? #t) > + #:recursive? #t))) > + (build-derivations %store (list drv)) > + (directory-contents (derivation->output-path drv) get-string-all))))) > + > +(unless (which (git-command)) (test-skip 1)) > +(test-assert "'git-download' built-in builder, invalid hash" > + (with-temporary-git-repository directory > + `((add "a.txt" "AAA") > + (add "b.scm" "#t") > + (commit "Commit!")) > + (let* ((commit (with-repository directory repository > + (oid->string > + (reference-name->oid repository "HEAD")))) > + (drv (derivation %store "git-download" > + "builtin:git-download" '() > + #:env-vars > + `(("url" > + . ,(object->string > + (string-append "file://" directory))) > + ("commit" . ,commit)) > + #:hash-algo 'sha256 > + #:hash (gcrypt:sha256 #vu8()) > + #:recursive? #t))) > + (guard (c ((store-protocol-error? c) > + (string-contains (store-protocol-error-message c) "failed"))) > + (build-derivations %store (list drv)) > + #f)))) > + > +(unless (which (git-command)) (test-skip 1)) > +(test-assert "'git-download' built-in builder, invalid commit" > + (with-temporary-git-repository directory > + `((add "a.txt" "AAA") > + (add "b.scm" "#t") > + (commit "Commit!")) > + (let* ((drv (derivation %store "git-download" > + "builtin:git-download" '() > + #:env-vars > + `(("url" > + . ,(object->string > + (string-append "file://" directory))) > + ("commit" > + . "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa")) > + #:hash-algo 'sha256 > + #:hash (gcrypt:sha256 #vu8()) > + #:recursive? #t))) > + (guard (c ((store-protocol-error? c) > + (string-contains (store-protocol-error-message c) "failed"))) > + (build-derivations %store (list drv)) > + #f)))) > + > +(test-assert "'git-download' built-in builder, not found" > + (let* ((drv (derivation %store "git-download" > + "builtin:git-download" '() > + #:env-vars > + `(("url" . "file:///does-not-exist.git") > + ("commit" > + . "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa")) > + #:hash-algo 'sha256 > + #:hash (gcrypt:sha256 #vu8()) > + #:recursive? #t))) > + (guard (c ((store-protocol-error? c) > + (string-contains (store-protocol-error-message c) "failed"))) > + (build-derivations %store (list drv)) > + #f))) > + Maybe the error message compared could be more precised, if it already contains the necessary details? Otherwise, well done! LGTM with my above comments.
Hi Maxim, Maxim Cournoyer <maxim.cournoyer@gmail.com> skribis: >> +(define* (perform-git-download drv #:optional output >> + #:key print-build-trace?) >> + "Perform the download described by DRV, a fixed-output derivation, to >> +OUTPUT. >> + >> +Note: Unless OUTPUT is #f, we don't read the value of 'out' in DRV since the >> +actual output is different from that when we're doing a 'bmCheck' or > > I'd drop the 'we's and use impersonal imperative tense or at least > 's/when we're doing/when doing/'. Noted. (That’s actually copied from ‘perform-download’; I’ll fix it there as well.) >> +'bmRepair' build." >> + (derivation-let drv ((output* "out") > > I'd name this variable just 'out', for consistency with the others. No because there’s also a parameter called ‘output’ and there’s (or output output*). But lemme see, I should remove this optional ‘output’ parameter. >> +;; 'with-temporary-git-repository' relies on the 'git' command. >> +(unless (which (git-command)) (test-skip 1)) > > I'd expect the 'git' command to now be required by Autoconf at build > time, which should mean checking it here is not useful/required? That comes in a subsequent patch. >> +(test-assert "'git-download' built-in builder, not found" >> + (let* ((drv (derivation %store "git-download" >> + "builtin:git-download" '() >> + #:env-vars >> + `(("url" . "file:///does-not-exist.git") >> + ("commit" >> + . "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa")) >> + #:hash-algo 'sha256 >> + #:hash (gcrypt:sha256 #vu8()) >> + #:recursive? #t))) >> + (guard (c ((store-protocol-error? c) >> + (string-contains (store-protocol-error-message c) "failed"))) >> + (build-derivations %store (list drv)) >> + #f))) >> + > > Maybe the error message compared could be more precised, if it already > contains the necessary details? Unfortunately it doesn’t (same strategy as with the existing “builtin:download” tests.) Thanks for your feedback! Ludo’.
diff --git a/guix/scripts/perform-download.scm b/guix/scripts/perform-download.scm index c8f044e82e..a287e97528 100644 --- a/guix/scripts/perform-download.scm +++ b/guix/scripts/perform-download.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2016, 2017, 2018, 2020 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2016-2018, 2020, 2023 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -21,7 +21,8 @@ (define-module (guix scripts perform-download) #:use-module (guix scripts) #:use-module (guix derivations) #:use-module ((guix store) #:select (derivation-path? store-path?)) - #:use-module (guix build download) + #:autoload (guix build download) (url-fetch) + #:autoload (guix build git) (git-fetch-with-fallback) #:use-module (ice-9 match) #:export (guix-perform-download)) @@ -64,10 +65,6 @@ (define* (perform-download drv #:optional output (drv-output (assoc-ref (derivation-outputs drv) "out")) (algo (derivation-output-hash-algo drv-output)) (hash (derivation-output-hash drv-output))) - (unless (and algo hash) - (leave (G_ "~a is not a fixed-output derivation~%") - (derivation-file-name drv))) - ;; We're invoked by the daemon, which gives us write access to OUTPUT. (when (url-fetch url output #:print-build-trace? print-build-trace? @@ -92,6 +89,33 @@ (define* (perform-download drv #:optional output (when (and executable (string=? executable "1")) (chmod output #o755)))))) +(define* (perform-git-download drv #:optional output + #:key print-build-trace?) + "Perform the download described by DRV, a fixed-output derivation, to +OUTPUT. + +Note: Unless OUTPUT is #f, we don't read the value of 'out' in DRV since the +actual output is different from that when we're doing a 'bmCheck' or +'bmRepair' build." + (derivation-let drv ((output* "out") + (url "url") + (commit "commit") + (recursive? "recursive?")) + (unless url + (leave (G_ "~a: missing Git URL~%") (derivation-file-name drv))) + (unless commit + (leave (G_ "~a: missing Git commit~%") (derivation-file-name drv))) + + (let* ((output (or output output*)) + (url (call-with-input-string url read)) + (recursive? (and recursive? + (call-with-input-string recursive? read))) + (drv-output (assoc-ref (derivation-outputs drv) "out")) + (algo (derivation-output-hash-algo drv-output)) + (hash (derivation-output-hash drv-output))) + (git-fetch-with-fallback url commit output + #:recursive? recursive?)))) + (define (assert-low-privileges) (when (zero? (getuid)) (leave (G_ "refusing to run with elevated privileges (UID ~a)~%") @@ -120,8 +144,20 @@ (define-command (guix-perform-download . args) (match args (((? derivation-path? drv) (? store-path? output)) (assert-low-privileges) - (let ((drv (read-derivation-from-file drv))) - (perform-download drv output #:print-build-trace? print-build-trace?))) + (let* ((drv (read-derivation-from-file drv)) + (download (match (derivation-builder drv) + ("builtin:download" perform-download) + ("builtin:git-download" perform-git-download) + (unknown (leave (G_ "~a: unknown builtin builder") + unknown)))) + (drv-output (assoc-ref (derivation-outputs drv) "out")) + (algo (derivation-output-hash-algo drv-output)) + (hash (derivation-output-hash drv-output))) + (unless (and hash algo) + (leave (G_ "~a is not a fixed-output derivation~%") + (derivation-file-name drv))) + + (download drv output #:print-build-trace? print-build-trace?))) (("--version") (show-version-and-exit)) (x diff --git a/nix/libstore/builtins.cc b/nix/libstore/builtins.cc index 4111ac4760..6bf467354a 100644 --- a/nix/libstore/builtins.cc +++ b/nix/libstore/builtins.cc @@ -1,5 +1,5 @@ /* GNU Guix --- Functional package management for GNU - Copyright (C) 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> + Copyright (C) 2016-2019, 2023 Ludovic Courtès <ludo@gnu.org> This file is part of GNU Guix. @@ -58,7 +58,8 @@ static void builtinDownload(const Derivation &drv, static const std::map<std::string, derivationBuilder> builtins = { - { "download", builtinDownload } + { "download", builtinDownload }, + { "git-download", builtinDownload } }; derivationBuilder lookupBuiltinBuilder(const std::string & name) diff --git a/tests/derivations.scm b/tests/derivations.scm index 66c777cfe7..e1312bd46b 100644 --- a/tests/derivations.scm +++ b/tests/derivations.scm @@ -24,10 +24,15 @@ (define-module (test-derivations) #:use-module (guix utils) #:use-module ((gcrypt hash) #:prefix gcrypt:) #:use-module (guix base32) + #:use-module ((guix git) #:select (with-repository)) #:use-module (guix tests) + #:use-module (guix tests git) #:use-module (guix tests http) #:use-module ((guix packages) #:select (package-derivation base32)) - #:use-module ((guix build utils) #:select (executable-file?)) + #:use-module ((guix build utils) #:select (executable-file? which)) + #:use-module ((guix hash) #:select (file-hash*)) + #:use-module ((git oid) #:select (oid->string)) + #:use-module ((git reference) #:select (reference-name->oid)) #:use-module (gnu packages bootstrap) #:use-module ((gnu packages guile) #:select (guile-1.8)) #:use-module (srfi srfi-1) @@ -195,7 +200,7 @@ (define* (directory-contents dir #:optional (slurp get-bytevector-all)) (stat:ino (lstat file2)))))))) (test-equal "built-in-builders" - '("download") + '("download" "git-download") (built-in-builders %store)) (test-assert "unknown built-in builder" @@ -290,6 +295,97 @@ (define* (directory-contents dir #:optional (slurp get-bytevector-all)) get-string-all) text)))))) +;; 'with-temporary-git-repository' relies on the 'git' command. +(unless (which (git-command)) (test-skip 1)) +(test-equal "'git-download' built-in builder" + `(("/a.txt" . "AAA") + ("/b.scm" . "#t")) + (let ((nonce (random-text))) + (with-temporary-git-repository directory + `((add "a.txt" "AAA") + (add "b.scm" "#t") + (commit ,nonce)) + (let* ((commit (with-repository directory repository + (oid->string + (reference-name->oid repository "HEAD")))) + (drv (derivation %store "git-download" + "builtin:git-download" '() + #:env-vars + `(("url" + . ,(object->string + (string-append "file://" directory))) + ("commit" . ,commit)) + #:hash-algo 'sha256 + #:hash (file-hash* directory + #:algorithm + (gcrypt:hash-algorithm + gcrypt:sha256) + #:recursive? #t) + #:recursive? #t))) + (build-derivations %store (list drv)) + (directory-contents (derivation->output-path drv) get-string-all))))) + +(unless (which (git-command)) (test-skip 1)) +(test-assert "'git-download' built-in builder, invalid hash" + (with-temporary-git-repository directory + `((add "a.txt" "AAA") + (add "b.scm" "#t") + (commit "Commit!")) + (let* ((commit (with-repository directory repository + (oid->string + (reference-name->oid repository "HEAD")))) + (drv (derivation %store "git-download" + "builtin:git-download" '() + #:env-vars + `(("url" + . ,(object->string + (string-append "file://" directory))) + ("commit" . ,commit)) + #:hash-algo 'sha256 + #:hash (gcrypt:sha256 #vu8()) + #:recursive? #t))) + (guard (c ((store-protocol-error? c) + (string-contains (store-protocol-error-message c) "failed"))) + (build-derivations %store (list drv)) + #f)))) + +(unless (which (git-command)) (test-skip 1)) +(test-assert "'git-download' built-in builder, invalid commit" + (with-temporary-git-repository directory + `((add "a.txt" "AAA") + (add "b.scm" "#t") + (commit "Commit!")) + (let* ((drv (derivation %store "git-download" + "builtin:git-download" '() + #:env-vars + `(("url" + . ,(object->string + (string-append "file://" directory))) + ("commit" + . "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa")) + #:hash-algo 'sha256 + #:hash (gcrypt:sha256 #vu8()) + #:recursive? #t))) + (guard (c ((store-protocol-error? c) + (string-contains (store-protocol-error-message c) "failed"))) + (build-derivations %store (list drv)) + #f)))) + +(test-assert "'git-download' built-in builder, not found" + (let* ((drv (derivation %store "git-download" + "builtin:git-download" '() + #:env-vars + `(("url" . "file:///does-not-exist.git") + ("commit" + . "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa")) + #:hash-algo 'sha256 + #:hash (gcrypt:sha256 #vu8()) + #:recursive? #t))) + (guard (c ((store-protocol-error? c) + (string-contains (store-protocol-error-message c) "failed"))) + (build-derivations %store (list drv)) + #f))) + (test-equal "derivation-name" "foo-0.0" (let ((drv (derivation %store "foo-0.0" %bash '())))
From: Ludovic Courtès <ludovic.courtes@inria.fr> The new builder makes it possible to break cycles that occurs when the fixed-output derivation for the source of a dependency of ‘git’ would itself depend on ‘git’. * guix/scripts/perform-download.scm (perform-git-download): New procedure. (perform-download): Move fixed-output derivation check to… (guix-perform-download): … here. Invoke ‘perform-download’ or ‘perform-git-download’ depending on what ‘derivation-builder’ returns. * nix/libstore/builtins.cc (builtins): Add “git-download”. * tests/derivations.scm ("built-in-builders"): Update. ("'git-download' built-in builder") ("'git-download' built-in builder, invalid hash") ("'git-download' built-in builder, invalid commit") ("'git-download' built-in builder, not found"): New tests. --- guix/scripts/perform-download.scm | 52 +++++++++++++--- nix/libstore/builtins.cc | 5 +- tests/derivations.scm | 100 +++++++++++++++++++++++++++++- 3 files changed, 145 insertions(+), 12 deletions(-)