* net/tramp.el (tramp-methods): Extend docstring.

(tramp-connection-timeout): New defcustom.
(tramp-error-with-buffer): Reset timestamp only when appropriate.
(with-tramp-progress-reporter): Simplify.
(tramp-process-actions): Improve messages.

* net/tramp-gvfs.el (tramp-gvfs-maybe-open-connection):
* net/tramp-sh.el (tramp-maybe-open-connection):
Use `tramp-connection-timeout'.
(tramp-methods) [su, sudo, ksu]: Add method specific timeouts.  (Bug#14808)

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 4b9cbe829f31f9060ba9278f0a1af38d57c12ea6..29f053c5ae124f573d42b89096b72b1d1cf4bd85 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,17 @@
+2013-07-11  Michael Albinus  <michael.albinus@gmx.de>
+
+       * net/tramp.el (tramp-methods): Extend docstring.
+       (tramp-connection-timeout): New defcustom.
+       (tramp-error-with-buffer): Reset timestamp only when appropriate.
+       (with-tramp-progress-reporter): Simplify.
+       (tramp-process-actions): Improve messages.
+
+       * net/tramp-gvfs.el (tramp-gvfs-maybe-open-connection):
+       * net/tramp-sh.el (tramp-maybe-open-connection):
+       Use `tramp-connection-timeout'.
+       (tramp-methods) [su, sudo, ksu]: Add method specific timeouts.
+       (Bug#14808)
+
 2013-07-11  Leo Liu  <sdl.web@gmail.com>
 
        * ido.el (ido-read-file-name): Conform to the requirements of

diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index 6ba055b8bb82fb7a7524f59b830082db1222b8c6..c2fdc0491b637a7077ec845ec4ab2d9d995a6e18 100644 (file)
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -1539,7 +1539,8 @@ connection if a previous connection has died for some reason."
        ;; indicated by the "mounted" signal, i.e. the "fuse-mountpoint"
        ;; file property.
        (with-timeout
-           (60
+           ((or (tramp-get-method-parameter method 'tramp-connection-timeout)
+                tramp-connection-timeout)
             (if (zerop (length (tramp-file-name-user vec)))
                 (tramp-error
                  vec 'file-error

diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index baa76026bbaf183fb224b0a30000364a5b93a524..281f497692d2a9ac9b34cff4c5f3032f75ffc7b1 100644 (file)
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -222,21 +222,24 @@ detected as prompt when being sent on echoing hosts, therefore.")
     (tramp-login-program        "su")
     (tramp-login-args           (("-") ("%u")))
     (tramp-remote-shell         "/bin/sh")
-    (tramp-remote-shell-args    ("-c"))))
+    (tramp-remote-shell-args    ("-c"))
+    (tramp-connection-timeout   10)))
 ;;;###tramp-autoload
 (add-to-list 'tramp-methods
   '("sudo"
     (tramp-login-program        "sudo")
     (tramp-login-args           (("-u" "%u") ("-s") ("-H") ("-p" "Password:")))
     (tramp-remote-shell         "/bin/sh")
-    (tramp-remote-shell-args    ("-c"))))
+    (tramp-remote-shell-args    ("-c"))
+    (tramp-connection-timeout   10)))
 ;;;###tramp-autoload
 (add-to-list 'tramp-methods
   '("ksu"
     (tramp-login-program        "ksu")
     (tramp-login-args           (("%u") ("-q")))
     (tramp-remote-shell         "/bin/sh")
-    (tramp-remote-shell-args    ("-c"))))
+    (tramp-remote-shell-args    ("-c"))
+    (tramp-connection-timeout   10)))
 ;;;###tramp-autoload
 (add-to-list 'tramp-methods
   '("krlogin"
@@ -4442,7 +4445,7 @@ connection if a previous connection has died for some reason."
 
                ;; Check whether process is alive.
                (tramp-barf-if-no-shell-prompt
-                p 60
+                p 10
                 "Couldn't find local shell prompt for %s" tramp-encoding-shell)
 
                ;; Now do all the connections as specified.
@@ -4461,6 +4464,9 @@ connection if a previous connection has died for some reason."
                         (async-args
                          (tramp-get-method-parameter
                           l-method 'tramp-async-args))
+                        (connection-timeout
+                         (tramp-get-method-parameter
+                          l-method 'tramp-connection-timeout))
                         (gw-args
                          (tramp-get-method-parameter l-method 'tramp-gw-args))
                         (gw (tramp-get-file-property hop "" "gateway" nil))
@@ -4543,7 +4549,8 @@ connection if a previous connection has died for some reason."
                    (tramp-message vec 3 "Sending command `%s'" command)
                    (tramp-send-command vec command t t)
                    (tramp-process-actions
-                    p vec pos tramp-actions-before-shell 60)
+                    p vec pos tramp-actions-before-shell
+                    (or connection-timeout tramp-connection-timeout))
                    (tramp-message
                     vec 3 "Found remote shell prompt on `%s'" l-host))
                  ;; Next hop.

diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 6c5fd5e5dd40bc6deac756a31bdc8529df3675b0..3513701d20ea54c60c80dcc8373102a09e684662 100644 (file)
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -252,6 +252,11 @@ pair of the form (KEY VALUE).  The following KEYs are defined:
   * `tramp-tmpdir'
     A directory on the remote host for temporary files.  If not
     specified, \"/tmp\" is taken as default.
+  * `tramp-connection-timeout'
+    This is the maximum time to be spent for establishing a connection.
+    In general, the global default value shall be used, but for
+    some methods, like \"su\" or \"sudo\", a shorter timeout
+    might be desirable.
 
 What does all this mean?  Well, you should specify `tramp-login-program'
 for all methods; this program is used to log in to the remote site.  Then,
@@ -1034,6 +1039,13 @@ opening a connection to a remote host."
   :group 'tramp
   :type '(choice (const nil) (const t) (const pty)))
 
+(defcustom tramp-connection-timeout 60
+  "Defines the max time to wait for establishing a connection (in seconds).
+This can be overwritten for different connection types in `tramp-methods'."
+  :group 'tramp
+  :version "24.4"
+  :type 'integer)
+
 (defcustom tramp-connection-min-time-diff 5
   "Defines seconds between two consecutive connection attempts.
 This is necessary as self defense mechanism, in order to avoid
@@ -1535,24 +1547,32 @@ signal identifier to be raised, remaining args passed to
 If BUFFER is nil, show the connection buffer.  Wait for 30\", or until
 an input event arrives.  The other arguments are passed to `tramp-error'."
   (save-window-excursion
-    (unwind-protect
-       (apply 'tramp-error vec-or-proc signal fmt-string args)
-      (when (and vec-or-proc
-                tramp-message-show-message
-                (not (zerop tramp-verbose))
-                (not (tramp-completion-mode-p)))
-       (let ((enable-recursive-minibuffers t))
-         (pop-to-buffer
-          (or (and (bufferp buffer) buffer)
-              (and (processp vec-or-proc) (process-buffer vec-or-proc))
-              (tramp-get-connection-buffer vec-or-proc)))
-         ;; `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))))))
+    (let* ((buf (or (and (bufferp buffer) buffer)
+                   (and (processp vec-or-proc) (process-buffer vec-or-proc))
+                   (and (vectorp vec-or-proc)
+                        (tramp-get-connection-buffer vec-or-proc))))
+          (vec (or (and (vectorp vec-or-proc) vec-or-proc)
+                   (and buf (with-current-buffer buf
+                              (tramp-dissect-file-name default-directory))))))
+      (unwind-protect
+         (apply 'tramp-error vec-or-proc signal fmt-string args)
+       ;; Save exit.
+       (when (and buf
+                  tramp-message-show-message
+                  (not (zerop tramp-verbose))
+                  (not (tramp-completion-mode-p)))
+         (let ((enable-recursive-minibuffers t))
+           ;; `tramp-error' does not show messages.  So we must do it
+           ;; ourselves.
+           (message fmt-string args)
+           ;; Show buffer.
+           (pop-to-buffer buf)
+           (discard-input)
+           (sit-for 30)))
+       ;; Reset timestamp.  It would be wrong after waiting for a while.
+       (when (equal (butlast (append vec nil) 2)
+                    (car 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.
@@ -1596,11 +1616,11 @@ If VAR is nil, then we bind `v' to the structure and `method', `user',
 
 (defmacro with-tramp-progress-reporter (vec level message &rest body)
   "Executes BODY, spinning a progress reporter with MESSAGE.
-If LEVEL does not fit for visible messages, or if this is a
-nested call of the macro, there are only traces without a visible
-progress reporter."
+If LEVEL does not fit for visible messages, there are only traces
+without a visible progress reporter."
   (declare (indent 3) (debug t))
-  `(let (pr tm result)
+  `(let ((result "failed")
+        pr tm)
      (tramp-message ,vec ,level "%s..." ,message)
      ;; We start a pulsing progress reporter after 3 seconds.  Feature
      ;; introduced in Emacs 24.1.
@@ -1611,21 +1631,12 @@ progress reporter."
         (setq pr (tramp-compat-funcall 'make-progress-reporter ,message)
               tm (when pr
                    (run-at-time 3 0.1 'tramp-progress-reporter-update pr)))))
-     (condition-case err
-        (unwind-protect
-            ;; Execute the body.
-            (setq result (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)
-     result))
+     (unwind-protect
+        ;; Execute the body.
+        (prog1 (progn ,@body) (setq result "done"))
+       ;; Stop progress reporter.
+       (if tm (tramp-compat-funcall 'cancel-timer tm))
+       (tramp-message ,vec ,level "%s...%s" ,message result))))
 
 (tramp-compat-font-lock-add-keywords
  'emacs-lisp-mode '("\\<with-tramp-progress-reporter\\>"))
@@ -3434,7 +3445,9 @@ connection buffer."
              "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")
+            (format
+             "Timeout reached, see buffer `%s' for details"
+             (tramp-get-connection-buffer vec)))
            (t "Login failed")))))
       (when (numberp pos)
        (with-current-buffer (tramp-get-connection-buffer vec)