=== 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)