1
0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-12 16:23:57 +00:00

Warn about incomplete untarring of link files

The current tar-mode doesn't really support unpacking symlinks, it
simply creates an empty file of the same name.

* lisp/tar-mode.el (tar--describe-as-link): New function extracted from
`tar--check-descriptor'.
(tar-untar-buffer): Use it to warn about imperfectly untarred link
files.
This commit is contained in:
Noam Postavsky 2016-12-17 18:01:52 -05:00
parent 5da2a5f449
commit 214a67b00b

View File

@ -544,6 +544,7 @@ MODE should be an integer which is a file mode value."
(dir (if (eq (tar-header-link-type descriptor) 5)
name
(file-name-directory name)))
(link-desc (tar--describe-as-link descriptor))
(start (tar-header-data-start descriptor))
(end (+ start (tar-header-size descriptor))))
(unless (file-directory-p name)
@ -552,6 +553,10 @@ MODE should be an integer which is a file mode value."
(make-directory dir t))
(unless (file-directory-p name)
(let ((coding-system-for-write 'no-conversion))
(when link-desc
(lwarn '(tar link) :warning
"Extracted `%s', %s, as a normal file"
name link-desc))
(write-region start end name)))
(set-file-modes name (tar-header-mode descriptor))))))))
@ -816,19 +821,23 @@ tar-file's buffer."
nil
(error "This line does not describe a tar-file entry"))))
(defun tar--check-descriptor (descriptor)
(defun tar--describe-as-link (descriptor)
(let ((link-p (tar-header-link-type descriptor)))
(if link-p
(error "This is %s, not a real file"
(cond ((eq link-p 5) "a directory")
((eq link-p 20) "a tar directory header")
((eq link-p 28) "a next has longname")
((eq link-p 29) "a multivolume-continuation")
((eq link-p 35) "a sparse entry")
((eq link-p 38) "a volume header")
((eq link-p 55) "a pax global extended header")
((eq link-p 72) "a pax extended header")
(t "a link"))))))
(cond ((eq link-p 5) "a directory")
((eq link-p 20) "a tar directory header")
((eq link-p 28) "a next has longname")
((eq link-p 29) "a multivolume-continuation")
((eq link-p 35) "a sparse entry")
((eq link-p 38) "a volume header")
((eq link-p 55) "a pax global extended header")
((eq link-p 72) "a pax extended header")
(t "a link")))))
(defun tar--check-descriptor (descriptor)
(let ((link-desc (tar--describe-as-link descriptor)))
(when link-desc
(error "This is %s, not a real file" link-desc))))
(defun tar-get-descriptor ()
(let* ((descriptor (tar-current-descriptor))