Commit 3c94d7a6 authored by Chong Yidong's avatar Chong Yidong

* emacs-lisp/package.el (package-untar-buffer): Improve integrity check for tarball contents.

parent af39894a
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
......
......@@ -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)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment