Re: ELPA security

[Ted Zlatanov]

On Tue, 08 Jan 2013 15:59:33 -0500 Stefan Monnier <address@hidden> 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

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