From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Daiki Ueno Newsgroups: gmane.emacs.devel Subject: [PATCHv2] package.el: check tarball signature Date: Wed, 02 Oct 2013 15:20:03 +0900 Message-ID: <87mwms9oto.fsf_-_-ueno@gnu.org> References: <83d2nqdqui.fsf@gnu.org> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: ger.gmane.org 1380694816 4370 80.91.229.3 (2 Oct 2013 06:20:16 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Wed, 2 Oct 2013 06:20:16 +0000 (UTC) Cc: emacs-devel@gnu.org To: Eli Zaretskii Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Wed Oct 02 08:20:19 2013 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1VRFnG-0003qc-2u for ged-emacs-devel@m.gmane.org; Wed, 02 Oct 2013 08:20:18 +0200 Original-Received: from localhost ([::1]:34054 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1VRFnF-00035Z-DA for ged-emacs-devel@m.gmane.org; Wed, 02 Oct 2013 02:20:17 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:36414) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1VRFn9-00034v-TH for emacs-devel@gnu.org; Wed, 02 Oct 2013 02:20:14 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1VRFn7-0005t2-TY for emacs-devel@gnu.org; Wed, 02 Oct 2013 02:20:11 -0400 Original-Received: from fencepost.gnu.org ([2001:4830:134:3::e]:42060) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1VRFn7-0005sx-Nw for emacs-devel@gnu.org; Wed, 02 Oct 2013 02:20:09 -0400 Original-Received: from du-a.org ([2001:e41:db5e:fb14::1]:37557 helo=debian) by fencepost.gnu.org with esmtpsa (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1VRFn6-0005BE-8m; Wed, 02 Oct 2013 02:20:08 -0400 In-Reply-To: <83d2nqdqui.fsf@gnu.org> (Eli Zaretskii's message of "Mon, 30 Sep 2013 22:58:13 +0300") User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/23.4 (gnu/linux) X-detected-operating-system: by eggs.gnu.org: Error: Malformed IPv6 address (bad octet value). X-Received-From: 2001:4830:134:3::e X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.14 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:163793 Archived-At: --=-=-= Hi, Thanks for the suggestion. (Sorry for the delay, I'm just back from Boston ;-) Eli Zaretskii writes: > Thanks, but please add a defcustom to disable this check (e.g., > because gnupg isn't installed, and isn't going to be). Done. Now it has package-check-signature option, which can be set either: nil (no signature verification), t (always check signature), or allow-unsigned (skip signature verification if no .sig file is provided, default). Actually I wondered whether it should be a per-archive option rather than a global option. But I'd leave it as global, for simplicity. > In general, I think .sig files are there for those who want to verify > the packages, but users should not be forced to do that as a > prerequisite for downloading. (And no, the y-or-n-p question doesn't > cut it: it's a nuisance to have to answer that question every time.) Agreed. Removed the y-or-n-p question. Other than those, I changed a bit: * display "unsigned" status on the package listing and the description buffer. * fixed the verification logic. The .sig file might contain multiple signatures and it should be considered as verified when one of those is good. * import the default keyring from /package-keyring.gpg. --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=package-signature.patch === modified file 'lisp/emacs-lisp/package.el' --- lisp/emacs-lisp/package.el 2013-10-01 15:52:53 +0000 +++ lisp/emacs-lisp/package.el 2013-10-02 05:48:13 +0000 @@ -206,6 +206,7 @@ (defvar Info-directory-list) (declare-function info-initialize "info" ()) (declare-function url-http-parse-response "url-http" ()) +(declare-function url-http-file-exists-p "url-http" (url)) (declare-function lm-header "lisp-mnt" (header)) (declare-function lm-commentary "lisp-mnt" (&optional file)) (defvar url-http-end-of-headers) @@ -285,6 +286,15 @@ :group 'package :version "24.1") +(defcustom package-check-signature 'allow-unsigned + "Whether to check package signatures when installing." + :type '(choice (const nil :tag "Never") + (const allow-unsigned :tag "Allow unsigned") + (const t :tag "Check always")) + :risky t + :group 'package + :version "24.1") + (defvar package--default-summary "No description available.") (cl-defstruct (package-desc @@ -340,7 +350,9 @@ `dir' The directory where the package is installed (if installed), `builtin' if it is built-in, or nil otherwise. -`extras' Optional alist of additional keyword-value pairs." +`extras' Optional alist of additional keyword-value pairs. + +`signed' Flag to indicate that the package is signed by provider." name version (summary package--default-summary) @@ -348,7 +360,8 @@ kind archive dir - extras) + extras + signed) ;; Pseudo fields. (defun package-desc-full-name (pkg-desc) @@ -428,7 +441,8 @@ (defun package-load-descriptor (pkg-dir) "Load the description file in directory PKG-DIR." (let ((pkg-file (expand-file-name (package--description-file pkg-dir) - pkg-dir))) + pkg-dir)) + (signed-file (concat pkg-dir ".signed"))) (when (file-exists-p pkg-file) (with-temp-buffer (insert-file-contents pkg-file) @@ -436,6 +450,8 @@ (let ((pkg-desc (package-process-define-package (read (current-buffer)) pkg-file))) (setf (package-desc-dir pkg-desc) pkg-dir) + (if (file-exists-p signed-file) + (setf (package-desc-signed pkg-desc) t)) pkg-desc))))) (defun package-load-all-descriptors () @@ -766,13 +782,90 @@ (error "Error during download request:%s" (buffer-substring-no-properties (point) (line-end-position)))))) +(defun package--archive-file-exists-p (location file) + (let ((http (string-match "\\`https?:" location))) + (if http + (progn + (require 'url-http) + (url-http-file-exists-p (concat location file))) + (file-exists-p (expand-file-name location file))))) + +(declare-function epg-make-context "epg" + (&optional protocol armor textmode include-certs + cipher-algorithm + digest-algorithm + compress-algorithm)) +(declare-function epg-context-set-home-directory "epg" (context directory)) +(declare-function epg-verify-string "epg" (context signature + &optional signed-text)) +(declare-function epg-context-result-for "epg" (context name)) +(declare-function epg-signature-status "epg" (signature)) +(declare-function epg-signature-to-string "epg" (signature)) + +(defun package--check-signature (pkg-desc) + "Check signature of a package. +GnuPG keyring is located under \"gnupg\" in `package-user-dir'." + (let ((location (package-archive-base pkg-desc)) + (context (epg-make-context 'OpenPGP)) + (homedir (expand-file-name "gnupg" package-user-dir)) + (sig-file (concat (package-desc-full-name pkg-desc) + (package-desc-suffix pkg-desc) + ".sig")) + sig-content + good-signatures) + (condition-case-unless-debug error + (setq sig-content (package--with-work-buffer location sig-file + (buffer-string))) + (error "Failed to download %s: %S" sig-file (cdr error))) + (epg-context-set-home-directory context homedir) + (epg-verify-string context sig-content (buffer-string)) + ;; The .sig file may contain multiple signatures. Success if one + ;; of the signatures is good. + (setq good-signatures + (delq nil (mapcar (lambda (sig) + (if (eq (epg-signature-status sig) 'good) + sig)) + (epg-context-result-for context 'verify)))) + (if (null good-signatures) + (error "Failed to verify signature %s: %S" + sig-file + (mapcar #'epg-signature-to-string + (epg-context-result-for context 'verify)))))) + (defun package-install-from-archive (pkg-desc) "Download and install a tar package." (let ((location (package-archive-base pkg-desc)) (file (concat (package-desc-full-name pkg-desc) - (package-desc-suffix pkg-desc)))) + (package-desc-suffix pkg-desc))) + (sig-file (concat (package-desc-full-name pkg-desc) + (package-desc-suffix pkg-desc) + ".sig")) + signed pkg-descs) (package--with-work-buffer location file - (package-unpack pkg-desc)))) + (if package-check-signature + (if (package--archive-file-exists-p location sig-file) + (progn + (package--check-signature pkg-desc) + (setq signed t)) + (unless (eq package-check-signature 'allow-unsigned) + (error "Unsigned package: `%s'" + (package-desc-name pkg-desc))))) + (package-unpack pkg-desc)) + ;; Here the package has been installed successfully, mark it as + ;; signed if appropriate. + (when signed + ;; Create an empty NAME-VERSION.signed file, which indicates the + ;; signature of the package was verified on installation. + (write-region "" nil (expand-file-name + (concat (package-desc-full-name pkg-desc) + ".signed") + package-user-dir)) + ;; Update the old pkg-desc which will be shown on the description buffer. + (setf (package-desc-signed pkg-desc) t) + ;; Update the new (activated) pkg-desc as well. + (setq pkg-descs (cdr (assq (package-desc-name pkg-desc) package-alist))) + (if pkg-descs + (setf (package-desc-signed (car pkg-descs)) t))))) (defvar package--initialized nil) @@ -1145,6 +1238,21 @@ (car archive))))) (package-read-all-archive-contents)) +(declare-function epg-check-configuration "epg-config" + (config &optional minimum-version)) +(declare-function epg-configuration "epg-config" ()) +(declare-function epg-import-keys-from-file "epg" (context keys)) + +(defun package--import-default-keyring () + (let* ((context (epg-make-context 'OpenPGP)) + (homedir (expand-file-name "gnupg" package-user-dir)) + (default-keyring (expand-file-name "package-keyring.gpg" + data-directory))) + (when (file-exists-p default-keyring) + (make-directory homedir t) + (epg-context-set-home-directory context homedir) + (epg-import-keys-from-file context default-keyring)))) + ;;;###autoload (defun package-initialize (&optional no-activate) "Load Emacs Lisp packages, and activate them. @@ -1157,6 +1265,11 @@ (unless no-activate (dolist (elt package-alist) (package-activate (car elt)))) + (condition-case-unless-debug nil + (progn + (epg-check-configuration (epg-configuration)) + (package--import-default-keyring)) + (error (message "Cannot import default keyring"))) (setq package--initialized t)) @@ -1209,7 +1322,8 @@ (homepage (if desc (cdr (assoc :url (package-desc-extras desc))))) (built-in (eq pkg-dir 'builtin)) (installable (and archive (not built-in))) - (status (if desc (package-desc-status desc) "orphan"))) + (status (if desc (package-desc-status desc) "orphan")) + (signed (if desc (package-desc-signed desc)))) (prin1 name) (princ " is ") (princ (if (memq (aref status 0) '(?a ?e ?i ?o ?u)) "an " "a ")) @@ -1233,9 +1347,11 @@ (not (package-built-in-p name version))) (insert "',\n shadowing a " (propertize "built-in package" - 'font-lock-face 'font-lock-builtin-face) - ".") - (insert "'."))) + 'font-lock-face 'font-lock-builtin-face)) + (insert "'")) + (if signed + (insert ".") + (insert " (unsigned)."))) (installable (insert (capitalize status)) (insert " from " (format "%s" archive)) @@ -1449,7 +1565,8 @@ (dir (package-desc-dir pkg-desc)) (lle (assq name package-load-list)) (held (cadr lle)) - (version (package-desc-version pkg-desc))) + (version (package-desc-version pkg-desc)) + (signed (package-desc-signed pkg-desc))) (cond ((eq dir 'builtin) "built-in") ((and lle (null held)) "disabled") @@ -1463,7 +1580,9 @@ (dir ;One of the installed packages. (cond ((not (file-exists-p (package-desc-dir pkg-desc))) "deleted") - ((eq pkg-desc (cadr (assq name package-alist))) "installed") + ((eq pkg-desc (cadr (assq name package-alist))) (if signed + "installed" + "unsigned")) (t "obsolete"))) (t (let* ((ins (cadr (assq name package-alist))) @@ -1473,7 +1592,9 @@ (if (memq name package-menu--new-package-list) "new" "available")) ((version-list-< version ins-v) "obsolete") - ((version-list-= version ins-v) "installed"))))))) + ((version-list-= version ins-v) (if signed + "installed" + "unsigned")))))))) (defun package-menu--refresh (&optional packages) "Re-populate the `tabulated-list-entries'. @@ -1532,6 +1653,7 @@ (`"held" 'font-lock-constant-face) (`"disabled" 'font-lock-warning-face) (`"installed" 'font-lock-comment-face) + (`"unsigned" 'font-lock-warning-face) (_ 'font-lock-warning-face)))) ; obsolete. (list pkg-desc (vector (list (symbol-name (package-desc-name pkg-desc)) @@ -1570,7 +1692,7 @@ (defun package-menu-mark-delete (&optional _num) "Mark a package for deletion and move to the next line." (interactive "p") - (if (member (package-menu-get-status) '("installed" "obsolete")) + (if (member (package-menu-get-status) '("installed" "obsolete" "unsigned")) (tabulated-list-put-tag "D" t) (forward-line))) @@ -1738,6 +1860,8 @@ ((string= sB "available") nil) ((string= sA "installed") t) ((string= sB "installed") nil) + ((string= sA "unsigned") t) + ((string= sB "unsigned") nil) ((string= sA "held") t) ((string= sB "held") nil) ((string= sA "built-in") t) --=-=-= Regards, -- Daiki Ueno --=-=-=--