summaryrefslogtreecommitdiff
path: root/guix/scripts/refresh.scm
diff options
context:
space:
mode:
Diffstat (limited to 'guix/scripts/refresh.scm')
-rw-r--r--guix/scripts/refresh.scm79
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)