From ba7a1a7a4eb64dd391d2e866c82cadfcc00d364d Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Wed, 1 Apr 2015 11:03:43 +0100 Subject: [PATCH] * emacs-lisp/package.el: Implement asynchronous refreshing. (package--with-work-buffer-async) (package--check-signature-content) (package--update-downloads-in-progress): New functions. (package--check-signature, package--download-one-archive) (package--download-and-read-archives, package-refresh-contents): Optional arguments for async usage. (package--post-download-archives-hook): New variable. Hook run after every refresh. --- lisp/ChangeLog | 12 +++ lisp/emacs-lisp/package.el | 183 ++++++++++++++++++++++++++----------- 2 files changed, 144 insertions(+), 51 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 621121e0f06..da3cd513ca2 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,15 @@ +2015-04-01 Artur Malabarba + + * emacs-lisp/package.el: Implement asynchronous refreshing. + (package--with-work-buffer-async) + (package--check-signature-content) + (package--update-downloads-in-progress): New functions. + (package--check-signature, package--download-one-archive) + (package--download-and-read-archives, package-refresh-contents): + Optional arguments for async usage. + (package--post-download-archives-hook): New variable. Hook run + after every refresh. + 2015-03-31 Simen Heggestøyl * textmodes/css-mode.el (css-mode): Derive from `prog-mode'. diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 526c0b41a77..89d92464119 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -1082,20 +1082,43 @@ buffer is killed afterwards. Return the last value in BODY." (insert-file-contents (expand-file-name ,file ,location))) ,@body)) -(defun package--check-signature (location file) - "Check signature of the current buffer. -GnuPG keyring is located under \"gnupg\" in `package-user-dir'." +(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, the operation is run +asynchronously. If an error is encountered and ASYNC is a +function, it is called with no arguments (instead of executing +body), otherwise the error is propagated. For description on the +other arguments see `package--with-work-buffer'." + (declare (indent 3) (debug t)) + `(if (or (not ,async) + (not (string-match-p "\\`https?:" ,location))) + (package--with-work-buffer ,location ,file ,@body) + (url-retrieve (concat ,location ,file) + (lambda (status) + (if (eq (car status) :error) + (if (functionp ,async) + (funcall ,async) + (signal (cdar status) (cddr status))) + (goto-char (point-min)) + (unless (search-forward "\n\n" nil 'noerror) + (error "Invalid url response")) + (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)) - (sig-file (concat file ".sig")) - (sig-content (package--with-work-buffer location sig-file - (buffer-string)))) + (homedir (expand-file-name "gnupg" package-user-dir))) (setf (epg-context-home-directory context) homedir) (condition-case error - (epg-verify-string context sig-content (buffer-string)) - (error - (package--display-verify-error context sig-file) - (signal (car error) (cdr 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. @@ -1114,6 +1137,30 @@ GnuPG keyring is located under \"gnupg\" in `package-user-dir'." (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. +Signature file is downloaded 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))))) + ;;; Packages on Archives ;; The following variables store information about packages available @@ -1281,36 +1328,8 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages." ;;;; Populating `package-archive-contents' from archives ;; This subsection populates the variables listed above from the ;; actual archives, instead of from a local cache. -(defun package--download-one-archive (archive file) - "Retrieve an archive file FILE from ARCHIVE, and cache it. -ARCHIVE should be a cons cell of the form (NAME . LOCATION), -similar to an entry in `package-alist'. Save the cached copy to -\"archives/NAME/archive-contents\" in `package-user-dir'." - (let ((dir (expand-file-name (format "archives/%s" (car archive)) - package-user-dir)) - (sig-file (concat file ".sig")) - good-signatures) - (package--with-work-buffer (cdr archive) file - ;; Check signature of archive-contents, if desired. - (if (and package-check-signature - (not (member archive package-unsigned-archives))) - (if (package--archive-file-exists-p (cdr archive) sig-file) - (setq good-signatures (package--check-signature (cdr archive) - file)) - (unless (eq package-check-signature 'allow-unsigned) - (error "Unsigned archive `%s'" - (car archive))))) - ;; Read the retrieved buffer to make sure it is valid (e.g. it - ;; may fetch a URL redirect page). - (when (listp (read (current-buffer))) - (make-directory dir t) - (write-region nil nil (expand-file-name file dir) nil 'silent))) - (when good-signatures - ;; Write out good signatures into archive-contents.signed file. - (write-region (mapconcat #'epg-signature-to-string good-signatures "\n") - nil - (expand-file-name (concat file ".signed") dir) - nil 'silent)))) +(defvar package--downloads-in-progress nil + "List of in-progress asynchronous downloads.") (declare-function epg-check-configuration "epg-config" (config &optional minimum-version)) @@ -1331,12 +1350,81 @@ similar to an entry in `package-alist'. Save the cached copy to (epg-import-keys-from-file context file) (message "Importing %s...done" (file-name-nondirectory file)))) +(defvar package--post-download-archives-hook nil + "Hook run after the archive contents are downloaded. +Don't run this hook directly. It is meant to be run as part of +`package--update-downloads-in-progress'.") +(put 'package--post-download-archives-hook 'risky-local-variable t) + +(defun package--update-downloads-in-progress (entry) + "Remove ENTRY from `package--downloads-in-progress'. +Once it's empty, run `package--post-download-archives-hook'." + ;; Keep track of the downloading progress. + (setq package--downloads-in-progress + (remove entry package--downloads-in-progress)) + ;; If this was the last download, run the hook. + (unless package--downloads-in-progress + (package--build-compatibility-table) + (package-read-all-archive-contents) + ;; We message before running the hook, so the hook can give + ;; messages as well. + (message "Package refresh done") + (run-hooks 'package--post-download-archives-hook))) + +(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), +similar to an entry in `package-alist'. Save the cached copy to +\"archives/NAME/FILE\" in `package-user-dir'." + (package--with-work-buffer-async (cdr archive) file async + (let* ((location (cdr archive)) + (name (car archive)) + (content (buffer-string)) + (dir (expand-file-name (format "archives/%s" name) package-user-dir)) + (local-file (expand-file-name file dir))) + (when (listp (read-from-string content)) + (make-directory dir t) + (if (or (not package-check-signature) + (member archive package-unsigned-archives)) + ;; If we don't care about the signature, save the file and + ;; we're done. + (progn (write-region content nil local-file nil 'silent) + (package--update-downloads-in-progress archive)) + ;; If we care, check it (perhaps async) and *then* write the file. + (package--check-signature + location file content async + (lambda (&optional good-sigs) + (unless (or good-sigs (eq package-check-signature 'allow-unsigned)) + (error "Unsigned archive `%s'" name)) + ;; Write out the archives file. + (write-region content nil local-file nil 'silent) + ;; Write out good signatures into archive-contents.signed file. + (when good-sigs + (write-region (mapconcat #'epg-signature-to-string good-sigs "\n") + nil (concat local-file ".signed") nil 'silent)) + (package--update-downloads-in-progress archive)))))))) + +(defun package--download-and-read-archives (&optional async) + "Download descriptions of all `package-archives' and read them. +This populates `package-archive-contents'. If ASYNC is non-nil, +the downloads are performed asynchronously." + ;; The dowloaded archive contents will be read as part of + ;; `package--update-downloads-in-progress'. + (setq package--downloads-in-progress package-archives) + (dolist (archive package-archives) + (condition-case-unless-debug nil + (package--download-one-archive archive "archive-contents" async) + (error (message "Failed to download `%s' archive." + (car archive)))))) + ;;;###autoload -(defun package-refresh-contents () +(defun package-refresh-contents (&optional async) "Download descriptions of all configured ELPA packages. For each archive configured in the variable `package-archives', inform Emacs about the latest versions of all packages it offers, -and make them available for download." +and make them available for download. +Optional argument, ASYNC, specifies whether the downloads should +be performed in the background." (interactive) ;; FIXME: Do it asynchronously. (unless (file-exists-p package-user-dir) @@ -1349,14 +1437,7 @@ and make them available for download." (epg-check-configuration (epg-configuration)) (package-import-keyring default-keyring)) (error (message "Cannot import default keyring: %S" (cdr error)))))) - (dolist (archive package-archives) - (condition-case-unless-debug nil - (package--download-one-archive archive "archive-contents") - (error (message "Failed to download `%s' archive." - (car archive))))) - (package-read-all-archive-contents) - (package--build-compatibility-table) - (message "Package refresh done")) + (package--download-and-read-archives async)) ;;; Dependency Management -- 2.39.5