mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-12-12 09:28:24 +00:00
Implement asynchronous GnuTLS connections
* doc/misc/emacs-gnutls.texi (Help For Developers): Mention the nowait parameter. * lisp/net/gnutls.el (open-gnutls-stream): Allow asynchronous connections with the new nowait parameter. * lisp/net/network-stream.el (network-stream-open-tls): Pass on :nowait to open-gnutls-stream. * lisp/url/url-http.el (url-http): Don't overwrite the sentinel created by open-gnutls-stream. * src/gnutls.c (Fgnutls_mark_process): New function. * src/process.c (send_process): Don't write to GnuTLS sockets that haven't been initialised yed. * src/process.h: New slot gnutls_wait_p.
This commit is contained in:
parent
cc45809152
commit
0f47153b97
@ -173,7 +173,7 @@ Just use @code{open-protocol-stream} or @code{open-network-stream}
|
||||
You should not have to use the @file{gnutls.el} functions directly.
|
||||
But you can test them with @code{open-gnutls-stream}.
|
||||
|
||||
@defun open-gnutls-stream name buffer host service
|
||||
@defun open-gnutls-stream name buffer host service &optional nowait
|
||||
This function creates a buffer connected to a specific @var{host} and
|
||||
@var{service} (port number or service name). The parameters and their
|
||||
syntax are the same as those given to @code{open-network-stream}
|
||||
@ -181,6 +181,9 @@ 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")
|
||||
|
@ -95,7 +95,7 @@ A value of nil says to use the default GnuTLS value."
|
||||
(integer :tag "Number of bits" 512))
|
||||
:group 'gnutls)
|
||||
|
||||
(defun open-gnutls-stream (name buffer host service)
|
||||
(defun open-gnutls-stream (name buffer host service &optional nowait)
|
||||
"Open a SSL/TLS connection for a service to a host.
|
||||
Returns a subprocess-object to represent the connection.
|
||||
Input and output work as for subprocesses; `delete-process' closes it.
|
||||
@ -109,6 +109,8 @@ BUFFER is the buffer (or `buffer-name') to associate with the process.
|
||||
Third arg is name of the host to connect to, or its IP address.
|
||||
Fourth arg SERVICE is name of the service desired, or an integer
|
||||
specifying a port number to connect to.
|
||||
Fifth arg NOWAIT (which is optional) means that the socket should
|
||||
be opened asynchronously.
|
||||
|
||||
Usage example:
|
||||
|
||||
@ -122,9 +124,24 @@ This is a very simple wrapper around `gnutls-negotiate'. See its
|
||||
documentation for the specific parameters you can use to open a
|
||||
GnuTLS connection, including specifying the credential type,
|
||||
trust and key files, and priority string."
|
||||
(gnutls-negotiate :process (open-network-stream name buffer host service)
|
||||
:type 'gnutls-x509pki
|
||||
:hostname host))
|
||||
(let ((process (open-network-stream name buffer host service
|
||||
:nowait nowait)))
|
||||
(if nowait
|
||||
(progn
|
||||
(gnutls-mark-process process t)
|
||||
(set-process-sentinel process 'gnutls-async-sentinel)
|
||||
process)
|
||||
(gnutls-negotiate :process (open-network-stream name buffer host service)
|
||||
:type 'gnutls-x509pki
|
||||
:hostname host))))
|
||||
|
||||
(defun gnutls-async-sentinel (process change)
|
||||
(message "change: %S %s" change (car (process-contact process)))
|
||||
(when (string-match "open" change)
|
||||
(gnutls-negotiate :process process
|
||||
:type 'gnutls-x509pki
|
||||
:hostname (car (process-contact process)))
|
||||
(gnutls-mark-process process nil)))
|
||||
|
||||
(define-error 'gnutls-error "GnuTLS error")
|
||||
|
||||
|
@ -359,10 +359,10 @@ asynchronously, if possible."
|
||||
(with-current-buffer buffer
|
||||
(let* ((start (point-max))
|
||||
(stream
|
||||
(funcall (if (gnutls-available-p)
|
||||
'open-gnutls-stream
|
||||
'open-tls-stream)
|
||||
name buffer host service))
|
||||
(if (gnutls-available-p)
|
||||
(open-gnutls-stream name buffer host service
|
||||
(plist-get parameters :nowait))
|
||||
(open-tls-stream name buffer host service)))
|
||||
(eoc (plist-get parameters :end-of-command)))
|
||||
;; Check certificate validity etc.
|
||||
(when (and (gnutls-available-p) stream)
|
||||
|
@ -1277,7 +1277,17 @@ The return value of this function is the retrieval buffer."
|
||||
(pcase (process-status connection)
|
||||
(`connect
|
||||
;; Asynchronous connection
|
||||
(set-process-sentinel connection 'url-http-async-sentinel))
|
||||
(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))))))
|
||||
(`failed
|
||||
;; Asynchronous connection failed
|
||||
(error "Could not create connection to %s:%d" host port))
|
||||
|
11
src/gnutls.c
11
src/gnutls.c
@ -686,6 +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)
|
||||
{
|
||||
CHECK_PROCESS (proc);
|
||||
|
||||
XPROCESS (proc)->gnutls_wait_p = !NILP (state);
|
||||
return Qnil;
|
||||
}
|
||||
|
||||
DEFUN ("gnutls-get-initstage", Fgnutls_get_initstage, Sgnutls_get_initstage, 1, 1, 0,
|
||||
doc: /* Return the GnuTLS init stage of process PROC.
|
||||
See also `gnutls-boot'. */)
|
||||
@ -1693,6 +1703,7 @@ syms_of_gnutls (void)
|
||||
make_number (GNUTLS_E_APPLICATION_ERROR_MIN));
|
||||
|
||||
defsubr (&Sgnutls_get_initstage);
|
||||
defsubr (&Sgnutls_mark_process);
|
||||
defsubr (&Sgnutls_errorp);
|
||||
defsubr (&Sgnutls_error_fatalp);
|
||||
defsubr (&Sgnutls_error_string);
|
||||
|
@ -5806,6 +5806,11 @@ send_process (Lisp_Object proc, const char *buf, ptrdiff_t len,
|
||||
if (p->outfd < 0)
|
||||
error ("Output file descriptor of %s is closed", SDATA (p->name));
|
||||
|
||||
#ifdef HAVE_GNUTLS
|
||||
if (p->gnutls_wait_p)
|
||||
return;
|
||||
#endif
|
||||
|
||||
coding = proc_encode_coding_system[p->outfd];
|
||||
Vlast_coding_system_used = CODING_ID_NAME (coding->id);
|
||||
|
||||
|
@ -192,6 +192,7 @@ struct Lisp_Process
|
||||
int gnutls_log_level;
|
||||
int gnutls_handshakes_tried;
|
||||
bool_bf gnutls_p : 1;
|
||||
bool_bf gnutls_wait_p : 1;
|
||||
#endif
|
||||
};
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user