Allow making TLS negotiation blocking

* lisp/net/gnutls.el (gnutls-negotiate): Make negotiation blocking.

* src/gnutls.c (Fgnutls_boot): Provide a new keyword,
:complete-negotiation, to specify that we want complete
negotiation even if the socket is non-blocking.
(gnutls_try_handshake): Complete negotiation if given that keyword.

* src/process.h (L): Added gnutls_complete_negotiation_p.

2 files changed, 15 insertions, 3 deletions

diff --git a/src/gnutls.c b/src/gnutls.c
index 988c0104869..db22c924f0c 100644
--- a/src/gnutls.c
+++ b/src/gnutls.c
@@ -402,8 +402,12 @@ gnutls_try_handshake (struct Lisp_Process *proc)
 {
   gnutls_session_t state = proc->gnutls_state;
   int ret;
+  bool non_blocking = proc->is_non_blocking_client;
 
-  if (proc->is_non_blocking_client)
+  if (proc->gnutls_complete_negotiation_p)
+    non_blocking = false;
+
+  if (non_blocking)
     proc->gnutls_p = true;
 
   do
@@ -412,8 +416,9 @@ gnutls_try_handshake (struct Lisp_Process *proc)
       emacs_gnutls_handle_error (state, ret);
       QUIT;
     }
-  while (ret < 0 && gnutls_error_is_fatal (ret) == 0
-         && ! proc->is_non_blocking_client);
+  while (ret < 0
+         && gnutls_error_is_fatal (ret) == 0
+         && ! non_blocking);
 
   proc->gnutls_initstage = GNUTLS_STAGE_HANDSHAKE_TRIED;
 
@@ -1354,6 +1359,9 @@ t to do all checks.  Currently it can contain `:trustfiles' and
 :min-prime-bits is the minimum accepted number of bits the client will
 accept in Diffie-Hellman key exchange.
 
+:complete-negotiation, if non-nil, will make negotiation complete
+before returning even on non-blocking sockets.
+
 The debug level will be set for this process AND globally for GnuTLS.
 So if you set it higher or lower at any point, it affects global
 debugging.
@@ -1642,6 +1650,8 @@ one trustfile (usually a CA bundle).  */)
         return gnutls_make_error (ret);
     }
 
+  XPROCESS (proc)->gnutls_complete_negotiation_p =
+    !NILP (Fplist_get (proplist, QCgnutls_complete_negotiation));
   GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CRED_SET;
   ret = emacs_gnutls_handshake (XPROCESS (proc));
   if (ret < GNUTLS_E_SUCCESS)
@@ -1734,6 +1744,7 @@ syms_of_gnutls (void)
   DEFSYM (QCgnutls_bootprop_crlfiles, ":crlfiles");
   DEFSYM (QCgnutls_bootprop_min_prime_bits, ":min-prime-bits");
   DEFSYM (QCgnutls_bootprop_loglevel, ":loglevel");
+  DEFSYM (QCgnutls_complete_negotiation, ":complete-negotiation");
   DEFSYM (QCgnutls_bootprop_verify_flags, ":verify-flags");
   DEFSYM (QCgnutls_bootprop_verify_error, ":verify-error");
 
diff --git a/src/process.h b/src/process.h
index 038d58b7370..95bd1b65363 100644
--- a/src/process.h
+++ b/src/process.h
@@ -193,6 +193,7 @@ struct Lisp_Process
     int gnutls_log_level;
     int gnutls_handshakes_tried;
     bool_bf gnutls_p : 1;
+    bool_bf gnutls_complete_negotiation_p : 1;
 #endif
 };