From 3443574a66dc05ec78b0f3b15fb7231ce228c713 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 27 Jul 2023 19:09:33 +0300 Subject: [PATCH] ; * lisp/tar-mode.el (tar-header-block-tokenize): Fix logic (bug#64686). --- lisp/tar-mode.el | 212 +++++++++++++++++++++++------------------------ 1 file changed, 106 insertions(+), 106 deletions(-) diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el index 4e9843123b0..e4ea95343e0 100644 --- a/lisp/tar-mode.el +++ b/lisp/tar-mode.el @@ -364,112 +364,112 @@ of the file header. This is used for \"old GNU\" Tar format." (if (and (null link-p) (null disable-slash) (string-match "/\\'" name)) (setq link-p 5)) ; directory - (if (member magic-str '("ustar " "ustar\0")) - (if (equal name "././@LongLink") - ;; Supposedly @LongLink is only used for GNUTAR - ;; format (i.e. "ustar ") but some POSIX Tar files - ;; (with "ustar\0") have been seen using it as well. - ;; This is a GNU Tar long-file-name header. - (let* ((size (tar-parse-octal-integer - string tar-size-offset tar-time-offset)) - ;; 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 - ;; -1 so as to strip the terminating 0 byte. - (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 - (+ pos (tar-roundup-512 size)) 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 - ((eq link-p (- ?L ?0)) ;GNUTYPE_LONGNAME. - (setf (tar-header-name descriptor) name)) - ((eq link-p (- ?K ?0)) ;GNUTYPE_LONGLINK. - (setf (tar-header-link-name descriptor) name)) - (t - (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) - (copy-marker (- pos 512) t)) - descriptor) - ;; Posix pax extended header. FIXME: support ?g as well. - (if (eq link-p (- ?x ?0)) - ;; Get whatever attributes are in the extended header, - (let* ((pax-attrs (tar-parse-pax-extended-header pos)) - (gid (pax-header-gid pax-attrs)) - (gname (pax-header-gname pax-attrs)) - (linkpath (pax-header-linkpath pax-attrs)) - (mtime (pax-header-mtime pax-attrs)) - (path (pax-header-path pax-attrs)) - (size (pax-header-size pax-attrs)) - (uid (pax-header-uid pax-attrs)) - (uname (pax-header-uname pax-attrs)) - ;; Tokenize the header of the _real_ file entry, - ;; which is further 512 bytes into the archive. - (descriptor - (tar-header-block-tokenize (+ pos 512) coding - 'ignore-trailing-slash))) - ;; Fix the descriptor of the real file entry by - ;; overriding some of the fields with the information - ;; from the extended header. - (if gid - (setf (tar-header-gid descriptor) gid)) - (if gname - (setf (tar-header-gname descriptor) gname)) - (if linkpath - (setf (tar-header-link-name descriptor) linkpath)) - (if mtime - (setf (tar-header-date descriptor) mtime)) - (if path - (setf (tar-header-name descriptor) path)) - (if size - (setf (tar-header-size descriptor) size)) - (if uid - (setf (tar-header-uid descriptor) uid)) - (if uname - (setf (tar-header-uname descriptor) uname)) - descriptor) - - (make-tar-header - (copy-marker pos nil) - name - (tar-parse-octal-integer string tar-mode-offset - tar-uid-offset) - (tar-parse-octal-integer string tar-uid-offset - tar-gid-offset) - (tar-parse-octal-integer string tar-gid-offset - tar-size-offset) - (tar-parse-octal-integer string tar-size-offset - tar-time-offset) - (tar-parse-octal-integer string tar-time-offset - tar-chk-offset) - (tar-parse-octal-integer string tar-chk-offset - tar-linkp-offset) - link-p - linkname - uname-valid-p - (when uname-valid-p - (decode-coding-string - (substring string tar-uname-offset uname-end) coding)) - (when uname-valid-p - (decode-coding-string - (substring string tar-gname-offset gname-end) coding)) - (tar-parse-octal-integer string tar-dmaj-offset - tar-dmin-offset) - (tar-parse-octal-integer string tar-dmin-offset - tar-prefix-offset) - )))))))) + (if (and (equal name "././@LongLink") + ;; Supposedly @LongLink is only used for GNUTAR + ;; format (i.e. "ustar ") but some POSIX Tar files + ;; (with "ustar\0") have been seen using it as well. + (member magic-str '("ustar " "ustar\0"))) + (let* ((size (tar-parse-octal-integer + string tar-size-offset tar-time-offset)) + ;; 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 + ;; -1 so as to strip the terminating 0 byte. + (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 + (+ pos (tar-roundup-512 size)) 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 + ((eq link-p (- ?L ?0)) ;GNUTYPE_LONGNAME. + (setf (tar-header-name descriptor) name)) + ((eq link-p (- ?K ?0)) ;GNUTYPE_LONGLINK. + (setf (tar-header-link-name descriptor) name)) + (t + (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) + (copy-marker (- pos 512) t)) + descriptor) + ;; Posix pax extended header. FIXME: support ?g as well. + (if (and (eq link-p (- ?x ?0)) + (member magic-str '("ustar " "ustar\0"))) + ;; Get whatever attributes are in the extended header, + (let* ((pax-attrs (tar-parse-pax-extended-header pos)) + (gid (pax-header-gid pax-attrs)) + (gname (pax-header-gname pax-attrs)) + (linkpath (pax-header-linkpath pax-attrs)) + (mtime (pax-header-mtime pax-attrs)) + (path (pax-header-path pax-attrs)) + (size (pax-header-size pax-attrs)) + (uid (pax-header-uid pax-attrs)) + (uname (pax-header-uname pax-attrs)) + ;; Tokenize the header of the _real_ file entry, + ;; which is further 512 bytes into the archive. + (descriptor + (tar-header-block-tokenize (+ pos 512) coding + 'ignore-trailing-slash))) + ;; Fix the descriptor of the real file entry by + ;; overriding some of the fields with the information + ;; from the extended header. + (if gid + (setf (tar-header-gid descriptor) gid)) + (if gname + (setf (tar-header-gname descriptor) gname)) + (if linkpath + (setf (tar-header-link-name descriptor) linkpath)) + (if mtime + (setf (tar-header-date descriptor) mtime)) + (if path + (setf (tar-header-name descriptor) path)) + (if size + (setf (tar-header-size descriptor) size)) + (if uid + (setf (tar-header-uid descriptor) uid)) + (if uname + (setf (tar-header-uname descriptor) uname)) + descriptor) + + (make-tar-header + (copy-marker pos nil) + name + (tar-parse-octal-integer string tar-mode-offset + tar-uid-offset) + (tar-parse-octal-integer string tar-uid-offset + tar-gid-offset) + (tar-parse-octal-integer string tar-gid-offset + tar-size-offset) + (tar-parse-octal-integer string tar-size-offset + tar-time-offset) + (tar-parse-octal-integer string tar-time-offset + tar-chk-offset) + (tar-parse-octal-integer string tar-chk-offset + tar-linkp-offset) + link-p + linkname + uname-valid-p + (when uname-valid-p + (decode-coding-string + (substring string tar-uname-offset uname-end) coding)) + (when uname-valid-p + (decode-coding-string + (substring string tar-gname-offset gname-end) coding)) + (tar-parse-octal-integer string tar-dmaj-offset + tar-dmin-offset) + (tar-parse-octal-integer string tar-dmin-offset + tar-prefix-offset) + ))))))) ;; Pseudo-field. (defun tar-header-data-end (descriptor) -- 2.39.2