From 392b5d8cab0c676f19d14a139f14802ef0237ddf Mon Sep 17 00:00:00 2001 From: Nikita Karetnikov Date: Mon, 10 Jun 2013 07:46:13 +0000 Subject: guix refresh: Add '--key-download'. * guix/gnu-maintenance.scm (download-tarball): Add a 'key-download' keyword argument and pass it to 'gnupg-verify*'. Make 'archive-type' a keyword argument. (package-update): Add a 'key-download' keyword argument. Pass 'archive-type' and 'key-download' keyword arguments to 'download-tarball'. * guix/gnupg.scm: Import (ice-9 i18n) and (guix ui). (gnupg-verify*): Add a 'key-download' keyword argument and adjust 'gnupg-verify*' to use it. Make 'server' a keyword argument. * guix/scripts/refresh.scm (show-help, %options): Add and document '--key-download'. (update-package): Add a 'key-download' keyword argument and pass it to 'package-update'. (guix-refresh): Pass 'key-download' to 'update-package'. Limit lines to a maximum of 79 characters. --- guix/scripts/refresh.scm | 79 ++++++++++++++++++++++++++++++------------------ 1 file changed, 50 insertions(+), 29 deletions(-) (limited to 'guix/scripts/refresh.scm') 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 +;;; Copyright © 2013 Nikita Karetnikov ;;; ;;; This file is part of GNU Guix. ;;; @@ -64,6 +65,15 @@ (define %options (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 @@ (define (show-help) --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 @@ (define (show-help) (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 @@ (define core-package? ;; 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 @@ (define core-package? (%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) -- cgit v1.2.3