diff options
| author | Noam Postavsky | 2016-12-17 18:01:52 -0500 |
|---|---|---|
| committer | Noam Postavsky | 2017-01-01 16:36:23 -0500 |
| commit | 214a67b00b7b47445bcff284168da56b4934ffdb (patch) | |
| tree | 5d248890aef4b0c6190c7474c27f74f91c802108 /lisp | |
| parent | 5da2a5f449cd0c8f16f2244c90b57e27ca373892 (diff) | |
| download | emacs-214a67b00b7b47445bcff284168da56b4934ffdb.tar.gz emacs-214a67b00b7b47445bcff284168da56b4934ffdb.zip | |
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.
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/tar-mode.el | 31 |
1 files changed, 20 insertions, 11 deletions
diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el index 345333b8bc4..f25b1a45ba1 100644 --- a/lisp/tar-mode.el +++ b/lisp/tar-mode.el | |||
| @@ -544,6 +544,7 @@ MODE should be an integer which is a file mode value." | |||
| 544 | (dir (if (eq (tar-header-link-type descriptor) 5) | 544 | (dir (if (eq (tar-header-link-type descriptor) 5) |
| 545 | name | 545 | name |
| 546 | (file-name-directory name))) | 546 | (file-name-directory name))) |
| 547 | (link-desc (tar--describe-as-link descriptor)) | ||
| 547 | (start (tar-header-data-start descriptor)) | 548 | (start (tar-header-data-start descriptor)) |
| 548 | (end (+ start (tar-header-size descriptor)))) | 549 | (end (+ start (tar-header-size descriptor)))) |
| 549 | (unless (file-directory-p name) | 550 | (unless (file-directory-p name) |
| @@ -552,6 +553,10 @@ MODE should be an integer which is a file mode value." | |||
| 552 | (make-directory dir t)) | 553 | (make-directory dir t)) |
| 553 | (unless (file-directory-p name) | 554 | (unless (file-directory-p name) |
| 554 | (let ((coding-system-for-write 'no-conversion)) | 555 | (let ((coding-system-for-write 'no-conversion)) |
| 556 | (when link-desc | ||
| 557 | (lwarn '(tar link) :warning | ||
| 558 | "Extracted `%s', %s, as a normal file" | ||
| 559 | name link-desc)) | ||
| 555 | (write-region start end name))) | 560 | (write-region start end name))) |
| 556 | (set-file-modes name (tar-header-mode descriptor)))))))) | 561 | (set-file-modes name (tar-header-mode descriptor)))))))) |
| 557 | 562 | ||
| @@ -816,19 +821,23 @@ tar-file's buffer." | |||
| 816 | nil | 821 | nil |
| 817 | (error "This line does not describe a tar-file entry")))) | 822 | (error "This line does not describe a tar-file entry")))) |
| 818 | 823 | ||
| 819 | (defun tar--check-descriptor (descriptor) | 824 | (defun tar--describe-as-link (descriptor) |
| 820 | (let ((link-p (tar-header-link-type descriptor))) | 825 | (let ((link-p (tar-header-link-type descriptor))) |
| 821 | (if link-p | 826 | (if link-p |
| 822 | (error "This is %s, not a real file" | 827 | (cond ((eq link-p 5) "a directory") |
| 823 | (cond ((eq link-p 5) "a directory") | 828 | ((eq link-p 20) "a tar directory header") |
| 824 | ((eq link-p 20) "a tar directory header") | 829 | ((eq link-p 28) "a next has longname") |
| 825 | ((eq link-p 28) "a next has longname") | 830 | ((eq link-p 29) "a multivolume-continuation") |
| 826 | ((eq link-p 29) "a multivolume-continuation") | 831 | ((eq link-p 35) "a sparse entry") |
| 827 | ((eq link-p 35) "a sparse entry") | 832 | ((eq link-p 38) "a volume header") |
| 828 | ((eq link-p 38) "a volume header") | 833 | ((eq link-p 55) "a pax global extended header") |
| 829 | ((eq link-p 55) "a pax global extended header") | 834 | ((eq link-p 72) "a pax extended header") |
| 830 | ((eq link-p 72) "a pax extended header") | 835 | (t "a link"))))) |
| 831 | (t "a link")))))) | 836 | |
| 837 | (defun tar--check-descriptor (descriptor) | ||
| 838 | (let ((link-desc (tar--describe-as-link descriptor))) | ||
| 839 | (when link-desc | ||
| 840 | (error "This is %s, not a real file" link-desc)))) | ||
| 832 | 841 | ||
| 833 | (defun tar-get-descriptor () | 842 | (defun tar-get-descriptor () |
| 834 | (let* ((descriptor (tar-current-descriptor)) | 843 | (let* ((descriptor (tar-current-descriptor)) |