- (setq string (string-as-unibyte string))
- (cond ((< (length string) 512) nil)
- (;(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 (1- tar-uname-offset)))
- (uname-valid-p (or (string= "ustar " magic-str) (string= "GNUtar " magic-str)
- (string= "ustar\0000" magic-str)))
- 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 uname-valid-p
- (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)))
- (if default-enable-multibyte-characters
- (setq name
- (decode-coding-string name tar-file-name-coding-system)
- linkname
- (decode-coding-string linkname
- tar-file-name-coding-system)))
- (if (and (null link-p) (string-match "/\\'" name)) (setq link-p 5)) ; directory
- (make-tar-header
- 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-long-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
- (and uname-valid-p (substring string tar-uname-offset uname-end))
- (and uname-valid-p (substring string tar-gname-offset gname-end))
- (tar-parse-octal-integer string tar-dmaj-offset tar-dmin-offset)
- (tar-parse-octal-integer string tar-dmin-offset tar-prefix-offset)
- )))
- (t 'empty-tar-block)))
-
+ (if (> (+ pos 512) (point-max)) (error "Malformed Tar header"))
+ (assert (zerop (mod (- pos (point-min)) 512)))
+ (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)))
+ (if (default-value 'enable-multibyte-characters)
+ (setq name
+ (decode-coding-string name coding)
+ linkname
+ (decode-coding-string linkname coding)))
+ (if (and (null link-p) (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")))
+ ;; This is a GNU Tar long-file-name header.
+ (let* ((size (tar-parse-octal-integer
+ string tar-size-offset tar-time-offset))
+ ;; -1 so as to strip the terminating 0 byte.
+ (name (decode-coding-string
+ (buffer-substring pos (+ pos size -1)) coding))
+ (descriptor (tar-header-block-tokenize
+ (+ pos (tar-roundup-512 size))
+ coding)))
+ (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")))
+ (setf (tar-header-header-start descriptor)
+ (copy-marker (- pos 512) t))
+ 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-long-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)
+ (let* ((data-start (tar-header-data-start descriptor))
+ (link-type (tar-header-link-type descriptor))
+ (size (tar-header-size descriptor))
+ (fudge (cond
+ ;; Foo. There's an extra empty block after these.
+ ((memq link-type '(20 55)) 512)
+ (t 0))))
+ (+ data-start fudge
+ (if (and (null link-type) (> size 0))
+ (tar-roundup-512 size)
+ 0))))