From 4525ce3eb56a1f4b7c50eac9217854bbd170f660 Mon Sep 17 00:00:00 2001 From: Chong Yidong Date: Sat, 19 Mar 2011 14:27:55 -0400 Subject: [PATCH] Fix tar package handling, and clean up package-subdirectory-regexp usage. * lisp/startup.el (package-subdirectory-regexp): Move from package.el. Omit \\` and \\', and let callers add them. * lisp/emacs-lisp/package.el (package-strip-version) (package-load-all-descriptors): Add \\` and \\' to package-subdirectory-regexp before using it. (package-untar-buffer): New arg DIR; ensure that file untars only into this expected directory. Remove superfluous delete-region. (package-unpack): Caller changed. (package-tar-file-info): Use package-subdirectory-regexp. --- lisp/ChangeLog | 13 +++++++++++ lisp/emacs-lisp/package.el | 47 +++++++++++++++++--------------------- lisp/startup.el | 15 +++++++++--- 3 files changed, 46 insertions(+), 29 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 3a8cf025ad6..42b4d759c07 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,16 @@ +2011-03-19 Chong Yidong + + * startup.el (package-subdirectory-regexp): Move from package.el. + Omit \\` and \\', and let callers add them. + + * emacs-lisp/package.el (package-strip-version) + (package-load-all-descriptors): Add \\` and \\' to + package-subdirectory-regexp before using it. + (package-untar-buffer): New arg DIR; ensure that file untars only + into this expected directory. Remove superfluous delete-region. + (package-unpack): Caller changed. + (package-tar-file-info): Use package-subdirectory-regexp. + 2011-03-18 Stefan Monnier * vc/diff-mode.el (diff-mode-map): Shadow problematic bindings from diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 399e0fb2e24..5dc2938fe08 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -319,12 +319,6 @@ Like `package-alist', but maps package name to a second alist. The inner alist is keyed by version.") (put 'package-obsolete-alist 'risky-local-variable t) -(defconst package-subdirectory-regexp - "\\`\\([^.].*?\\)-\\([0-9]+\\(?:[.][0-9]+\\|\\(?:pre\\|beta\\|alpha\\)[0-9]+\\)*\\)\\'" - "Regular expression matching the name of a package subdirectory. -The first subexpression is the package name. -The second subexpression is the version string.") - (defun package-version-join (vlist) "Return the version string corresponding to the list VLIST. This is, approximately, the inverse of `version-to-list'. @@ -357,7 +351,7 @@ This is, approximately, the inverse of `version-to-list'. (defun package-strip-version (dirname) "Strip the version from a combined package name and version. E.g., if given \"quux-23.0\", will return \"quux\"" - (if (string-match package-subdirectory-regexp dirname) + (if (string-match (concat "\\`" package-subdirectory-regexp "\\'") dirname) (match-string 1 dirname))) (defun package-load-descriptor (dir package) @@ -382,12 +376,13 @@ In each valid package subdirectory, this function loads the description file containing a call to `define-package', which updates `package-alist' and `package-obsolete-alist'." (let ((all (memq 'all package-load-list)) + (regexp (concat "\\`" package-subdirectory-regexp "\\'")) name version force) (dolist (dir (cons package-user-dir package-directory-list)) (when (file-directory-p dir) (dolist (subdir (directory-files dir)) (when (and (file-directory-p (expand-file-name subdir dir)) - (string-match package-subdirectory-regexp subdir)) + (string-match regexp subdir)) (setq name (intern (match-string 1 subdir)) version (match-string 2 subdir) force (assq name package-load-list)) @@ -579,30 +574,29 @@ EXTRA-PROPERTIES is currently unused." (package-autoload-ensure-default-file generated-autoload-file)) (update-directory-autoloads pkg-dir))) -(defun package-untar-buffer () +(defvar tar-parse-info) +(declare-function tar-untar-buffer "tar-mode" ()) + +(defun package-untar-buffer (dir) "Untar the current buffer. -This uses `tar-untar-buffer' if it is available. -Otherwise it uses an external `tar' program. -`default-directory' should be set by the caller." +This uses `tar-untar-buffer' from Tar mode. All files should +untar into a directory named DIR; otherwise, signal an error." (require 'tar-mode) - (if (fboundp 'tar-untar-buffer) - (progn - ;; tar-mode messes with narrowing, so we just let it have the - ;; whole buffer to play with. - (delete-region (point-min) (point)) - (tar-mode) - (tar-untar-buffer)) - ;; FIXME: check the result. - (call-process-region (point) (point-max) "tar" nil '(nil nil) nil - "xf" "-"))) + (tar-mode) + ;; Make sure everything extracts into DIR. + (let ((regexp (concat "\\`" (regexp-quote dir) "/"))) + (dolist (tar-data tar-parse-info) + (unless (string-match regexp (aref tar-data 2)) + (error "Package does not untar cleanly into directory %s/" dir)))) + (tar-untar-buffer)) (defun package-unpack (name version) - (let ((pkg-dir (expand-file-name (concat (symbol-name name) "-" version) - package-user-dir))) + (let* ((dirname (concat (symbol-name name) "-" version)) + (pkg-dir (expand-file-name dirname package-user-dir))) (make-directory package-user-dir t) ;; FIXME: should we delete PKG-DIR if it exists? (let* ((default-directory (file-name-as-directory package-user-dir))) - (package-untar-buffer) + (package-untar-buffer dirname) (package-generate-autoloads (symbol-name name) pkg-dir) (let ((load-path (cons pkg-dir load-path))) (byte-recompile-directory pkg-dir 0 t))))) @@ -942,7 +936,8 @@ FILE is the name of the tar file to examine. The return result is a vector like `package-buffer-info'." (let ((default-directory (file-name-directory file)) (file (file-name-nondirectory file))) - (unless (string-match "^\\(.+\\)-\\([0-9.]+\\)\\.tar$" file) + (unless (string-match (concat "\\`" package-subdirectory-regexp "\\.tar\\'") + file) (error "Invalid package name `%s'" file)) (let* ((pkg-name (match-string-no-properties 1 file)) (pkg-version (match-string-no-properties 2 file)) diff --git a/lisp/startup.el b/lisp/startup.el index 65b1a013c21..e8e85a41c77 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -392,6 +392,15 @@ Warning Warning!!! Pure space overflow !!!Warning Warning :type 'directory :initialize 'custom-initialize-delay) +(defconst package-subdirectory-regexp + "\\([^.].*?\\)-\\([0-9]+\\(?:[.][0-9]+\\|\\(?:pre\\|beta\\|alpha\\)[0-9]+\\)*\\)" + "Regular expression matching the name of a package subdirectory. +The first subexpression is the package name. +The second subexpression is the version string. + +The regexp should not contain a starting \"\\`\" or a trailing + \"\\'\"; those are added automatically by callers.") + (defun normal-top-level-add-subdirs-to-load-path () "Add all subdirectories of current directory to `load-path'. More precisely, this uses only the subdirectories whose names @@ -1194,9 +1203,9 @@ the `--debug-init' option to view a complete error backtrace." (when (file-directory-p dir) (dolist (subdir (directory-files dir)) (when (and (file-directory-p (expand-file-name subdir dir)) - ;; package-subdirectory-regexp from package.el - (string-match "\\`\\([^.].*?\\)-\\([0-9]+\\(?:[.][0-9]+\\|\\(?:pre\\|beta\\|alpha\\)[0-9]+\\)*\\)\\'" - subdir)) + (string-match + (concat "\\`" package-subdirectory-regexp "\\'") + subdir)) (throw 'package-dir-found t))))))) (package-initialize)) -- 2.39.2