summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMichael Albinus <michael.albinus@gmx.de>2020-06-15 16:24:22 +0200
committerMichael Albinus <michael.albinus@gmx.de>2020-06-15 16:24:22 +0200
commit4503dcf635aae4d40024267d373332bab588009f (patch)
treeb13d311404c3c99f1278b4a03fb47cc6789cb9d7
parent1507d61ebc5b572f6c9173ce9d76de379d919a94 (diff)
downloademacs-4503dcf635aae4d40024267d373332bab588009f.tar.gz
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.
-rw-r--r--lisp/net/tramp-crypt.el42
-rw-r--r--lisp/net/tramp.el19
2 files changed, 51 insertions, 10 deletions
diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el
index 4f01f1bf6c4..2eb3b9f8b7d 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 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."
;; 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)
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index f3c065e9e7a..3a8a51fd4ad 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
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: