mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-20 18:17:20 +00:00
Code Issues Releases Activity

package.el: Understand a few more variations in tarball formats

Browse Source 
* lisp/emacs-lisp/package.el (package-untar-buffer): Fix thinko.
(package-tar-file-info): Handle the case where the first file is in
a subdirectory.

* test/lisp/emacs-lisp/package-tests.el (package-test-bug58367): New test.
* test/lisp/emacs-lisp/package-resources/ustar-withsub-0.1.tar:
* test/lisp/emacs-lisp/package-resources/v7-withsub-0.1.tar: New files.
This commit is contained in:
Stefan Monnier 2022-10-08 12:19:40 -04:00
parent b8ab4f018b
commit 8de7995ae6
4 changed files with 29 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
lisp/emacs-lisp/package.el
View File

@ -930,7 +930,7 @@ untar into a directory named DIR; otherwise, signal an error."
(or (string-match regexp name)
;; Tarballs created by some utilities don't list
;; directories with a trailing slash (Bug#13136).
(and (string-equal dir name)
(and (string-equal (expand-file-name dir) name)
(eq (tar-header-link-type tar-data) 5))
(error "Package does not untar cleanly into directory %s/" dir)))))
(tar-untar-buffer))
@ -1192,8 +1192,12 @@ Return the pkg-desc, with desc-kind set to KIND."
"Find package information for a tar file.
The return result is a `package-desc'."
(cl-assert (derived-mode-p 'tar-mode))
(let* ((dir-name (file-name-directory
(tar-header-name (car tar-parse-info))))
(let* ((dir-name (named-let loop
((filename (tar-header-name (car tar-parse-info))))
(let ((dirname (file-name-directory filename)))
;; The first file can be in a subdir: look for the top.
(if dirname (loop (directory-file-name dirname))
(file-name-as-directory filename)))))
(desc-file (package--description-file dir-name))
(tar-desc (tar-get-file-descriptor (concat dir-name desc-file))))
(unless tar-desc

BIN
test/lisp/emacs-lisp/package-resources/ustar-withsub-0.1.tar Normal file
View File

Binary file not shown.

BIN
test/lisp/emacs-lisp/package-resources/v7-withsub-0.1.tar Normal file
View File

Binary file not shown.

24
test/lisp/emacs-lisp/package-tests.el
View File

@ -275,11 +275,31 @@ Must called from within a `tar-mode' buffer."
(let* ((pkg-el "multi-file-0.2.3.tar")
(source-file (expand-file-name pkg-el (ert-resource-directory))))
(package-initialize)
(should-not (package-installed-p 'multie-file))
(package-install-file source-file)
(should (package-installed-p 'multi-file))
(package-delete (cadr (assq 'multi-file package-alist))))
(package-delete (cadr (assq 'multi-file package-alist))))))
(ert-deftest package-test-bug58367 ()
"Check variations in tarball formats."
(with-package-test (:basedir (ert-resource-directory))
(package-initialize)
;; A package whose first entry is the main dir but without trailing /.
(let* ((pkg-el "ustar-withsub-0.1.tar")
(source-file (expand-file-name pkg-el (ert-resource-directory))))
(should-not (package-installed-p 'ustar-withsub))
(package-install-file source-file)
(should (package-installed-p 'ustar-withsub))
(package-delete (cadr (assq 'ustar-withsub package-alist))))
;; A package whose first entry is a file in a subdir.
(let* ((pkg-el "v7-withsub-0.1.tar")
(source-file (expand-file-name pkg-el (ert-resource-directory))))
(should-not (package-installed-p 'v7-withsub))
(package-install-file source-file)
(should (package-installed-p 'v7-withsub))
(package-delete (cadr (assq 'v7-withsub package-alist))))
))
(ert-deftest package-test-install-file-EOLs ()