mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-15 10:30:25 -08:00
Code Issues Projects Releases Wiki Activity

Fix (un)compressing directories in Tramp

Browse source 
* lisp/net/tramp-sh.el (tramp-sh-handle-dired-compress-file):
Check whether the file is a directory (bug#50581).
This commit is contained in:
Tino Calancha 2021-11-05 04:35:08 +01:00 • committed by Lars Ingebrigtsen
parent f0768d3145
commit f80d701ec8
2 changed files with 56 additions and 11 deletions
Download patch file Download diff file Expand all files Collapse all files

34
lisp/net/tramp-sh.el
View file

@ -2494,9 +2494,14 @@ The method used must be an out-of-band method."
(with-tramp-progress-reporter
v 0 (format "Uncompressing %s" file)
(when (tramp-send-command-and-check
v (concat (nth 2 suffix) " "
(tramp-shell-quote-argument localname)))
(dired-remove-file file)
v (if (string-match-p "%[io]" (nth 2 suffix))
(replace-regexp-in-string
"%i" (tramp-shell-quote-argument localname)
(nth 2 suffix))
(concat (nth 2 suffix) " "
(tramp-shell-quote-argument localname))))
(unless (string-match-p "\\.tar\\.gz" file)
(dired-remove-file file))
(string-match (car suffix) file)
(concat (substring file 0 (match-beginning 0))))))
(t
@ -2504,14 +2509,21 @@ The method used must be an out-of-band method."
;; Try gzip.
(with-tramp-progress-reporter v 0 (format "Compressing %s" file)
(when (tramp-send-command-and-check
v (concat "gzip -f "
(tramp-shell-quote-argument localname)))
(dired-remove-file file)
(cond ((file-exists-p (concat file ".gz"))
(concat file ".gz"))
((file-exists-p (concat file ".z"))
(concat file ".z"))
(t nil)))))))))
v (if (file-directory-p file)
(format "tar -cf - %s | gzip -c9 > %s.tar.gz"
(tramp-shell-quote-argument
(file-name-nondirectory localname))
(tramp-shell-quote-argument localname))
(concat "gzip -f "
(tramp-shell-quote-argument localname))))
(unless (file-directory-p file)
(dired-remove-file file))
(catch 'found nil
(dolist (target (mapcar (lambda (suffix)
(concat file suffix))
'(".tar.gz" ".gz" ".z")))
(when (file-exists-p target)
(throw 'found target)))))))))))
(defun tramp-sh-handle-insert-directory
(filename switches &optional wildcard full-directory-p)

33
test/lisp/net/tramp-tests.el
View file

@ -62,6 +62,7 @@
(declare-function tramp-list-tramp-buffers "tramp-cmds")
(declare-function tramp-method-out-of-band-p "tramp-sh")
(declare-function tramp-smb-get-localname "tramp-smb")
(declare-function dired-compress "dired-aux")
(defvar ange-ftp-make-backup-files)
(defvar auto-save-file-name-transforms)
(defvar lock-file-name-transforms)
@ -7168,6 +7169,38 @@ Since it unloads Tramp, it shall be the last test to run."
(ignore-errors (all-completions "tramp" (symbol-value x)))
(ert-fail (format "Hook `%s' still contains Tramp function" x))))))
(ert-deftest tramp-test44-dired-compress-file ()
"Check that Tramp (un)compresses normal files."
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
(let ((default-directory tramp-test-temporary-file-directory)
(tmp-name (tramp--test-make-temp-name)))
(write-region "foo" nil tmp-name)
(dired default-directory)
(dired-revert)
(dired-goto-file tmp-name)
(should-not (dired-compress))
(should (string= (concat tmp-name ".gz") (dired-get-filename)))
(should-not (dired-compress))
(should (string= tmp-name (dired-get-filename)))
(delete-file tmp-name)))
(ert-deftest tramp-test44-dired-compress-dir ()
"Check that Tramp (un)compresses directories."
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
(let ((default-directory tramp-test-temporary-file-directory)
(tmp-name (tramp--test-make-temp-name)))
(make-directory tmp-name)
(dired default-directory)
(dired-revert)
(dired-goto-file tmp-name)
(should-not (dired-compress))
(should (string= (concat tmp-name ".tar.gz") (dired-get-filename)))
(should-not (dired-compress))
(should (string= tmp-name (dired-get-filename)))
(delete-directory tmp-name)))
(defun tramp-test-all (&optional interactive)
"Run all tests for \\[tramp].
If INTERACTIVE is non-nil, the tests are run interactively."