[Emacs-diffs] trunk r113368: * net/tramp.el (tramp-methods): Extend docstring.

[Michael Albinus]

------------------------------------------------------------
revno: 113368
revision-id: address@hidden
parent: address@hidden
committer: Michael Albinus <address@hidden>
branch nick: trunk
timestamp: Thu 2013-07-11 11:52:54 +0200
message:
  * 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)
modified:
  lisp/ChangeLog                 changelog-20091113204419-o5vbwnq5f7feedwu-1432
  lisp/net/tramp-gvfs.el         
trampgvfs.el-20091113204419-o5vbwnq5f7feedwu-10898
  lisp/net/tramp-sh.el           trampsh.el-20100913133439-a1faifh29eqoi4nh-1
  lisp/net/tramp.el              tramp.el-20091113204419-o5vbwnq5f7feedwu-2427

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2013-07-11 02:59:54 +0000
+++ b/lisp/ChangeLog    2013-07-11 09:52:54 +0000
@@ -1,3 +1,17 @@
+2013-07-11  Michael Albinus  <address@hidden>
+
+       * 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  <address@hidden>
 
        * ido.el (ido-read-file-name): Conform to the requirements of

=== modified file 'lisp/net/tramp-gvfs.el'
--- a/lisp/net/tramp-gvfs.el    2013-05-24 10:03:45 +0000
+++ b/lisp/net/tramp-gvfs.el    2013-07-11 09:52:54 +0000
@@ -1539,7 +1539,8 @@
        ;; 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

=== modified file 'lisp/net/tramp-sh.el'
--- a/lisp/net/tramp-sh.el      2013-07-10 14:58:26 +0000
+++ b/lisp/net/tramp-sh.el      2013-07-11 09:52:54 +0000
@@ -222,21 +222,24 @@
     (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 @@
 
                ;; 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 @@
                         (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 @@
                    (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.

=== modified file 'lisp/net/tramp.el'
--- a/lisp/net/tramp.el 2013-07-10 15:18:39 +0000
+++ b/lisp/net/tramp.el 2013-07-11 09:52:54 +0000
@@ -252,6 +252,11 @@
   * `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 @@
   :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 @@
 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 @@
 
 (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 @@
         (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 @@
              "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)