master f80d701: Fix (un)compressing directories in Tramp

[Lars Ingebrigtsen]

branch: master
commit f80d701ec8966800e0f71038df9eb3580ed7b320
Author: Tino Calancha <tino.calancha@gmail.com>
Commit: Lars Ingebrigtsen <larsi@gnus.org>

    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 6f3b324..6292190 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 47ef46f..737e220 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."