Improve error handling in Tramp

* lisp/net/tramp-compat.el (ls-lisp): Require.

* lisp/net/tramp.el (ls-lisp-use-insert-directory-program):
Don't declare.
(tramp-current-connection): Adapt docstring.
(tramp-debug-message): Adapt function names.
(tramp-error, tramp-run-real-handler): Let-bind `signal-hook-function'.
(tramp-signal-hook-function): New defun.
(tramp-debug-on-error, tramp-condition-case-unless-debug): Remove.
(tramp-file-name-handler): Handle `tramp-current-connection'.
Let-bind `signal-hook-function'.  Use `unwind-protect' instead of
`tramp-condition-case-unless-debug'.
(tramp-handle-insert-directory): Don't require ls-lisp.
(tramp-process-actions): Check, that
`tramp-password-save-function' is non-nil.
(tramp-equal-remote): Handle the case both files are local.

* test/lisp/net/tramp-tests.el (tramp--test-instrument-test-case):
Do not bind `tramp-debug-on-error'.
(tramp--test-ignore-make-symbolic-link-error): Make error handler
more explicit about the error.

3 files changed, 103 insertions, 119 deletions

diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el
index d4380f8deb3..15b737d281b 100644
--- a/lisp/net/tramp-compat.el
+++ b/lisp/net/tramp-compat.el
@@ -36,6 +36,7 @@
 
 (require 'auth-source)
 (require 'format-spec)
+(require 'ls-lisp)  ;; Due to `tramp-handle-insert-directory'.
 (require 'parse-time)
 (require 'shell)
 
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index e5b0f149ca6..0a5ccb6f1c6 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -64,7 +64,6 @@
 (require 'cl-lib)
 (declare-function netrc-parse "netrc")
 (defvar auto-save-file-name-transforms)
-(defvar ls-lisp-use-insert-directory-program)
 (defvar outline-regexp)
 
 ;;; User Customizable Internal Variables:
@@ -1221,7 +1220,9 @@ means to use always cached values for the directory contents."
 ;;; Internal Variables:
 
 (defvar tramp-current-connection nil
-  "Last connection timestamp.")
+  "Last connection timestamp.
+It is a cons cell of the actual `tramp-file-name-structure', and
+the (optional) timestamp of last activity on this connection.")
 
 (defvar tramp-password-save-function nil
   "Password save function.
@@ -1713,11 +1714,11 @@ ARGUMENTS to actually emit the message (if applicable)."
                       (regexp-opt
                        '("tramp-backtrace"
                          "tramp-compat-funcall"
-                         "tramp-condition-case-unless-debug"
                          "tramp-debug-message"
                          "tramp-error"
                          "tramp-error-with-buffer"
                          "tramp-message"
+                         "tramp-signal-hook-function"
                          "tramp-user-error")
                        t)
                       "$"))
@@ -1805,7 +1806,7 @@ function is meant for debugging purposes."
 VEC-OR-PROC identifies the connection to use, SIGNAL is the
 signal identifier to be raised, remaining arguments passed to
 `tramp-message'.  Finally, signal SIGNAL is raised."
-  (let (tramp-message-show-message)
+  (let (tramp-message-show-message signal-hook-function)
     (tramp-backtrace vec-or-proc)
     (unless arguments
       ;; FMT-STRING could be just a file name, as in
@@ -1894,6 +1895,12 @@ the resulting error message."
          (progn ,@body)
        (error (tramp-message ,vec-or-proc 3 ,format ,err) nil))))
 
+;; This function provides traces in case of errors not triggered by
+;; Tramp functions.
+(defun tramp-signal-hook-function (error-symbol data)
+  "Funtion to be called via `signal-hook-function'."
+  (tramp-error (car tramp-current-connection) error-symbol "%s" data))
+
 (defmacro with-parsed-tramp-file-name (filename var &rest body)
   "Parse a Tramp filename and make components available in the body.
 
@@ -2140,7 +2147,8 @@ pass to the OPERATION."
             .
             ,(and (eq inhibit-file-name-operation operation)
                   inhibit-file-name-handlers)))
-         (inhibit-file-name-operation operation))
+         (inhibit-file-name-operation operation)
+         signal-hook-function)
     (apply operation args)))
 
 ;; We handle here all file primitives.  Most of them have the file
@@ -2250,16 +2258,6 @@ Must be handled by the callers."
                 res (cdr elt))))
       res)))
 
-(defvar tramp-debug-on-error nil
-  "Like `debug-on-error' but used Tramp internal.")
-
-(defmacro tramp-condition-case-unless-debug
-  (var bodyform &rest handlers)
-  "Like `condition-case-unless-debug' but `tramp-debug-on-error'."
-  (declare (debug condition-case) (indent 2))
-  `(let ((debug-on-error tramp-debug-on-error))
-     (condition-case-unless-debug ,var ,bodyform ,@handlers)))
-
 ;; 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
@@ -2299,100 +2297,84 @@ Falls back to normal file name handler if no Tramp file name handler exists."
         (save-match-data
           (setq filename (tramp-replace-environment-variables filename))
           (with-parsed-tramp-file-name filename nil
-            (let ((completion (tramp-completion-mode-p))
+            (let ((current-connection tramp-current-connection)
                   (foreign
                    (tramp-find-foreign-file-name-handler filename operation))
+                  (signal-hook-function #'tramp-signal-hook-function)
                   result)
+              ;; Set `tramp-current-connection'.
+              (unless
+                  (tramp-file-name-equal-p v (car tramp-current-connection))
+                (setq tramp-current-connection (list v)))
+
               ;; Call the backend function.
-              (if foreign
-                  (tramp-condition-case-unless-debug err
-                    (let ((sf (symbol-function foreign)))
-                      ;; Some packages set the default directory to a
-                      ;; remote path, before respective Tramp packages
-                      ;; are already loaded.  This results in
-                      ;; recursive loading.  Therefore, we load the
-                      ;; Tramp packages locally.
-                      (when (autoloadp sf)
-                        (let ((default-directory
-                                (tramp-compat-temporary-file-directory))
-                              file-name-handler-alist)
-                          (load (cadr sf) 'noerror 'nomessage)))
-;;                    (tramp-message
-;;                     v 4 "Running `%s'..." (cons operation args))
-                      ;; If `non-essential' is non-nil, Tramp shall
-                      ;; not open a new connection.
-                      ;; If Tramp detects that it shouldn't continue
-                      ;; to work, it throws the `suppress' event.
-                      ;; This could happen for example, when Tramp
-                      ;; tries to open the same connection twice in a
-                      ;; short time frame.
-                      ;; In both cases, we try the default handler then.
-                      (setq result
-                            (catch 'non-essential
-                              (catch 'suppress
-                                (when (and tramp-locked (not tramp-locker))
-                                  (setq tramp-locked nil)
-                                  (tramp-error
-                                   (car-safe tramp-current-connection)
-                                   '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))))))
-;;                    (tramp-message
-;;                     v 4 "Running `%s'...`%s'" (cons operation args) result)
-                      (cond
-                       ((eq result 'non-essential)
-                        (tramp-message
-                         v 5 "Non-essential received in operation %s"
-                         (cons operation args))
-                        (tramp-run-real-handler operation args))
-                       ((eq result 'suppress)
-                        (let (tramp-message-show-message)
+              (unwind-protect
+                  (if foreign
+                      (let ((sf (symbol-function foreign)))
+                        ;; Some packages set the default directory to
+                        ;; a remote path, before respective Tramp
+                        ;; packages are already loaded.  This results
+                        ;; in recursive loading.  Therefore, we load
+                        ;; the Tramp packages locally.
+                        (when (autoloadp sf)
+                          (let ((default-directory
+                                  (tramp-compat-temporary-file-directory))
+                                file-name-handler-alist)
+                            (load (cadr sf) 'noerror 'nomessage)))
+                        ;; (tramp-message
+                        ;;  v 4 "Running `%s'..." (cons operation args))
+                        ;; If `non-essential' is non-nil, Tramp shall
+                        ;; not open a new connection.
+                        ;; If Tramp detects that it shouldn't continue
+                        ;; to work, it throws the `suppress' event.
+                        ;; This could happen for example, when Tramp
+                        ;; tries to open the same connection twice in
+                        ;; a short time frame.
+                        ;; In both cases, we try the default handler then.
+                        (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))))))
+                        ;; (tramp-message
+                        ;;  v 4 "Running `%s'...`%s'" (cons operation args) result)
+                        (cond
+                         ((eq result 'non-essential)
                           (tramp-message
-                           v 1 "Suppress received in operation %s"
+                           v 5 "Non-essential received in operation %s"
                            (cons operation args))
-                          (tramp-cleanup-connection v t)
-                          (tramp-run-real-handler operation args)))
-                       (t result)))
-
-                    ;; Trace that somebody has interrupted the operation.
-                    ((debug quit)
-                     (let (tramp-message-show-message)
-                       (tramp-message
-                        v 1 "Interrupt received in operation %s"
-                        (cons operation args)))
-                     ;; Propagate the signal.
-                     (signal (car err) (cdr err)))
-
-                    ;; When we are in completion mode, some failed
-                    ;; operations shall return at least a default
-                    ;; value in order to give the user a chance to
-                    ;; correct the file name in the minibuffer.
-                    ;; In order to get a full backtrace, one could apply
-                    ;;   (setq tramp-debug-on-error t)
-                    (error
-                     (cond
-                      ((and completion (zerop (length localname))
-                            (memq operation '(file-exists-p file-directory-p)))
-                       t)
-                      ((and completion (zerop (length localname))
-                            (memq operation
-                                  '(expand-file-name file-name-as-directory)))
-                       filename)
-                      ;; Propagate the error.
-                      (t (signal (car err) (cdr err))))))
-
-                ;; Nothing to do for us.  However, since we are in
-                ;; `tramp-mode', we must suppress the volume letter on
-                ;; MS Windows.
-                (setq result (tramp-run-real-handler operation args))
-                (if (stringp result)
-                    (tramp-drop-volume-letter result)
-                  result)))))
+                          (tramp-run-real-handler operation args))
+                         ((eq result 'suppress)
+                          (let (tramp-message-show-message)
+                            (tramp-message
+                             v 1 "Suppress received in operation %s"
+                             (cons operation args))
+                            (tramp-cleanup-connection v t)
+                            (tramp-run-real-handler operation args)))
+                         (t result)))
+
+                    ;; Nothing to do for us.  However, since we are in
+                    ;; `tramp-mode', we must suppress the volume
+                    ;; letter on MS Windows.
+                    (setq result (tramp-run-real-handler operation args))
+                    (if (stringp result)
+                        (tramp-drop-volume-letter result)
+                      result))
+
+                ;; Reset `tramp-current-connection'.
+                (unless
+                    (tramp-file-name-equal-p
+                     (car current-connection) (car tramp-current-connection))
+                  (setq tramp-current-connection current-connection))))))
 
       ;; When `tramp-mode' is not enabled, or the file name is quoted,
       ;; we don't do anything.
@@ -3403,9 +3385,9 @@ User is always nil."
     (access-file filename "Reading directory"))
   (with-parsed-tramp-file-name (expand-file-name filename) nil
     (with-tramp-progress-reporter v 0 (format "Opening directory %s" filename)
-      ;; We must load it in order to get the advice around `insert-directory'.
-      (require 'ls-lisp)
       (let (ls-lisp-use-insert-directory-program start)
+        ;; Silence byte compiler.
+        ls-lisp-use-insert-directory-program
         (tramp-run-real-handler
          #'insert-directory
          (list filename switches wildcard full-directory-p))
@@ -4074,7 +4056,9 @@ performed successfully.  Any other value means an error."
           (widen)
           (tramp-message vec 6 "\n%s" (buffer-string)))
         (if (eq exit 'ok)
-            (ignore-errors (funcall tramp-password-save-function))
+            (ignore-errors
+              (and (functionp tramp-password-save-function)
+                   (funcall tramp-password-save-function)))
           ;; Not successful.
           (tramp-clear-passwd vec)
           (delete-process proc)
@@ -4268,10 +4252,12 @@ Example:
 
 would yield t.  On the other hand, the following check results in nil:
 
-  (tramp-equal-remote \"/sudo::/etc\" \"/su::/etc\")"
-  (and (tramp-tramp-file-p file1)
-       (tramp-tramp-file-p file2)
-       (string-equal (file-remote-p file1) (file-remote-p file2))))
+  (tramp-equal-remote \"/sudo::/etc\" \"/su::/etc\")
+
+If both files are local, the function returns t."
+  (or (and (null (file-remote-p file1)) (null (file-remote-p file2)))
+      (and (tramp-tramp-file-p file1) (tramp-tramp-file-p file2)
+           (string-equal (file-remote-p file1) (file-remote-p file2)))))
 
 (defun tramp-mode-string-to-int (mode-string)
   "Converts a ten-letter `drwxrwxrwx'-style mode string into mode bits."
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index c9ae4d8b139..525f62a3c0b 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -169,7 +169,6 @@ properly.  BODY shall not contain a timeout."
   (declare (indent 1) (debug (natnump body)))
   `(let ((tramp-verbose (max (or ,verbose 0) (or tramp-verbose 0)))
          (tramp-message-show-message t)
-         (tramp-debug-on-error t)
          (debug-ignored-errors
           (cons "^make-symbolic-link not supported$" debug-ignored-errors))
          inhibit-message)
@@ -178,9 +177,8 @@ properly.  BODY shall not contain a timeout."
        ;; Unwind forms.
        (when (and (null tramp--test-instrument-test-case-p) (> tramp-verbose 3))
          (dolist (buf (tramp-list-tramp-buffers))
-           (message ";; %s" buf)
            (with-current-buffer buf
-             (message "%s" (buffer-string))))))))
+             (message ";; %s\n%s" buf (buffer-string))))))))
 
 (defsubst tramp--test-message (fmt-string &rest arguments)
   "Emit a message into ERT *Messages*."
@@ -2960,17 +2958,16 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
         (ignore-errors (delete-directory tmp-name2 'recursive))))))
 
 ;; Method "smb" supports `make-symbolic-link' only if the remote host
-;; has CIFS capabilities.  tramp-adb.el and tramp-gvfs.el do not
-;; support symbolic links at all.
+;; has CIFS capabilities.  tramp-adb.el, tramp-gvfs.el and
+;; tramp-rclone.el do not support symbolic links at all.
 (defmacro tramp--test-ignore-make-symbolic-link-error (&rest body)
   "Run BODY, ignoring \"make-symbolic-link not supported\" file error."
   (declare (indent defun) (debug (body)))
   `(condition-case err
        (progn ,@body)
-     ((error quit debug)
-      (unless (and (eq (car err) 'file-error)
-                   (string-equal (error-message-string err)
-                                 "make-symbolic-link not supported"))
+     (file-error
+      (unless (string-equal (error-message-string err)
+                            "make-symbolic-link not supported")
         (signal (car err) (cdr err))))))
 
 (ert-deftest tramp-test18-file-attributes ()