From 525c5c7704d217dac5aae8f3730f4a31b5603be8 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Wed, 10 Jul 2013 16:58:26 +0200 Subject: [PATCH] Improve error messages. (Bug#14808) * net/tramp.el (tramp-current-connection): New defvar, moved from tramp-sh.el. (tramp-message-show-progress-reporter-message): Removed, not needed anymore. (tramp-error-with-buffer): Show message in minibuffer. Discard input before waiting. Reset connection timestamp. (with-tramp-progress-reporter): Improve messages. (tramp-process-actions): Use progress reporter. Delete process in case of error. Improve messages. * net/tramp-sh.el (tramp-barf-if-no-shell-prompt): Use condition-case. Call `tramp-error-with-buffer' with vector and buffer. (tramp-current-connection): Removed. (tramp-maybe-open-connection): The car of `tramp-current-connection' are the first 3 slots of the vector. --- lisp/ChangeLog | 20 +++++++++ lisp/net/tramp-sh.el | 25 +++++------ lisp/net/tramp.el | 100 ++++++++++++++++++++++++------------------- 3 files changed, 89 insertions(+), 56 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index c159daa161d..008932be738 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,23 @@ +2013-07-10 Michael Albinus + + Improve error messages. (Bug#14808) + + * net/tramp.el (tramp-current-connection): New defvar, moved from + tramp-sh.el. + (tramp-message-show-progress-reporter-message): Removed, not + needed anymore. + (tramp-error-with-buffer): Show message in minibuffer. Discard + input before waiting. Reset connection timestamp. + (with-tramp-progress-reporter): Improve messages. + (tramp-process-actions): Use progress reporter. Delete process in + case of error. Improve messages. + + * net/tramp-sh.el (tramp-barf-if-no-shell-prompt): Use + condition-case. Call `tramp-error-with-buffer' with vector and buffer. + (tramp-current-connection): Removed. + (tramp-maybe-open-connection): The car of + `tramp-current-connection' are the first 3 slots of the vector. + 2013-07-10 Teodor Zlatanov * progmodes/cfengine.el (cfengine3-indent-line): Do not indent diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index d7316b8d2ea..baa76026bba 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -3752,12 +3752,16 @@ file exists and nonzero exit status otherwise." "Wait for shell prompt and barf if none appears. Looks at process PROC to see if a shell prompt appears in TIMEOUT seconds. If not, it produces an error message with the given ERROR-ARGS." - (unless - (tramp-wait-for-regexp - proc timeout - (format - "\\(%s\\|%s\\)\\'" shell-prompt-pattern tramp-shell-prompt-pattern)) - (apply 'tramp-error-with-buffer nil proc 'file-error error-args))) + (let ((vec (tramp-get-connection-property proc "vector" nil))) + (condition-case err + (tramp-wait-for-regexp + proc timeout + (format + "\\(%s\\|%s\\)\\'" shell-prompt-pattern tramp-shell-prompt-pattern)) + (error + (delete-process proc) + (apply 'tramp-error-with-buffer + (tramp-get-connection-buffer vec) vec 'file-error error-args))))) (defun tramp-open-connection-setup-interactive-shell (proc vec) "Set up an interactive shell. @@ -4332,9 +4336,6 @@ Gateway hops are already opened." ;; Result. target-alist)) -(defvar tramp-current-connection nil - "Last connection timestamp.") - (defun tramp-maybe-open-connection (vec) "Maybe open a connection VEC. Does not do anything if a connection is already open, but re-opens the @@ -4348,7 +4349,7 @@ connection if a previous connection has died for some reason." ;; If Tramp opens the same connection within a short time frame, ;; there is a problem. We shall signal this. (unless (or (and p (processp p) (memq (process-status p) '(run open))) - (not (equal (butlast (append vec nil)) + (not (equal (butlast (append vec nil) 2) (car tramp-current-connection))) (> (tramp-time-diff (current-time) (cdr tramp-current-connection)) @@ -4433,7 +4434,7 @@ connection if a previous connection has died for some reason." (set-process-sentinel p 'tramp-process-sentinel) (tramp-compat-set-process-query-on-exit-flag p nil) (setq tramp-current-connection - (cons (butlast (append vec nil)) (current-time)) + (cons (butlast (append vec nil) 2) (current-time)) tramp-current-host (system-name)) (tramp-message @@ -4442,7 +4443,7 @@ connection if a previous connection has died for some reason." ;; Check whether process is alive. (tramp-barf-if-no-shell-prompt p 60 - "Couldn't find local shell prompt %s" tramp-encoding-shell) + "Couldn't find local shell prompt for %s" tramp-encoding-shell) ;; Now do all the connections as specified. (while target-alist diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index f114c681fb7..6b2e20a0dae 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1071,6 +1071,9 @@ means to use always cached values for the directory contents." (defvar tramp-current-host nil "Remote host for this *tramp* buffer.") +(defvar tramp-current-connection nil + "Last connection timestamp.") + ;;;###autoload (defconst tramp-completion-file-name-handler-alist '((file-name-all-completions . tramp-completion-handle-file-name-all-completions) @@ -1464,10 +1467,6 @@ ARGS to actually emit the message (if applicable)." This variable is used to disable messages from `tramp-error'. The messages are visible anyway, because an error is raised.") -(defvar tramp-message-show-progress-reporter-message t - "Show Tramp progress reporter message in the minibuffer. -This variable is used to disable recursive progress reporter messages.") - (defsubst tramp-message (vec-or-proc level fmt-string &rest args) "Emit a message depending on verbosity level. VEC-OR-PROC identifies the Tramp buffer to use. It can be either a @@ -1547,12 +1546,13 @@ an input event arrives. The other arguments are passed to `tramp-error'." (or (and (bufferp buffer) buffer) (and (processp vec-or-proc) (process-buffer vec-or-proc)) (tramp-get-connection-buffer vec-or-proc))) - (when (string-equal fmt-string "Process died") - (message - "%s\n %s" - "Tramp failed to connect. If this happens repeatedly, try" - "`M-x tramp-cleanup-this-connection'")) - (sit-for 30)))))) + ;; `tramp-error' does not show messages. So we must do it ourselves. + (message fmt-string args) + (discard-input) + (sit-for 30))) + ;; Reset timestamp. It would be wrong after waiting for a while. + (when tramp-current-connection + (setcdr tramp-current-connection (current-time)))))) (defmacro with-parsed-tramp-file-name (filename var &rest body) "Parse a Tramp filename and make components available in the body. @@ -1604,23 +1604,27 @@ progress reporter." (tramp-message ,vec ,level "%s..." ,message) ;; We start a pulsing progress reporter after 3 seconds. Feature ;; introduced in Emacs 24.1. - (when (and tramp-message-show-progress-reporter-message - tramp-message-show-message + (when (and tramp-message-show-message ;; Display only when there is a minimum level. (<= ,level (min tramp-verbose 3))) (ignore-errors (setq pr (tramp-compat-funcall 'make-progress-reporter ,message) tm (when pr (run-at-time 3 0.1 'tramp-progress-reporter-update pr))))) - (unwind-protect - ;; Execute the body. Suppress concurrent progress reporter - ;; messages. - (let ((tramp-message-show-progress-reporter-message - (and tramp-message-show-progress-reporter-message (not tm)))) - ,@body) - ;; Stop progress reporter. - (if tm (tramp-compat-funcall 'cancel-timer tm)) - (tramp-message ,vec ,level "%s...done" ,message)))) + (condition-case err + (unwind-protect + ;; Execute the body. + (progn ,@body) + ;; Stop progress reporter. + (if tm (tramp-compat-funcall 'cancel-timer tm))) + + ;; Error handling. + ((error quit) + (tramp-message ,vec ,level "%s...failed" ,message) + (signal (car err) (cdr err)))) + + ;; Exit. + (tramp-message ,vec ,level "%s...done" ,message))) (tramp-compat-font-lock-add-keywords 'emacs-lisp-mode '("\\")) @@ -3393,39 +3397,47 @@ The terminal type can be configured with `tramp-terminal-type'." PROC and VEC indicate the remote connection to be used. POS, if set, is the starting point of the region to be deleted in the connection buffer." - ;; Preserve message for `progress-reporter'. - (tramp-compat-with-temp-message "" - ;; Enable `auth-source' and `password-cache'. We must use - ;; tramp-current-* variables in case we have several hops. - (tramp-set-connection-property - (tramp-dissect-file-name - (tramp-make-tramp-file-name - tramp-current-method tramp-current-user tramp-current-host "")) - "first-password-request" t) - (save-restriction + ;; Enable `auth-source' and `password-cache'. We must use + ;; tramp-current-* variables in case we have several hops. + (tramp-set-connection-property + (tramp-dissect-file-name + (tramp-make-tramp-file-name + tramp-current-method tramp-current-user tramp-current-host "")) + "first-password-request" t) + (save-restriction + (with-tramp-progress-reporter + proc 3 "Waiting for prompts from remote shell" (let (exit) - (while (not exit) - (tramp-message proc 3 "Waiting for prompts from remote shell") - (setq exit - (catch 'tramp-action - (if timeout - (with-timeout (timeout) - (tramp-process-one-action proc vec actions)) + (if timeout + (with-timeout (timeout (setq exit 'timeout)) + (while (not exit) + (setq exit + (catch 'tramp-action + (tramp-process-one-action proc vec actions))))) + (while (not exit) + (setq exit + (catch 'tramp-action (tramp-process-one-action proc vec actions))))) (with-current-buffer (tramp-get-connection-buffer vec) (widen) (tramp-message vec 6 "\n%s" (buffer-string))) (unless (eq exit 'ok) (tramp-clear-passwd vec) + (delete-process proc) (tramp-error-with-buffer - nil vec 'file-error + (tramp-get-connection-buffer vec) vec 'file-error (cond ((eq exit 'permission-denied) "Permission denied") - ((eq exit 'process-died) "Process died") - (t "Login failed")))) - (when (numberp pos) - (with-current-buffer (tramp-get-connection-buffer vec) - (let (buffer-read-only) (delete-region pos (point))))))))) + ((eq exit 'process-died) + (concat + "Tramp failed to connect. If this happens repeatedly, try\n" + " `M-x tramp-cleanup-this-connection'")) + ((eq exit 'timeout) + "Timeout reached. Check the buffer for the error reason") + (t "Login failed"))))) + (when (numberp pos) + (with-current-buffer (tramp-get-connection-buffer vec) + (let (buffer-read-only) (delete-region pos (point)))))))) :;; Utility functions: -- 2.39.2