From mboxrd@z Thu Jan 1 00:00:00 1970 From: Nikita Karetnikov Subject: Re: New =?utf-8?Q?=E2=80=9Cguix_refresh=E2=80=9D?= command Date: Thu, 30 May 2013 04:46:21 +0400 Message-ID: <877gih2t2a.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> Mime-Version: 1.0 Content-Type: multipart/signed; boundary="==-=-="; micalg=pgp-sha1; protocol="application/pgp-signature" Return-path: Received: from eggs.gnu.org ([208.118.235.92]:45195) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Uhqxh-0000Ph-Tv for bug-guix@gnu.org; Wed, 29 May 2013 20:43:33 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1Uhqxa-0000Lk-Vs for bug-guix@gnu.org; Wed, 29 May 2013 20:43:25 -0400 In-Reply-To: <87y5b4y1vp.fsf@gnu.org> ("Ludovic =?utf-8?Q?Court=C3=A8s=22'?= =?utf-8?Q?s?= message of "Fri, 24 May 2013 14:54:18 +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 > That could be done by changing =E2=80=98gnupg-verify*=E2=80=99. An optio= nal argument > could be added to select between interactive behavior (=E2=80=9Cdo you wa= nt to > download this key and add it to your keyring?=E2=80=9D), always-download,= and > never-download. I'm attaching my attempt. There are two similar but unrelated problems: 1. The following function doesn't print the message. (begin (format #t (_ "~a~a~!") "Would you like to download this key " "and add it to your keyring? (y/N) ") (read-line)) 2. 'else' doesn't work. (else (and (receive?) (download-and-try-again))) # which gpg2 /root/.guix-profile/bin/gpg2 # gpg2 --delete-key EA52ECF4 # ./pre-inst-env guix refresh -u accepted connection from pid 7779, uid 0 starting download of `guix-file.RAA3r7' from `ftp://ftp.gnu.org//gnu/guile/= guile-2.0.9.tar.gz'... ftp://ftp.gnu.org/.../guile-2.0.9.tar.gz 100.0% of 7163.4 KiB starting download of `guix-file.gJlE96' from `ftp://ftp.gnu.org//gnu/guile/= guile-2.0.9.tar.gz.sig'... 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 (It should print the above message here, but it always tries to download GCC instead.) starting download of `guix-file.ZkDiI7' from `ftp://ftp.gnu.org//gnu/gcc/gc= c-4.8.0/gcc-4.8.0.tar.bz2'... To-do list: 1. Any argument except 'always', 'never', and 'interactive' should raise an error. 2. Fetch signatures first and don't download tarballs which can't be authenticated (when signatures are missing and 'never' is used). 3. How should I change 'receive?' to support i18n? Anything else? --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=download-sigs.diff Content-Transfer-Encoding: quoted-printable diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm index b54cd84..04d72d3 100644 =2D-- a/guix/gnu-maintenance.scm +++ b/guix/gnu-maintenance.scm @@ -24,6 +24,7 @@ #:use-module (ice-9 regex) #:use-module (ice-9 rdelim) #:use-module (ice-9 match) + #:use-module (ice-9 optargs) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) @@ -341,7 +342,7 @@ pairs. Example: (\"mit-scheme-9.0.1\" . \"/gnu/mit-sch= eme/stable.pkg/9.0.1\"). (_ #f)))) =20 (define* (download-tarball store project directory version =2D #:optional (archive-type "gz")) + #:optional (archive-type "gz") download-sigs) "Download PROJECT's tarball over FTP and check its OpenPGP signature. On success, return the tarball file name." (let* ((server (ftp-server/directory project)) @@ -350,7 +351,7 @@ success, return the tarball file name." (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 download-sigs))) (if ret tarball (begin @@ -359,7 +360,7 @@ 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 download-sigs) "Return the new version and the file name of the new version tarball for PACKAGE, or #f and #f when PACKAGE is up-to-date." (match (package-update-path package) @@ -372,7 +373,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 download-sigs))) (values version tarball)))) (_ (values #f #f)))) diff --git a/guix/gnupg.scm b/guix/gnupg.scm index c17a495..8d2a7e6 100644 =2D-- a/guix/gnupg.scm +++ b/guix/gnupg.scm @@ -17,6 +17,7 @@ ;;; along with GNU Guix. If not, see . =20 (define-module (guix gnupg) + #:use-module (ice-9 format) #:use-module (ice-9 popen) #:use-module (ice-9 match) #:use-module (ice-9 regex) @@ -145,16 +146,42 @@ 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 download-sigs + (server (%openpgp-key-server))) "Like `gnupg-verify', but try downloading the public key if it's missing. Return #t if the signature was good, #f otherwise." (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?) + (string=3D? "y" ; XXX: i18n + + ;; XXX: Doesn't print the message. + ;; (begin (format #t (_ "~a~a~!") + ;; "Would you like to download this k= ey " + ;; "and add it to your keyring? (y/N)= ") + ;; (read-line)))) + + (begin (format #t "~a~a~!" + "Would you like to download this key " + "and add it to your keyring? (y/N) ") + (read-line)))) + + (and + missing + ;; XXX: 'else' doesn't work. + (cond ((string=3D? download-sigs "always") + (download-and-try-again)) + ((string=3D? download-sigs "never") + #f) + (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..9beeddc 100644 =2D-- a/guix/scripts/refresh.scm +++ b/guix/scripts/refresh.scm @@ -27,6 +27,7 @@ #:use-module ((gnu packages base) #:select (%final-inputs)) #:use-module (ice-9 match) #:use-module (ice-9 regex) + #:use-module (ice-9 optargs) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) @@ -64,6 +65,9 @@ (option '("gpg") #t #f (lambda (opt name arg result) (alist-cons 'gpg-command arg result))) + (option '(#\d "download-sigs") #t #f + (lambda (opt name arg result) + (alist-cons 'download-sigs arg result))) =20 (option '(#\h "help") #f #f (lambda args @@ -79,7 +83,11 @@ Update package definitions to match the latest upstream = version. =20 When PACKAGE... is given, update only the specified packages. Otherwise update all the packages of the distribution, or the subset thereof =2Dspecified with `--select'.\n")) +specified with `--select'. + +'download-sigs' accepts one of the following arguments: 'interactive', +'always', and 'never'. When 'download-sigs' is not specified, assume +'interactive'.\n")) (display (_ " -u, --update update source files in place")) (display (_ " @@ -90,6 +98,9 @@ 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 (_ " + -d, --download-sigs=3DARG + download and add signatures to your keyring")) (newline) (display (_ " -h, --help display this help and exit")) @@ -98,12 +109,12 @@ specified with `--select'.\n")) (newline) (show-bug-report-information)) =20 =2D(define (update-package store package) +(define* (update-package store package #:optional download-sigs) "Update the source file that defines PACKAGE with the new version." (let-values (((version tarball) (catch #t (lambda () =2D (package-update store package)) + (package-update store package download-sigs)) (lambda _ (values #f #f)))) ((loc) @@ -161,31 +172,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?)) + (download-sigs (assoc-ref opts 'download-sigs)) + (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 +208,7 @@ 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 <> download-sigs) packag= es))) (for-each (lambda (package) (match (false-if-exception (package-update-path pack= age)) ((new-version . directory) --=-=-=-- --==-=-= Content-Type: application/pgp-signature -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.4.10 (GNU/Linux) iQIcBAEBAgAGBQJRpqFiAAoJEM+IQzI9IQ38yywP/R/Tt6+QZZXWirjI/naj8wEc BaTdacYdALvQor9c++TfLhSfvzNWKQq9NJyc1bvw4Atlh3DVu8Pi7wBowaxFubx3 2SA2VTkm20kCXeELagnKjy1aO59fwqUMRC5o0XFKINGEmvtgSdF0mwZI4OkSgl3d lihLLQfybEAd8yUQ2jjvZpExGeF9vnZPxDJAbx9/svEzo+bA1mvEs/ioeHm+ubik mHDh77+jVgWf4gM+t59GVZpzzckcOEfqAkxEtCOgnWa/T1mMlRSzpR5EQH+TyMSn CmdyqxlETCMslsdnDt/tr0DbRKebpMGtMNwwJ0kjhJ4thkfU3yZCLW0RhrvLyLh2 8lFfmT52Dpd9yy8MSz7bo7HKCxvulHPF5nWRxNPnQANKbgSdUgXhcs3XpCwV9pG3 xIaZjqLb87iQYmCdndCDWTg5nqgdWhdN0+5JBNlJWuSQ22Zha12qjs3KEk9Lilig 963NONdAsLDWj6z2E9WyyMqL/ezQkNk2onmtMjLZAYdGsGAvKUFoH1kBA8n5Frzl 55MObNgORNw19P8om2sUseW1OjXWrRbXmQvihvnVxBxPl2OgNAupt8V2AFvDl+TL CgYC921sX/PVcbvL2rlsIQcxyJNIdrVKO9WEmRqhy+zovqoIgzcA+pefHEGRNULv 12gupg3gcJ7lCQ5WQ1Db =1t2R -----END PGP SIGNATURE----- --==-=-=--