bug#50581: 27.2.50; Tramp fails to (un)compress directories

[Tino Calancha]

Michael Albinus <michael.albinus@gmx.de> writes:

> Indeed, the directory case is not implemented in 
> tramp-sh-handle-dired-compress-file.
> I will see how to implement it next time.

I have mimic what `dired-compress-file' does: it checks if the
file is a directory.

--8<-----------------------------cut here---------------start------------->8---
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index fbb122e721..54256253b1 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -2498,9 +2498,13 @@ tramp-sh-handle-dired-compress-file
             (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
@@ -2508,14 +2512,19 @@ tramp-sh-handle-dired-compress-file
             ;; 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 9f0264abc1..b0b61ad8f0 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -61,6 +61,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)
@@ -7079,6 +7080,36 @@ tramp--test-with-proper-process-name-and-buffer
          (ignore-errors (all-completions "tramp" (symbol-value x)))
          (ert-fail (format "Hook `%s' still contains Tramp function" x))))))
 
+(ert-deftest tramp-test47-dired-compress-file ()
+  "Check that Tramp (un)compress normal files."
+  (skip-unless (tramp--test-enabled))
+  (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-test47-dired-compress-dir ()
+  "Check that Tramp (un)compress directories."
+  (skip-unless (tramp--test-enabled))
+  (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."

--8<-----------------------------cut here---------------end--------------->8---
In GNU Emacs 28.0.50 (build 6, x86_64-pc-linux-gnu, GTK+ Version 3.24.5, cairo 
version 1.16.0)
Repository revision: 7abbf3779cf88c59a9c20526464974213db63fdb
Repository branch: master
Windowing system distributor 'The X.Org Foundation', version 11.0.12004000
System Description: Debian GNU/Linux 10 (buster)