Mercurial > emacs
changeset 95378:4eddf6f13d89
(tar-header): New field `header-start'.
(tar-header-block-tokenize): Set it when useful.
Drop "GNUtar " magic value, which even GNU Tar doesn't know about.
(tar-header-data-end): New function.
(tar-summarize-buffer): Use it.
(tar-next-line): Fix goal column for long usernames.
(tar-expunge-internal): Use header-start.
(tar-rename-entry): Handle ustar-style long names.
(tar-alter-one-field): Add optional `descriptor' argument.
(tar-subfile-save-buffer): Use it.
| author | Stefan Monnier <monnier@iro.umontreal.ca> |
|---|---|
| date | Thu, 29 May 2008 05:25:22 +0000 |
| parents | 0c4bba8ae9f2 |
| children | 7b3fda45dbec |
| files | lisp/ChangeLog lisp/tar-mode.el |
| diffstat | 2 files changed, 111 insertions(+), 96 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/ChangeLog Thu May 29 04:46:59 2008 +0000 +++ b/lisp/ChangeLog Thu May 29 05:25:22 2008 +0000 @@ -1,5 +1,22 @@ +2008-05-29 Stefan Monnier <monnier@iro.umontreal.ca> + + * tar-mode.el (tar-header): New field `header-start'. + (tar-header-block-tokenize): Set it when useful. + Drop "GNUtar " magic value, which even GNU Tar doesn't know about. + (tar-header-data-end): New function. + (tar-summarize-buffer): Use it. + (tar-next-line): Fix goal column for long usernames. + (tar-expunge-internal): Use header-start. + (tar-rename-entry): Handle ustar-style long names. + (tar-alter-one-field): Add optional `descriptor' argument. + (tar-subfile-save-buffer): Use it. + 2008-05-28 Stefan Monnier <monnier@iro.umontreal.ca> + * tar-mode.el (tar-header): New field `header-start'. + (tar-header-block-tokenize): Set header-start for longlink entries. + (tar-expunge-internal): Use header-start to expunge longlink entries. + * files.el (hack-local-variables): Don't signal an error if the local variable section is not properly terminated.
--- a/lisp/tar-mode.el Thu May 29 04:46:59 2008 +0000 +++ b/lisp/tar-mode.el Thu May 29 05:25:22 2008 +0000 @@ -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: @@ -181,7 +180,10 @@ 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)) @@ -223,8 +225,7 @@ (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"))) + (uname-valid-p (car (member magic-str '("ustar " "ustar\0\0")))) name linkname (nulsexp "[^\000]*\000")) (when (string-match nulsexp string tar-name-offset) @@ -240,7 +241,7 @@ 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\0") (string-match nulsexp string tar-prefix-offset) (> (match-end 0) (1+ tar-prefix-offset))) (setq name (concat (substring string tar-prefix-offset @@ -271,6 +272,8 @@ (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 +294,19 @@ (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 +347,6 @@ (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) @@ -449,27 +464,20 @@ (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))) (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)) + (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))) - (push descriptor result) - - (and (null (tar-header-link-type descriptor)) - (> size 0) - (setq pos (+ pos (tar-roundup-512 size))))))) - (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. @@ -617,7 +625,7 @@ (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 @@ -674,7 +682,7 @@ "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 +913,7 @@ (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 +922,10 @@ (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 +1020,29 @@ (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\0") + (tar-alter-one-field tar-magic-offset "ustar\0\0")) + (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 +1056,43 @@ (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 +1149,19 @@ (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