41 |
;; This code now understands the extra fields that GNU tar adds to tar files. |
;; This code now understands the extra fields that GNU tar adds to tar files. |
42 |
|
|
43 |
;; This interacts correctly with "uncompress.el" in the Emacs library, |
;; This interacts correctly with "uncompress.el" in the Emacs library, |
44 |
;; which you get with |
;; which you get with |
45 |
;; |
;; |
46 |
;; (autoload 'uncompress-while-visiting "uncompress") |
;; (autoload 'uncompress-while-visiting "uncompress") |
47 |
;; (setq auto-mode-alist (cons '("\\.Z$" . uncompress-while-visiting) |
;; (setq auto-mode-alist (cons '("\\.Z$" . uncompress-while-visiting) |
49 |
;; |
;; |
50 |
;; Do not attempt to use tar-mode.el with crypt.el, you will lose. |
;; Do not attempt to use tar-mode.el with crypt.el, you will lose. |
51 |
|
|
52 |
;; *************** TO DO *************** |
;; *************** TO DO *************** |
53 |
;; |
;; |
54 |
;; o chmod should understand "a+x,og-w". |
;; o chmod should understand "a+x,og-w". |
55 |
;; |
;; |
56 |
;; o It's not possible to add a NEW file to a tar archive; not that |
;; o It's not possible to add a NEW file to a tar archive; not that |
57 |
;; important, but still... |
;; important, but still... |
58 |
;; |
;; |
59 |
;; o The code is less efficient that it could be - in a lot of places, I |
;; o The code is less efficient that it could be - in a lot of places, I |
64 |
;; of an archive, where <esc> would leave you in a subfile-edit buffer. |
;; of an archive, where <esc> would leave you in a subfile-edit buffer. |
65 |
;; (Like the Meta-R command of the Zmacs mail reader.) |
;; (Like the Meta-R command of the Zmacs mail reader.) |
66 |
;; |
;; |
67 |
;; o Sometimes (but not always) reverting the tar-file buffer does not |
;; o Sometimes (but not always) reverting the tar-file buffer does not |
68 |
;; re-grind the listing, and you are staring at the binary tar data. |
;; re-grind the listing, and you are staring at the binary tar data. |
69 |
;; Typing 'g' again immediately after that will always revert and re-grind |
;; Typing 'g' again immediately after that will always revert and re-grind |
70 |
;; it, though. I have no idea why this happens. |
;; it, though. I have no idea why this happens. |
76 |
;; might be a problem if the tar write-file-hook does not come *first* on |
;; might be a problem if the tar write-file-hook does not come *first* on |
77 |
;; the list. |
;; the list. |
78 |
;; |
;; |
79 |
;; o Block files, sparse files, continuation files, and the various header |
;; o Block files, sparse files, continuation files, and the various header |
80 |
;; types aren't editable. Actually I don't know that they work at all. |
;; types aren't editable. Actually I don't know that they work at all. |
81 |
|
|
82 |
;; Rationale: |
;; Rationale: |
103 |
(defcustom tar-anal-blocksize 20 |
(defcustom tar-anal-blocksize 20 |
104 |
"*The blocksize of tar files written by Emacs, or nil, meaning don't care. |
"*The blocksize of tar files written by Emacs, or nil, meaning don't care. |
105 |
The blocksize of a tar file is not really the size of the blocks; rather, it is |
The blocksize of a tar file is not really the size of the blocks; rather, it is |
106 |
the number of blocks written with one system call. When tarring to a tape, |
the number of blocks written with one system call. When tarring to a tape, |
107 |
this is the size of the *tape* blocks, but when writing to a file, it doesn't |
this is the size of the *tape* blocks, but when writing to a file, it doesn't |
108 |
matter much. The only noticeable difference is that if a tar file does not |
matter much. The only noticeable difference is that if a tar file does not |
109 |
have a blocksize of 20, tar will tell you that; all this really controls is |
have a blocksize of 20, tar will tell you that; all this really controls is |
117 |
tar file will update its datestamp. If false, the datestamp is unchanged. |
tar file will update its datestamp. If false, the datestamp is unchanged. |
118 |
You may or may not want this - it is good in that you can tell when a file |
You may or may not want this - it is good in that you can tell when a file |
119 |
in a tar archive has been changed, but it is bad for the same reason that |
in a tar archive has been changed, but it is bad for the same reason that |
120 |
editing a file in the tar archive at all is bad - the changed version of |
editing a file in the tar archive at all is bad - the changed version of |
121 |
the file never exists on disk." |
the file never exists on disk." |
122 |
:type 'boolean |
:type 'boolean |
123 |
:group 'tar) |
:group 'tar) |
201 |
|
|
202 |
(defun tar-header-block-tokenize (string) |
(defun tar-header-block-tokenize (string) |
203 |
"Return a `tar-header' structure. |
"Return a `tar-header' structure. |
204 |
This is a list of name, mode, uid, gid, size, |
This is a list of name, mode, uid, gid, size, |
205 |
write-date, checksum, link-type, and link-name." |
write-date, checksum, link-type, and link-name." |
206 |
(cond ((< (length string) 512) nil) |
(cond ((< (length string) 512) nil) |
207 |
(;(some 'plusp string) ; <-- oops, massive cycle hog! |
(;(some 'plusp string) ; <-- oops, massive cycle hog! |
349 |
(format "%c%c%s%8s/%-8s%7s%s %s%s" |
(format "%c%c%s%8s/%-8s%7s%s %s%s" |
350 |
(if mod-p ?* ? ) |
(if mod-p ?* ? ) |
351 |
(cond ((or (eq type nil) (eq type 0)) ?-) |
(cond ((or (eq type nil) (eq type 0)) ?-) |
352 |
((eq type 1) ?l) ; link |
((eq type 1) ?h) ; link |
353 |
((eq type 2) ?s) ; symlink |
((eq type 2) ?l) ; symlink |
354 |
((eq type 3) ?c) ; char special |
((eq type 3) ?c) ; char special |
355 |
((eq type 4) ?b) ; block special |
((eq type 4) ?b) ; block special |
356 |
((eq type 5) ?d) ; directory |
((eq type 5) ?d) ; directory |
375 |
"")))) |
"")))) |
376 |
|
|
377 |
(defun tar-untar-buffer () |
(defun tar-untar-buffer () |
378 |
"Extract all archive members in the tar-file." |
"Extract all archive members in the tar-file into the current directory." |
379 |
(interactive) |
(interactive) |
380 |
(let ((multibyte enable-multibyte-characters)) |
(let ((multibyte enable-multibyte-characters)) |
381 |
(unwind-protect |
(unwind-protect |
386 |
(let* ((tokens (tar-desc-tokens descriptor)) |
(let* ((tokens (tar-desc-tokens descriptor)) |
387 |
(name (tar-header-name tokens)) |
(name (tar-header-name tokens)) |
388 |
(dir (file-name-directory name)) |
(dir (file-name-directory name)) |
389 |
(start (+ (tar-desc-data-start descriptor) tar-header-offset -1)) |
(start (+ (tar-desc-data-start descriptor) |
390 |
|
(- tar-header-offset (point-min)))) |
391 |
(end (+ start (tar-header-size tokens)))) |
(end (+ start (tar-header-size tokens)))) |
392 |
(message "Extracting %s" name) |
(unless (file-directory-p name) |
393 |
(if (and dir (not (file-exists-p dir))) |
(message "Extracting %s" name) |
394 |
(make-directory dir t)) |
(if (and dir (not (file-exists-p dir))) |
395 |
(write-region start end name) |
(make-directory dir t)) |
396 |
(set-file-modes name (tar-header-mode tokens))))) |
(unless (file-directory-p name) |
397 |
|
(write-region start end name)) |
398 |
|
(set-file-modes name (tar-header-mode tokens)))))) |
399 |
(set-buffer-multibyte multibyte)))) |
(set-buffer-multibyte multibyte)))) |
400 |
|
|
401 |
(defun tar-summarize-buffer () |
(defun tar-summarize-buffer () |
406 |
(set-buffer-multibyte nil) |
(set-buffer-multibyte nil) |
407 |
(message "Parsing tar file...") |
(message "Parsing tar file...") |
408 |
(let* ((result '()) |
(let* ((result '()) |
409 |
(pos 1) |
(pos (point-min)) |
410 |
(bs (max 1 (- (buffer-size) 1024))) ; always 2+ empty blocks at end. |
(bs (max 1 (- (buffer-size) 1024))) ; always 2+ empty blocks at end. |
411 |
(bs100 (max 1 (/ bs 100))) |
(bs100 (max 1 (/ bs 100))) |
412 |
tokens) |
tokens) |
465 |
(insert total-summaries)) |
(insert total-summaries)) |
466 |
(make-local-variable 'tar-header-offset) |
(make-local-variable 'tar-header-offset) |
467 |
(setq tar-header-offset (point)) |
(setq tar-header-offset (point)) |
468 |
(narrow-to-region 1 tar-header-offset) |
(narrow-to-region (point-min) tar-header-offset) |
469 |
(if enable-multibyte-characters |
(if enable-multibyte-characters |
470 |
(setq tar-header-offset (position-bytes tar-header-offset))) |
(setq tar-header-offset (position-bytes tar-header-offset))) |
471 |
(set-buffer-modified-p nil)))) |
(set-buffer-modified-p nil)))) |
555 |
;;;###autoload |
;;;###autoload |
556 |
(define-derived-mode tar-mode nil "Tar" |
(define-derived-mode tar-mode nil "Tar" |
557 |
"Major mode for viewing a tar file as a dired-like listing of its contents. |
"Major mode for viewing a tar file as a dired-like listing of its contents. |
558 |
You can move around using the usual cursor motion commands. |
You can move around using the usual cursor motion commands. |
559 |
Letters no longer insert themselves. |
Letters no longer insert themselves. |
560 |
Type `e' to pull a file out of the tar file and into its own buffer; |
Type `e' to pull a file out of the tar file and into its own buffer; |
561 |
or click mouse-2 on the file's line in the Tar mode buffer. |
or click mouse-2 on the file's line in the Tar mode buffer. |
562 |
Type `c' to copy an entry from the tar file into another file on disk. |
Type `c' to copy an entry from the tar file into another file on disk. |
563 |
|
|
564 |
If you edit a sub-file of this archive (as with the `e' command) and |
If you edit a sub-file of this archive (as with the `e' command) and |
565 |
save it with Control-x Control-s, the contents of that buffer will be |
save it with Control-x Control-s, the contents of that buffer will be |
566 |
saved back into the tar-file buffer; in this way you can edit a file |
saved back into the tar-file buffer; in this way you can edit a file |
567 |
inside of a tar archive without extracting it and re-archiving it. |
inside of a tar archive without extracting it and re-archiving it. |
568 |
|
|
569 |
See also: variables `tar-update-datestamp' and `tar-anal-blocksize'. |
See also: variables `tar-update-datestamp' and `tar-anal-blocksize'. |
584 |
(set (make-local-variable 'write-contents-hooks) '(tar-mode-write-file)) |
(set (make-local-variable 'write-contents-hooks) '(tar-mode-write-file)) |
585 |
(widen) |
(widen) |
586 |
(if (and (boundp 'tar-header-offset) tar-header-offset) |
(if (and (boundp 'tar-header-offset) tar-header-offset) |
587 |
(narrow-to-region 1 (byte-to-position tar-header-offset)) |
(narrow-to-region (point-min) (byte-to-position tar-header-offset)) |
588 |
(tar-summarize-buffer) |
(tar-summarize-buffer) |
589 |
(tar-next-line 0))) |
(tar-next-line 0))) |
590 |
|
|
597 |
(interactive "P") |
(interactive "P") |
598 |
(or (and (boundp 'tar-superior-buffer) tar-superior-buffer) |
(or (and (boundp 'tar-superior-buffer) tar-superior-buffer) |
599 |
(error "This buffer is not an element of a tar file")) |
(error "This buffer is not an element of a tar file")) |
600 |
;;; Don't do this, because it is redundant and wastes mode line space. |
;; Don't do this, because it is redundant and wastes mode line space. |
601 |
;;; (or (assq 'tar-subfile-mode minor-mode-alist) |
;; (or (assq 'tar-subfile-mode minor-mode-alist) |
602 |
;;; (setq minor-mode-alist (append minor-mode-alist |
;; (setq minor-mode-alist (append minor-mode-alist |
603 |
;;; (list '(tar-subfile-mode " TarFile"))))) |
;; (list '(tar-subfile-mode " TarFile"))))) |
604 |
(make-local-variable 'tar-subfile-mode) |
(make-local-variable 'tar-subfile-mode) |
605 |
(setq tar-subfile-mode |
(setq tar-subfile-mode |
606 |
(if (null p) |
(if (null p) |
607 |
(not tar-subfile-mode) |
(not tar-subfile-mode) |
608 |
(> (prefix-numeric-value p) 0))) |
(> (prefix-numeric-value p) 0))) |
609 |
(cond (tar-subfile-mode |
(cond (tar-subfile-mode |
610 |
(make-local-variable 'local-write-file-hooks) |
(add-hook 'write-file-functions 'tar-subfile-save-buffer nil t) |
|
(setq local-write-file-hooks '(tar-subfile-save-buffer)) |
|
611 |
;; turn off auto-save. |
;; turn off auto-save. |
612 |
(auto-save-mode -1) |
(auto-save-mode -1) |
613 |
(setq buffer-auto-save-file-name nil) |
(setq buffer-auto-save-file-name nil) |
614 |
(run-hooks 'tar-subfile-mode-hook)) |
(run-hooks 'tar-subfile-mode-hook)) |
615 |
(t |
(t |
616 |
(kill-local-variable 'local-write-file-hooks)))) |
(remove-hook 'write-file-functions 'tar-subfile-save-buffer t)))) |
617 |
|
|
618 |
|
|
619 |
;; Revert the buffer and recompute the dired-like listing. |
;; Revert the buffer and recompute the dired-like listing. |
692 |
(tokens (tar-desc-tokens descriptor)) |
(tokens (tar-desc-tokens descriptor)) |
693 |
(name (tar-header-name tokens)) |
(name (tar-header-name tokens)) |
694 |
(size (tar-header-size tokens)) |
(size (tar-header-size tokens)) |
695 |
(start (+ (tar-desc-data-start descriptor) tar-header-offset -1)) |
(start (+ (tar-desc-data-start descriptor) |
696 |
|
(- tar-header-offset (point-min)))) |
697 |
(end (+ start size))) |
(end (+ start size))) |
698 |
(let* ((tar-buffer (current-buffer)) |
(let* ((tar-buffer (current-buffer)) |
699 |
(tar-buffer-multibyte enable-multibyte-characters) |
(tar-buffer-multibyte enable-multibyte-characters) |
739 |
name (- (point-max) (point))))))) |
name (- (point-max) (point))))))) |
740 |
(multibyte enable-multibyte-characters) |
(multibyte enable-multibyte-characters) |
741 |
(detected (detect-coding-region |
(detected (detect-coding-region |
742 |
1 (min 16384 (point-max)) t))) |
(point-min) |
743 |
|
(min (+ (point-min) 16384) (point-max)) t))) |
744 |
(if coding |
(if coding |
745 |
(or (numberp (coding-system-eol-type coding)) |
(or (numberp (coding-system-eol-type coding)) |
746 |
(setq coding (coding-system-change-eol-conversion |
(setq coding (coding-system-change-eol-conversion |
761 |
(setq coding |
(setq coding |
762 |
(coding-system-change-text-conversion |
(coding-system-change-text-conversion |
763 |
coding 'raw-text))) |
coding 'raw-text))) |
764 |
(decode-coding-region 1 (point-max) coding) |
(decode-coding-region (point-min) (point-max) coding) |
765 |
(set-buffer-file-coding-system coding)) |
(set-buffer-file-coding-system coding)) |
766 |
;; Set the default-directory to the dir of the |
;; Set the default-directory to the dir of the |
767 |
;; superior buffer. |
;; superior buffer. |
768 |
(setq default-directory |
(setq default-directory |
769 |
(save-excursion |
(save-excursion |
770 |
(set-buffer tar-buffer) |
(set-buffer tar-buffer) |
775 |
(make-local-variable 'tar-superior-descriptor) |
(make-local-variable 'tar-superior-descriptor) |
776 |
(setq tar-superior-buffer tar-buffer) |
(setq tar-superior-buffer tar-buffer) |
777 |
(setq tar-superior-descriptor descriptor) |
(setq tar-superior-descriptor descriptor) |
778 |
(setq buffer-read-only read-only-p) |
(setq buffer-read-only read-only-p) |
779 |
(set-buffer-modified-p nil) |
(set-buffer-modified-p nil) |
780 |
(tar-subfile-mode 1)) |
(tar-subfile-mode 1)) |
781 |
(set-buffer tar-buffer)) |
(set-buffer tar-buffer)) |
782 |
(narrow-to-region 1 tar-header-offset) |
(narrow-to-region (point-min) tar-header-offset) |
783 |
(set-buffer-multibyte tar-buffer-multibyte))) |
(set-buffer-multibyte tar-buffer-multibyte))) |
784 |
(if view-p |
(if view-p |
785 |
(view-buffer buffer (and just-created 'kill-buffer)) |
(view-buffer buffer (and just-created 'kill-buffer)) |
835 |
(tokens (tar-desc-tokens descriptor)) |
(tokens (tar-desc-tokens descriptor)) |
836 |
(name (tar-header-name tokens)) |
(name (tar-header-name tokens)) |
837 |
(size (tar-header-size tokens)) |
(size (tar-header-size tokens)) |
838 |
(start (+ (tar-desc-data-start descriptor) tar-header-offset -1)) |
(start (+ (tar-desc-data-start descriptor) |
839 |
|
(- tar-header-offset (point-min)))) |
840 |
(end (+ start size)) |
(end (+ start size)) |
841 |
(multibyte enable-multibyte-characters) |
(multibyte enable-multibyte-characters) |
842 |
(inhibit-file-name-handlers inhibit-file-name-handlers) |
(inhibit-file-name-handlers inhibit-file-name-handlers) |
927 |
(tar-setf (tar-desc-data-start desc) |
(tar-setf (tar-desc-data-start desc) |
928 |
(- (tar-desc-data-start desc) data-length)))) |
(- (tar-desc-data-start desc) data-length)))) |
929 |
)) |
)) |
930 |
(narrow-to-region 1 tar-header-offset)) |
(narrow-to-region (point-min) tar-header-offset)) |
931 |
|
|
932 |
|
|
933 |
(defun tar-expunge (&optional noconfirm) |
(defun tar-expunge (&optional noconfirm) |
949 |
(forward-line 1))) |
(forward-line 1))) |
950 |
;; after doing the deletions, add any padding that may be necessary. |
;; after doing the deletions, add any padding that may be necessary. |
951 |
(tar-pad-to-blocksize) |
(tar-pad-to-blocksize) |
952 |
(narrow-to-region 1 tar-header-offset)) |
(narrow-to-region (point-min) tar-header-offset)) |
953 |
(set-buffer-multibyte multibyte) |
(set-buffer-multibyte multibyte) |
954 |
(if (zerop n) |
(if (zerop n) |
955 |
(message "Nothing to expunge.") |
(message "Nothing to expunge.") |
1064 |
(delete-region p (point)) |
(delete-region p (point)) |
1065 |
(insert (tar-header-block-summarize tokens) "\n") |
(insert (tar-header-block-summarize tokens) "\n") |
1066 |
(setq tar-header-offset (position-bytes (point-max)))) |
(setq tar-header-offset (position-bytes (point-max)))) |
1067 |
|
|
1068 |
(widen) |
(widen) |
1069 |
(set-buffer-multibyte nil) |
(set-buffer-multibyte nil) |
1070 |
(let* ((start (+ (tar-desc-data-start descriptor) tar-header-offset -513))) |
(let* ((start (+ (tar-desc-data-start descriptor) tar-header-offset -513))) |
1089 |
(buffer-substring start (+ start 512)) |
(buffer-substring start (+ start 512)) |
1090 |
chk (tar-header-name tokens)) |
chk (tar-header-name tokens)) |
1091 |
))) |
))) |
1092 |
(narrow-to-region 1 tar-header-offset) |
(narrow-to-region (point-min) tar-header-offset) |
1093 |
(set-buffer-multibyte multibyte) |
(set-buffer-multibyte multibyte) |
1094 |
(tar-next-line 0)))) |
(tar-next-line 0)))) |
1095 |
|
|
1139 |
(widen) |
(widen) |
1140 |
(set-buffer-multibyte nil) |
(set-buffer-multibyte nil) |
1141 |
;; delete the old data... |
;; delete the old data... |
1142 |
(let* ((data-start (+ start tar-header-offset -1)) |
(let* ((data-start (+ start (- tar-header-offset (point-min)))) |
1143 |
(data-end (+ data-start (ash (ash (+ size 511) -9) 9)))) |
(data-end (+ data-start (ash (ash (+ size 511) -9) 9)))) |
1144 |
(delete-region data-start data-end) |
(delete-region data-start data-end) |
1145 |
;; insert the new data... |
;; insert the new data... |
1208 |
))) |
))) |
1209 |
;; after doing the insertion, add any final padding that may be necessary. |
;; after doing the insertion, add any final padding that may be necessary. |
1210 |
(tar-pad-to-blocksize)) |
(tar-pad-to-blocksize)) |
1211 |
(narrow-to-region 1 tar-header-offset) |
(narrow-to-region (point-min) tar-header-offset) |
1212 |
(set-buffer-multibyte tar-buffer-multibyte))) |
(set-buffer-multibyte tar-buffer-multibyte))) |
1213 |
(set-buffer-modified-p t) ; mark the tar file as modified |
(set-buffer-modified-p t) ; mark the tar file as modified |
1214 |
(tar-next-line 0) |
(tar-next-line 0) |
1271 |
buffer-file-name nil t)) |
buffer-file-name nil t)) |
1272 |
(tar-clear-modification-flags) |
(tar-clear-modification-flags) |
1273 |
(set-buffer-modified-p nil)) |
(set-buffer-modified-p nil)) |
1274 |
(narrow-to-region 1 (byte-to-position tar-header-offset))) |
(narrow-to-region (point-min) (byte-to-position tar-header-offset))) |
1275 |
;; Return t because we've written the file. |
;; Return t because we've written the file. |
1276 |
t) |
t) |
1277 |
|
|