From f80d701ec8966800e0f71038df9eb3580ed7b320 Mon Sep 17 00:00:00 2001 From: Tino Calancha Date: Fri, 5 Nov 2021 04:35:08 +0100 Subject: [PATCH] Fix (un)compressing directories in Tramp * lisp/net/tramp-sh.el (tramp-sh-handle-dired-compress-file): Check whether the file is a directory (bug#50581). --- lisp/net/tramp-sh.el | 34 +++++++++++++++++++++++----------- test/lisp/net/tramp-tests.el | 33 +++++++++++++++++++++++++++++++++ 2 files changed, 56 insertions(+), 11 deletions(-) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 6f3b3245225..62921909406 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -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) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 47ef46f8ec0..737e2209cc8 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -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." -- 2.39.2