Fix tar-mode reading the oldgnu Tar format

This makes sure an entry for a long file name will not
accidentally appear as a directory, and thus its size will be
disregarded, causing corrupted file headers for all the subsequent
entries.  The original problem happened because the long file name
truncated to 99 bytes happened to end in a slash, which tar-mode
takes to be the indication of a directory.
* lisp/tar-mode.el (tar-header-block-tokenize): Accept an
additional argument DISABLE-SLASH; if non-nil, don't set the
link-type field of the descriptor to 5 (meaning a directory) just
because the name ends in a slash.  Use this argument when calling
itself recursively, to read the entry of the file with a long
name.  Set the link-type to 5 if the long name ends in a slash.
(Bug#38777)
This commit is contained in:
Eli Zaretskii 2019-12-30 18:17:03 +02:00
parent e3ec84fd7d
commit 59f71d20ea

View file

@ -223,10 +223,14 @@ Preserve the modified states of the buffers and set `buffer-swapped-with'."
"Round S up to the next multiple of 512." "Round S up to the next multiple of 512."
(ash (ash (+ s 511) -9) 9)) (ash (ash (+ s 511) -9) 9))
(defun tar-header-block-tokenize (pos coding) (defun tar-header-block-tokenize (pos coding &optional disable-slash)
"Return a `tar-header' structure. "Return a `tar-header' structure.
This is a list of name, mode, uid, gid, size, This is a list of name, mode, uid, gid, size,
write-date, checksum, link-type, and link-name." write-date, checksum, link-type, and link-name.
CODING is our best guess for decoding non-ASCII file names.
DISABLE-SLASH, if non-nil, means don't decide an entry is a directory
based on the trailing slash, only based on the \"link-type\" field
of the file header. This is used for \"old GNU\" Tar format."
(if (> (+ pos 512) (point-max)) (error "Malformed Tar header")) (if (> (+ pos 512) (point-max)) (error "Malformed Tar header"))
(cl-assert (zerop (mod (- pos (point-min)) 512))) (cl-assert (zerop (mod (- pos (point-min)) 512)))
(cl-assert (not enable-multibyte-characters)) (cl-assert (not enable-multibyte-characters))
@ -272,7 +276,7 @@ write-date, checksum, link-type, and link-name."
(decode-coding-string name coding) (decode-coding-string name coding)
linkname linkname
(decode-coding-string linkname coding)) (decode-coding-string linkname coding))
(if (and (null link-p) (string-match "/\\'" name)) (if (and (null link-p) (null disable-slash) (string-match "/\\'" name))
(setq link-p 5)) ; directory (setq link-p 5)) ; directory
(if (and (equal name "././@LongLink") (if (and (equal name "././@LongLink")
@ -283,12 +287,23 @@ write-date, checksum, link-type, and link-name."
;; This is a GNU Tar long-file-name header. ;; This is a GNU Tar long-file-name header.
(let* ((size (tar-parse-octal-integer (let* ((size (tar-parse-octal-integer
string tar-size-offset tar-time-offset)) string tar-size-offset tar-time-offset))
;; -1 so as to strip the terminating 0 byte. ;; The long name is in the next 512-byte block.
;; We've already moved POS there, when we computed
;; STRING above.
(name (decode-coding-string (name (decode-coding-string
;; -1 so as to strip the terminating 0 byte.
(buffer-substring pos (+ pos size -1)) coding)) (buffer-substring pos (+ pos size -1)) coding))
;; Tokenize the header of the _real_ file entry,
;; which is further 512 bytes into the archive.
(descriptor (tar-header-block-tokenize (descriptor (tar-header-block-tokenize
(+ pos (tar-roundup-512 size)) (+ pos (tar-roundup-512 size)) coding
coding))) ;; Don't intuit directories from
;; the trailing slash, because the
;; truncated name might by chance end
;; in a slash.
'ignore-trailing-slash)))
;; Fix the descriptor of the real file entry by using
;; the information from the long name entry.
(cond (cond
((eq link-p (- ?L ?0)) ;GNUTYPE_LONGNAME. ((eq link-p (- ?L ?0)) ;GNUTYPE_LONGNAME.
(setf (tar-header-name descriptor) name)) (setf (tar-header-name descriptor) name))
@ -296,6 +311,10 @@ write-date, checksum, link-type, and link-name."
(setf (tar-header-link-name descriptor) name)) (setf (tar-header-link-name descriptor) name))
(t (t
(message "Unrecognized GNU Tar @LongLink format"))) (message "Unrecognized GNU Tar @LongLink format")))
;; Fix the "link-type" attribute, based on the long name.
(if (and (null (tar-header-link-type descriptor))
(string-match "/\\'" name))
(setf (tar-header-link-type descriptor) 5)) ; directory
(setf (tar-header-header-start descriptor) (setf (tar-header-header-start descriptor)
(copy-marker (- pos 512) t)) (copy-marker (- pos 512) t))
descriptor) descriptor)