forked from Github/emacs
Suspend timers when reading Tramp process output
* lisp/net/tramp-compat.el (xdg): Require. (tramp-compat-temporary-file-directory): Set it to $XDG_CACHE_HOME/emacs if possible. * lisp/net/tramp.el (tramp-debug-to-file): Fix docstring. (tramp-wrong-passwd-regexp): Add "Authentication failed" string (from doas). (tramp-debug-message): Simplify backtrace check. (with-tramp-locked-connection): Suppress timers. (Bug#49954, Bug60534) * test/lisp/net/tramp-tests.el (tramp-test09-insert-file-contents): Adapt test. (tramp-test45-asynchronous-requests): Remove :unstable tag. Adapt test.
This commit is contained in:
parent
d3ec68f5e4
commit
5f79d821a0
4 changed files with 61 additions and 47 deletions
|
|
@ -496,12 +496,12 @@ PROPERTIES is a list of file properties (strings)."
|
|||
(cons property (gethash property hash tramp-cache-undefined)))
|
||||
,properties)))
|
||||
(unwind-protect (progn ,@body)
|
||||
;; Reset PROPERTIES. Recompute hash, it could have been flushed.
|
||||
(setq hash (tramp-get-hash-table ,key))
|
||||
(dolist (value values)
|
||||
(if (not (eq (cdr value) tramp-cache-undefined))
|
||||
(puthash (car value) (cdr value) hash)
|
||||
(remhash (car value) hash)))))))
|
||||
;; Reset PROPERTIES. Recompute hash, it could have been flushed.
|
||||
(setq hash (tramp-get-hash-table ,key))
|
||||
(dolist (value values)
|
||||
(if (not (eq (cdr value) tramp-cache-undefined))
|
||||
(puthash (car value) (cdr value) hash)
|
||||
(remhash (car value) hash)))))))
|
||||
|
||||
;;;###tramp-autoload
|
||||
(defun tramp-cache-print (table)
|
||||
|
|
|
|||
|
|
@ -35,6 +35,7 @@
|
|||
(require 'parse-time)
|
||||
(require 'shell)
|
||||
(require 'subr-x)
|
||||
(require 'xdg)
|
||||
|
||||
(declare-function tramp-error "tramp")
|
||||
(declare-function tramp-tramp-file-p "tramp")
|
||||
|
|
@ -64,9 +65,16 @@
|
|||
(with-no-warnings (funcall ,function ,@arguments))))
|
||||
|
||||
;; We must use a local directory. If it is remote, we could run into
|
||||
;; an infloop.
|
||||
;; an infloop. We try to follow the XDG specification, for security reasons.
|
||||
(defconst tramp-compat-temporary-file-directory
|
||||
(eval (car (get 'temporary-file-directory 'standard-value)) t)
|
||||
(file-name-as-directory
|
||||
(if-let ((xdg (xdg-cache-home))
|
||||
((file-directory-p xdg))
|
||||
((file-writable-p xdg)))
|
||||
;; We can use `file-name-concat' starting with Emacs 28.1.
|
||||
(prog1 (setq xdg (concat (file-name-as-directory xdg) "emacs"))
|
||||
(make-directory xdg t))
|
||||
(eval (car (get 'temporary-file-directory 'standard-value)) t)))
|
||||
"The default value of `temporary-file-directory'.")
|
||||
|
||||
(defsubst tramp-compat-make-temp-name ()
|
||||
|
|
|
|||
|
|
@ -120,7 +120,7 @@ Any level x includes messages for all levels 1 .. x-1. The levels are
|
|||
(defcustom tramp-debug-to-file nil
|
||||
"Whether Tramp debug messages shall be saved to file.
|
||||
The debug file has the same name as the debug buffer, written to
|
||||
`temporary-file-directory'."
|
||||
`tramp-compat-temporary-file-directory'."
|
||||
:version "28.1"
|
||||
:type 'boolean)
|
||||
|
||||
|
|
@ -665,6 +665,7 @@ The `sudo' program appears to insert a `^@' character into the prompt."
|
|||
"Sorry, try again."
|
||||
"Name or service not known"
|
||||
"Host key verification failed."
|
||||
"Authentication failed"
|
||||
"No supported authentication methods left to try!"
|
||||
(: "Login " (| "Incorrect" "incorrect"))
|
||||
(: "Connection " (| "refused" "closed"))
|
||||
|
|
@ -1970,7 +1971,7 @@ of `current-buffer'."
|
|||
(+ digit) ":" (+ digit) ":" (+ digit) "." (+ digit) blank
|
||||
;; Thread.
|
||||
(? (group "#<thread " (+ nonl) ">") blank)
|
||||
;; Function name, verbosity.
|
||||
;; Function name, verbosity.
|
||||
(+ (any "-" alnum)) " (" (group (+ digit)) ") #")
|
||||
"Used for highlighting Tramp debug buffers in `outline-mode'.")
|
||||
|
||||
|
|
@ -2109,18 +2110,23 @@ ARGUMENTS to actually emit the message (if applicable)."
|
|||
(insert "\n"))
|
||||
;; Timestamp.
|
||||
(insert (format-time-string "%T.%6N "))
|
||||
;; Threads. `current-thread' might not exist when Emacs is
|
||||
;; configured --without-threads.
|
||||
;; (unless (eq (tramp-compat-funcall 'current-thread) main-thread)
|
||||
;; (insert (format "%s " (tramp-compat-funcall 'current-thread))))
|
||||
;; Calling Tramp function. We suppress compat and trace
|
||||
;; functions from being displayed.
|
||||
(let ((btn 1) btf fn)
|
||||
(let ((frames (backtrace-frames))
|
||||
btf fn)
|
||||
(while (not fn)
|
||||
(setq btf (nth 1 (backtrace-frame btn)))
|
||||
(setq btf (cadadr frames))
|
||||
(if (not btf)
|
||||
(setq fn "")
|
||||
(and (symbolp btf) (setq fn (symbol-name btf))
|
||||
(or (not (string-prefix-p "tramp" fn))
|
||||
(get btf 'tramp-suppress-trace))
|
||||
(setq fn nil))
|
||||
(setq btn (1+ btn))))
|
||||
(setq frames (cdr frames))))
|
||||
;; The following code inserts filename and line number.
|
||||
;; Should be inactive by default, because it is time consuming.
|
||||
;; (let ((ffn (find-function-noselect (intern fn))))
|
||||
|
|
@ -3790,14 +3796,14 @@ BODY is the backend specific code."
|
|||
;; VISIT, for example `jka-compr-handler'. We must respect this.
|
||||
;; See Bug#55166.
|
||||
`(let* ((filename (expand-file-name ,filename))
|
||||
(lockname (file-truename (or ,lockname filename)))
|
||||
(handler (and (stringp ,visit)
|
||||
(let ((inhibit-file-name-handlers
|
||||
`(tramp-file-name-handler
|
||||
tramp-crypt-file-name-handler
|
||||
. inhibit-file-name-handlers))
|
||||
(inhibit-file-name-operation 'write-region))
|
||||
(find-file-name-handler ,visit 'write-region)))))
|
||||
(lockname (file-truename (or ,lockname filename)))
|
||||
(handler (and (stringp ,visit)
|
||||
(let ((inhibit-file-name-handlers
|
||||
`(tramp-file-name-handler
|
||||
tramp-crypt-file-name-handler
|
||||
. inhibit-file-name-handlers))
|
||||
(inhibit-file-name-operation 'write-region))
|
||||
(find-file-name-handler ,visit 'write-region)))))
|
||||
(with-parsed-tramp-file-name filename nil
|
||||
(if handler
|
||||
(progn
|
||||
|
|
@ -5821,11 +5827,14 @@ Mostly useful to protect BODY from being interrupted by timers."
|
|||
(throw 'non-essential 'non-essential)
|
||||
(tramp-error
|
||||
,proc 'remote-file-error "Forbidden reentrant call of Tramp"))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(tramp-set-connection-property ,proc "locked" t)
|
||||
,@body)
|
||||
(tramp-flush-connection-property ,proc "locked"))))
|
||||
(let ((stimers (with-timeout-suspend))
|
||||
timer-list timer-idle-list)
|
||||
(unwind-protect
|
||||
(progn
|
||||
(tramp-set-connection-property ,proc "locked" t)
|
||||
,@body)
|
||||
(tramp-flush-connection-property ,proc "locked")
|
||||
(with-timeout-unsuspend stimers)))))
|
||||
|
||||
(defun tramp-accept-process-output (proc &optional _timeout)
|
||||
"Like `accept-process-output' for Tramp processes.
|
||||
|
|
|
|||
|
|
@ -2440,15 +2440,19 @@ This checks also `file-name-as-directory', `file-name-directory',
|
|||
`(,(expand-file-name tmp-name) 0)))
|
||||
(should (string-equal (buffer-string) "foo"))
|
||||
(should (= point (point))))
|
||||
(let ((point (point)))
|
||||
(replace-string-in-region "foo" "bar" (point-min) (point-max))
|
||||
(goto-char point)
|
||||
(should
|
||||
(equal
|
||||
(insert-file-contents tmp-name nil nil nil 'replace)
|
||||
`(,(expand-file-name tmp-name) 3)))
|
||||
(should (string-equal (buffer-string) "foo"))
|
||||
(should (= point (point))))
|
||||
;; Insert another string.
|
||||
;; `replace-string-in-region' was introduced in Emacs 28.1.
|
||||
(when (tramp--test-emacs28-p)
|
||||
(let ((point (point)))
|
||||
(with-no-warnings
|
||||
(replace-string-in-region "foo" "bar" (point-min) (point-max)))
|
||||
(goto-char point)
|
||||
(should
|
||||
(equal
|
||||
(insert-file-contents tmp-name nil nil nil 'replace)
|
||||
`(,(expand-file-name tmp-name) 3)))
|
||||
(should (string-equal (buffer-string) "foo"))
|
||||
(should (= point (point)))))
|
||||
;; Error case.
|
||||
(delete-file tmp-name)
|
||||
(should-error
|
||||
|
|
@ -7444,12 +7448,7 @@ This is needed in timer functions as well as process filters and sentinels."
|
|||
"Check parallel asynchronous requests.
|
||||
Such requests could arrive from timers, process filters and
|
||||
process sentinels. They shall not disturb each other."
|
||||
;; :tags (append '(:expensive-test :tramp-asynchronous-processes)
|
||||
;; (and (or (getenv "EMACS_HYDRA_CI")
|
||||
;; (getenv "EMACS_EMBA_CI"))
|
||||
;; '(:unstable)))
|
||||
;; It doesn't work sufficiently.
|
||||
:tags '(:expensive-test :tramp-asynchronous-processes :unstable)
|
||||
:tags '(:expensive-test :tramp-asynchronous-processes)
|
||||
(skip-unless (tramp--test-enabled))
|
||||
(skip-unless (tramp--test-supports-processes-p))
|
||||
(skip-unless (not (tramp--test-container-p)))
|
||||
|
|
@ -7517,14 +7516,12 @@ process sentinels. They shall not disturb each other."
|
|||
(when buffers
|
||||
(let ((time (float-time))
|
||||
(default-directory tmp-name)
|
||||
(file (buffer-name (seq-random-elt buffers)))
|
||||
;; A remote operation in a timer could
|
||||
;; confuse Tramp heavily. So we ignore this
|
||||
;; error here.
|
||||
(debug-ignored-errors
|
||||
(cons 'remote-file-error debug-ignored-errors)))
|
||||
(file (buffer-name (seq-random-elt buffers))))
|
||||
(tramp--test-message
|
||||
"Start timer %s %s" file (current-time-string))
|
||||
(dired-uncache file)
|
||||
(tramp--test-message
|
||||
"Continue timer %s %s" file (file-attributes file))
|
||||
(vc-registered file)
|
||||
(tramp--test-message
|
||||
"Stop timer %s %s" file (current-time-string))
|
||||
|
|
|
|||
Loading…
Reference in a new issue