diff options
| author | Karl Heuer | 1994-10-27 18:29:49 +0000 |
|---|---|---|
| committer | Karl Heuer | 1994-10-27 18:29:49 +0000 |
| commit | 7bfcceabaa587248fc72912beb8a3da513337f9e (patch) | |
| tree | 1701ea446a656ce64a63ca44b4d6d057400189fa | |
| parent | bf074c060ca957e67f1828422e0d018aefdfad97 (diff) | |
| download | emacs-7bfcceabaa587248fc72912beb8a3da513337f9e.tar.gz emacs-7bfcceabaa587248fc72912beb8a3da513337f9e.zip | |
(tar-summarize-buffer): Improperly terminated archive now produces only a
warning.
| -rw-r--r-- | lisp/tar-mode.el | 68 |
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 | ||