scratch/package-security 4f344ff: Support expiration of metadata by package archives

[Stefan Kangas]

branch: scratch/package-security
commit 4f344fff3549e775d9d509d0e5f11a7b61a02e50
Author: Stefan Kangas <stefan@marxist.se>
Commit: Stefan Kangas <stefan@marxist.se>

    Support expiration of metadata by package archives
    
    Expiring package metadata is intended to limit the effectiveness of a
    replay attack, and is used by the APT package manager, among others.
    Here, the onus is on the package archives to implement a secure and
    reasonable policy.  (Debian uses 7 days before metadata expires.)
    
    * lisp/emacs-lisp/package.el (package--parse-header-from-buffer):
    Break out new defun from...
    (package--parse-timestamp-from-buffer): ...here.
    (package--parse-valid-until-from-buffer)
    (package--archive-contents-not-expired): New defuns.
    (package--check-archive-timestamp): Test for a "Valid-Until" header in
    the archive-contents file and signal an error if it's too old.
    
    * test/lisp/emacs-lisp/package-tests.el
    (package--parse-valid-until-from-buffer)
    (package-test-check-archive-timestamp/not-expired)
    (package-test-check-archive-timestamp/expired): New tests for the
    above.
---
 lisp/emacs-lisp/package.el            | 34 ++++++++++++++++++++++++----------
 test/lisp/emacs-lisp/package-tests.el | 20 ++++++++++++++++++++
 2 files changed, 44 insertions(+), 10 deletions(-)

diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index 1f322bd..eb33b93 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -1819,27 +1819,39 @@ Once it's empty, run 
`package--post-download-archives-hook'."
     (message "Package refresh done")
     (run-hooks 'package--post-download-archives-hook)))
 
-(defun package--parse-timestamp-from-buffer (name)
-  "Return \"archive-contents\" timestamp for archive named NAME.
+(defun package--parse-header-from-buffer (header name)
+  "Find and return \"archive-contents\" HEADER for archive NAME.
 This function assumes that the current buffer contains the
-\"archive-contents\" file.  If there is no valid timestamp, return nil.
-
-A valid timestamp looks like:
+\"archive-contents\" file.
 
-;; Last-Updated: <TIMESTAMP>
+A valid header looks like: \";; HEADER: <TIMESTAMP>\"
 
 Where <TIMESTAMP> is a valid ISO-8601 (RFC 3339) date.  If there
 is such a line but <TIMESTAMP> is invalid, show a warning and
-return nil."
+return nil.  If there is no valid header, return nil."
   (save-excursion
     (goto-char (point-min))
-    (when (re-search-forward "^;; Last-Updated: *\\(.+?\\) *$" nil t)
+    (when (re-search-forward (concat "^;; " header ": *\\(.+?\\) *$") nil t)
       (condition-case-unless-debug nil
           (encode-time (iso8601-parse (match-string 1)))
         (lwarn '(package timestamp)
                (list (format "Malformed timestamp for archive `%s': `%s'"
                              name (match-string 1))))))))
 
+(defun package--parse-valid-until-from-buffer (name)
+  "Find and return \"Valid-Until\" header for archive NAME."
+  (package--parse-header-from-buffer "Valid-Until" name))
+
+(defun package--parse-timestamp-from-buffer (name)
+  "Find and return \"Last-Updated\" header for archive NAME."
+  (package--parse-header-from-buffer "Last-Updated" name))
+
+(defun package--archive-contents-not-expired (timestamp name)
+  (when (time-less-p timestamp (current-time))
+    (user-error
+     (format-message "Package archive `%s' has sent an expired 
`archive-contents' file"
+                     name))))
+
 (defun package--compare-archive-timestamps (old new name)
   "Signal error unless NEW timestamp is more recent than OLD."
   ;; If timestamp is missing on cached (old) file, do nothing here.
@@ -1884,8 +1896,10 @@ contain a timestamp."
       (let ((old (with-temp-buffer
                    (insert-file-contents old-file)
                    (package--parse-timestamp-from-buffer name)))
-            (new (package--parse-timestamp-from-buffer name)))
-        (package--compare-archive-timestamps old new name)))))
+            (new (package--parse-timestamp-from-buffer name))
+            (new-expired (package--parse-valid-until-from-buffer name)))
+        (package--compare-archive-timestamps old new name)
+        (package--archive-contents-not-expired new-expired name)))))
 
 (defun package--download-one-archive (archive file &optional async)
   "Retrieve an archive file FILE from ARCHIVE, and cache it.
diff --git a/test/lisp/emacs-lisp/package-tests.el 
b/test/lisp/emacs-lisp/package-tests.el
index e6fb70c..af35db7 100644
--- a/test/lisp/emacs-lisp/package-tests.el
+++ b/test/lisp/emacs-lisp/package-tests.el
@@ -854,6 +854,12 @@ If the rest succeed, just ignore the unsupported one."
       (insert "7")
       (should-error (package--verify-package-size pkg-desc)))))
 
+(ert-deftest package--parse-valid-until-from-buffer ()
+  (with-temp-buffer
+    (insert ";; Valid-Until: 2020-05-01T15:43:35.000Z\n(foo bar baz)")
+    (should (equal (package--parse-valid-until-from-buffer "foo")
+                   '(24236 17319)))))
+
 (ert-deftest package-tests--parse-timestamp-from-buffer ()
   (with-temp-buffer
     (insert ";; Last-Updated: 2020-05-01T15:43:35.000Z\n(foo bar baz)")
@@ -909,6 +915,20 @@ If the rest succeed, just ignore the unsupported one."
       (should-not (package--check-archive-timestamp "missing"))
       (should-error (package--check-archive-timestamp "newer")))))
 
+(ert-deftest package-test-check-archive-timestamp/not-expired ()
+  (let ((package-user-dir package-test-data-dir))
+    (with-temp-buffer
+      (insert ";; Last-Updated: 2020-01-01T00:00:00.000Z\n"
+              ";; Valid-Until: 2999-01-02T00:00:00.000Z\n")
+      (should-not (package--check-archive-timestamp "older")))))
+
+(ert-deftest package-test-check-archive-timestamp/expired ()
+  (let ((package-user-dir package-test-data-dir))
+    (with-temp-buffer
+      (insert ";; Last-Updated: 2020-01-01T00:00:00.000Z\n"
+              ";; Valid-Until: 2020-01-02T00:00:00.000Z\n")
+      (should-error (package--check-archive-timestamp "older")))))
+
 
 ;;; Tests for package-x features.