Commit cecf6c9a authored by Lars Ingebrigtsen's avatar Lars Ingebrigtsen
Browse files

Rework the mechanisms for async GnuTLS connections

* lisp/net/gnutls.el (open-gnutls-stream): Compute the
gnutls-boot parameters and pass them to the process object.
(gnutls-negotiate): New parameter :return-keywords that won't
connect to anything, just compute the keywords.

* lisp/url/url-http.el (url-http): Revert async TLS sentinel
hack, which is no longer necessary.

* src/gnutls.c (Fgnutls_asynchronous_parameters): Rename from
gnutls-mark-process.

* src/process.c (connect_network_socket): If we're connecting to
an asynchronous TLS socket, complete the GnuTLS boot sequence here.

* src/process.h: New parameter gnutls_async_parameters.
parent 1f71df7a
......@@ -181,9 +181,6 @@ syntax are the same as those given to @code{open-network-stream}
Manual}). The connection process is called @var{name} (made unique if
necessary). This function returns the connection process.
If called with @var{nowait}, the process is returned immediately
(before connecting to the server).
@lisp
;; open a HTTPS connection
(open-gnutls-stream "tls" "tls-buffer" "yourserver.com" "https")
......@@ -194,6 +191,12 @@ If called with @var{nowait}, the process is returned immediately
@end defun
@findex gnutls-asynchronous-parameters
If called with @var{nowait}, the process is returned immediately
(before connecting to the server). In that case, the process object
is told what parameters to use when negotiating the connection
by using the @code{gnutls-asynchronous-parameters} function.
The function @code{gnutls-negotiate} is not generally useful and it
may change as needed, so please see @file{gnutls.el} for the details.
......
......@@ -128,8 +128,11 @@ trust and key files, and priority string."
:nowait nowait)))
(if nowait
(progn
(gnutls-mark-process process t)
(set-process-sentinel process 'gnutls-async-sentinel)
(gnutls-asynchronous-parameters
process
(gnutls-negotiate :type 'gnutls-x509pki
:return-keywords t
:hostname host))
process)
(gnutls-negotiate :process (open-network-stream name buffer host service)
:type 'gnutls-x509pki
......@@ -153,6 +156,7 @@ trust and key files, and priority string."
&key process type hostname priority-string
trustfiles crlfiles keylist min-prime-bits
verify-flags verify-error verify-hostname-error
return-keywords
&allow-other-keys)
"Negotiate a SSL/TLS connection. Returns proc. Signals gnutls-error.
......@@ -204,7 +208,13 @@ here's a recent version of the list.
GNUTLS_VERIFY_DO_NOT_ALLOW_X509_V1_CA_CRT = 256
It must be omitted, a number, or nil; if omitted or nil it
defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT."
defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT.
If RETURN-KEYWORDS, don't connect to anything, but just return
the computed parameters that we otherwise would be calling
gnutls-boot with. The return value will be a list where the
first element is the TLS type, and the rest of the list consists
of the keywords."
(let* ((type (or type 'gnutls-x509pki))
;; The gnutls library doesn't understand files delivered via
;; the special handlers, so ignore all files found via those.
......@@ -252,15 +262,17 @@ defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT."
:verify-error ,verify-error
:callbacks nil))
(gnutls-message-maybe
(setq ret (gnutls-boot process type params))
"boot: %s" params)
(if return-keywords
(cons type params)
(gnutls-message-maybe
(setq ret (gnutls-boot process type params))
"boot: %s" params)
(when (gnutls-errorp ret)
;; This is a error from the underlying C code.
(signal 'gnutls-error (list process ret)))
(when (gnutls-errorp ret)
;; This is a error from the underlying C code.
(signal 'gnutls-error (list process ret)))
process))
process)))
(defun gnutls-trustfiles ()
"Return a list of usable trustfiles."
......
......@@ -1277,17 +1277,7 @@ The return value of this function is the retrieval buffer."
(pcase (process-status connection)
(`connect
;; Asynchronous connection
(if (not (process-sentinel connection))
(set-process-sentinel connection 'url-http-async-sentinel)
;; If we already have a sentinel on this process (for
;; instance on TLS connections), then chain them
;; together.
(let ((old (process-sentinel connection)))
(set-process-sentinel
connection
`(lambda (proc why)
(funcall ',old proc why)
(url-http-async-sentinel proc why))))))
(set-process-sentinel connection 'url-http-async-sentinel))
(`failed
;; Asynchronous connection failed
(error "Could not create connection to %s:%d" host port))
......
......@@ -686,13 +686,16 @@ emacs_gnutls_deinit (Lisp_Object proc)
return Qt;
}
DEFUN ("gnutls-mark-process", Fgnutls_mark_process, Sgnutls_mark_process, 2, 2, 0,
doc: /* Mark this process as being a pre-init GnuTLS process. */)
(Lisp_Object proc, Lisp_Object state)
DEFUN ("gnutls-asynchronous-parameters", Fgnutls_asynchronous_parameters,
Sgnutls_asynchronous_parameters, 2, 2, 0,
doc: /* Mark this process as being a pre-init GnuTLS process.
The second parameter is the list of parameters to feed to gnutls-boot
to finish setting up the connection. */)
(Lisp_Object proc, Lisp_Object params)
{
CHECK_PROCESS (proc);
XPROCESS (proc)->gnutls_wait_p = !NILP (state);
XPROCESS (proc)->gnutls_async_parameters = params;
return Qnil;
}
......@@ -1703,7 +1706,7 @@ syms_of_gnutls (void)
make_number (GNUTLS_E_APPLICATION_ERROR_MIN));
defsubr (&Sgnutls_get_initstage);
defsubr (&Sgnutls_mark_process);
defsubr (&Sgnutls_asynchronous_parameters);
defsubr (&Sgnutls_errorp);
defsubr (&Sgnutls_error_fatalp);
defsubr (&Sgnutls_error_string);
......
......@@ -715,6 +715,7 @@ make_process (Lisp_Object name)
#ifdef HAVE_GNUTLS
p->gnutls_initstage = GNUTLS_STAGE_EMPTY;
p->gnutls_async_parameters = Qnil;
#endif
/* If name is already in use, modify it until it is unused. */
......@@ -3305,6 +3306,14 @@ void connect_network_socket (Lisp_Object proc, Lisp_Object ip_addresses)
max_process_desc = inch;
set_network_socket_coding_system (proc);
#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));
p->gnutls_async_parameters = Qnil;
}
#endif
}
......@@ -5817,7 +5826,9 @@ send_process (Lisp_Object proc, const char *buf, ptrdiff_t len,
error ("Output file descriptor of %s is closed", SDATA (p->name));
#ifdef HAVE_GNUTLS
if (p->gnutls_wait_p)
/* The TLS connection hasn't been set up yet, so we can't write
anything on the socket. */
if (p->gnutls_async_parameters)
return;
#endif
......
......@@ -191,8 +191,8 @@ struct Lisp_Process
unsigned int gnutls_extra_peer_verification;
int gnutls_log_level;
int gnutls_handshakes_tried;
Lisp_Object gnutls_async_parameters;
bool_bf gnutls_p : 1;
bool_bf gnutls_wait_p : 1;
#endif
};
......
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