diff options
author | Michael Albinus <michael.albinus@gmx.de> | 2020-06-15 16:24:22 +0200 |
---|---|---|
committer | Michael Albinus <michael.albinus@gmx.de> | 2020-06-15 16:24:22 +0200 |
commit | 4503dcf635aae4d40024267d373332bab588009f (patch) | |
tree | b13d311404c3c99f1278b4a03fb47cc6789cb9d7 | |
parent | 1507d61ebc5b572f6c9173ce9d76de379d919a94 (diff) | |
download | emacs-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.el | 42 | ||||
-rw-r--r-- | 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 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: |