From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Ted Zlatanov Newsgroups: gmane.emacs.devel Subject: Re: ELPA security Date: Sun, 16 Jun 2013 07:18:56 -0400 Organization: =?utf-8?B?0KLQtdC+0LTQvtGAINCX0LvQsNGC0LDQvdC+0LI=?= @ Cienfuegos Message-ID: References: <8738zf70ep.fsf@riseup.net> <871uejlbm1.fsf@lifelogs.com> <87k3rrr31g.fsf@Rainer.invalid> <874nium8h0.fsf@lifelogs.com> <87zk0ljaub.fsf@lifelogs.com> <87wqvng299.fsf@lifelogs.com> <87ip77y2s9.fsf@Rainer.invalid> Reply-To: emacs-devel@gnu.org NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: ger.gmane.org 1371381561 12789 80.91.229.3 (16 Jun 2013 11:19:21 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Sun, 16 Jun 2013 11:19:21 +0000 (UTC) To: emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Sun Jun 16 13:19:17 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 1UoAzM-0006Su-0Y for ged-emacs-devel@m.gmane.org; Sun, 16 Jun 2013 13:19:16 +0200 Original-Received: from localhost ([::1]:47580 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1UoAzL-0005gH-IP for ged-emacs-devel@m.gmane.org; Sun, 16 Jun 2013 07:19:15 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:43313) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1UoAzG-0005fK-LF for emacs-devel@gnu.org; Sun, 16 Jun 2013 07:19:13 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1UoAzE-0006DH-TV for emacs-devel@gnu.org; Sun, 16 Jun 2013 07:19:10 -0400 Original-Received: from plane.gmane.org ([80.91.229.3]:40430) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1UoAzE-0006D9-I1 for emacs-devel@gnu.org; Sun, 16 Jun 2013 07:19:08 -0400 Original-Received: from list by plane.gmane.org with local (Exim 4.69) (envelope-from ) id 1UoAzD-0006K7-FM for emacs-devel@gnu.org; Sun, 16 Jun 2013 13:19:07 +0200 Original-Received: from 11.79-161-196.customer.lyse.net ([79.161.196.11]) by main.gmane.org with esmtp (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Sun, 16 Jun 2013 13:19:07 +0200 Original-Received: from tzz by 11.79-161-196.customer.lyse.net with local (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Sun, 16 Jun 2013 13:19:07 +0200 X-Injected-Via-Gmane: http://gmane.org/ Mail-Followup-To: emacs-devel@gnu.org Original-Lines: 238 Original-X-Complaints-To: usenet@ger.gmane.org X-Gmane-NNTP-Posting-Host: 11.79-161-196.customer.lyse.net X-Face: bd.DQ~'29fIs`T_%O%C\g%6jW)yi[zuz6; d4V0`@y-~$#3P_Ng{@m+e4o<4P'#(_GJQ%TT= D}[Ep*b!\e,fBZ'j_+#"Ps?s2!4H2-Y"sx" Mail-Copies-To: never User-Agent: Gnus/5.130008 (Ma Gnus v0.8) Emacs/24.3.50 (darwin) Cancel-Lock: sha1:jchvegEj16Q5q5lt0mJx7zZbACw= X-detected-operating-system: by eggs.gnu.org: Genre and OS details not recognized. X-Received-From: 80.91.229.3 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:160463 Archived-At: --=-=-= Content-Type: text/plain On Tue, 08 Jan 2013 15:59:33 -0500 Stefan Monnier wrote: >>> Actually, I see a problem with this scheme, now that we also keep around >>> older versions of the packages. So maybe it's better to keep the >>> signatures in a separate file, next to the signed file (e.g. have foo.tar >>> and foo.tar.gpgsig). >> Then maybe the file listed in the package vector should be the *.gpgsig >> one, since otherwise it becomes easy to bypass the check by filtering >> out any traces of the signature file. SM> Right, we'd need to indicate somewhere that the sig should be SM> present, indeed. SM> A simple way to do that is to tell package.el directly, e.g. via SM> `package-archives' or just by declaring that all ELPA archives should SM> always have such signatures (they're pretty easy to add, so I'd expect SM> marmalade and melpa to adjust pretty quickly). Please see the attached patch. The code is not ready for testing, it's just for review before I implement things further. Changes: * add `package-signed-archives', a list of logical archive names with default '("gnu"). Add `package-archive-signed-p' to check it. * change `package--with-work-buffer' to take an archive entry instead of just the location. When an archive is `package-archive-signed-p', create a signing buffer and load the archive filename with ".gpgsig" appended. Then call `package--verify-signature' on the package buffer and the signing buffer. If it fails, do `y-or-n-p', and if the user rejects, error out. * `package--verify-signature' is mocked to t right now, but will check the maintainer signature. * `package-download-single' and `package-download-tar' now pass the archive entry, not just the location, to `package--with-work-buffer' * rename `package-archive-base' to `package-archive-for' * installable packages say "signed" or "unsigned" before the archive name If you're OK with the code changes I'll get them working and start implementing `package--verify-signature'. Ted --=-=-= Content-Type: text/x-patch Content-Disposition: inline; filename=package-archive-signed.patch === modified file 'lisp/emacs-lisp/package.el' --- lisp/emacs-lisp/package.el 2013-06-15 15:36:11 +0000 +++ lisp/emacs-lisp/package.el 2013-06-16 11:05:16 +0000 @@ -229,6 +229,15 @@ :group 'package :version "24.1") +(defcustom package-signed-archives '("gnu") + "An list of archives whose contents are 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 @@ -699,20 +708,39 @@ nil nil nil 'excl)) (package--make-autoloads-and-compile name pkg-dir)))) -(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'. +(defun package-archive-signed-p (archive) + "Returns whether ARCHIVE is signed. +ARCHIVE is a package archive in the form (NAME . LOCATION) and should +be specified in `package-archives'." + (member (car archive) package-signed-archives)) + +(defmacro package--with-work-buffer (archive file &rest body) + "Run BODY in a buffer containing the contents of FILE at ARCHIVE. +ARCHIVE is a package archive in the form (NAME . LOCATION) and should +be 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, -and evaluates BODY while that buffer is current. This work -buffer is killed afterwards. Return the last value in BODY." - `(let* ((http (string-match "\\`https?:" ,location)) +This macro retrieves FILE from ARCHIVE into a temporary buffer, +checks its signature if the ARCHIVE is defined to be signed by +`package-signed-archives', and evaluates BODY while that buffer +is current. This work buffer is killed afterwards. Return the +last value in BODY." + `(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 url) + (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 @@ -720,12 +748,32 @@ (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." + t) (defun package-handle-response () "Handle the response from a `url-retrieve-synchronously' call. @@ -742,16 +790,16 @@ (defun package-download-single (name version desc requires) "Download and install a single-file package." - (let ((location (package-archive-base name)) + (let ((archive (package-archive-for name)) (file (concat (symbol-name name) "-" version ".el"))) - (package--with-work-buffer location file + (package--with-work-buffer archive file (package-unpack-single name version desc requires)))) (defun package-download-tar (name version) "Download and install a tar package." - (let ((location (package-archive-base name)) + (let ((archive (package-archive-for name)) (file (concat (symbol-name name) "-" version ".tar"))) - (package--with-work-buffer location file + (package--with-work-buffer archive file (package-unpack name version)))) (defvar package--initialized nil) @@ -875,6 +923,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))) @@ -1094,10 +1143,10 @@ (error "Package `%s' is a system package, not deleting" (package-desc-full-name pkg-desc))))) -(defun package-archive-base (name) +(defun package-archive-for (name) "Return the archive containing the package NAME." (let ((desc (cdr (assq (intern-soft name) package-archive-contents)))) - (cdr (assoc (package-desc-archive desc) package-archives)))) + (assoc (package-desc-archive desc) package-archives))) (defun package--download-one-archive (archive file) "Retrieve an archive file FILE from ARCHIVE, and cache it. @@ -1106,7 +1155,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)) @@ -1229,7 +1278,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) @@ -1287,7 +1340,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 package) + (package--with-work-buffer (package-archive-for package) (concat package-name "-readme.txt") (setq buffer-file-name (expand-file-name readme package-user-dir)) --=-=-=--