From 8de7995ae6388e5ae5418cb6af579281121f14a4 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 8 Oct 2022 12:19:40 -0400 Subject: [PATCH] package.el: Understand a few more variations in tarball formats * 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. --- lisp/emacs-lisp/package.el | 10 +++++--- .../package-resources/ustar-withsub-0.1.tar | Bin 0 -> 10240 bytes .../package-resources/v7-withsub-0.1.tar | Bin 0 -> 10240 bytes test/lisp/emacs-lisp/package-tests.el | 24 ++++++++++++++++-- 4 files changed, 29 insertions(+), 5 deletions(-) create mode 100644 test/lisp/emacs-lisp/package-resources/ustar-withsub-0.1.tar create mode 100644 test/lisp/emacs-lisp/package-resources/v7-withsub-0.1.tar diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 4268f7d27a7..d619142d64c 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -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 diff --git a/test/lisp/emacs-lisp/package-resources/ustar-withsub-0.1.tar b/test/lisp/emacs-lisp/package-resources/ustar-withsub-0.1.tar new file mode 100644 index 0000000000000000000000000000000000000000..009c4fc420c7c69f971d16a8a67d1f73b2cd1c19 GIT binary patch literal 10240 zcmeH~&2FPG5P);$DJ*g*tmM=Xex&jM-Q%A2PGFK)B{l-ncHe%-q-lb>DOm-nsxllP z@|ZFH#-HVMt;rkyBF(n#R$MHC+4PqXkx1isCWHvmSe!nwslR4HvB{~S!_Q>k1b>IW6y8(tDpX9{qOfJxEdy#$A8pcq*!;Xe-tlcs{dpa zIG^Z~`rog$UYJ*N{^biJBCuvhr`{j-fxZ1fa_}Gf_4P;nvHyknuj)qrANPOfDw6c_ zHzaV*|F;vt0;=mLHRgX5ig*9<9ANkVL|_~Fe?9xL3|W@3!5YAdGtN1?2KaAiTB+3o!}FyLWb^qv?~JZ=UOHY0>rM?nf_c8f znCs%rlgdDo7e+pVZS;1~wwRQ;KcT8LTQ_<)eA)GV$MNb$Kg$x>-C%aU9evo{P8d|# zvMn@lb35RGjy?aso&OI12>Y5g-CYfCvx)B0vO)01+SpM1Tko0U|&IhyW2F K0z}}J2>b~`xbg%oi>cmy+s`{^SIb5HP>f78K-!huYv$3oO@Bo`*(gR-V(fE>2n@N5s$$1 z^TNOzXK;!#NWdigntyAsA2t3@0$u)Z{$H2F9P_be{LKG=dw2g=JZ$|BmgN6f{DSvN3k{z-yEGwbp8qE39G{n>C zG&yONt0c3W47VrQ`vP!W3&6I`#Sv0tnWS3O*i<@4tSS=`><`Ry1=~^`dvDsVYgtZF zs#;_Svu;vuGia}4Gf9+L1$!*<)pxxP(}Vx4IP6B+1D^SB{tE8?M}B+$`@SCzEn8|E zi9n;qJ4)l3#te#!vyfqxmZH$c+eghBdm6_>Y5g-CYfCvx)B0vO)01+SpM1Tko P0U|&IhyW2F0xf}Gg}tyk literal 0 HcmV?d00001 diff --git a/test/lisp/emacs-lisp/package-tests.el b/test/lisp/emacs-lisp/package-tests.el index b903cd781ba..ffe4d7cd5fd 100644 --- a/test/lisp/emacs-lisp/package-tests.el +++ b/test/lisp/emacs-lisp/package-tests.el @@ -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 ()