Re: ELPA security

[Ted Zlatanov]

On Wed, 19 Jun 2013 01:02:16 -0400 Ted Zlatanov <address@hidden> 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

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