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

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

[Tino Calancha]

X-Debbugs-Cc: michael.albinus@gmx.de, uyennhi.qm@gmail.com

Hi Michael,

AFAICS, it only fails for the case of directories (normal files are handled fine).

### Emacs -Q recipe ###

$ src/emacs -Q /sudo::/tmp
+ foo RET
Z

;; Failed to (un)compress /sudo:root@localhost.example.com:/tmp/tramp-test/foo




In GNU Emacs 27.2.50 (build 1, x86_64-pc-linux-gnu, X toolkit, Xaw scroll bars)
 of 2021-09-14 built on localhost.example.com
Repository revision: d7f4cc0974645cc6a295740afe85c6e21d956119
Repository branch: emacs-27
Windowing system distributor 'The X.Org Foundation', version 11.0.12013000
System Description: openSUSE Tumbleweed

Recent messages:
Tramp: Opening connection for root@localhost.example.com using sudo...
Tramp: Sending command ‘exec sudo -u root -s -H -p P""a""s""s""w""o""r""d"": /bin/sh ’
Tramp: Waiting for prompts from remote shell...
Tramp: Sending Password
Tramp: Waiting for prompts from remote shell...done
Tramp: Found remote shell prompt on ‘localhost.example.com’
Tramp: Opening connection for root@localhost.example.com using sudo...done
Compress or uncompress foo? (y or n) y
Compressing /sudo:root@localhost.example.com:/tmp/foo...done
Failed to (un)compress /sudo:root@localhost.example.com:/tmp/foo

Configured using:
 'configure --with-x-toolkit=lucid'

Configured features:
XPM JPEG TIFF GIF PNG SOUND DBUS GSETTINGS GLIB NOTIFY INOTIFY
LIBSELINUX GNUTLS LIBXML2 FREETYPE HARFBUZZ XFT ZLIB TOOLKIT_SCROLL_BARS
LUCID X11 XDBE XIM MODULES THREADS PDUMPER GMP

Important settings:
  value of $LANG: en_US.UTF-8
  value of $XMODIFIERS: @im=ibus
  locale-coding-system: utf-8-unix

Major mode: Dired by name

Minor modes in effect:
  shell-dirtrack-mode: t
  tooltip-mode: t
  global-eldoc-mode: t
  electric-indent-mode: t
  mouse-wheel-mode: t
  tool-bar-mode: t
  menu-bar-mode: t
  file-name-shadow-mode: t
  global-font-lock-mode: t
  font-lock-mode: t
  blink-cursor-mode: t
  auto-composition-mode: t
  auto-encryption-mode: t
  auto-compression-mode: t
  buffer-read-only: t
  line-number-mode: t
  transient-mark-mode: t

Load-path shadows:
None found.

Features:
(shadow sort mail-extr emacsbug message rmc puny rfc822 mml easymenu
mml-sec epa derived epg epg-config gnus-util rmail rmail-loaddefs
text-property-search mm-decode mm-bodies mm-encode mail-parse rfc2231
mailabbrev gmm-utils mailheader sendmail rfc2047 rfc2045 ietf-drums
mm-util mail-prsvr mail-utils dired-aux dired dired-loaddefs tramp-cache
tramp-sh tramp tramp-loaddefs trampver tramp-integration files-x
tramp-compat shell pcomplete comint ansi-color ring parse-time iso8601
time-date ls-lisp format-spec auth-source cl-seq eieio eieio-core
cl-macs eieio-loaddefs cl-loaddefs cl-lib password-cache json subr-x map
seq byte-opt gv bytecomp byte-compile cconv tooltip eldoc electric
uniquify ediff-hook vc-hooks lisp-float-type mwheel term/x-win x-win
term/common-win x-dnd tool-bar dnd fontset image regexp-opt fringe
tabulated-list replace newcomment text-mode elisp-mode lisp-mode
prog-mode register page tab-bar menu-bar rfn-eshadow isearch timer
select scroll-bar mouse jit-lock font-lock syntax facemenu font-core
term/tty-colors frame minibuffer cl-generic cham georgian utf-8-lang
misc-lang vietnamese tibetan thai tai-viet lao korean japanese eucjp-ms
cp51932 hebrew greek romanian slovak czech european ethiopic indian
cyrillic chinese composite charscript charprop case-table epa-hook
jka-cmpr-hook help simple abbrev obarray cl-preloaded nadvice loaddefs
button faces cus-face macroexp files text-properties overlay sha1 md5
base64 format env code-pages mule custom widget hashtable-print-readable
backquote threads dbusbind inotify dynamic-setting system-font-setting
font-render-setting x-toolkit x multi-tty make-network-process emacs)

Memory information:
((conses 16 67680 8068)
 (symbols 48 8193 1)
 (strings 32 25787 2051)
 (string-bytes 1 907396)
 (vectors 16 14425)
 (vector-slots 8 183921 10206)
 (floats 8 42 32)
 (intervals 56 701 289)
 (buffers 1000 14))

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

[Michael Albinus]

Tino Calancha <tino.calancha@gmail.com> writes:

> Hi Michael,

Hi Tino,

> AFAICS, it only fails for the case of directories (normal files are handled fine).
>
> ### Emacs -Q recipe ###
>
> $ src/emacs -Q /sudo::/tmp
> + foo RET
> Z
>
> ;; Failed to (un)compress /sudo:root@localhost.example.com:/tmp/tramp-test/foo

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

Thanks for the report, and best regards, Michael.

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)

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

[Michael Albinus]

Tino Calancha <tino.calancha@gmail.com> writes:

Hi Tino,

>> 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.

Thanks, your patch looks good to me. And the two test functions work in
general.

Just some few comments:

> --- a/test/lisp/net/tramp-tests.el
> +++ b/test/lisp/net/tramp-tests.el
> +(ert-deftest tramp-test47-dired-compress-file ()

Please give it another name, which comes lexically before
tramp-test46-unload. That test must be the last one, because it unloads
Tramp in batch mode.

I recommend tramp-test44-dired-compress-file.

> +  "Check that Tramp (un)compress normal files."

"compresses"

> +  (skip-unless (tramp--test-enabled))

Add also

  (skip-unless (tramp--test-sh-p))

This is the only backend which implements dired-compress-file.

> +(ert-deftest tramp-test47-dired-compress-dir ()

Same comments.

If you like you could push it to Emacs, I will run then the zillions of
test configurations I have available locally.

Thanks, and best regards, Michael.

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

[Lars Ingebrigtsen]

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

> Thanks, your patch looks good to me. And the two test functions work in
> general.

[...]

> If you like you could push it to Emacs, I will run then the zillions of
> test configurations I have available locally.

This was six weeks ago, so I went ahead and applied Tino's patch to
Emacs 29 (amended with Michael's comments).

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no