=== modified file 'lisp/emacs-lisp/package.el' --- lisp/emacs-lisp/package.el 2013-06-22 20:09:19 +0000 +++ lisp/emacs-lisp/package.el 2013-06-23 11:44:08 +0000 @@ -164,6 +164,7 @@ (eval-when-compile (require 'cl-lib)) +(require 'epg nil t) (require 'tabulated-list) (defgroup package nil @@ -228,6 +229,16 @@ :group 'package :version "24.1") +;; TODO: maybe base this on the existence of etc/elpa/ARCHIVE.gpgsig +(defcustom package-unsigned-archives nil + "An list of archives whose contents are not signed. + +Signed archives trigger verification of each package's contents." + :type '(list string :tag "Archive name") + :risky t + :group 'package + :version "24.4") + (defcustom package-pinned-packages nil "An alist of packages that are pinned to a specific archive @@ -692,21 +703,39 @@ (let ((buffer-file-coding-system 'no-conversion)) (write-region (point-min) (point-max) file-name))) -(defmacro package--with-work-buffer (location file &rest body) - "Run BODY in a buffer containing the contents of FILE at LOCATION. -LOCATION is the base location of a package archive, and should be -one of the URLs (or file names) specified in `package-archives'. -FILE is the name of a file relative to that base location. - -This macro retrieves FILE from LOCATION into a temporary buffer, +(defun package-archive-signed-p (archive) + "Returns whether ARCHIVE is signed. +ARCHIVE is specified in `package-archives'." + (not (member (car archive) package-unsigned-archives))) + +(defmacro package--with-work-buffer (archive file &rest body) + "Run BODY in a buffer containing the contents of FILE from ARCHIVE. +ARCHIVE is a package archive specified in `package-archives'. +FILE is the name of a file relative to that archive's location. + +This macro retrieves FILE from ARCHIVE into a temporary buffer, and evaluates BODY while that buffer is current. This work -buffer is killed afterwards. Return the last value in BODY." +buffer is killed afterwards. Return the last value in BODY. + +If ARCHIVE is not in `package-unsigned-archives', FILE.gpg is +verified against FILE." (declare (indent 2) (debug t)) - `(let* ((http (string-match "\\`https?:" ,location)) + `(let* ((archive-name (car ,archive)) + (location (cdr ,archive)) + (sign-file (concat ,file ".gpgsig")) + (http (string-match "\\`https?:" location)) + (sign (when (package-archive-signed-p ,archive) + (concat location sign-file))) (buffer (if http - (url-retrieve-synchronously (concat ,location ,file)) - (generate-new-buffer "*package work buffer*")))) + (url-retrieve-synchronously (concat location ,file)) + (generate-new-buffer "*package work buffer*"))) + (sign-buffer (when sign + (if http + ;; Retrieve the signature file too. + (url-retrieve-synchronously + (concat location sign-file)) + (generate-new-buffer "*package sign buffer*"))))) (prog1 (with-current-buffer buffer (if http @@ -714,12 +743,49 @@ (re-search-forward "^$" nil 'move) (forward-char) (delete-region (point-min) (point))) - (unless (file-name-absolute-p ,location) + (unless (file-name-absolute-p location) (error "Archive location %s is not an absolute file name" - ,location)) - (insert-file-contents (expand-file-name ,file ,location))) + location)) + (insert-file-contents (expand-file-name ,file location))) + (when sign-buffer + (with-current-buffer sign-buffer + (if http + (progn (package-handle-response) + (re-search-forward "^$" nil 'move) + (forward-char) + (delete-region (point-min) (point))) + ;; No need to check the location again like we did above. + (insert-file-contents (expand-file-name sign-file location))) + (unless (package--verify-signature archive sign-buffer buffer) + (let ((q (format "Can't verify .gpgsig for %s" + (concat location ,file)))) + (unless (y-or-n-p (concat q "; continue? (y/n)")) + (error q)))))) ,@body) - (kill-buffer buffer)))) + (kill-buffer buffer) + (when sign-buffer + (kill-buffer sign-buffer))))) + +(defun package--verify-signature (archive sign-buffer buffer) + "Verify SIGN-BUFFER signs BUFFER correctly for ARCHIVE. + +The signing key may be specifically indicated later, but right +now we let EPG determine which one to use." + (let ((ctx (epg-make-context)) + (signature (with-current-buffer sign-buffer + (buffer-string))) + (data (with-current-buffer buffer + (buffer-string)))) + (epg-verify-string ctx signature data))) + +(defun package--create-detached-signature (file) + "Create FILE.gpgsig for FILE using EPG." + (unless (featurep 'epg) + (error "Sorry, EPG could not be loaded.")) + (let ((sig (concat file ".gpgsig")) + (ctx (epg-make-context))) + (epg-sign-file ctx file sig 'detached) + sig)) (defun package-handle-response () "Handle the response from a `url-retrieve-synchronously' call. @@ -736,10 +802,9 @@ (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) + (let ((file (concat (package-desc-full-name pkg-desc) (package-desc-suffix pkg-desc)))) - (package--with-work-buffer location file + (package--with-work-buffer (package-archive-for pkg-desc) file (package-unpack pkg-desc)))) (defvar package--initialized nil) @@ -864,6 +929,7 @@ (defun package--add-to-archive-contents (package archive) "Add the PACKAGE from the given ARCHIVE if necessary. PACKAGE should have the form (NAME . PACKAGE--AC-DESC). + Also, add the originating archive to the `package-desc' structure." (let* ((name (car package)) (version (package--ac-desc-version (cdr package))) @@ -1054,8 +1120,12 @@ (package-desc-full-name pkg-desc))))) (defun package-archive-base (desc) - "Return the archive containing the package NAME." - (cdr (assoc (package-desc-archive desc) package-archives))) + "Return the archive location containing the package DESC." + (cdr (package-archive-for desc))) + +(defun package-archive-for (desc) + "Return the archive containing the package DESC." + (assoc (package-desc-archive desc) package-archives)) (defun package--download-one-archive (archive file) "Retrieve an archive file FILE from ARCHIVE, and cache it. @@ -1064,7 +1134,7 @@ \"archives/NAME/archive-contents\" in `package-user-dir'." (let* ((dir (expand-file-name (format "archives/%s" (car archive)) package-user-dir))) - (package--with-work-buffer (cdr archive) file + (package--with-work-buffer archive file ;; Read the retrieved buffer to make sure it is valid (e.g. it ;; may fetch a URL redirect page). (when (listp (read buffer)) @@ -1187,7 +1257,11 @@ 'font-lock-face 'font-lock-builtin-face) " Alternate version available") (insert "Available")) - (insert " from " archive) + (insert " from " (if (package-archive-signed-p + (assoc archive package-archives)) + "signed" + "unsigned") + " " archive) (insert " -- ") (let ((button-text (if (display-graphic-p) "Install" "[Install]")) (button-face (if (display-graphic-p) @@ -1245,7 +1319,7 @@ ;; For elpa packages, try downloading the commentary. If that ;; fails, try an existing readme file in `package-user-dir'. (cond ((condition-case nil - (package--with-work-buffer (package-archive-base desc) + (package--with-work-buffer (package-archive-for desc) (concat package-name "-readme.txt") (setq buffer-file-name (expand-file-name readme package-user-dir))