From mboxrd@z Thu Jan 1 00:00:00 1970 From: Nikita Karetnikov Subject: [PATCH] guix refresh: Add '--key-download'. Date: Fri, 07 Jun 2013 09:26:23 +0400 Message-ID: <87ip1qsd8g.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> 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]:58801) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Ukp9O-0003MR-2y for bug-guix@gnu.org; Fri, 07 Jun 2013 01:23:51 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1Ukp9K-0004iS-D8 for bug-guix@gnu.org; Fri, 07 Jun 2013 01:23:46 -0400 In-Reply-To: <87a9n9vna8.fsf@gnu.org> ("Ludovic =?utf-8?Q?Court=C3=A8s=22'?= =?utf-8?Q?s?= message of "Sat, 01 Jun 2013 17:55:11 +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="=-=-=" --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable > First the whole string should be enclosed in (_ ...), otherwise xgettext > will just extract "~a~a" for translation. Should I do the same here? + (match arg + ((or "interactive" "always" "never") + (alist-cons 'key-download (string->symbol arg) + result)) > Perhaps change it to > #:key (key-download 'interactive) I've tried that, but things like (package-update #:key-download key-download) don't look right. Here is a simplified example: ;; guix/scripts/refresh.scm (define* (update-package #:key (key-download 'interactive)) (package-update #:key-download key-download)) ;; guix/gnu-maintenance.scm (define* (download-tarball #:key (key-download 'interactive)) (gnupg-verify* #:key-download key-download)) (define* (package-update #:key (key-download 'interactive)) (download-tarball #:key-download key-download)) ;; guix/gnupg.scm (define* (gnupg-verify* #:key (key-download 'interactive)) (begin (display key-download) (newline))) scheme@(guile-user)> (update-package) interactive scheme@(guile-user)> (update-package #:key-download 'never) never > > + (define (receive?) > > + (string=3D? "y" ; XXX: i18n > Guile=E2=80=99s (ice-9 i18n) exports =E2=80=98locale-yes-regexp=E2=80=99 = and =E2=80=98locale-no-regexp=E2=80=99 > (info "(guile) Accessing Locale Information"). Is it fine now? I'm attaching a patch. Examples (some commands were omitted): # ./pre-inst-env guix refresh -u [...] ftp://ftp.gnu.org/.../guile-2.0.9.tar.gz.sig 100.0% of 0.2 KiB gpg: Signature made Wed 10 Apr 2013 06:14:45 AM UTC using DSA key ID EA52EC= F4 gpg: Can't check signature: No public key Would you like to download this key and add it to your keyring? n guix refresh: warning: signature verification failed for `guile-2.0.9.tar.g= z' guix refresh: warning: (could be because the public key is not in your keyr= ing) Should I prepend "guix refresh: " to the question? # ./pre-inst-env guix refresh -u [...] ftp://ftp.gnu.org/.../guile-2.0.9.tar.gz.sig 100.0% of 0.2 KiB gpg: Signature made Wed 10 Apr 2013 06:14:45 AM UTC using DSA key ID EA52EC= F4 gpg: Can't check signature: No public key Would you like to download this key and add it to your keyring? y gpg: requesting key EA52ECF4 from hkp server pgp.mit.edu gpg: key EA52ECF4: public key "Ludovic Court=C3=A8s " imported gpg: no ultimately trusted keys found gpg: Total number processed: 1 gpg: imported: 1 gpg: Signature made Wed 10 Apr 2013 06:14:45 AM UTC using DSA key ID EA52EC= F4 gpg: Good signature from "Ludovic Court=C3=A8s " gpg: aka "Ludovic Court=C3=A8s " gpg: aka "Ludovic Court=C3=A8s " gpg: aka "Ludovic Court=C3=A8s (INRIA) " gpg: WARNING: This key is not certified with a trusted signature! gpg: There is no indication that the signature belongs to the owne= r. Primary key fingerprint: 83C4 F8E5 10A3 3B4C 5BEA D15D 77DD 95E2 EA52 ECF4 gnu/packages/guile.scm:49:12: guile: updating from version 1.8.8 to version= 2.0.9... # ./pre-inst-env guix refresh -u --key-download=3Dnever [...] ftp://ftp.gnu.org/.../guile-2.0.9.tar.gz.sig 100.0% of 0.2 KiB gpg: Signature made Wed 10 Apr 2013 06:14:45 AM UTC using DSA key ID EA52EC= F4 gpg: Can't check signature: No public key guix refresh: warning: signature verification failed for `guile-2.0.9.tar.g= z' guix refresh: warning: (could be because the public key is not in your keyr= ing) # ./pre-inst-env guix refresh -u --key-download=3Dalways [...] ftp://ftp.gnu.org/.../guile-2.0.9.tar.gz.sig 100.0% of 0.2 KiB gpg: Signature made Wed 10 Apr 2013 06:14:45 AM UTC using DSA key ID EA52EC= F4 gpg: Can't check signature: No public key gpg: requesting key EA52ECF4 from hkp server pgp.mit.edu gpg: key EA52ECF4: public key "Ludovic Court=C3=A8s " imported gpg: no ultimately trusted keys found gpg: Total number processed: 1 gpg: imported: 1 gpg: Signature made Wed 10 Apr 2013 06:14:45 AM UTC using DSA key ID EA52EC= F4 gpg: Good signature from "Ludovic Court=C3=A8s " gpg: aka "Ludovic Court=C3=A8s " gpg: aka "Ludovic Court=C3=A8s " gpg: aka "Ludovic Court=C3=A8s (INRIA) " gpg: WARNING: This key is not certified with a trusted signature! gpg: There is no indication that the signature belongs to the owne= r. Primary key fingerprint: 83C4 F8E5 10A3 3B4C 5BEA D15D 77DD 95E2 EA52 ECF4 gnu/packages/guile.scm:49:12: guile: updating from version 1.8.8 to version= 2.0.9... # ./pre-inst-env guix refresh -u --key-download=3Dinteractive ftp://ftp.gnu.org/.../guile-2.0.9.tar.gz.sig 100.0% of 0.2 KiB gpg: Signature made Wed 10 Apr 2013 06:14:45 AM UTC using DSA key ID EA52EC= F4 gpg: Can't check signature: No public key Would you like to download this key and add it to your keyring? n guix refresh: warning: signature verification failed for `guile-2.0.9.tar.g= z' guix refresh: warning: (could be because the public key is not in your keyr= ing) # ./pre-inst-env guix refresh -u --key-download=3Dinteractive ftp://ftp.gnu.org/.../guile-2.0.9.tar.gz.sig 100.0% of 0.2 KiB gpg: Signature made Wed 10 Apr 2013 06:14:45 AM UTC using DSA key ID EA52EC= F4 gpg: Can't check signature: No public key Would you like to download this key and add it to your keyring? y gpg: requesting key EA52ECF4 from hkp server pgp.mit.edu gpg: key EA52ECF4: public key "Ludovic Court=C3=A8s " imported gpg: no ultimately trusted keys found gpg: Total number processed: 1 gpg: imported: 1 gpg: Signature made Wed 10 Apr 2013 06:14:45 AM UTC using DSA key ID EA52EC= F4 gpg: Good signature from "Ludovic Court=C3=A8s " gpg: aka "Ludovic Court=C3=A8s " gpg: aka "Ludovic Court=C3=A8s " gpg: aka "Ludovic Court=C3=A8s (INRIA) " gpg: WARNING: This key is not certified with a trusted signature! gpg: There is no indication that the signature belongs to the owne= r. Primary key fingerprint: 83C4 F8E5 10A3 3B4C 5BEA D15D 77DD 95E2 EA52 ECF4 gnu/packages/guile.scm:49:12: guile: updating from version 1.8.8 to version= 2.0.9... # ./pre-inst-env guix refresh -u --key-download=3Dfoo guix refresh: error: unsupported policy: foo --=-=-= 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=20394191811139e66183309bc44979b146d6a9f969 Mon Sep 17 00:00:00 2001 From: Nikita Karetnikov Date: Fri, 7 Jun 2013 04:14:17 +0000 Subject: [PATCH] guix refresh: Add '--key-download'. * guix/gnu-maintenance.scm (download-tarball, package-update): Add 'key-download'. guix/gnupg.scm (gnupg-verify*): Add 'key-download' and adjust 'gnupg-verify*' accordingly. guix/scripts/refresh.scm (show-help, %options): Add and document '--key-download'. (update-package): Add 'key-download'. (guix-refresh): Adjust to handle 'key-download'. =2D-- guix/gnu-maintenance.scm | 17 ++++++--- guix/gnupg.scm | 38 ++++++++++++++++++---- guix/scripts/refresh.scm | 79 +++++++++++++++++++++++++++++-------------= ---- 3 files changed, 92 insertions(+), 42 deletions(-) diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm index b54cd84..0f1a05b 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")) + #:optional (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))) (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 #:optional (key-download 'interacti= ve)) "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,7 @@ 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 key-download))) (values version tarball)))) (_ (values #f #f)))) diff --git a/guix/gnupg.scm b/guix/gnupg.scm index c17a495..5396f20 100644 =2D-- a/guix/gnupg.scm +++ b/guix/gnupg.scm @@ -21,7 +21,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 +147,38 @@ 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 + #:optional (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))) =2D (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)))= ))))) + (define (download-and-try-again) + (begin + ;; Download the missing key and try again. + (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 + (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..f54b5ad 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 #:optional (key-download 'interacti= ve)) + "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)) (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) + 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) iQIcBAEBAgAGBQJRsW8gAAoJEM+IQzI9IQ38CgMP/RgD2z+XSK/eFMat6Gx69kGw BGUw3OSo6WZqdJC9msiQZ80mnJ+iHg+44UBx9Yckh0TPYqUM4RQRjyA8L6FZuox1 M0t8JF6Y7Es8J8azJstd8N3LIXcE97HKjOZ8aX5YMmS9HKS7pE2Tmuo9sN33gcgw i5qrSEUsMBzMk/jOGFo3Z987kEoy/gP0ldzVAZtUn7MqLIyl8WDzR530bwxLleAI YHCnVkFCcITjPRhUEi4bS1DbBuX/VlJ0PcZTkIhmVQL0ZbMn9Hnvks5+SNEW6EVx 5T8N3W5Gr4SjOYhurYXi2HZVBSXiqEgnOh9PCK4jF3952eqxOibtuZ0OCGuUCQ04 eaYjYbTrlkprdriaerjvXnW6mStT+wqQHKz6RA2LCTWV3ydTtDPvzoeYV2MOJbpe tm2jIJ/+CClhTeEPeFwrxsvzm5gzxbfTlNixbyADFlbbSghSvnDEpT1InHwCVZMT 3nC8e2xrTMrzTSl/nvpcVqKvYrl/FOGhFv7FJjGIc/qC6UdXGgAlv5YlIHp5IQt7 RDNVX/knYYFQLyhqd/Sgahh7Ahkk5los2NiM+nxrOuGGERvj79wsZywRJVdfSomF LVgyO78Owgt66H5qkuyWzlv6SHL7RdTSTtSqjNRpHXe9kZhLljrEsXkBkcVXIn2s ftoVkR1IN+zhbuU8x31U =Rgf8 -----END PGP SIGNATURE----- --==-=-=--