Re: ELPA security

[Ted Zlatanov]

On Mon, 17 Jun 2013 03:20:41 -0400 Ted Zlatanov <address@hidden> wrote: 

TZ> On Sun, 16 Jun 2013 19:12:02 -0400 Stefan Monnier <address@hidden> wrote: 
>>> * add `package-signed-archives', a list of logical archive names with
>>> default '("gnu").  Add `package-archive-signed-p' to check it.

SM> I'd opt for the opposite, i.e. list the archives that aren't signed.

SM> And maybe automatically eliminate an archive from that "not signed"
SM> list if we ever find a signature in it.

TZ> How about basing the decision on the existence of
TZ> etc/elpa/ARCHIVE-NAME.signed which can then tell us more about the way
TZ> the archive is signed without customizing ELisp code?  Like a Yum or APT
TZ> repository description you can drop in?  I could use it to automatically
TZ> augment `package-archives' if you think that's useful, so it becomes
TZ> very manageable for a whole site.

I haven't made this change.  I'll wait for some opinions.  I think the
".signed" extension is unnecessary.

etc/elpa/ARCHIVE-NAME can contain the actual armored GPG signature but
it can also have more metadata about the archive.  So the format could
be:

url=ARCHIVE-URL
other-metadata=whatever
then-a-new-line=ends metadata

SIGNATURE

and if SIGNATURE is missing, the archive is not signed.

This would augment `package-archives' on startup and on demand.

>>> If you're OK with the code changes I'll get them working and start
>>> implementing `package--verify-signature'.

SM> Go ahead,

The attached patch implements `package--verify-signature' and
`package--create-detached-signature' using EPG functions, against the
currently-loaded GPG keys.  Otherwise it's the same as before.
`package--create-detached-signature' is pretty easy from the command
line as well (see http://gnupg.org/gph/en/manual/x135.html).

>From the command line, exporting and importing public GPG keys is easy,
e.g. "gpg --armor --output /tmp/tzz.gpg --export address@hidden".  So
the workflow is not difficult.

Using EPG functions, however, I could not figure out how to verify with
an external public GPG key.  I don't see that option with any of the
context functions.  Perhaps someone knows?  Without that option, the
user has to explicitly load the maintainer's public GPG key, which is
very impractical around package.el.

Ted

=== modified file 'lisp/emacs-lisp/package.el'
--- lisp/emacs-lisp/package.el  2013-06-18 01:26:47 +0000
+++ lisp/emacs-lisp/package.el  2013-06-19 04:42:45 +0000
@@ -164,6 +164,7 @@
 
 (eval-when-compile (require 'cl-lib))
 
+(require 'epg nil t)
 (require 'tabulated-list)
 
 (defgroup package nil
@@ -229,6 +230,16 @@
   :group 'package
   :version "24.1")
 
+;; TODO: maybe base this on the existence of etc/elpa/ARCHIVE.gpgsig
+(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
 
@@ -700,20 +711,39 @@
       (package--make-autoloads-and-compile name pkg-dir)
       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
@@ -721,12 +751,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.
@@ -743,16 +810,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)
@@ -876,6 +943,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)))
@@ -1099,10 +1167,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.
@@ -1111,7 +1179,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))
@@ -1234,7 +1302,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)
@@ -1292,7 +1364,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))