daemon: Add “git-download” built-in builder.

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.
This commit is contained in:
Ludovic Courtès 2023-09-11 14:22:44 +02:00 committed by Ludovic Courtès
parent 9d0e2002a5
commit 95f2123135
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
3 changed files with 142 additions and 12 deletions

View file

@ -24,10 +24,15 @@
#: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 @@
(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 @@
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 '())))