+(defmacro package--with-work-buffer-async (location file async &rest body)
+ "Run BODY in a buffer containing the contents of FILE at LOCATION.
+If ASYNC is non-nil, and if it is possible, run BODY
+asynchronously. If an error is encountered and ASYNC is a
+function, call it with no arguments (instead of executing BODY),
+otherwise propagate the error. For description of the other
+arguments see `package--with-work-buffer'."
+ (declare (indent 3) (debug t))
+ (macroexp-let2* macroexp-copyable-p
+ ((async-1 async)
+ (file-1 file)
+ (location-1 location))
+ `(if (or (not ,async-1)
+ (not (string-match-p "\\`https?:" ,location-1)))
+ (package--with-work-buffer ,location-1 ,file-1 ,@body)
+ (url-retrieve (concat ,location-1 ,file-1)
+ (lambda (status)
+ (if (eq (car status) :error)
+ (if (functionp ,async-1)
+ (funcall ,async-1)
+ (signal (cdar status) (cddr status)))
+ (goto-char (point-min))
+ (unless (search-forward "\n\n" nil 'noerror)
+ (error "Invalid url response in buffer %s"
+ (current-buffer)))
+ (delete-region (point-min) (point))
+ ,@body)
+ (kill-buffer (current-buffer)))
+ nil
+ 'silent))))
+
+(defun package--check-signature-content (content string &optional sig-file)
+ "Check signature CONTENT against STRING.
+SIG-FILE is the name of the signature file, used when signaling
+errors."
+ (let* ((context (epg-make-context 'OpenPGP))
+ (homedir (expand-file-name "gnupg" package-user-dir)))
+ (setf (epg-context-home-directory context) homedir)
+ (condition-case error
+ (epg-verify-string context content string)
+ (error (package--display-verify-error context sig-file)
+ (signal (car error) (cdr error))))
+ (let (good-signatures had-fatal-error)
+ ;; The .sig file may contain multiple signatures. Success if one
+ ;; of the signatures is good.
+ (dolist (sig (epg-context-result-for context 'verify))
+ (if (eq (epg-signature-status sig) 'good)
+ (push sig good-signatures)
+ ;; If package-check-signature is allow-unsigned, don't
+ ;; signal error when we can't verify signature because of
+ ;; missing public key. Other errors are still treated as
+ ;; fatal (bug#17625).
+ (unless (and (eq package-check-signature 'allow-unsigned)
+ (eq (epg-signature-status sig) 'no-pubkey))
+ (setq had-fatal-error t))))
+ (when (and (null good-signatures) had-fatal-error)
+ (package--display-verify-error context sig-file)
+ (error "Failed to verify signature %s" sig-file))
+ good-signatures)))
+
+(defun package--check-signature (location file &optional string async callback)
+ "Check signature of the current buffer.
+Download the signature file from LOCATION by appending \".sig\"
+to FILE.
+GnuPG keyring is located under \"gnupg\" in `package-user-dir'.
+STRING is the string to verify, it defaults to `buffer-string'.
+If ASYNC is non-nil, the download of the signature file is
+done asynchronously.
+
+If the signature is verified and CALLBACK was provided, CALLBACK
+is `funcall'ed with the list of good signatures as argument (the
+list can be empty). If the signatures file is not found,
+CALLBACK is called with no arguments."
+ (let ((sig-file (concat file ".sig"))
+ (string (or string (buffer-string))))
+ (condition-case nil
+ (package--with-work-buffer-async
+ location sig-file (when async (or callback t))
+ (let ((sig (package--check-signature-content
+ (buffer-string) string sig-file)))
+ (when callback (funcall callback sig))
+ sig))
+ (file-error (funcall callback)))))
+
+\f
+;;; Packages on Archives
+;; The following variables store information about packages available
+;; from archives. The most important of these is
+;; `package-archive-contents' which is initially populated by the
+;; function `package-read-all-archive-contents' from a cache on disk.
+;; The `package-initialize' command is also closely related to this
+;; section, but it has its own section.
+(defconst package-archive-version 1
+ "Version number of the package archive understood by this file.
+Lower version numbers than this will probably be understood as well.")
+
+;; We don't prime the cache since it tends to get out of date.
+(defvar package-archive-contents nil
+ "Cache of the contents of the Emacs Lisp Package Archive.
+This is an alist mapping package names (symbols) to
+non-empty lists of `package-desc' structures.")
+(put 'package-archive-contents 'risky-local-variable t)
+
+(defvar package--compatibility-table nil
+ "Hash table connecting package names to their compatibility.
+Each key is a symbol, the name of a package.
+
+The value is either nil, representing an incompatible package, or
+a version list, representing the highest compatible version of
+that package which is available.
+
+A package is considered incompatible if it requires an Emacs
+version higher than the one being used. To check for package
+\(in)compatibility, don't read this table directly, use
+`package--incompatible-p' which also checks dependencies.")
+
+(defun package--build-compatibility-table ()
+ "Build `package--compatibility-table' with `package--mapc'."
+ ;; Initialize the list of built-ins.
+ (require 'finder-inf nil t)
+ ;; Build compat table.
+ (setq package--compatibility-table (make-hash-table :test 'eq))
+ (package--mapc #'package--add-to-compatibility-table))
+
+(defun package--add-to-compatibility-table (pkg)
+ "If PKG is compatible (without dependencies), add to the compatibility table.
+PKG is a package-desc object.
+Only adds if its version is higher than what's already stored in
+the table."
+ (unless (package--incompatible-p pkg 'shallow)
+ (let* ((name (package-desc-name pkg))
+ (version (or (package-desc-version pkg) '(0)))
+ (table-version (gethash name package--compatibility-table)))
+ (when (or (not table-version)
+ (version-list-< table-version version))
+ (puthash name version package--compatibility-table)))))
+
+;; Package descriptor objects used inside the "archive-contents" file.
+;; Changing this defstruct implies changing the format of the
+;; "archive-contents" files.
+(cl-defstruct (package--ac-desc
+ (:constructor package-make-ac-desc (version reqs summary kind extras))
+ (:copier nil)
+ (:type vector))
+ version reqs summary kind extras)
+
+(defun package--append-to-alist (pkg-desc alist)
+ "Append an entry for PKG-DESC to the start of ALIST and return it.
+This entry takes the form (`package-desc-name' PKG-DESC).
+
+If ALIST already has an entry with this name, destructively add
+PKG-DESC to the cdr of this entry instead, sorted by version
+number."
+ (let* ((name (package-desc-name pkg-desc))
+ (priority-version (package-desc-priority-version pkg-desc))
+ (existing-packages (assq name alist)))
+ (if (not existing-packages)
+ (cons (list name pkg-desc)
+ alist)
+ (while (if (and (cdr existing-packages)
+ (version-list-< priority-version
+ (package-desc-priority-version
+ (cadr existing-packages))))
+ (setq existing-packages (cdr existing-packages))
+ (push pkg-desc (cdr existing-packages))
+ nil))
+ alist)))
+
+(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)))
+ (pkg-desc
+ (package-desc-create
+ :name name
+ :version version
+ :reqs (package--ac-desc-reqs (cdr package))
+ :summary (package--ac-desc-summary (cdr package))
+ :kind (package--ac-desc-kind (cdr package))
+ :archive archive
+ :extras (and (> (length (cdr package)) 4)
+ ;; Older archive-contents files have only 4
+ ;; elements here.
+ (package--ac-desc-extras (cdr package)))))
+ (pinned-to-archive (assoc name package-pinned-packages)))
+ ;; Skip entirely if pinned to another archive.
+ (when (not (and pinned-to-archive
+ (not (equal (cdr pinned-to-archive) archive))))
+ (setq package-archive-contents
+ (package--append-to-alist pkg-desc package-archive-contents)))))
+
+(defun package--read-archive-file (file)
+ "Re-read archive file FILE, if it exists.
+Will return the data from the file, or nil if the file does not exist.
+Will throw an error if the archive version is too new."
+ (let ((filename (expand-file-name file package-user-dir)))
+ (when (file-exists-p filename)
+ (with-temp-buffer
+ (let ((coding-system-for-read 'utf-8))
+ (insert-file-contents filename))
+ (let ((contents (read (current-buffer))))
+ (if (> (car contents) package-archive-version)
+ (error "Package archive version %d is higher than %d"
+ (car contents) package-archive-version))
+ (cdr contents))))))
+
+(defun package-read-archive-contents (archive)
+ "Re-read archive contents for ARCHIVE.
+If successful, set the variable `package-archive-contents'.
+If the archive version is too new, signal an error."
+ ;; Version 1 of 'archive-contents' is identical to our internal
+ ;; representation.
+ (let* ((contents-file (format "archives/%s/archive-contents" archive))
+ (contents (package--read-archive-file contents-file)))
+ (when contents
+ (dolist (package contents)
+ (package--add-to-archive-contents package archive)))))
+
+(defun package-read-all-archive-contents ()
+ "Re-read `archive-contents', if it exists.
+If successful, set `package-archive-contents'."
+ (setq package-archive-contents nil)
+ (dolist (archive package-archives)
+ (package-read-archive-contents (car archive))))