Mercurial > emacs

changeset 94270:e1d36e944ae0

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(tar-prefix-offset): New constant. (tar-header-block-tokenize): Support paths with long names which use the "ustar" standard.
author Juri Linkov <juri@jurta.org>
date Tue, 22 Apr 2008 22:49:46 +0000
parents 6806318c3af6
children 2a2794632c84
files lisp/tar-mode.el
diffstat 1 files changed, 12 insertions(+), 4 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/tar-mode.el	Tue Apr 22 22:49:02 2008 +0000
+++ b/lisp/tar-mode.el	Tue Apr 22 22:49:46 2008 +0000
@@ -198,7 +198,8 @@
 (defconst tar-gname-offset (+ tar-uname-offset 32))
 (defconst tar-dmaj-offset (+ tar-gname-offset 32))
 (defconst tar-dmin-offset (+ tar-dmaj-offset 8))
-(defconst tar-end-offset (+ tar-dmin-offset 8))
+(defconst tar-prefix-offset (+ tar-dmin-offset 8))
+(defconst tar-end-offset (+ tar-prefix-offset 155))
 
 (defun tar-header-block-tokenize (string)
   "Return a `tar-header' structure.
@@ -209,13 +210,14 @@
 	(;(some 'plusp string)		 ; <-- oops, massive cycle hog!
 	 (or (not (= 0 (aref string 0))) ; This will do.
 	     (not (= 0 (aref string 101))))
-	 (let* ((name-end (1- tar-mode-offset))
+	 (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)))
+		(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)
@@ -231,6 +233,12 @@
 			    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)
@@ -252,7 +260,7 @@
 	     (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-end-offset)
+	     (tar-parse-octal-integer string tar-dmin-offset tar-prefix-offset)
 	     )))
 	(t 'empty-tar-block)))