]> git.eshelyaron.com Git - emacs.git/commitdiff
Fix some Tramp problems seen during tests
authorMichael Albinus <michael.albinus@gmx.de>
Mon, 15 Jun 2020 14:24:22 +0000 (16:24 +0200)
committerMichael Albinus <michael.albinus@gmx.de>
Mon, 15 Jun 2020 14:24:22 +0000 (16:24 +0200)
* 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
lisp/net/tramp.el

index 4f01f1bf6c4496ec8e42038679d7346a580d7447..2eb3b9f8b7d3df3b4bb5d6f8552227c1b44fb2d1 100644 (file)
@@ -145,7 +145,7 @@ If NAME doesn't belong to a crypted remote directory, retun nil."
 ;; New handlers should be added here.
 ;;;###tramp-autoload
 (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 reason."
 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))
   (with-temp-buffer
     (let* (;; Don't check for a proper method.
           (non-essential t)
@@ -511,6 +518,21 @@ localname."
 \f
 ;; 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))
                   tramp-crypt-enabled)
              (cond
+              ;; 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.
               (t1
                (if (eq op 'copy)
index f3c065e9e7a0a7a4e49e06eb0898d52acd4dfaf4..3a8a51fd4ade80e7911b917a39b7bb67185a26fb 100644 (file)
@@ -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
 applicable)."
   (ignore-errors
     (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
               (concat
                (cond
@@ -2014,7 +2020,12 @@ without a visible progress reporter."
              (run-at-time 3 0.1 #'tramp-progress-reporter-update pr))))
        (unwind-protect
            ;; 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: