--- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -757,6 +757,8 @@ defun package-untar-buffer (dir) (dolist (tar-data tar-parse-info) (let ((name (expand-file-name (tar-header-name tar-data)))) (or (string-match regexp name) + ;; Ignore non-extractable entries (e. g., pax_global_header.) + (not (tar-header-extractable-p tar-data)) ;; Tarballs created by some utilities don't list ;; directories with a trailing slash (Bug#13136). (and (string-equal dir name) @@ -1291,4 +1293,3 @@ defun package-tar-file-info () "Find package information for a tar file. The return result is a `package-desc'." (cl-assert (derived-mode-p 'tar-mode)) - (let* ((dir-name (file-name-directory e- (tar-header-name (car tar-parse-info)))) + (let* ((dir-name + ;; Take care of pax_global_header, if any. + (or (file-name-directory (tar-header-name (car tar-parse-info))) + (file-name-directory (tar-header-name (cadr tar-parse-info))))) (desc-file (package--description-file dir-name)) (tar-desc (tar-get-file-descriptor (concat dir-name desc-file)))) (unless tar-desc --- a/lisp/tar-mode.el +++ b/lisp/tar-mode.el @@ -331,6 +331,17 @@ (tar-roundup-512 size) 0)))) +(defun tar-header-extractable-p (descriptor) + "Return non-nil if DESCRIPTOR refers to a file we can extract. +Currently tar-mode only supports extracting regular files and (to a +limited extent) directories. + +If DESCRIPTOR is an integer, it is handled as a link type." + (let ((type (if (integerp descriptor) + descriptor + (tar-header-link-type descriptor)))) + (memq '(nil 0 5) type))) + (defun tar-parse-octal-integer (string &optional start end) (if (null start) (setq start 0)) (if (null end) (setq end (length string))) @@ -531,9 +542,17 @@ (concat (if (= type 1) " ==> " " --> ") link-name) "")))) -(defun tar-untar-buffer () - "Extract all archive members in the tar-file into the current directory." +(defun tar-untar-buffer (&optional filter) + "Extract all archive members in the tar-file into the current directory. + +Optional FILTER is a function called with the Tar header (descriptor) +as its only argument for each of archive members in turn. Any given +member will only be extracted if the function returns non-nil. + +If FILTER is not given or nil, use `tar-header-extractable-p'." (interactive) + (unless filter + (setq filter 'tar-header-extractable-p)) ;; FIXME: make it work even if we're not in tar-mode. (let ((descriptors tar-parse-info)) ;Read the var in its buffer. (with-current-buffer @@ -546,7 +565,8 @@ defun tar-untar-buffer () (file-name-directory name))) (start (tar-header-data-start descriptor)) (end (+ start (tar-header-size descriptor)))) - (unless (file-directory-p name) + (when (and (not (file-directory-p name)) + (funcall filter descriptor)) (message "Extracting %s" name) (if (and dir (not (file-exists-p dir))) (make-directory dir t))