diff options
| author | Chong Yidong <cyd@gnu.org> | 2012-12-29 19:06:10 +0800 |
|---|---|---|
| committer | Chong Yidong <cyd@gnu.org> | 2012-12-29 19:06:10 +0800 |
| commit | 3c94d7a636863b61de68199e5767bb093503551a (patch) | |
| tree | c07cdb1d412ea3bce0d9fb62109e7fc1eb8b9ba6 | |
| parent | af39894ab4b8a68eef14b39c030577b419a582a8 (diff) | |
| download | emacs-3c94d7a636863b61de68199e5767bb093503551a.tar.gz | |
* emacs-lisp/package.el (package-untar-buffer): Improve integrity check for tarball contents.
| -rw-r--r-- | lisp/ChangeLog | 5 | ||||
| -rw-r--r-- | lisp/emacs-lisp/package.el | 18 |
2 files changed, 16 insertions, 7 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 4ed7103270e..5907f5ef7ec 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2012-12-29 Chong Yidong <cyd@gnu.org> + + * emacs-lisp/package.el (package-untar-buffer): Improve integrity + check for the tarball contents. + 2012-12-29 Matt Fidler <matt.fidler@alcon.com> (tiny change) * emacs-lisp/package.el (package-untar-buffer): Handle problematic diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 54d133b166c..96435e52f11 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -596,6 +596,8 @@ EXTRA-PROPERTIES is currently unused." (defvar tar-parse-info) (declare-function tar-untar-buffer "tar-mode" ()) +(declare-function tar-header-name "tar-mode" (tar-header)) +(declare-function tar-header-link-type "tar-mode" (tar-header)) (defun package-untar-buffer (dir) "Untar the current buffer. @@ -604,14 +606,16 @@ untar into a directory named DIR; otherwise, signal an error." (require 'tar-mode) (tar-mode) ;; Make sure everything extracts into DIR. - (let ((regexp (concat "\\`" (regexp-quote dir) - ;; Tarballs created by some utilities don't - ;; list directories with a trailing slash - ;; (Bug#13136). - "\\(/\\|\\'\\)"))) + (let ((regexp (concat "\\`" (regexp-quote (expand-file-name dir)) "/")) + (case-fold-search (memq system-type '(windows-nt ms-dos cygwin)))) (dolist (tar-data tar-parse-info) - (unless (string-match regexp (aref tar-data 2)) - (error "Package does not untar cleanly into directory %s/" dir)))) + (let ((name (expand-file-name (tar-header-name tar-data)))) + (or (string-match regexp name) + ;; Tarballs created by some utilities don't list + ;; directories with a trailing slash (Bug#13136). + (and (string-equal dir name) + (eq (tar-header-link-type tar-data) 5)) + (error "Package does not untar cleanly into directory %s/" dir))))) (tar-untar-buffer)) (defun package-unpack (package version) |