Re: [RFC] automatically retrying network connections

[Robert Pluim]

Lars Ingebrigtsen <address@hidden> writes:

> Robert Pluim <address@hidden> writes:
>
>> one of the consequences of asking the user questions during network
>> connection setup is that the server they're trying to connect to might
>> have decided to close the connection by the time they've finished
>> answering.
>
> Yes, the NSM should reconnect if the user says "go ahead" to the NSM
> warning and the server has closed the connection.  The reason that
> landed on the back burner is that servers seem to mostly have long
> timeouts, so this turned out to be less of a problem in practice than I
> expected.  (I.e., I don't recall seeing a bug report about this, which
> is just plain weird.)

Thereʼs this little-known news server called news.gmane.org that has a
10 second timeout :-) Reconnecting immediately works, so itʼs not a
big deal.

So you'd put this in nsm-verify-connection, without a user option? I
donʼt think nsm currently has access to all the connection setup
parameters, which is why I put the logic in open-network-stream.
Proof-of-concept patch attached (it should really do more checking of
what nsm returned).

> We could also reverse the logic a bit and have the NSM always shut down
> the connection before prompting.  This will make network connections
> (that prompt an NSM warning) be somewhat slower, but it shouldn't be a
> big deal.

That seems wasteful. In most cases the connection will complete OK, so
why add an extra connection setup for all cases?

> In any case, when reconnecting we have to consider whether this would
> trigger extra auth-source prompts, which would be annoying, but I have a
> feeling like these are mostly done later in the connection process
> usually, so it shouldn't be an issue.

If youʼre thinking of authentication for SMTP sessions and the like,
they'd all arrive after completion of the TLS setup.

Robert

>From 99ba6345bf38305b5480d07851bc5d64fd3e9dcd Mon Sep 17 00:00:00 2001
From: Robert Pluim <address@hidden>
Date: Fri, 20 Jul 2018 18:35:22 +0200
Subject: [PATCH] Allow retrying of network connections on failure
To: address@hidden

With network-security-manager, there are cases where the user is
expected to answer one or more questions before a network connection
is finally established, which can result in the other end having timed
out.  Allow specifying :retry-on-fail t to open-network-stream to
retry the connection, which should now succeed.

* src/process.c (syms_of_process): Define Qprocess_not_running_error
symbol.
(send_process): Signal Qprocess_not_running_error for the specific
case of the process having died only.

* lisp/net/network-stream.el (open-network-stream): Add :retry-on-fail
parameter, and retry network connection if it is set and we receive a
Qprocess_not_running_error.
---
 lisp/net/network-stream.el | 42 +++++++++++++++++++++++++++-----------
 src/process.c              | 15 +++++++++++++-
 2 files changed, 44 insertions(+), 13 deletions(-)

diff --git a/lisp/net/network-stream.el b/lisp/net/network-stream.el
index a0589e25a4..3ecd8c2c64 100644
--- a/lisp/net/network-stream.el
+++ b/lisp/net/network-stream.el
@@ -153,22 +153,34 @@ open-network-stream
 opening a TLS connection.  The first element is the TLS
 type (either `gnutls-x509pki' or `gnutls-anon'), and the
 remaining elements should be a keyword list accepted by
-gnutls-boot (as returned by `gnutls-boot-parameters')."
+gnutls-boot (as returned by `gnutls-boot-parameters').
+
+:retry-on-fail, if non-nil, means attempt the connection again,
+once, if it initially fails.  This is to cover the case where
+answering network-security-manager questions causes the remote
+server to timeout the connection."
   (unless (featurep 'make-network-process)
     (error "Emacs was compiled without networking support"))
   (let ((type (plist-get parameters :type))
-       (return-list (plist-get parameters :return-list)))
+       (return-list (plist-get parameters :return-list))
+        (fun 'make-network-process)
+        (args (list :name name :buffer buffer
+                    :host (puny-encode-domain host) :service service
+                    :nowait (plist-get parameters :nowait)
+                    :tls-parameters
+                    (plist-get parameters :tls-parameters))))
     (if (and (not return-list)
             (or (eq type 'plain)
                 (and (memq type '(nil network))
                      (not (and (plist-get parameters :success)
                                (plist-get parameters :capability-command))))))
        ;; The simplest case: wrapper around `make-network-process'.
-       (make-network-process :name name :buffer buffer
-                             :host (puny-encode-domain host) :service service
-                             :nowait (plist-get parameters :nowait)
-                              :tls-parameters
-                              (plist-get parameters :tls-parameters))
+        (condition-case err
+            (apply fun args)
+          (process-not-running-error
+           (when (plist-get parameters :retry-on-fail)
+             (delete-process (cdr err))
+             (apply fun args))))
       (let ((work-buffer (or buffer
                             (generate-new-buffer " *stream buffer*")))
            (fun (cond ((and (eq type 'plain)
@@ -181,12 +193,18 @@ open-network-stream
                       ((eq type 'shell) 'network-stream-open-shell)
                       (t (error "Invalid connection type %s" type))))
            result)
-       (unwind-protect
+       (condition-case err
            (setq result (funcall fun name work-buffer host service parameters))
-         (unless buffer
-           (and (processp (car result))
-                (set-process-buffer (car result) nil))
-           (kill-buffer work-buffer)))
+          (process-not-running-error
+           (when (plist-get parameters :retry-on-fail)
+            (delete-process (cdr err))
+            (setq result (funcall fun name work-buffer host service 
parameters))))
+          (error
+          (unless buffer
+            (and (processp (car result))
+                 (set-process-buffer (car result) nil))
+            (kill-buffer work-buffer))
+           (signal (car err) (cdr err))))
        (if return-list
            (list (car result)
                  :greeting     (nth 1 result)
diff --git a/src/process.c b/src/process.c
index 279b74bc66..222bd9fcff 100644
--- a/src/process.c
+++ b/src/process.c
@@ -6233,8 +6233,11 @@ send_process (Lisp_Object proc, const char *buf, 
ptrdiff_t len,
 
   if (p->raw_status_new)
     update_status (p);
+  /* Process might have died whilst we were waiting for the user to
+     answer nsm questions.  Signal a specific error in that case so
+     higher levels can retry if they want.  */
   if (! EQ (p->status, Qrun))
-    error ("Process %s not running", SDATA (p->name));
+    xsignal (Qprocess_not_running_error, proc);
   if (p->outfd < 0)
     error ("Output file descriptor of %s is closed", SDATA (p->name));
 
@@ -8091,6 +8094,8 @@ syms_of_process (void)
 {
 #ifdef subprocesses
 
+  Lisp_Object error_tail;
+
   DEFSYM (Qprocessp, "processp");
   DEFSYM (Qrun, "run");
   DEFSYM (Qstop, "stop");
@@ -8241,6 +8246,14 @@ returns non-`nil'.  */);
          "internal-default-interrupt-process");
   DEFSYM (Qinterrupt_process_functions, "interrupt-process-functions");
 
+  DEFSYM (Qprocess_not_running_error, "process-not-running-error");
+  error_tail = pure_cons (Qprocess_not_running_error, Qnil);
+
+  Fput (Qprocess_not_running_error, Qerror_conditions,
+       error_tail);
+  Fput (Qprocess_not_running_error, Qerror_message,
+       build_pure_c_string ("process not running error"));
+
   defsubr (&Sprocessp);
   defsubr (&Sget_process);
   defsubr (&Sdelete_process);
-- 
2.18.0.129.ge3331758f1