diff options
Diffstat (limited to 'guix/scripts')
| -rw-r--r-- | guix/scripts/refresh.scm | 79 |
1 files changed, 50 insertions, 29 deletions
diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm index 10715ebc2d..b8d4efd204 100644 --- a/guix/scripts/refresh.scm +++ b/guix/scripts/refresh.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -64,6 +65,15 @@ (option '("gpg") #t #f (lambda (opt name arg result) (alist-cons 'gpg-command arg result))) + (option '("key-download") #t #f + (lambda (opt name arg result) + (match arg + ((or "interactive" "always" "never") + (alist-cons 'key-download (string->symbol arg) + result)) + (_ + (leave (_ "unsupported policy: ~a~%") + arg))))) (option '(#\h "help") #f #f (lambda args @@ -90,6 +100,11 @@ specified with `--select'.\n")) --key-server=HOST use HOST as the OpenPGP key server")) (display (_ " --gpg=COMMAND use COMMAND as the GnuPG 2.x command")) + (display (_ " + --key-download=POLICY + handle missing OpenPGP keys according to POLICY: + 'always', 'never', and 'interactive', which is also + used when 'key-download' is not specified")) (newline) (display (_ " -h, --help display this help and exit")) @@ -98,12 +113,14 @@ specified with `--select'.\n")) (newline) (show-bug-report-information)) -(define (update-package store package) - "Update the source file that defines PACKAGE with the new version." +(define* (update-package store package #:key (key-download 'interactive)) + "Update the source file that defines PACKAGE with the new version. +KEY-DOWNLOAD specifies a download policy for missing OpenPGP keys; allowed +values: 'interactive' (default), 'always', and 'never'." (let-values (((version tarball) (catch #t (lambda () - (package-update store package)) + (package-update store package #:key-download key-download)) (lambda _ (values #f #f)))) ((loc) @@ -161,31 +178,33 @@ update would trigger a complete rebuild." ;; XXX: Fails to catch MPFR/MPC, whose *source* is used as input. (member (package-name package) names)))) - (let* ((opts (parse-options)) - (update? (assoc-ref opts 'update?)) - (packages (match (concatenate - (filter-map (match-lambda - (('argument . value) - (let ((p (find-packages-by-name value))) - (unless p - (leave (_ "~a: no package by that name") - value)) - p)) - (_ #f)) - opts)) - (() ; default to all packages - (let ((select? (match (assoc-ref opts 'select) - ('core core-package?) - ('non-core (negate core-package?)) - (_ (const #t))))) - ;; TODO: Keep only the newest of each package. - (fold-packages (lambda (package result) - (if (select? package) - (cons package result) - result)) - '()))) - (some ; user-specified packages - some)))) + (let* ((opts (parse-options)) + (update? (assoc-ref opts 'update?)) + (key-download (assoc-ref opts 'key-download)) + (packages + (match (concatenate + (filter-map (match-lambda + (('argument . value) + (let ((p (find-packages-by-name value))) + (unless p + (leave (_ "~a: no package by that name") + value)) + p)) + (_ #f)) + opts)) + (() ; default to all packages + (let ((select? (match (assoc-ref opts 'select) + ('core core-package?) + ('non-core (negate core-package?)) + (_ (const #t))))) + ;; TODO: Keep only the newest of each package. + (fold-packages (lambda (package result) + (if (select? package) + (cons package result) + result)) + '()))) + (some ; user-specified packages + some)))) (with-error-handling (if update? (let ((store (open-connection))) @@ -195,7 +214,9 @@ update would trigger a complete rebuild." (%gpg-command (or (assoc-ref opts 'gpg-command) (%gpg-command)))) - (for-each (cut update-package store <>) packages))) + (for-each + (cut update-package store <> #:key-download key-download) + packages))) (for-each (lambda (package) (match (false-if-exception (package-update-path package)) ((new-version . directory) |