Function: tar-header-block-tokenize
tar-header-block-tokenize is a byte-compiled function defined in
tar-mode.el.gz.
Signature
(tar-header-block-tokenize POS CODING &optional DISABLE-SLASH)
Documentation
Return a tar-header structure.
This is a list of name, mode, uid, gid, size, 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.
Source Code
;; Defined in /usr/src/emacs/lisp/tar-mode.el.gz
(defun tar-header-block-tokenize (pos coding &optional disable-slash)
"Return a `tar-header' structure.
This is a list of name, mode, uid, gid, size,
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"))
(cl-assert (zerop (mod (- pos (point-min)) 512)))
(cl-assert (not enable-multibyte-characters))
(let ((string (buffer-substring pos (setq pos (+ pos 512)))))
(when ;(some 'plusp string) ; <-- oops, massive cycle hog!
(or (not (= 0 (aref string 0))) ; This will do.
(not (= 0 (aref string 101))))
(let* ((name-end tar-mode-offset)
(link-end (1- tar-magic-offset))
(uname-end (1- tar-gname-offset))
(gname-end (1- tar-dmaj-offset))
(link-p (aref string tar-linkp-offset))
(magic-str (substring string tar-magic-offset
;; The magic string is actually 6bytes
;; of magic string plus 2bytes of version
;; which we here ignore.
(- tar-uname-offset 2)))
;; The magic string is "ustar\0" for POSIX format, and
;; "ustar " for GNU Tar's format.
(uname-valid-p (car (member magic-str '("ustar " "ustar\0"))))
name linkname
(nulsexp "[^\000]*\000"))
(when (string-match nulsexp string tar-name-offset)
(setq name-end (min name-end (1- (match-end 0)))))
(when (string-match nulsexp string tar-link-offset)
(setq link-end (min link-end (1- (match-end 0)))))
(when (string-match nulsexp string tar-uname-offset)
(setq uname-end (min uname-end (1- (match-end 0)))))
(when (string-match nulsexp string tar-gname-offset)
(setq gname-end (min gname-end (1- (match-end 0)))))
(setq name (substring string tar-name-offset name-end)
link-p (if (or (= link-p 0) (= link-p ?0))
nil
(- link-p ?0)))
(setq linkname (substring string tar-link-offset link-end))
(when (and (equal uname-valid-p "ustar\0")
(string-match nulsexp string tar-prefix-offset)
(> (match-end 0) (1+ tar-prefix-offset)))
(setq name (concat (substring string tar-prefix-offset
(1- (match-end 0)))
"/" name)))
(setq name
(decode-coding-string name coding)
linkname
(decode-coding-string linkname coding))
(if (and (null link-p) (null disable-slash) (string-match "/\\'" name))
(setq link-p 5)) ; directory
(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)
)))))))