Mercurial > emacs
comparison lisp/tar-mode.el @ 9724:193eeb5e78aa
(tar-summarize-buffer): Improperly terminated archive now produces only a
warning.
| author | Karl Heuer <kwzh@gnu.org> |
|---|---|
| date | Thu, 27 Oct 1994 18:29:49 +0000 |
| parents | b321ed01c3dc |
| children | cf4658356724 |
comparison
equal
deleted
inserted
replaced
| 9723:ba541f60aa46 | 9724:193eeb5e78aa |
|---|---|
| 396 (message "parsing tar file...") | 396 (message "parsing tar file...") |
| 397 (let* ((result '()) | 397 (let* ((result '()) |
| 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)) |
| 440 (tar-dolist (tar-desc tar-parse-info) | 443 (tar-dolist (tar-desc tar-parse-info) |
| 441 (insert-string | 444 (insert-string |
| 442 (tar-header-block-summarize (tar-desc-tokens tar-desc))) | 445 (tar-header-block-summarize (tar-desc-tokens tar-desc))) |
| 443 (insert-string "\n")) | 446 (insert-string "\n")) |
| 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 |
| 452 (if tar-mode-map | 454 (if tar-mode-map |
| 453 nil | 455 nil |