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, 23 Jun 2013 07:58:31 -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 1371988739 9658 80.91.229.3 (23 Jun 2013 11:58:59 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Sun, 23 Jun 2013 11:58:59 +0000 (UTC) Cc: Daiki Ueno To: emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Sun Jun 23 13:58:56 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 1UqiwZ-0003Hn-IU for ged-emacs-devel@m.gmane.org; Sun, 23 Jun 2013 13:58:55 +0200 Original-Received: from localhost ([::1]:42597 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1UqiwZ-0002is-56 for ged-emacs-devel@m.gmane.org; Sun, 23 Jun 2013 07:58:55 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:37618) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1UqiwU-0002im-NU for emacs-devel@gnu.org; Sun, 23 Jun 2013 07:58:53 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1UqiwS-0003tE-VW for emacs-devel@gnu.org; Sun, 23 Jun 2013 07:58:50 -0400 Original-Received: from plane.gmane.org ([80.91.229.3]:33479) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1UqiwS-0003rQ-Ku for emacs-devel@gnu.org; Sun, 23 Jun 2013 07:58:48 -0400 Original-Received: from list by plane.gmane.org with local (Exim 4.69) (envelope-from ) id 1UqiwP-00038z-TP for emacs-devel@gnu.org; Sun, 23 Jun 2013 13:58:45 +0200 Original-Received: from 138.62.236.28 ([138.62.236.28]) by main.gmane.org with esmtp (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Sun, 23 Jun 2013 13:58:45 +0200 Original-Received: from tzz by 138.62.236.28 with local (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Sun, 23 Jun 2013 13:58:45 +0200 X-Injected-Via-Gmane: http://gmane.org/ Mail-Followup-To: emacs-devel@gnu.org Original-Lines: 258 Original-X-Complaints-To: usenet@ger.gmane.org X-Gmane-NNTP-Posting-Host: 138.62.236.28 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:IgyVv4V9W0kujGsyBKjy3C2ro0U= 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:160907 Archived-At: --=-=-= Content-Type: text/plain On Wed, 19 Jun 2013 01:02:16 -0400 Ted Zlatanov wrote: TZ> etc/elpa/ARCHIVE-NAME can contain the actual armored GPG signature but TZ> it can also have more metadata about the archive. So the format could TZ> be: TZ> url=ARCHIVE-URL TZ> other-metadata=whatever TZ> then-a-new-line=ends metadata TZ> SIGNATURE TZ> and if SIGNATURE is missing, the archive is not signed. TZ> This would augment `package-archives' on startup and on demand. Any opinions here? For now I'm using the old format. Archives are signed by default as requested. I've rebased the patch against the changes to package.el. If we push this change, it will break all users against all ELPA archives until all their files are signed (they will have to answer 'y' every time files are retrieved). I think that's pretty radical. Maybe we should coordinate the change with all the repo maintainers? Or come back to my original setup, where archives are unsigned by default? Finally, for easier testing I think we should put a fake archive with 1 package in test/elpa/packages. If you agree I'll push that as a separate commit, including a small self-contained test. I didn't do it because Stefan mentioned Daniel Hackney's changes included some testing code and I didn't want to confuse matters. TZ> Using EPG functions, however, I could not figure out how to verify with TZ> an external public GPG key. I don't see that option with any of the TZ> context functions. Perhaps someone knows? Without that option, the TZ> user has to explicitly load the maintainer's public GPG key, which is TZ> very impractical around package.el. I need to know the above to make the patch usable, so I won't commit for now. Also the signature has to be named .gpgsig because the extension .gpg (the default) makes EPA/EPG attempt to decrypt it. Ted --=-=-= Content-Type: text/x-patch Content-Disposition: inline; filename=package-archive-signed-3.patch === 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)) --=-=-=--