diff options
Diffstat (limited to 'guix/scripts')
| -rw-r--r-- | guix/scripts/archive.scm | 3 | ||||
| -rw-r--r-- | guix/scripts/perform-download.scm | 67 |
2 files changed, 48 insertions, 22 deletions
diff --git a/guix/scripts/archive.scm b/guix/scripts/archive.scm index a7ff1593a6..e32f22ec99 100644 --- a/guix/scripts/archive.scm +++ b/guix/scripts/archive.scm @@ -123,8 +123,7 @@ Export/import one or more packages from/to the store.\n")) (exit 0))) (option '(#\V "version") #f #f (lambda args - (show-version-and-exit "guix build"))) - + (show-version-and-exit "guix archive"))) (option '("export") #f #f (lambda (opt name arg result) (alist-cons 'export #t result))) diff --git a/guix/scripts/perform-download.scm b/guix/scripts/perform-download.scm index 6889bcef79..045dd84ad6 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,9 @@ #: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) + #:autoload (guix config) (%git) #:use-module (ice-9 match) #:export (guix-perform-download)) @@ -42,16 +44,14 @@ (module-use! module (resolve-interface '(guix base32))) module)) -(define* (perform-download drv #:optional output +(define* (perform-download drv 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." +Note: OUTPUT may differ from the 'out' value of DRV, notably for 'bmCheck' or +'bmRepair' builds." (derivation-let drv ((url "url") - (output* "out") (executable "executable") (mirrors "mirrors") (content-addressed-mirrors "content-addressed-mirrors") @@ -59,15 +59,10 @@ actual output is different from that when we're doing a 'bmCheck' or (unless url (leave (G_ "~a: missing URL~%") (derivation-file-name drv))) - (let* ((output (or output output*)) - (url (call-with-input-string url read)) + (let* ((url (call-with-input-string url read)) (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 +87,31 @@ actual output is different from that when we're doing a 'bmCheck' or (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? + #:git-command %git)))) + (define (assert-low-privileges) (when (zero? (getuid)) (leave (G_ "refusing to run with elevated privileges (UID ~a)~%") @@ -120,13 +140,20 @@ actual output is different from that when we're doing a 'bmCheck' or (match args (((? derivation-path? drv) (? store-path? output)) (assert-low-privileges) - (perform-download (read-derivation-from-file drv) - output - #:print-build-trace? print-build-trace?)) - (((? derivation-path? drv)) ;backward compatibility - (assert-low-privileges) - (perform-download (read-derivation-from-file drv) - #: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 |