bug#19481: package.el: support .tar archives featuring a pax_global_header entry

[Ivan Shmakov]

>>>>> Ivan Shmakov <ivan@siamics.net> writes:
>>>>> Eli Zaretskii <eliz@gnu.org> writes:
>>>>> From: Ivan Shmakov  Date: Thu, 01 Jan 2015 17:55:46 +0000

[…]

 >>> * lisp/tar-mode.el (tar-untar-buffer): Ignore archive entries with
 >>> link type being 55 (pax global extended header.)

 >> What about type 72?

 > Frankly, – no idea; I don’t seem to recall seeing one so far.

 > In order not to place such checks all over the code, we may want
 > either a separate tar-header-service-p function for the
 > tar-untar-buffer callers to use to decide whether the file will be
 > extracted or not, /or/ an optional filter function argument to
 > tar-untar-buffer for the /caller/ to specify which files to filter
 > out.

        Please consider the revised patch MIMEd.

        * lisp/tar-mode.el (tar-header-extractable-p): New function.
        (tar-untar-buffer): Use it; or use the value of the new optional
        argument instead.

        * lisp/emacs-lisp/package.el (package-untar-buffer): Use
        tar-header-extractable-p.
        (package-tar-file-info): Consider the second file name in the
        archive if the first one has no directory component.

[…]

-- 
FSF associate member #7257  http://boycottsystemd.org/  … 3013 B6A0 230E 334A

--- 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))