[Top][All Lists]

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

master 4503dcf: Fix some Tramp problems seen during tests

From: Michael Albinus
Subject: master 4503dcf: Fix some Tramp problems seen during tests
Date: Mon, 15 Jun 2020 10:24:29 -0400 (EDT)

branch: master
commit 4503dcf635aae4d40024267d373332bab588009f
Author: Michael Albinus <michael.albinus@gmx.de>
Commit: Michael Albinus <michael.albinus@gmx.de>

    Fix some Tramp problems seen during tests
    * lisp/net/tramp-crypt.el (tramp-crypt-file-name-handler-alist):
    Add `access-file'.
    (tramp-crypt-file-name-for-operation): Rewrite.  Take second
    argument into account.
    (tramp-crypt-file-name-handler): Use it.
    (tramp-crypt-send-command): Set buffer multibyte (but utf8 files
    still don't work).
    (tramp-crypt-handle-access-file): New defun.
    (tramp-crypt-do-copy-or-rename-file): Short track if both files
    are on a crypted remote dir.
    * lisp/net/tramp.el (file-notify-rm-watch): Declare.
    (tramp-inhibit-progress-reporter): New defvar.
    (tramp-message): Display message only if not suppressed by
    progress reporter.
    (with-tramp-progress-reporter): Suppress concurrent progress
    reporter messages.
    (tramp-file-notify-process-sentinel): Simplify.
 lisp/net/tramp-crypt.el | 42 ++++++++++++++++++++++++++++++++++++------
 lisp/net/tramp.el       | 19 +++++++++++++++----
 2 files changed, 51 insertions(+), 10 deletions(-)

diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el
index 4f01f1b..2eb3b9f 100644
--- a/lisp/net/tramp-crypt.el
+++ b/lisp/net/tramp-crypt.el
@@ -145,7 +145,7 @@ If NAME doesn't belong to a crypted remote directory, retun 
 ;; New handlers should be added here.
 (defconst tramp-crypt-file-name-handler-alist
-  '(;; (access-file . tramp-crypt-handle-access-file)
+  '((access-file . tramp-crypt-handle-access-file)
     ;; (add-name-to-file . tramp-crypt-handle-not-implemented)
     ;; `byte-compiler-base-file-name' performed by default handler.
     (copy-directory . tramp-handle-copy-directory)
@@ -225,9 +225,14 @@ Operations not mentioned here will be handled by the 
default Emacs primitives.")
 (defsubst tramp-crypt-file-name-for-operation (operation &rest args)
   "Like `tramp-file-name-for-operation', but for crypted remote files."
-  (cl-letf (((symbol-function #'tramp-tramp-file-p)
-            #'tramp-crypt-file-name-p))
-    (apply #'tramp-file-name-for-operation operation args)))
+  (let ((tfnfo (apply #'tramp-file-name-for-operation operation args)))
+    ;; `tramp-file-name-for-operation' returns already the first argument
+    ;; if it is remote.  So we check a possible second argument.
+    (unless (tramp-crypt-file-name-p tfnfo)
+      (setq tfnfo (apply
+                  #'tramp-file-name-for-operation
+                  operation (cons temporary-file-directory (cdr args)))))
+    tfnfo))
 (defun tramp-crypt-run-real-handler (operation args)
   "Invoke normal file name handler for OPERATION.
@@ -246,7 +251,8 @@ arguments to pass to the OPERATION."
   "Invoke the crypted remote file related OPERATION.
 First arg specifies the OPERATION, second arg ARGS is a list of
 arguments to pass to the OPERATION."
-  (if-let ((filename (apply #'tramp-file-name-for-operation operation args))
+  (if-let ((filename
+           (apply #'tramp-crypt-file-name-for-operation operation args))
           (fn (and (tramp-crypt-file-name-p filename)
                    (assoc operation tramp-crypt-file-name-handler-alist))))
       (save-match-data (apply (cdr fn) args))
@@ -356,7 +362,8 @@ connection if a previous connection has died for some 
 ARGS are the arguments.  It returns t if ran successful, and nil otherwise."
   (tramp-crypt-maybe-open-connection vec)
   (with-current-buffer (tramp-get-connection-buffer vec)
-    (erase-buffer))
+    (erase-buffer)
+    (set-buffer-multibyte nil))
     (let* (;; Don't check for a proper method.
           (non-essential t)
@@ -511,6 +518,21 @@ localname."
 ;; File name primitives.
+(defun tramp-crypt-handle-access-file (filename string)
+  "Like `access-file' for Tramp files."
+  (let* ((encrypt-filename (tramp-crypt-encrypt-file-name filename))
+        (encrypt-regexp (concat (regexp-quote encrypt-filename) "\\'"))
+        tramp-crypt-enabled)
+    (condition-case err
+       (access-file encrypt-filename string)
+      (error
+       (when (and (eq (car err) 'file-missing) (stringp (cadr err))
+                 (string-match-p encrypt-regexp (cadr err)))
+        (setcar
+         (cdr err)
+         (replace-regexp-in-string encrypt-regexp filename (cadr err))))
+       (signal (car err) (cdr err))))))
 (defun tramp-crypt-do-copy-or-rename-file
   (op filename newname &optional ok-if-already-exists keep-date
    preserve-uid-gid preserve-extended-attributes)
@@ -576,6 +598,14 @@ absolute file names."
                     (file-name-nondirectory encrypt-newname) tmpdir))
+              ;; Source and target file are on a crypted remote directory.
+              ((and t1 t2)
+               (if (eq op 'copy)
+                   (copy-file
+                    encrypt-filename encrypt-newname ok-if-already-exists
+                    keep-date preserve-uid-gid preserve-extended-attributes)
+                 (rename-file
+                  encrypt-filename encrypt-newname ok-if-already-exists)))
               ;; Source file is on a crypted remote directory.
                (if (eq op 'copy)
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index f3c065e..3a8a51f 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -64,6 +64,7 @@
 ;; Pacify byte-compiler.
 (require 'cl-lib)
+(declare-function file-notify-rm-watch "filenotify")
 (declare-function netrc-parse "netrc")
 (defvar auto-save-file-name-transforms)
@@ -1780,6 +1781,10 @@ ARGUMENTS to actually emit the message (if applicable)."
 (put #'tramp-debug-message 'tramp-suppress-trace t)
+(defvar tramp-inhibit-progress-reporter nil
+  "Show Tramp progress reporter in the minibuffer.
+This variable is used to disable concurrent progress reporter messages.")
 (defsubst tramp-message (vec-or-proc level fmt-string &rest arguments)
   "Emit a message depending on verbosity level.
 VEC-OR-PROC identifies the Tramp buffer to use.  It can be either a
@@ -1795,8 +1800,9 @@ control string and the remaining ARGUMENTS to actually 
emit the message (if
     (when (<= level tramp-verbose)
-      ;; Display only when there is a minimum level.
-      (when (<= level 3)
+      ;; Display only when there is a minimum level, and the progress
+      ;; reporter doesn't suppress further messages.
+      (when (and (<= level 3) (null tramp-inhibit-progress-reporter))
        (apply #'message
@@ -2014,7 +2020,12 @@ without a visible progress reporter."
              (run-at-time 3 0.1 #'tramp-progress-reporter-update pr))))
            ;; Execute the body.
-           (prog1 (progn ,@body) (setq cookie "done"))
+           (prog1
+              ;; Suppress concurrent progress reporter messages.
+              (let ((tramp-inhibit-progress-reporter
+                     (or tramp-inhibit-progress-reporter tm)))
+                ,@body)
+            (setq cookie "done"))
          ;; Stop progress reporter.
          (if tm (cancel-timer tm))
          (tramp-message ,vec ,level "%s...%s" ,message cookie)))))
@@ -3995,7 +4006,7 @@ of."
   "Call `file-notify-rm-watch'."
   (unless (process-live-p proc)
     (tramp-message proc 5 "Sentinel called: `%S' `%s'" proc event)
-    (tramp-compat-funcall 'file-notify-rm-watch proc)))
+    (file-notify-rm-watch proc)))
 ;;; Functions for establishing connection:

reply via email to

[Prev in Thread] Current Thread [Next in Thread]