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:
parent
5da2a5f449
commit
214a67b00b
@ -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))
|
||||
|
Loading…
Reference in New Issue
Block a user