X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/dd798c64f3b27b657d04bba804bf0a63759609ca..80ddad17acad2466d0aa04f208d14f56a3fd2ff3:/lisp/tar-mode.el diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el index e3ca528ad8..12c39117dd 100644 --- a/lisp/tar-mode.el +++ b/lisp/tar-mode.el @@ -1,7 +1,7 @@ ;;; tar-mode.el --- simple editing of tar files from GNU emacs ;; Copyright (C) 1990, 1991, 1993, 1994, 1995, 1996, 1997, 1998, 1999, -;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. +;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. ;; Author: Jamie Zawinski ;; Maintainer: FSF @@ -93,9 +93,8 @@ ;;; Bugs: -;; - Expunge and rename on ././@LongLink files +;; - Rename on ././@LongLink files ;; - Revert confirmation displays the raw data temporarily. -;; - Incorrect goal-column if username is too long. ;;; Code: @@ -160,16 +159,31 @@ This information is useful, but it takes screen space away from file names." (defvar tar-data-buffer nil "Buffer that holds the actual raw tar bytes.") (make-variable-buffer-local 'tar-data-buffer) +(defvar tar-data-swapped nil + "If non-nil, `tar-data-buffer' indeed holds raw tar bytes.") +(make-variable-buffer-local 'tar-data-swapped) + (defun tar-data-swapped-p () "Return non-nil if the tar-data is in `tar-data-buffer'." - ;; We need to be careful to keep track of which buffer holds the tar-data, - ;; since we swap them back and forth. Since the user may make the summary - ;; buffer unibyte, we can't rely on the multibyteness of the buffers. - ;; We could try and recognize the tar-format signature, but instead - ;; I decided to go for something simpler. (and (buffer-live-p tar-data-buffer) - (> (buffer-size tar-data-buffer) (buffer-size)))) - + ;; Sanity check to try and make sure tar-data-swapped tracks the swap + ;; state correctly: the raw data is expected to be always larger than + ;; the summary. + (progn + (assert (eq tar-data-swapped + (> (buffer-size tar-data-buffer) (buffer-size)))) + tar-data-swapped))) + +(defun tar-swap-data () + "Swap buffer contents between current buffer and `tar-data-buffer'. +Preserve the modified states of the buffers and set `buffer-swapped-with'." + (let ((data-buffer-modified-p (buffer-modified-p tar-data-buffer)) + (current-buffer-modified-p (buffer-modified-p))) + (buffer-swap-text tar-data-buffer) + (setq tar-data-swapped (not tar-data-swapped)) + (restore-buffer-modified-p data-buffer-modified-p) + (with-current-buffer tar-data-buffer + (restore-buffer-modified-p current-buffer-modified-p)))) ;;; down to business. @@ -181,7 +195,10 @@ This information is useful, but it takes screen space away from file names." make-tar-header (data-start name mode uid gid size date checksum link-type link-name magic uname gname dmaj dmin))) data-start name mode uid gid size date checksum link-type link-name - magic uname gname dmaj dmin) + magic uname gname dmaj dmin + ;; Start of the header can be nil (meaning it's 512 bytes before data-start) + ;; or a marker (in case the header uses LongLink thingies). + header-start) (defconst tar-name-offset 0) (defconst tar-mode-offset (+ tar-name-offset 100)) @@ -205,7 +222,7 @@ This information is useful, but it takes screen space away from file names." "Round S up to the next multiple of 512." (ash (ash (+ s 511) -9) 9)) -(defun tar-header-block-tokenize (pos) +(defun tar-header-block-tokenize (pos coding) "Return a `tar-header' structure. This is a list of name, mode, uid, gid, size, write-date, checksum, link-type, and link-name." @@ -222,9 +239,13 @@ write-date, checksum, link-type, and link-name." (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 (member magic-str - '("ustar " "GNUtar " "ustar\0\0"))) + ;; The magic string is actually 6bytes + ;; of magic string plus 2bytes of version + ;; which we here ignore. + (- tar-uname-offset 2))) + ;; The magic string is "ustar\0" for POSIX format, and + ;; "ustar " for GNU Tar's format. + (uname-valid-p (car (member magic-str '("ustar " "ustar\0")))) name linkname (nulsexp "[^\000]*\000")) (when (string-match nulsexp string tar-name-offset) @@ -240,7 +261,7 @@ write-date, checksum, link-type, and link-name." nil (- link-p ?0))) (setq linkname (substring string tar-link-offset link-end)) - (when (and uname-valid-p + (when (and (equal uname-valid-p "ustar\0") (string-match nulsexp string tar-prefix-offset) (> (match-end 0) (1+ tar-prefix-offset))) (setq name (concat (substring string tar-prefix-offset @@ -248,22 +269,22 @@ write-date, checksum, link-type, and link-name." "/" name))) (if default-enable-multibyte-characters (setq name - (decode-coding-string name tar-file-name-coding-system) + (decode-coding-string name coding) linkname - (decode-coding-string linkname - tar-file-name-coding-system))) + (decode-coding-string linkname coding))) (if (and (null link-p) (string-match "/\\'" name)) (setq link-p 5)) ; directory (if (and (equal name "././@LongLink") - (equal magic-str "ustar ")) ;OLDGNU_MAGIC. + (equal magic-str "ustar ")) ;OLDGNU_MAGIC. ;; This is a GNU Tar long-file-name header. (let* ((size (tar-parse-octal-integer string tar-size-offset tar-time-offset)) ;; -1 so as to strip the terminating 0 byte. (name (buffer-substring pos (+ pos size -1))) (descriptor (tar-header-block-tokenize - (+ pos (tar-roundup-512 size))))) + (+ pos (tar-roundup-512 size)) + coding))) (cond ((eq link-p (- ?L ?0)) ;GNUTYPE_LONGNAME. (setf (tar-header-name descriptor) name)) @@ -271,6 +292,8 @@ write-date, checksum, link-type, and link-name." (setf (tar-header-link-name descriptor) name)) (t (message "Unrecognized GNU Tar @LongLink format"))) + (setf (tar-header-header-start descriptor) + (copy-marker (- pos 512) t)) descriptor) (make-tar-header @@ -291,6 +314,19 @@ write-date, checksum, link-type, and link-name." (tar-parse-octal-integer string tar-dmin-offset tar-prefix-offset) )))))) +;; Pseudo-field. +(defun tar-header-data-end (descriptor) + (let* ((data-start (tar-header-data-start descriptor)) + (link-type (tar-header-link-type descriptor)) + (size (tar-header-size descriptor)) + (fudge (cond + ;; Foo. There's an extra empty block after these. + ((memq link-type '(20 55)) 512) + (t 0)))) + (+ data-start fudge + (if (and (null link-type) (> size 0)) + (tar-roundup-512 size) + 0)))) (defun tar-parse-octal-integer (string &optional start end) (if (null start) (setq start 0)) @@ -331,7 +367,6 @@ write-date, checksum, link-type, and link-name." (defun tar-header-block-checksum (string) "Compute and return a tar-acceptable checksum for this block." (assert (not (multibyte-string-p string))) - (setq string (string-as-unibyte string)) (let* ((chk-field-start tar-chk-offset) (chk-field-end (+ chk-field-start 8)) (sum 0) @@ -383,7 +418,7 @@ MODE should be an integer which is a file mode value." ;; (ck (tar-header-checksum tar-hblock)) (type (tar-header-link-type tar-hblock)) (link-name (tar-header-link-name tar-hblock))) - (format "%c%c%s%8s/%-8s%7s%s %s%s" + (format "%c%c%s %7s/%-7s %7s%s %s%s" (if mod-p ?* ? ) (cond ((or (eq type nil) (eq type 0)) ?-) ((eq type 1) ?h) ; link @@ -441,6 +476,7 @@ MODE should be an integer which is a file mode value." (let* ((modified (buffer-modified-p)) (result '()) (pos (point-min)) + (coding tar-file-name-coding-system) (progress-reporter (with-current-buffer tar-data-buffer (make-progress-reporter "Parsing tar file..." @@ -448,28 +484,21 @@ MODE should be an integer which is a file mode value." descriptor) (with-current-buffer tar-data-buffer (while (and (<= (+ pos 512) (point-max)) - (setq descriptor (tar-header-block-tokenize pos))) - (setq pos (marker-position (tar-header-data-start descriptor))) - (progress-reporter-update progress-reporter pos) - (if (memq (tar-header-link-type descriptor) '(20 55)) - ;; Foo. There's an extra empty block after these. - (setq pos (+ pos 512))) + (setq descriptor (tar-header-block-tokenize pos coding))) (let ((size (tar-header-size descriptor))) (if (< size 0) (error "%s has size %s - corrupted" - (tar-header-name descriptor) size)) - ;; - ;; This is just too slow. Don't really need it anyway.... - ;;(tar-header-block-check-checksum - ;; hblock (tar-header-block-checksum hblock) - ;; (tar-header-name descriptor)) - - (push descriptor result) - - (and (null (tar-header-link-type descriptor)) - (> size 0) - (setq pos (+ pos (tar-roundup-512 size))))))) - + (tar-header-name descriptor) size))) + ;; + ;; This is just too slow. Don't really need it anyway.... + ;;(tar-header-block-check-checksum + ;; hblock (tar-header-block-checksum hblock) + ;; (tar-header-name descriptor)) + + (push descriptor result) + (setq pos (tar-header-data-end descriptor)) + (progress-reporter-update progress-reporter pos))) + (set (make-local-variable 'tar-parse-info) (nreverse result)) ;; A tar file should end with a block or two of nulls, ;; but let's not get a fatal error if it doesn't. @@ -570,7 +599,7 @@ MODE should be an integer which is a file mode value." (defun tar-change-major-mode-hook () ;; Bring the actual Tar data back into the main buffer. - (when (tar-data-swapped-p) (buffer-swap-text tar-data-buffer)) + (when (tar-data-swapped-p) (tar-swap-data)) ;; Throw away the summary. (when (buffer-live-p tar-data-buffer) (kill-buffer tar-data-buffer))) @@ -613,16 +642,19 @@ See also: variables `tar-update-datestamp' and `tar-anal-blocksize'. ;; buffer for the summary. (assert (not (tar-data-swapped-p))) (set (make-local-variable 'revert-buffer-function) 'tar-mode-revert) + ;; We started using write-contents-functions, but this hook is not + ;; used during auto-save, so we now use + ;; write-region-annotate-functions which hooks at a lower-level. (add-hook 'write-region-annotate-functions 'tar-write-region-annotate nil t) (add-hook 'kill-buffer-hook 'tar-mode-kill-buffer-hook nil t) (add-hook 'change-major-mode-hook 'tar-change-major-mode-hook nil t) ;; Tar data is made of bytes, not chars. - (set-buffer-multibyte nil) + (set-buffer-multibyte nil) ;Hopefully a no-op. (set (make-local-variable 'tar-data-buffer) (generate-new-buffer (format " *tar-data %s*" (file-name-nondirectory (or buffer-file-name (buffer-name)))))) - (buffer-swap-text tar-data-buffer) + (tar-swap-data) (tar-summarize-buffer) (tar-next-line 0)) @@ -658,23 +690,21 @@ appear on disk when you save the tar-file's buffer." (defun tar-mode-revert (&optional no-auto-save no-confirm) (unwind-protect (let ((revert-buffer-function nil)) - (if (tar-data-swapped-p) (buffer-swap-text tar-data-buffer)) + (if (tar-data-swapped-p) (tar-swap-data)) ;; FIXME: If we ask for confirmation, the user will be temporarily ;; looking at the raw data. (revert-buffer no-auto-save no-confirm 'preserve-modes) - ;; The new raw data may be smaller than the old summary, so let's - ;; make sure tar-data-swapped-p doesn't get confused. - (if (buffer-live-p tar-data-buffer) (kill-buffer tar-data-buffer)) ;; Recompute the summary. + (if (buffer-live-p tar-data-buffer) (kill-buffer tar-data-buffer)) (tar-mode)) - (unless (tar-data-swapped-p) (buffer-swap-text tar-data-buffer)))) + (unless (tar-data-swapped-p) (tar-swap-data)))) (defun tar-next-line (arg) "Move cursor vertically down ARG lines and to the start of the filename." (interactive "p") (forward-line arg) - (if (eobp) nil (forward-char (if tar-mode-show-date 54 36)))) + (goto-char (or (next-single-property-change (point) 'mouse-face) (point)))) (defun tar-previous-line (arg) "Move cursor vertically up ARG lines and to the start of the filename." @@ -905,14 +935,7 @@ With a prefix argument, un-mark that many files backward." (defun tar-expunge-internal () "Expunge the tar-entry specified by the current line." - (let* ((descriptor (tar-current-descriptor)) - ;; (line (tar-header-data-start descriptor)) - (name (tar-header-name descriptor)) - (size (tar-header-size descriptor)) - (link-p (tar-header-link-type descriptor)) - (start (tar-header-data-start descriptor)) - (following-descs (cdr (memq descriptor tar-parse-info)))) - (if link-p (setq size 0)) ; size lies for hard-links. + (let ((descriptor (tar-current-descriptor))) ;; ;; delete the current line... (delete-region (line-beginning-position) (line-beginning-position 2)) @@ -921,10 +944,10 @@ With a prefix argument, un-mark that many files backward." (setq tar-parse-info (delq descriptor tar-parse-info)) ;; ;; delete the data from inside the file... - (let* ((data-start (- start 512)) - (data-end (+ start (tar-roundup-512 size)))) - (with-current-buffer tar-data-buffer - (delete-region data-start data-end))))) + (with-current-buffer tar-data-buffer + (delete-region (or (tar-header-header-start descriptor) + (- (tar-header-data-start descriptor) 512)) + (tar-header-data-end descriptor))))) (defun tar-expunge (&optional noconfirm) @@ -1019,12 +1042,29 @@ for this to be permanent." (tar-header-name (tar-current-descriptor))))) (if (string= "" new-name) (error "zero length name")) (let ((encoded-new-name (encode-coding-string new-name - tar-file-name-coding-system))) + tar-file-name-coding-system)) + (descriptor (tar-current-descriptor)) + (prefix nil)) + (when (tar-header-header-start descriptor) + ;; FIXME: Make it work for ././@LongLink. + (error "Rename with @LongLink format is not implemented")) + + (when (and (> (length encoded-new-name) 98) + (string-match "/" encoded-new-name + (- (length encoded-new-name) 99)) + (< (match-beginning 0) 155)) + (unless (equal (tar-header-magic descriptor) "ustar\0") + (tar-alter-one-field tar-magic-offset (concat "ustar\0" "00"))) + (setq prefix (substring encoded-new-name 0 (match-beginning 0))) + (setq encoded-new-name (substring encoded-new-name (match-end 0)))) + (if (> (length encoded-new-name) 98) (error "name too long")) - (setf (tar-header-name (tar-current-descriptor)) new-name) - ;; FIXME: Make it work for ././@LongLink. + (setf (tar-header-name descriptor) new-name) (tar-alter-one-field 0 - (substring (concat encoded-new-name (make-string 99 0)) 0 99)))) + (substring (concat encoded-new-name (make-string 99 0)) 0 99)) + (if prefix + (tar-alter-one-field tar-prefix-offset + (substring (concat prefix (make-string 155 0)) 0 155))))) (defun tar-chmod-entry (new-mode) @@ -1038,41 +1078,43 @@ for this to be permanent." (concat (substring (format "%6o" new-mode) 0 6) "\000 "))) -(defun tar-alter-one-field (data-position new-data-string) - (let* ((descriptor (tar-current-descriptor))) - ;; - ;; update the header-line. - (let ((col (current-column))) - (delete-region (line-beginning-position) (line-beginning-position 2)) - (insert (tar-header-block-summarize descriptor) "\n") - (forward-line -1) (move-to-column col)) +(defun tar-alter-one-field (data-position new-data-string &optional descriptor) + (unless descriptor (setq descriptor (tar-current-descriptor))) + ;; + ;; update the header-line. + (let ((col (current-column))) + (delete-region (line-beginning-position) + (prog2 (forward-line 1) + (point) + ;; Insert the new text after the old, before deleting, + ;; to preserve markers such as the window start. + (insert (tar-header-block-summarize descriptor) "\n"))) + (forward-line -1) (move-to-column col)) - (with-current-buffer tar-data-buffer - (let* ((start (- (tar-header-data-start descriptor) 512))) + (assert (tar-data-swapped-p)) + (with-current-buffer tar-data-buffer + (let* ((start (- (tar-header-data-start descriptor) 512))) ;; ;; delete the old field and insert a new one. (goto-char (+ start data-position)) (delete-region (point) (+ (point) (length new-data-string))) ; <-- - (assert (not (or enable-multibyte-characters (multibyte-string-p new-data-string)))) (insert new-data-string) ;; ;; compute a new checksum and insert it. (let ((chk (tar-header-block-checksum - (buffer-substring start (+ start 512))))) - (goto-char (+ start tar-chk-offset)) - (delete-region (point) (+ (point) 8)) - (insert (format "%6o" chk)) - (insert 0) - (insert ? ) - (setf (tar-header-checksum descriptor) chk) - ;; - ;; ok, make sure we didn't botch it. - (tar-header-block-check-checksum - (buffer-substring start (+ start 512)) - chk (tar-header-name descriptor)) - ))))) + (buffer-substring start (+ start 512))))) + (goto-char (+ start tar-chk-offset)) + (delete-region (point) (+ (point) 8)) + (insert (format "%6o\0 " chk)) + (setf (tar-header-checksum descriptor) chk) + ;; + ;; ok, make sure we didn't botch it. + (tar-header-block-check-checksum + (buffer-substring start (+ start 512)) + chk (tar-header-name descriptor)) + )))) (defun tar-octal-time (timeval) @@ -1129,41 +1171,19 @@ to make your changes permanent." (setf (tar-header-size descriptor) subfile-size) ;; ;; Update the size field in the header block. - (widen) - (let ((header-start (- data-start 512))) - (goto-char (+ header-start tar-size-offset)) - (delete-region (point) (+ (point) 12)) - (insert (format "%11o " subfile-size)) - ;; - ;; Maybe update the datestamp. - (if (not tar-update-datestamp) - nil - (goto-char (+ header-start tar-time-offset)) - (delete-region (point) (+ (point) 12)) - (insert (tar-octal-time (current-time))) - (insert ?\s)) - ;; - ;; compute a new checksum and insert it. - (let ((chk (tar-header-block-checksum - (buffer-substring header-start data-start)))) - (goto-char (+ header-start tar-chk-offset)) - (delete-region (point) (+ (point) 8)) - (insert (format "%6o\0 " chk)) - (setf (tar-header-checksum descriptor) chk)))))) + (widen)))) ;; - ;; alter the descriptor-line... + ;; alter the descriptor-line and header ;; (let ((position (- (length tar-parse-info) (length head)))) (goto-char (point-min)) (forward-line position) - (let ((p (point)) - (after (line-beginning-position 2))) - (goto-char after) - ;; Insert the new text after the old, before deleting, - ;; to preserve the window start. - (let ((line (tar-header-block-summarize descriptor t))) - (insert-before-markers line "\n")) - (delete-region p after))) + (tar-alter-one-field tar-size-offset (format "%11o " subfile-size)) + ;; + ;; Maybe update the datestamp. + (when tar-update-datestamp + (tar-alter-one-field tar-time-offset + (concat (tar-octal-time (current-time)) " ")))) ;; After doing the insertion, add any necessary final padding. (tar-pad-to-blocksize)) (set-buffer-modified-p t) ; mark the tar file as modified @@ -1207,10 +1227,10 @@ Leaves the region wide." ;; When called from M-x write-region, we assume the user wants to save ;; (part of) the summary, not the tar data. (unless (or start (not (tar-data-swapped-p))) - (tar-clear-modification-flags) + (tar-clear-modification-flags) (set-buffer tar-data-buffer) nil)) - + (provide 'tar-mode) ;; arch-tag: 8a585a4a-340e-42c2-89e7-d3b1013a4b78