From mboxrd@z Thu Jan 1 00:00:00 1970 From: Nikita Karetnikov Subject: Re: [PATCH] guix refresh: Add '--key-download'. Date: Sat, 08 Jun 2013 15:19:05 +0400 Message-ID: <87obbg3l5i.fsf_-_@karetnikov.org> References: <87ehdzlg89.fsf@gnu.org> <87d2t2ehnp.fsf@karetnikov.org> <87d2t24ejj.fsf@gnu.org> <87bo8jfziy.fsf@karetnikov.org> <87obcjt1x5.fsf@gnu.org> <87fvxu30pi.fsf@karetnikov.org> <877gj5su70.fsf@gnu.org> <87obchmx23.fsf@karetnikov.org> <87fvxc4r3k.fsf@karetnikov.org> <87y5b4y1vp.fsf@gnu.org> <877gih2t2a.fsf@karetnikov.org> <87a9n9vna8.fsf@gnu.org> <87ip1qsd8g.fsf_-_@karetnikov.org> <87ppvxgavg.fsf@gnu.org> Mime-Version: 1.0 Content-Type: multipart/signed; boundary="==-=-="; micalg=pgp-sha1; protocol="application/pgp-signature" Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:35329) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1UlH7s-0006Vg-6N for bug-guix@gnu.org; Sat, 08 Jun 2013 07:16:08 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1UlH7p-0000J2-7Y for bug-guix@gnu.org; Sat, 08 Jun 2013 07:16:04 -0400 In-Reply-To: <87ppvxgavg.fsf@gnu.org> ("Ludovic =?utf-8?Q?Court=C3=A8s=22'?= =?utf-8?Q?s?= message of "Fri, 07 Jun 2013 18:19:39 +0200") List-Id: Bug reports for GNU Guix List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-guix-bounces+gcggb-bug-guix=m.gmane.org@gnu.org Sender: bug-guix-bounces+gcggb-bug-guix=m.gmane.org@gnu.org To: Ludovic =?utf-8?Q?Court=C3=A8s?= Cc: bug-guix@gnu.org --==-=-= Content-Type: multipart/mixed; boundary="=-=-=" --=-=-= > It just occurred to me that it might be more intuitive to use one of > 'interactive > #f ; never download > _ ; (any other value) always download IMO, an attached version is better because we use high-level terms: interactive, never, and always. > Modulo these details, it seems ready to get it. Can I push the attached version? What should I do next? For instance, I can change 'guix refresh' to fetch signatures first and don't download tarballs that can't be authenticated (when signatures are missing and 'never' is used). Or I can fix it not to mix version numbers (not to update Guile 1.8.8 to version 2.0.9). --=-=-= Content-Type: text/x-diff; charset=utf-8 Content-Disposition: attachment; filename=0001-guix-refresh-Add-key-download.patch Content-Transfer-Encoding: quoted-printable From=20911bd9c696b3104ac41f37dc0d2cf3741801d1d2 Mon Sep 17 00:00:00 2001 From: Nikita Karetnikov Date: Sat, 8 Jun 2013 10:35:11 +0000 Subject: [PATCH] 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. =2D-- guix/gnu-maintenance.scm | 18 +++++++--- guix/gnupg.scm | 36 +++++++++++++++++--- guix/scripts/refresh.scm | 79 +++++++++++++++++++++++++++++-------------= ---- 3 files changed, 92 insertions(+), 41 deletions(-) diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm index b54cd84..ed446c4 100644 =2D-- a/guix/gnu-maintenance.scm +++ b/guix/gnu-maintenance.scm @@ -341,16 +341,19 @@ pairs. Example: (\"mit-scheme-9.0.1\" . \"/gnu/mit-s= cheme/stable.pkg/9.0.1\"). (_ #f)))) =20 (define* (download-tarball store project directory version =2D #:optional (archive-type "gz")) + #:key (archive-type "gz") + (key-download 'interactive)) "Download PROJECT's tarball over FTP and check its OpenPGP signature. On =2Dsuccess, return the tarball file name." +success, return the tarball file name. KEY-DOWNLOAD specifies a download +policy for missing OpenPGP keys; allowed values: INTERACTIVE (default), +ALWAYS, and NEVER." (let* ((server (ftp-server/directory project)) (base (string-append project "-" version ".tar." archive-type)) (url (string-append "ftp://" server "/" directory "/" base)) (sig-url (string-append url ".sig")) (tarball (download-to-store store url)) (sig (download-to-store store sig-url))) =2D (let ((ret (gnupg-verify* sig tarball))) + (let ((ret (gnupg-verify* sig tarball #:key-download key-download))) (if ret tarball (begin @@ -359,9 +362,11 @@ success, return the tarball file name." (warning (_ "(could be because the public key is not in your k= eyring)~%")) #f))))) =20 =2D(define (package-update store package) +(define* (package-update store package #:key (key-download 'interactive)) "Return the new version and the file name of the new version tarball for =2DPACKAGE, or #f and #f when PACKAGE is up-to-date." +PACKAGE, or #f and #f when PACKAGE is up-to-date. KEY-DOWNLOAD specifies a +download policy for missing OpenPGP keys; allowed values: ALWAYS, NEVER, a= nd +INTERACTIVE (default)." (match (package-update-path package) ((version . directory) (let-values (((name) @@ -372,7 +377,8 @@ PACKAGE, or #f and #f when PACKAGE is up-to-date." (file-extension (origin-uri source))) "gz")))) (let ((tarball (download-tarball store name directory version =2D archive-type))) + #:archive-type archive-type + #:key-download key-download))) (values version tarball)))) (_ (values #f #f)))) diff --git a/guix/gnupg.scm b/guix/gnupg.scm index c17a495..40dc864 100644 =2D-- a/guix/gnupg.scm +++ b/guix/gnupg.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright =C2=A9 2010, 2011, 2013 Ludovic Court=C3=A8s +;;; Copyright =C2=A9 2013 Nikita Karetnikov ;;; ;;; This file is part of GNU Guix. ;;; @@ -21,7 +22,9 @@ #:use-module (ice-9 match) #:use-module (ice-9 regex) #:use-module (ice-9 rdelim) + #:use-module (ice-9 i18n) #:use-module (srfi srfi-1) + #:use-module (guix ui) #:export (%gpg-command %openpgp-key-server gnupg-verify @@ -145,16 +148,37 @@ missing key." (define (gnupg-receive-keys key-id server) (system* (%gpg-command) "--keyserver" server "--recv-keys" key-id)) =20 =2D(define* (gnupg-verify* sig file #:optional (server (%openpgp-key-server= ))) +(define* (gnupg-verify* sig file + #:key (key-download 'interactive) + (server (%openpgp-key-server))) "Like `gnupg-verify', but try downloading the public key if it's missing. =2DReturn #t if the signature was good, #f otherwise." +Return #t if the signature was good, #f otherwise. KEY-DOWNLOAD specifies= a +download policy for missing OpenPGP keys; allowed values: ALWAYS, NEVER, a= nd +INTERACTIVE (default)." (let ((status (gnupg-verify sig file))) (or (gnupg-status-good-signature? status) (let ((missing (gnupg-status-missing-key? status))) + (define (download-and-try-again) + ;; Download the missing key and try again. + (begin + (gnupg-receive-keys missing server) + (gnupg-status-good-signature? (gnupg-verify sig file)))) + + (define (receive?) + (let ((answer + (_ (begin (format #t "~a~a~%" + "Would you like to download this key " + "and add it to your keyring?") + (read-line))))) + (string-match (locale-yes-regexp) answer))) + (and missing =2D (begin =2D ;; Download the missing key and try again. =2D (gnupg-receive-keys missing server) =2D (gnupg-status-good-signature? (gnupg-verify sig file)))= ))))) + (case key-download + ((never) #f) + ((always) + (download-and-try-again)) + (else + (and (receive?) + (download-and-try-again))))))))) =20 ;;; gnupg.scm ends here diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm index 10715eb..e7eb578 100644 =2D-- a/guix/scripts/refresh.scm +++ b/guix/scripts/refresh.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright =C2=A9 2013 Ludovic Court=C3=A8s +;;; Copyright =C2=A9 2013 Nikita Karetnikov ;;; ;;; 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))))) =20 (option '(#\h "help") #f #f (lambda args @@ -90,6 +100,11 @@ specified with `--select'.\n")) --key-server=3DHOST use HOST as the OpenPGP key server")) (display (_ " --gpg=3DCOMMAND use COMMAND as the GnuPG 2.x command")) + (display (_ " + --key-download=3DPOLICY + handle missing OpenPGP keys according to POLICY: + 'always', 'never', and 'interactive', which is al= so + 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)) =20 =2D(define (update-package store package) =2D "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 () =2D (package-update store package)) + (package-update store package #:key-download key-downl= oad)) (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)))) =20 =2D (let* ((opts (parse-options)) =2D (update? (assoc-ref opts 'update?)) =2D (packages (match (concatenate =2D (filter-map (match-lambda =2D (('argument . value) =2D (let ((p (find-packages-by-name= value))) =2D (unless p =2D (leave (_ "~a: no package b= y that name") =2D value)) =2D p)) =2D (_ #f)) =2D opts)) =2D (() ; default to all packa= ges =2D (let ((select? (match (assoc-ref opts 'select) =2D ('core core-package?) =2D ('non-core (negate core-package?)) =2D (_ (const #t))))) =2D ;; TODO: Keep only the newest of each package. =2D (fold-packages (lambda (package result) =2D (if (select? package) =2D (cons package result) =2D result)) =2D '()))) =2D (some ; user-specified packa= ges =2D 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)))) =2D (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 pack= age)) ((new-version . directory) =2D-=20 1.7.5.4 --=-=-=-- --==-=-= Content-Type: application/pgp-signature -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.4.10 (GNU/Linux) iQIcBAEBAgAGBQJRsxM0AAoJEM+IQzI9IQ38b6UP/34opVPF6Kt4rxz0a+GMdce0 pg/Jd7vL1feTjlcxI5EV/odIlWStNXInptcO6yk5Np9E4G9BuCHEKCAJsAIGIomh LAAqXqEXuKVDIMaC8bOsttNW7b+KiyGOrXOPpZK4eAiVa9pXjt8EytA82UB5a4Dx +7rdrw/hd5PGGl1fYfNuIyAxevVhZjwn6r1kZt2H+E+FT0MQaR2uoXv+ylZTuVwm 3PFAy8hV4ELXQomBS2CIBTdqH6GXNBlIJy7kUG55mmqg3ADwKM1Jis+tlxIPxra4 dl+D8uSIo/2fLyRPrHHOLJukHtE7rXe53OTGjhwwyZNPB1BW05KxA78MMmbi7f/N 0VzBwznpCdHaurhexJsm/ChZDk20ein9FnoZ/wnui2zOkp8pPq87FeC9/ENs3Wdh e0Fx98eJ4lo93zH+LimNRkksXJlVRcmIgn1MB1aTbPgOOQhZNlIqFuTGHMwqyztS uKyGpIwrpcOR9U6XlK1gh849xuYH57myLx1wDnFji844Q/iWVguOI3ZCb7xArAnU v/4MyWFBeqO/yU9aZQJoduz0LKQavpTFVMGKT/fsEZsWxqishL82al54eEjVQ0I1 YEtLkDZkHTs6zXDOMDUgM/pTHRRJzYI+94igwviEKsfiAG39HZqcch4nrFlmlVEb PxwcbItpB9Y8oX244klJ =q/4q -----END PGP SIGNATURE----- --==-=-=--