aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lisp/tar-mode.el68
1 files changed, 35 insertions, 33 deletions
diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el
index 190c37988b9..894349cf4f8 100644
--- a/lisp/tar-mode.el
+++ b/lisp/tar-mode.el
@@ -398,42 +398,45 @@ is visible (and the real data of the buffer is hidden)."
398 (pos 1) 398 (pos 1)
399 (bs (max 1 (- (buffer-size) 1024))) ; always 2+ empty blocks at end. 399 (bs (max 1 (- (buffer-size) 1024))) ; always 2+ empty blocks at end.
400 (bs100 (max 1 (/ bs 100))) 400 (bs100 (max 1 (/ bs 100)))
401 (tokens nil)) 401 tokens)
402 (while (not (eq tokens 'empty-tar-block)) 402 (while (and (<= (+ pos 512) (point-max))
403 (if (> (+ pos 512) (point-max)) 403 (not (eq 'empty-tar-block
404 (error "premature EOF parsing tar file")) 404 (setq tokens
405 (setq tokens 405 (tar-header-block-tokenize
406 (tar-header-block-tokenize (buffer-substring pos (+ pos 512)))) 406 (buffer-substring pos (+ pos 512)))))))
407 (setq pos (+ pos 512)) 407 (setq pos (+ pos 512))
408 (message "parsing tar file...%d%%" 408 (message "Parsing tar file...%d%%"
409 ;(/ (* pos 100) bs) ; this gets round-off lossage 409 ;(/ (* pos 100) bs) ; this gets round-off lossage
410 (/ pos bs100) ; this doesn't 410 (/ pos bs100) ; this doesn't
411 ) 411 )
412 (if (eq tokens 'empty-tar-block) 412 (if (eq (tar-header-link-type tokens) 20)
413 nil 413 ;; Foo. There's an extra empty block after these.
414 (if (eq (tar-header-link-type tokens) 20) 414 (setq pos (+ pos 512)))
415 ;; Foo. There's an extra empty block after these. 415 (let ((size (tar-header-size tokens)))
416 (setq pos (+ pos 512))) 416 (if (< size 0)
417 (let ((size (tar-header-size tokens))) 417 (error "%s has size %s - corrupted"
418 (if (< size 0) 418 (tar-header-name tokens) size))
419 (error "%s has size %s - corrupted" 419 ;
420 (tar-header-name tokens) size)) 420 ; This is just too slow. Don't really need it anyway....
421 ; 421 ;(tar-header-block-check-checksum
422 ; This is just too slow. Don't really need it anyway.... 422 ; hblock (tar-header-block-checksum hblock)
423 ;(tar-header-block-check-checksum 423 ; (tar-header-name tokens))
424 ; hblock (tar-header-block-checksum hblock) 424
425 ; (tar-header-name tokens)) 425 (setq result (cons (make-tar-desc pos tokens) result))
426 426
427 (setq result (cons (make-tar-desc pos tokens) result)) 427 (and (null (tar-header-link-type tokens))
428 428 (> size 0)
429 (and (null (tar-header-link-type tokens)) 429 (setq pos
430 (> size 0) 430 (+ pos 512 (ash (ash (1- size) -9) 9)) ; this works
431 (setq pos 431 ;(+ pos (+ size (- 512 (rem (1- size) 512)))) ; this doesn't
432 (+ pos 512 (ash (ash (1- size) -9) 9)) ; this works 432 ))))
433 ;(+ pos (+ size (- 512 (rem (1- size) 512)))) ; this doesn't
434 )))))
435 (make-local-variable 'tar-parse-info) 433 (make-local-variable 'tar-parse-info)
436 (setq tar-parse-info (nreverse result))) 434 (setq tar-parse-info (nreverse result))
435 ;; A tar file should end with a block or two of nulls,
436 ;; but let's not get a fatal error if it doesn't.
437 (if (eq tokens 'empty-tar-block)
438 (message "Parsing tar file...done.")
439 (message "Warning: premature EOF parsing tar file")))
437 (save-excursion 440 (save-excursion
438 (goto-char (point-min)) 441 (goto-char (point-min))
439 (let ((buffer-read-only nil)) 442 (let ((buffer-read-only nil))
@@ -444,8 +447,7 @@ is visible (and the real data of the buffer is hidden)."
444 (make-local-variable 'tar-header-offset) 447 (make-local-variable 'tar-header-offset)
445 (setq tar-header-offset (point)) 448 (setq tar-header-offset (point))
446 (narrow-to-region 1 tar-header-offset) 449 (narrow-to-region 1 tar-header-offset)
447 (set-buffer-modified-p nil))) 450 (set-buffer-modified-p nil))))
448 (message "parsing tar file...done."))
449 451
450(defvar tar-mode-map nil "*Local keymap for Tar mode listings.") 452(defvar tar-mode-map nil "*Local keymap for Tar mode listings.")
451 453