Commit 4ff81f8f authored by Lars Ingebrigtsen's avatar Lars Ingebrigtsen

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.
parent 99723293
......@@ -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
{
......
......@@ -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 */
......
......@@ -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)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment