mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-07 07:26:13 -05:00
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
Ludovic Courtès
parent
9d0e2002a5
commit
95f2123135
3 changed files with 142 additions and 12 deletions
|
|
@ -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))
|
||||
|
||||
|
|
@ -61,10 +62,6 @@ (define* (perform-download drv 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?
|
||||
|
|
@ -89,6 +86,30 @@ (define* (perform-download drv output
|
|||
(when (and executable (string=? executable "1"))
|
||||
(chmod output #o755))))))
|
||||
|
||||
(define* (perform-git-download drv output
|
||||
#:key print-build-trace?)
|
||||
"Perform the download described by DRV, a fixed-output derivation, to
|
||||
OUTPUT.
|
||||
|
||||
Note: OUTPUT may differ from the 'out' value of DRV, notably for 'bmCheck' or
|
||||
'bmRepair' builds."
|
||||
(derivation-let drv ((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* ((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)~%")
|
||||
|
|
@ -117,8 +138,20 @@ (define print-build-trace?
|
|||
(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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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 prefix-len (string-length dir))
|
|||
(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 prefix-len (string-length dir))
|
|||
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 '())))
|
||||
|
|
|
|||
Loading…
Reference in a new issue