diff options
Diffstat (limited to 'lisp/emacs-lisp/package.el')
| -rw-r--r-- | lisp/emacs-lisp/package.el | 105 |
1 files changed, 105 insertions, 0 deletions
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 308f9eb3a63..1e73a1690cc 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -360,6 +360,15 @@ should normally not be used since it will decrease security." :risky t :version "28.1") +(defcustom package-check-timestamp t + "Non-nil means to verify the package archive timestamp. + +Note that setting this to nil is intended for debugging, and +should normally not be used since it will decrease security." + :type 'boolean + :risky t + :version "28.1") + (defcustom package-check-signature 'allow-unsigned "Non-nil means to check package signatures when installing. More specifically the value can be: @@ -449,6 +458,7 @@ synchronously." (define-error 'bad-size "Package size mismatch" 'package-error) (define-error 'bad-signature "Failed to verify signature" 'package-error) (define-error 'bad-checksum "Failed to verify checksum" 'package-error) +(define-error 'bad-timestamp "Failed to verify timestamp" 'package-error) ;;; `package-desc' object definition @@ -1812,6 +1822,100 @@ Once it's empty, run `package--post-download-archives-hook'." (message "Package refresh done") (run-hooks 'package--post-download-archives-hook))) +(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. + +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. If there is no valid header, return nil." + (save-excursion + (goto-char (point-min)) + (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-last-updated-from-buffer (name) + "Find and return \"Last-Updated\" header for archive NAME." + (package--parse-header-from-buffer "Last-Updated" name)) + +(defun package--archive-verify-timestamp (new old name) + "Return t if timestamp NEW is more recent than OLD for archive NAME. +Signal error otherwise. +Warn if NEW is in the future." + ;; If timestamp is missing on cached (old) file, do nothing here. + ;; This package archive recently introduced support for timestamps. + ;; We will require a timestamp for that archive in future updates. + (if old + (cond + ((not new) + (signal 'bad-timestamp + (list (format-message + (concat + "New archive contents for `%s' missing " + "timestamp, refusing to proceed") + name)))) + ((time-less-p new old) + (signal 'bad-timestamp + (list (format-message + (concat + "New archive contents for `%s' older than " + "cached, refusing to proceed") + name)))) + ((time-less-p (current-time) new) + (signal 'bad-timestamp + (list (format-message + (concat + "New archive contents for `%s' is " + "in the future: %s") + name (format-time-string "%c" new))))) + ;; Check ok, return t. + (t)) + t)) + +(defun package--archive-verify-not-expired (timestamp name) + "Return t if TIMESTAMP has not yet expired for archive NAME. +Signal error otherwise." + (unless (time-less-p (current-time) timestamp) + (signal 'bad-timestamp + (list (format-message + (concat + "Package archive `%s' has sent " + "an expired `archive-contents' file") + name))))) + +(defun package--check-archive-timestamp (name) + "Verify timestamp of \"archive-contents\" file for archive NAME. +Compare the archive timestamp of the previously downloaded +\"archive-contents\" file to the timestamp in the current buffer. +Signal error if the old timestamp is more recent than the new one. + +Do nothing if there is no previously downloaded file, if such a +file exists but does not contain any timestamp, or if +`package-check-timestamp' is nil." + (let ((old-file (expand-file-name + (concat "archives/" name "/archive-contents") + package-user-dir))) + (when (and package-check-timestamp + (file-readable-p old-file)) + (let ((old (with-temp-buffer + (insert-file-contents old-file) + (package--parse-last-updated-from-buffer name))) + (new (package--parse-last-updated-from-buffer name)) + (new-expires (package--parse-valid-until-from-buffer name))) + (package--archive-verify-timestamp new old name) + (package--archive-verify-not-expired new-expires name))))) + (defun package--download-one-archive (archive file &optional async) "Retrieve an archive file FILE from ARCHIVE, and cache it. ARCHIVE should be a cons cell of the form (NAME . LOCATION), @@ -1825,6 +1929,7 @@ similar to an entry in `package-alist'. Save the cached copy to (content (buffer-string)) (dir (expand-file-name (concat "archives/" name) package-user-dir)) (local-file (expand-file-name file dir))) + (package--check-archive-timestamp name) (when (listp (read content)) (make-directory dir t) (if (or (not (package-check-signature)) |