Add 'remote-file-error' for Tramp

* doc/lispref/errors.texi (Standard Errors): Add 'remote-file-error'.

* etc/NEWS: Mention 'remote-file-error'.

* lisp/net/ange-ftp.el (ftp-error): Add error condition
`remote-file-error'.

* lisp/net/tramp-cmds.el (tramp-cleanup-all-connections): Do not set
`tramp-locked'.

* lisp/net/tramp-compat.el (remote-file-error): Define if it
doesn't exist.

* lisp/net/tramp-sh.el (tramp-timeout-session): Check for "locked"
property.
(tramp-maybe-open-connection): Simplify.

* lisp/net/tramp.el (tramp-locked, tramp-locker): Remove them.
(tramp-file-name-handler): Do not set them.
(with-tramp-locked-connection): New defmacro.
(tramp-accept-process-output, tramp-send-string): Use it.

* src/fileio.c (Qremote_file_error): New error symbol.

* test/lisp/net/tramp-tests.el (tramp-test43-asynchronous-requests):
Adapt test.  Remove :unstable tag.

5 files changed, 66 insertions, 70 deletions

diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el
index c627e1a088d..1922adb5480 100644
--- a/lisp/net/ange-ftp.el
+++ b/lisp/net/ange-ftp.el
@@ -1080,7 +1080,7 @@ All HOST values should be in lower case.")
 (defvar ange-ftp-trample-marker)
 
 ;; New error symbols.
-(define-error 'ftp-error nil 'file-error) ;"FTP error"
+(define-error 'ftp-error nil '(remote-file-error file-error)) ;"FTP error"
 
 ;;; ------------------------------------------------------------
 ;;; Enhanced message support.
diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el
index 622116d9f90..9b6250430a8 100644
--- a/lisp/net/tramp-cmds.el
+++ b/lisp/net/tramp-cmds.el
@@ -159,9 +159,6 @@ When called interactively, a Tramp connection has to be selected."
 This includes password cache, file cache, connection cache, buffers."
   (interactive)
 
-  ;; Unlock Tramp.
-  (setq tramp-locked nil)
-
   ;; Flush password cache.
   (password-reset)
 
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el
index b44eabcfa8b..4c8d37d602c 100644
--- a/lisp/net/tramp-compat.el
+++ b/lisp/net/tramp-compat.el
@@ -348,6 +348,11 @@ A nil value for either argument stands for the current time."
     (lambda (fromstring tostring instring)
       (replace-regexp-in-string (regexp-quote fromstring) tostring instring))))
 
+;; Error symbol `remote-file-error' is defined in Emacs 28.1.  We use
+;; an adapted error message in order to see that compatible symbol.
+(unless (get 'remote-file-error 'error-conditions)
+  (define-error 'remote-file-error "Remote file error (compat)" 'file-error))
+
 (add-hook 'tramp-unload-hook
 	  (lambda ()
 	    (unload-feature 'tramp-loaddefs 'force)
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 34be4fcba93..e9814cdadb9 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -2944,7 +2944,8 @@ implementation will be used."
 				 (mapconcat
 				  #'tramp-shell-quote-argument uenv " "))
 			      "")
-			    (if heredoc (format "<<'%s'" tramp-end-of-heredoc) "")
+			    (if heredoc
+				(format "<<'%s'" tramp-end-of-heredoc) "")
 			    (if tmpstderr (format "2>'%s'" tmpstderr) "")
 			    (mapconcat #'tramp-shell-quote-argument env " ")
 			    (if heredoc
@@ -4914,7 +4915,8 @@ Goes through the list `tramp-inline-compress-commands'."
 (defun tramp-timeout-session (vec)
   "Close the connection VEC after a session timeout.
 If there is just some editing, retry it after 5 seconds."
-  (if (and tramp-locked tramp-locker
+  (if (and (tramp-get-connection-property
+	    (tramp-get-connection-process vec) "locked" nil)
 	   (tramp-file-name-equal-p vec (car tramp-current-connection)))
       (progn
 	(tramp-message
@@ -4958,10 +4960,9 @@ connection if a previous connection has died for some reason."
 	(when (and (time-less-p
 		    60 (time-since
 			(tramp-get-connection-property p "last-cmd-time" 0)))
-		   (process-live-p p))
-	  (tramp-send-command vec "echo are you awake" t t)
-	  (unless (and (process-live-p p)
-		       (tramp-wait-for-output p 10))
+		   (process-live-p p)
+		   (tramp-get-connection-property p "connected" nil))
+	  (unless (tramp-send-command-and-check vec "echo are you awake")
 	    ;; The error will be caught locally.
 	    (tramp-error vec 'file-error "Awake did fail")))
       (file-error
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 6750a7ff4c6..70bf1eee26b 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -2349,33 +2349,6 @@ Must be handled by the callers."
 		res (cdr elt))))
       res)))
 
-;; In Emacs, there is some concurrency due to timers.  If a timer
-;; interrupts Tramp and wishes to use the same connection buffer as
-;; the "main" Emacs, then garbage might occur in the connection
-;; buffer.  Therefore, we need to make sure that a timer does not use
-;; the same connection buffer as the "main" Emacs.  We implement a
-;; cheap global lock, instead of locking each connection buffer
-;; separately.  The global lock is based on two variables,
-;; `tramp-locked' and `tramp-locker'.  `tramp-locked' is set to true
-;; (with setq) to indicate a lock.  But Tramp also calls itself during
-;; processing of a single file operation, so we need to allow
-;; recursive calls.  That's where the `tramp-locker' variable comes in
-;; -- it is let-bound to t during the execution of the current
-;; handler.  So if `tramp-locked' is t and `tramp-locker' is also t,
-;; then we should just proceed because we have been called
-;; recursively.  But if `tramp-locker' is nil, then we are a timer
-;; interrupting the "main" Emacs, and then we signal an error.
-
-(defvar tramp-locked nil
-  "If non-nil, then Tramp is currently busy.
-Together with `tramp-locker', this implements a locking mechanism
-preventing reentrant calls of Tramp.")
-
-(defvar tramp-locker nil
-  "If non-nil, then a caller has locked Tramp.
-Together with `tramp-locked', this implements a locking mechanism
-preventing reentrant calls of Tramp.")
-
 ;; Main function.
 (defun tramp-file-name-handler (operation &rest args)
   "Invoke Tramp file name handler for OPERATION and ARGS.
@@ -2429,17 +2402,7 @@ Fall back to normal file name handler if no Tramp file name handler exists."
 		        (setq result
 			      (catch 'non-essential
 			        (catch 'suppress
-				  (when (and tramp-locked (not tramp-locker))
-				    (setq tramp-locked nil)
-				    (tramp-error
-				     v 'file-error
-				     "Forbidden reentrant call of Tramp"))
-				  (let ((tl tramp-locked))
-				    (setq tramp-locked t)
-				    (unwind-protect
-				        (let ((tramp-locker t))
-					  (apply foreign operation args))
-				      (setq tramp-locked tl))))))
+				  (apply foreign operation args))))
                         ;; (tramp-message
                         ;;  v 4 "Running `%s'...`%s'" (cons operation args) result)
 		        (cond
@@ -4499,6 +4462,32 @@ performed successfully.  Any other value means an error."
 
 ;;; Utility functions:
 
+;; In Emacs, there is some concurrency due to timers.  If a timer
+;; interrupts Tramp and wishes to use the same connection buffer as
+;; the "main" Emacs, then garbage might occur in the connection
+;; buffer.  Therefore, we need to make sure that a timer does not use
+;; the same connection buffer as the "main" Emacs.  We lock each
+;; connection process separately by a connection property.
+
+(defmacro with-tramp-locked-connection (proc &rest body)
+  "Lock PROC for other communication, and run BODY.
+Mostly useful to protect BODY from being interrupted by timers."
+  (declare (indent 1) (debug t))
+  `(if (tramp-get-connection-property ,proc "locked" nil)
+       ;; Be kind for older Emacsen.
+       (if (member 'remote-file-error debug-ignored-errors)
+	   (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"))))
+
+(font-lock-add-keywords
+ 'emacs-lisp-mode '("\\<with-tramp-locked-connection\\>"))
+
 (defun tramp-accept-process-output (proc &optional timeout)
   "Like `accept-process-output' for Tramp processes.
 This is needed in order to hide `last-coding-system-used', which is set
@@ -4508,15 +4497,17 @@ If the user quits via `C-g', it is propagated up to `tramp-file-name-handler'."
     (let ((inhibit-read-only t)
 	  last-coding-system-used
 	  result)
-      ;; JUST-THIS-ONE is set due to Bug#12145.  `with-local-quit'
-      ;; returns t in order to report success.
-      (if (with-local-quit
-	    (setq result (accept-process-output proc timeout nil t)) t)
-	  (tramp-message
-	   proc 10 "%s %s %s %s\n%s"
-	   proc timeout (process-status proc) result (buffer-string))
-	;; Propagate quit.
-	(keyboard-quit))
+      ;; This must be protected by the "locked" property.
+      (with-tramp-locked-connection proc
+	;; JUST-THIS-ONE is set due to Bug#12145.  `with-local-quit'
+	;; returns t in order to report success.
+	(if (with-local-quit
+	      (setq result (accept-process-output proc timeout nil t)) t)
+	    (tramp-message
+	     proc 10 "%s %s %s %s\n%s"
+	     proc timeout (process-status proc) result (buffer-string))
+	  ;; Propagate quit.
+	  (keyboard-quit)))
       result)))
 
 (defun tramp-search-regexp (regexp)
@@ -4633,19 +4624,21 @@ the remote host use line-endings as defined in the variable
       (unless (or (string-empty-p string)
 		  (string-equal (substring string -1) tramp-rsh-end-of-line))
 	(setq string (concat string tramp-rsh-end-of-line)))
-      ;; Send the string.
-      (with-local-quit
-	(if (and chunksize (not (zerop chunksize)))
-	    (let ((pos 0)
-		  (end (length string)))
-	      (while (< pos end)
-		(tramp-message
-		 vec 10 "Sending chunk from %s to %s"
-		 pos (min (+ pos chunksize) end))
-		(process-send-string
-		 p (substring string pos (min (+ pos chunksize) end)))
-		(setq pos (+ pos chunksize))))
-	  (process-send-string p string))))))
+      ;; This must be protected by the "locked" property.
+      (with-tramp-locked-connection p
+	;; Send the string.
+	(with-local-quit
+	  (if (and chunksize (not (zerop chunksize)))
+	      (let ((pos 0)
+		    (end (length string)))
+		(while (< pos end)
+		  (tramp-message
+		   vec 10 "Sending chunk from %s to %s"
+		   pos (min (+ pos chunksize) end))
+		  (process-send-string
+		   p (substring string pos (min (+ pos chunksize) end)))
+		  (setq pos (+ pos chunksize))))
+	    (process-send-string p string)))))))
 
 (defun tramp-process-sentinel (proc event)
   "Flush file caches and remove shell prompt."