diff options
Diffstat (limited to 'lisp/emacs-lisp/package.el')
| -rw-r--r-- | lisp/emacs-lisp/package.el | 123 |
1 files changed, 91 insertions, 32 deletions
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 823ba365e62..80b7670c1f0 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -162,8 +162,10 @@ ;;; Code: (eval-when-compile (require 'cl-lib)) +(eval-when-compile (require 'epg)) ;For setf accessors. (require 'tabulated-list) +(require 'macroexp) (defgroup package nil "Manager for Emacs Lisp packages." @@ -289,6 +291,8 @@ contrast, `package-user-dir' contains packages for personal use." :group 'package :version "24.1") +(defvar epg-gpg-program) + (defcustom package-check-signature (if (progn (require 'epg-config) (executable-find epg-gpg-program)) 'allow-unsigned) @@ -512,7 +516,11 @@ Return the max version (as a string) if the package is held at a lower version." force)) (t (error "Invalid element in `package-load-list'"))))) -(defun package-activate-1 (pkg-desc) +(defun package-activate-1 (pkg-desc &optional reload) + "Activate package given by PKG-DESC, even if it was already active. +If RELOAD is non-nil, also `load' any files inside the package which +correspond to previously loaded files (those returned by +`package--list-loaded-files')." (let* ((name (package-desc-name pkg-desc)) (pkg-dir (package-desc-dir pkg-desc)) (pkg-dir-dir (file-name-as-directory pkg-dir))) @@ -520,15 +528,27 @@ Return the max version (as a string) if the package is held at a lower version." (error "Internal error: unable to find directory for `%s'" (package-desc-full-name pkg-desc))) ;; Add to load path, add autoloads, and activate the package. - (let ((old-lp load-path)) - (with-demoted-errors - (load (expand-file-name (format "%s-autoloads" name) pkg-dir) nil t)) + (let* ((old-lp load-path) + (autoloads-file (expand-file-name + (format "%s-autoloads" name) pkg-dir)) + (loaded-files-list (and reload (package--list-loaded-files pkg-dir)))) + (with-demoted-errors "Error in package-activate-1: %s" + (load autoloads-file nil t)) (when (and (eq old-lp load-path) (not (or (member pkg-dir load-path) (member pkg-dir-dir load-path)))) ;; Old packages don't add themselves to the `load-path', so we have to ;; do it ourselves. - (push pkg-dir load-path))) + (push pkg-dir load-path)) + ;; Call `load' on all files in `pkg-dir' already present in + ;; `load-history'. This is done so that macros in these files are updated + ;; to their new definitions. If another package is being installed which + ;; depends on this new definition, not doing this update would cause + ;; compilation errors and break the installation. + (with-demoted-errors "Error in package-activate-1: %s" + (mapc (lambda (feature) (load feature nil t)) + ;; Skip autoloads file since we already evaluated it above. + (remove (file-truename autoloads-file) loaded-files-list)))) ;; Add info node. (when (file-exists-p (expand-file-name "dir" pkg-dir)) ;; FIXME: not the friendliest, but simple. @@ -539,6 +559,41 @@ Return the max version (as a string) if the package is held at a lower version." ;; Don't return nil. t)) +(declare-function find-library-name "find-func" (library)) +(defun package--list-loaded-files (dir) + "Recursively list all files in DIR which correspond to loaded features. +Returns the `file-name-sans-extension' of each file, relative to +DIR, sorted by most recently loaded last." + (let* ((history (delq nil + (mapcar (lambda (x) + (let ((f (car x))) + (and f (file-name-sans-extension f)))) + load-history))) + (dir (file-truename dir)) + ;; List all files that have already been loaded. + (list-of-conflicts + (delq + nil + (mapcar + (lambda (x) (let* ((file (file-relative-name x dir)) + ;; Previously loaded file, if any. + (previous + (ignore-errors + (file-name-sans-extension + (file-truename (find-library-name file))))) + (pos (when previous (member previous history)))) + ;; Return (RELATIVE-FILENAME . HISTORY-POSITION) + (when pos + (cons (file-name-sans-extension file) (length pos))))) + (directory-files-recursively dir "\\`[^\\.].*\\.el\\'"))))) + ;; Turn the list of (FILENAME . POS) back into a list of features. Files in + ;; subdirectories are returned relative to DIR (so not actually features). + (let ((default-directory (file-name-as-directory dir))) + (mapcar (lambda (x) (file-truename (car x))) + (sort list-of-conflicts + ;; Sort the files by ascending HISTORY-POSITION. + (lambda (x y) (< (cdr x) (cdr y)))))))) + (defun package-built-in-p (package &optional min-version) "Return true if PACKAGE is built-in to Emacs. Optional arg MIN-VERSION, if non-nil, should be a version list @@ -588,14 +643,14 @@ If FORCE is true, (re-)activate it if it's already activated." (fail (catch 'dep-failure ;; Activate its dependencies recursively. (dolist (req (package-desc-reqs pkg-vec)) - (unless (package-activate (car req) (cadr req)) + (unless (package-activate (car req)) (throw 'dep-failure req)))))) (if fail (warn "Unable to activate package `%s'. Required package `%s-%s' is unavailable" package (car fail) (package-version-join (cadr fail))) ;; If all goes well, activate the package itself. - (package-activate-1 pkg-vec))))))) + (package-activate-1 pkg-vec force))))))) (defun define-package (_name-string _version-string &optional _docstring _requirements @@ -659,6 +714,7 @@ EXTRA-PROPERTIES is currently unused." (let* ((auto-name (format "%s-autoloads.el" name)) ;;(ignore-name (concat name "-pkg.el")) (generated-autoload-file (expand-file-name auto-name pkg-dir)) + (backup-inhibited t) (version-control 'never)) (package-autoload-ensure-default-file generated-autoload-file) (update-directory-autoloads pkg-dir) @@ -698,6 +754,7 @@ untar into a directory named DIR; otherwise, signal an error." (print-length nil)) (write-region (concat + ";;; -*- no-byte-compile: t -*-\n" (prin1-to-string (nconc (list 'define-package @@ -718,15 +775,9 @@ untar into a directory named DIR; otherwise, signal an error." nil pkg-file nil 'silent)))) (defun package--alist-to-plist-args (alist) - (mapcar (lambda (x) - (if (and (not (consp x)) - (or (keywordp x) - (not (symbolp x)) - (memq x '(nil t)))) - x `',x)) + (mapcar 'macroexp-quote (apply #'nconc (mapcar (lambda (pair) (list (car pair) (cdr pair))) alist)))) - (defun package-unpack (pkg-desc) "Install the contents of the current buffer as a package." (let* ((name (package-desc-name pkg-desc)) @@ -806,13 +857,24 @@ buffer is killed afterwards. Return the last value in BODY." cipher-algorithm digest-algorithm compress-algorithm)) -(declare-function epg-context-set-home-directory "epg" (context directory)) (declare-function epg-verify-string "epg" (context signature &optional signed-text)) (declare-function epg-context-result-for "epg" (context name)) (declare-function epg-signature-status "epg" (signature)) (declare-function epg-signature-to-string "epg" (signature)) +(defun package--display-verify-error (context sig-file) + (unless (equal (epg-context-error-output context) "") + (with-output-to-temp-buffer "*Error*" + (with-current-buffer standard-output + (if (epg-context-result-for context 'verify) + (insert (format "Failed to verify signature %s:\n" sig-file) + (mapconcat #'epg-signature-to-string + (epg-context-result-for context 'verify) + "\n")) + (insert (format "Error while verifying signature %s:\n" sig-file))) + (insert "\nCommand output:\n" (epg-context-error-output context)))))) + (defun package--check-signature (location file) "Check signature of the current buffer. GnuPG keyring is located under \"gnupg\" in `package-user-dir'." @@ -821,8 +883,12 @@ GnuPG keyring is located under \"gnupg\" in `package-user-dir'." (sig-file (concat file ".sig")) (sig-content (package--with-work-buffer location sig-file (buffer-string)))) - (epg-context-set-home-directory context homedir) - (epg-verify-string context sig-content (buffer-string)) + (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)))) (let (good-signatures had-fatal-error) ;; The .sig file may contain multiple signatures. Success if one ;; of the signatures is good. @@ -836,12 +902,10 @@ GnuPG keyring is located under \"gnupg\" in `package-user-dir'." (unless (and (eq package-check-signature 'allow-unsigned) (eq (epg-signature-status sig) 'no-pubkey)) (setq had-fatal-error t)))) - (if (and (null good-signatures) had-fatal-error) - (error "Failed to verify signature %s: %S" - sig-file - (mapcar #'epg-signature-to-string - (epg-context-result-for context 'verify))) - good-signatures)))) + (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-install-from-archive (pkg-desc) "Download and install a tar package." @@ -1298,14 +1362,9 @@ similar to an entry in `package-alist'. Save the cached copy to (setq file (expand-file-name file)) (let ((context (epg-make-context 'OpenPGP)) (homedir (expand-file-name "gnupg" package-user-dir))) - ;; FIXME Use `with-file-modes' when merged to trunk. - (let ((umask (default-file-modes))) - (unwind-protect - (progn - (set-default-file-modes 448) - (make-directory homedir t)) - (set-default-file-modes umask))) - (epg-context-set-home-directory context homedir) + (with-file-modes 448 + (make-directory homedir t)) + (setf (epg-context-home-directory context) homedir) (message "Importing %s..." (file-name-nondirectory file)) (epg-import-keys-from-file context file) (message "Importing %s...done" (file-name-nondirectory file)))) @@ -1650,7 +1709,7 @@ Letters do not insert themselves; instead, they are commands. \\{package-menu-mode-map}" (setq tabulated-list-format `[("Package" 18 package-menu--name-predicate) - ("Version" 12 nil) + ("Version" 13 nil) ("Status" 10 package-menu--status-predicate) ,@(if (cdr package-archives) '(("Archive" 10 package-menu--archive-predicate))) |