tramp (2.0.47); Unnecessary delays accept-process-output; proposed fix.

[Wagemans, Peter]

 
Long setup times for tramp ssh connections to remote servers have kept
me wondering about the underlying cause. Last week I found out about
the existence of the elp profiler and decided to have a look. After
some initial digging on tramp login with ntemacs, the following data
came up, using elp master function tramp-send-command-internal:

Function Name                  Call Count  Elapsed Time  Average Time
=============================  ==========  ============  ============
tramp-barf-if-no-shell-prompt  9           9.002         1.0002222222
tramp-send-command-internal    9           9.002         1.0002222222
tramp-wait-for-regexp          9           9.002         1.0002222222
tramp-wait-for-shell-prompt    9           9.002         1.0002222222
accept-process-output          9           9.002         1.0002222222
tramp-send-command             9           0.0           0.0

In the function tramp-wait-for-regexp we see two calls like this:

                 (accept-process-output proc 1)

From the above profiler data, it looks like accept-process-output is
always taking the full timeout period of 1 second. From a short scan
of the C code, it seems that this is indeed what accept-process-output
is supposed to do.

This leads to the following experiment to improve the tramp setup
time: reduce the two accept-process-output timeouts in
tramp-wait-for-regexp from 1 second to 0.1 seconds:

(defun tramp-wait-for-regexp (proc timeout regexp)
...
                 (accept-process-output proc 0 100000)
...
             (accept-process-output proc 0 100000)
...

With this new definition, the profiler says:

Function Name                 Call Count  Elapsed Time  Average Time
============================= ==========  ============  ============
tramp-barf-if-no-shell-prompt 9           0.981         0.109
tramp-send-command-internal   9           0.981         0.109
tramp-wait-for-shell-prompt   9           0.981         0.109
accept-process-output         9           0.981         0.109
tramp-send-command            9           0.0           0.0

Thus the smaller timeouts save me about 8 seconds connection setup
time.

Perhaps the reason for the fixed timeout of one second in the tramp
code is that not all platforms support the microsecond option.

It seemed like a good idea to make the use of smaller timeouts
possible on platforms that support it via a custom variable. The
default value of that variable can depend on whether the platform
supports timeouts for fractional seconds. After some fiddling around,
I ended up with the patch below.

In my environment, the modifications typically save me more than half
of the setup time for an initial ssh connection. There was also not
much sense in using shorter timeouts than 0.1 seconds: that resulted
in unsuccessful regexp matching of incomplete subshell output and more
accept-process-output calls to receive the remaining output.

Regards,

Peter Wagemans

PS. Being an elisp newbie, I hope the patch doesn't overlook better or
simpler solutions, or violate conventions that I'm unaware of.

Emacs  : GNU Emacs 21.3.50.1 (i386-mingw-nt5.0.2195)
 of 2005-01-30 on NONIQPC
Package: tramp (2.0.47)

[I deleted the remaining output of tramp-bug, since it did not seem
relevant to me.]

--- tramp.el.old_200602160921   2005-01-16 19:35:12.000000000 +0100
+++ tramp.el    2006-02-17 12:33:32.916297600 +0100
@@ -1404,6 +1404,42 @@
   :group 'tramp
   :type '(choice (const nil) (const t) (const pty)))
 
+
+
+(defcustom tramp-wait-for-process-output-time
+
+;; Try to figure out whether the system supports waiting for
+;; fractional seconds by sleeping for a millisecond. This should
+;; generate an error if the support is lacking, according to the elisp
+;; 21.2-8 manual and the following code in dispnew.c (21.4a).
+
+;; #ifndef EMACS_HAS_USECS
+;;   if (sec == 0 && usec != 0)
+;;     error ("millisecond `sleep-for' not supported on %s", SYSTEM_TYPE);
+;; #endif
+
+(condition-case nil
+    (progn (sleep-for 0 1) 0.1)
+  (error 1) )
+
+
+;; Documentation string:
+
+  "Time interval to listen for output from subprocesses.
+
+The default value is 0.1 second on systems that support waiting
+for fractional seconds. On systems without such support,
+fractional values are rounded down, thus values smaller than 1
+second result in a zero wait time. This could result in a busy
+loop with tramp wasting CPU cycles on matching regular
+expressions against incomplete subprocess output. Therefore the
+default value is 1 second on systems without wait support for
+fractional seconds."
+
+  :group 'tramp
+  :type 'number)
+
+
 ;;; Internal Variables:
 
 (defvar tramp-buffer-file-attributes nil
@@ -5175,6 +5211,28 @@
 ;; -- Functions for establishing connection --
 ;; ------------------------------------------------------------
 
+(defun tramp-accept-process-output (proc)
+  "Call accept-process-output with appropriate timeout parameters
+  based on tramp-wait-for-process-output-time"
+
+;; The elisp manual 2.8 for emacs 21.2 (latest on 20060217) says about
+;; accept-process-output: "The argument seconds need not be an
+;; integer. If it is a floating point number, this function waits for
+;; a fractional number of seconds." However, the implementation in
+;; emacs-21.4a (current on 20060217) accepts only integers:
+;;
+;;   if (! NILP (timeout))
+;;     {
+;;       CHECK_NUMBER (timeout, 1);
+;;       seconds = XINT (timeout);
+;;
+;; so we convert the wait time to seconds and microseconds, in a
+;; separate function to have this in a single place.
+
+  (let ((secs (floor tramp-wait-for-process-output-time))
+       (microsecs (floor (* (mod tramp-wait-for-process-output-time 1) 1000000))))
+    (accept-process-output proc secs microsecs)))
+
 ;; The following functions are actions to be taken when seeing certain
 ;; prompts from the remote host.  See the variable
 ;; `tramp-actions-before-shell' for usage of these functions.
@@ -5306,7 +5364,7 @@
     (tramp-message 9 "Waiting 60s for prompt from remote shell")
     (with-timeout (60 (throw 'tramp-action 'timeout))
       (while (not found)
-       (accept-process-output p 1)
+       (tramp-accept-process-output p)
        (goto-char (point-min))
        (setq todo actions)
        (while todo
@@ -5343,7 +5401,7 @@
     (tramp-message 9 "Waiting 60s for prompt from remote shell")
     (with-timeout (60 (throw 'tramp-action 'timeout))
       (while (not found)
-       (accept-process-output p 1)
+       (tramp-accept-process-output p)
        (setq todo actions)
        (goto-char (point-min))
        (while todo
@@ -5748,7 +5806,7 @@
                           timeout))
              (with-timeout (timeout)
                (while (not found)
-                 (accept-process-output proc 1)
+                 (tramp-accept-process-output proc)
                 (unless (memq (process-status proc) '(run open))
                   (error "Process has died"))
                  (goto-char (point-min))
@@ -5756,7 +5814,7 @@
                                (tramp-match-string-list)))))))
           (t
            (while (not found)
-             (accept-process-output proc 1)
+            (tramp-accept-process-output proc)
             (unless (memq (process-status proc) '(run open))
               (error "Process has died"))
              (goto-char (point-min))
@@ -6359,7 +6417,7 @@
                             timeout))
                (with-timeout (timeout)
                  (while (not found)
-                   (accept-process-output proc 1)
+                   (tramp-accept-process-output proc)
                   (unless (memq (process-status proc) '(run open))
                     (error "Process has died"))
                    (goto-char (point-max))
@@ -6367,7 +6425,7 @@
                    (setq found (looking-at end-of-output))))))
             (t
              (while (not found)
-               (accept-process-output proc 1)
+               (tramp-accept-process-output proc)
               (unless (memq (process-status proc) '(run open))
                 (error "Process has died"))
                (goto-char (point-max))
@@ -6516,7 +6574,7 @@
 If `tramp-discard-garbage' is nil, just erase buffer."
   (if (not tramp-discard-garbage)
       (erase-buffer)
-    (while (prog1 (erase-buffer) (accept-process-output p 0.25))
+    (while (prog1 (erase-buffer) (tramp-accept-process-output p))
       (when tramp-debug-buffer
         (save-excursion
           (set-buffer (tramp-get-debug-buffer multi-method method user host))