Further TLS async work

* gnutls.c (boot_error): New function to either signal an
error or return an error code.
(Fgnutls_boot): Don't signal errors when running asynchronously.

* process.h (pset_status): Move here from process.c to be
able to use from gnutls.c.

* process.c (connect_network_socket): Do the TLS boot here
when running asynchronously.
(wait_reading_process_output): Rework the dns_processes
handling for more safety.

3 files changed, 102 insertions, 33 deletions

diff --git a/src/gnutls.c b/src/gnutls.c
index 06459fb3ccd..a0b6e0df68b 100644
--- a/src/gnutls.c
+++ b/src/gnutls.c
@@ -1167,6 +1167,19 @@ emacs_gnutls_global_deinit (void)
 }
 #endif
 
+/* VARARGS 1 */
+static void
+boot_error (struct Lisp_Process *p, const char *m, ...)
+{
+  va_list ap;
+  va_start (ap, m);
+  if (p->is_non_blocking_client)
+    pset_status (p, Qfailed);
+  else
+    verror (m, ap);
+}
+
+
 DEFUN ("gnutls-boot", Fgnutls_boot, Sgnutls_boot, 3, 3, 0,
        doc: /* Initialize GnuTLS client for process PROC with TYPE+PROPLIST.
 Currently only client mode is supported.  Return a success/failure
@@ -1246,16 +1259,23 @@ one trustfile (usually a CA bundle).  */)
   Lisp_Object verify_error;
   Lisp_Object prime_bits;
   Lisp_Object warnings;
+  struct Lisp_Process *p = XPROCESS (proc);
 
   CHECK_PROCESS (proc);
   CHECK_SYMBOL (type);
   CHECK_LIST (proplist);
 
   if (NILP (Fgnutls_available_p ()))
-    error ("GnuTLS not available");
+    {
+      boot_error (p, "GnuTLS not available");
+      return Qnil;
+    }
 
   if (!EQ (type, Qgnutls_x509pki) && !EQ (type, Qgnutls_anon))
-    error ("Invalid GnuTLS credential type");
+    {
+      boot_error (p, "Invalid GnuTLS credential type");
+      return Qnil;
+    }
 
   hostname              = Fplist_get (proplist, QCgnutls_bootprop_hostname);
   priority_string       = Fplist_get (proplist, QCgnutls_bootprop_priority);
@@ -1272,11 +1292,15 @@ one trustfile (usually a CA bundle).  */)
     }
   else if (NILP (Flistp (verify_error)))
     {
-      error ("gnutls-boot: invalid :verify_error parameter (not a list)");
+      boot_error (p, "gnutls-boot: invalid :verify_error parameter (not a list)");
+      return Qnil;
     }
 
   if (!STRINGP (hostname))
-    error ("gnutls-boot: invalid :hostname parameter (not a string)");
+    {
+      boot_error (p, "gnutls-boot: invalid :hostname parameter (not a string)");
+      return Qnil;
+    }
   c_hostname = SSDATA (hostname);
 
   state = XPROCESS (proc)->gnutls_state;
@@ -1384,7 +1408,8 @@ one trustfile (usually a CA bundle).  */)
           else
             {
               emacs_gnutls_deinit (proc);
-              error ("Invalid trustfile");
+              boot_error (p, "Invalid trustfile");
+              return Qnil;
             }
         }
 
@@ -1408,7 +1433,8 @@ one trustfile (usually a CA bundle).  */)
           else
             {
               emacs_gnutls_deinit (proc);
-              error ("Invalid CRL file");
+              boot_error (p, "Invalid CRL file");
+              return Qnil;
             }
         }
 
@@ -1437,8 +1463,9 @@ one trustfile (usually a CA bundle).  */)
           else
             {
               emacs_gnutls_deinit (proc);
-              error (STRINGP (keyfile) ? "Invalid client cert file"
-                     : "Invalid client key file");
+              boot_error (p, STRINGP (keyfile) ? "Invalid client cert file"
+                          : "Invalid client key file");
+              return Qnil;
             }
         }
     }
@@ -1528,8 +1555,9 @@ one trustfile (usually a CA bundle).  */)
           || !NILP (Fmember (QCgnutls_bootprop_trustfiles, verify_error)))
         {
           emacs_gnutls_deinit (proc);
-          error ("Certificate validation failed %s, verification code %x",
-                 c_hostname, peer_verification);
+          boot_error (p, "Certificate validation failed %s, verification code %x",
+                      c_hostname, peer_verification);
+          return Qnil;
         }
       else
         {
@@ -1558,7 +1586,8 @@ one trustfile (usually a CA bundle).  */)
         {
           gnutls_x509_crt_deinit (gnutls_verify_cert);
           emacs_gnutls_deinit (proc);
-          error ("No x509 certificate was found\n");
+          boot_error (p, "No x509 certificate was found\n");
+          return Qnil;
         }
 
       /* We only check the first certificate in the given chain.  */
@@ -1586,7 +1615,8 @@ one trustfile (usually a CA bundle).  */)
             {
               gnutls_x509_crt_deinit (gnutls_verify_cert);
               emacs_gnutls_deinit (proc);
-              error ("The x509 certificate does not match \"%s\"", c_hostname);
+              boot_error (p, "The x509 certificate does not match \"%s\"", c_hostname);
+              return Qnil;
             }
           else
             {
diff --git a/src/process.c b/src/process.c
index 55264058340..afb98256ba5 100644
--- a/src/process.c
+++ b/src/process.c
@@ -385,11 +385,6 @@ pset_sentinel (struct Lisp_Process *p, Lisp_Object val)
   p->sentinel = NILP (val) ? Qinternal_default_process_sentinel : val;
 }
 static void
-pset_status (struct Lisp_Process *p, Lisp_Object val)
-{
-  p->status = val;
-}
-static void
 pset_tty_name (struct Lisp_Process *p, Lisp_Object val)
 {
   p->tty_name = val;
@@ -3309,11 +3304,17 @@ void connect_network_socket (Lisp_Object proc, Lisp_Object ip_addresses)
 
 #ifdef HAVE_GNUTLS
   if (!NILP (p->gnutls_async_parameters) && p->is_non_blocking_client) {
-    Fgnutls_boot (proc, Fcar (p->gnutls_async_parameters),
-                  Fcdr (p->gnutls_async_parameters));
+    Lisp_Object params = p->gnutls_async_parameters, boot = Qnil;
+
     p->gnutls_async_parameters = Qnil;
+    boot = Fgnutls_boot (proc, Fcar (params), Fcdr (params));
+    if (STRINGP (boot)) {
+      pset_status (p, Qfailed);
+      deactivate_process (proc);
+    }
   }
 #endif
+
 }
 
 
@@ -3798,6 +3799,9 @@ usage: (make-network-process &rest ARGS)  */)
 #ifdef HAVE_GETADDRINFO_A
   p->dns_requests = NULL;
 #endif
+#ifdef HAVE_GNUTLS
+  p->gnutls_async_parameters = Qnil;
+#endif
 
   unbind_to (count, Qnil);
 
@@ -4545,13 +4549,12 @@ server_accept_connection (Lisp_Object server, int channel)
 }
 
 #ifdef HAVE_GETADDRINFO_A
-static int
+static Lisp_Object
 check_for_dns (Lisp_Object proc)
 {
   struct Lisp_Process *p = XPROCESS (proc);
   Lisp_Object ip_addresses = Qnil;
   int ret = 0;
-  int connect = 0;
 
   /* Sanity check. */
   if (! p->dns_requests)
@@ -4559,7 +4562,7 @@ check_for_dns (Lisp_Object proc)
 
   ret = gai_error (p->dns_requests[0]);
   if (ret == EAI_INPROGRESS)
-    return 0;
+    return Qt;
 
   /* We got a response. */
   if (ret == 0)
@@ -4575,10 +4578,13 @@ check_for_dns (Lisp_Object proc)
 
       ip_addresses = Fnreverse (ip_addresses);
       freeaddrinfo (p->dns_requests[0]->ar_result);
-      connect = 1;
     }
+  /* The DNS lookup failed. */
   else
-    pset_status (p, Qfailed);
+    {
+      pset_status (p, Qfailed);
+      deactivate_process (proc);
+    }
 
   xfree ((void *)p->dns_requests[0]->ar_request);
   xfree ((void *)p->dns_requests[0]->ar_name);
@@ -4587,10 +4593,7 @@ check_for_dns (Lisp_Object proc)
   xfree (p->dns_requests);
   p->dns_requests = NULL;
 
-  if (connect)
-    connect_network_socket (proc, ip_addresses);
-
-  return 1;
+  return ip_addresses;
 }
 #endif /* HAVE_GETADDRINFO_A */
 
@@ -4722,18 +4725,47 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
 #ifdef HAVE_GETADDRINFO_A
       if (!NILP (dns_processes))
         {
-          Lisp_Object dns_list = dns_processes, dns;
+          Lisp_Object dns_list = dns_processes, dns, ip_addresses,
+            answers = Qnil, answer, new = Qnil;
           struct Lisp_Process *p;
 
+          /* This is programmed in a somewhat awkward fashion because
+          calling connect_network_socket might make us end up back
+          here again, and we would have a race condition with
+          segfaults.  So first go through all pending requests and see
+          whether we got any answers. */
           while (!NILP (dns_list))
             {
               dns = Fcar (dns_list);
               dns_list = Fcdr (dns_list);
               p = XPROCESS (dns);
-              if (p && p->dns_requests &&
-                  (! wait_proc || p == wait_proc) &&
-                  check_for_dns (dns))
-                dns_processes = Fdelq (dns, dns_processes);
+              if (p && p->dns_requests)
+                {
+                  if (! wait_proc || p == wait_proc)
+                    {
+                      ip_addresses = check_for_dns (dns);
+                      if (EQ (ip_addresses, Qt))
+                        new = Fcons (dns, new);
+                      else
+                        answers = Fcons (Fcons (dns, ip_addresses), answers);
+                    }
+                  else
+                    new = Fcons (dns, new);
+                }
+            }
+
+          /* Replace with the list of DNS requests still not responded
+             to. */
+          dns_processes = new;
+
+          /* Then continue the connection for the successful
+             requests. */
+          while (!NILP (answers))
+            {
+              answer = Fcar (answers);
+              answers = Fcdr (answers);
+              if (!NILP (Fcdr (answer)))
+                connect_network_socket (Fcar (answer), Fcdr (answer));
             }
         }
 #endif /* HAVE_GETADDRINFO_A */
@@ -7685,6 +7717,7 @@ syms_of_process (void)
 
   staticpro (&Vprocess_alist);
   staticpro (&deleted_pid_list);
+  staticpro (&dns_processes);
 
 #endif  /* subprocesses */
 
diff --git a/src/process.h b/src/process.h
index eb34f5f0411..95c64fa73b7 100644
--- a/src/process.h
+++ b/src/process.h
@@ -210,6 +210,12 @@ pset_childp (struct Lisp_Process *p, Lisp_Object val)
   p->childp = val;
 }
 
+INLINE void
+pset_status (struct Lisp_Process *p, Lisp_Object val)
+{
+  p->status = val;
+}
+
 #ifdef HAVE_GNUTLS
 INLINE void
 pset_gnutls_cred_type (struct Lisp_Process *p, Lisp_Object val)