From 99ba6345bf38305b5480d07851bc5d64fd3e9dcd Mon Sep 17 00:00:00 2001 From: Robert Pluim Date: Fri, 20 Jul 2018 18:35:22 +0200 Subject: [PATCH] Allow retrying of network connections on failure To: emacs-devel@gnu.org 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