aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--doc/misc/emacs-gnutls.texi9
-rw-r--r--lisp/net/gnutls.el32
-rw-r--r--lisp/url/url-http.el12
-rw-r--r--src/gnutls.c13
-rw-r--r--src/process.c13
-rw-r--r--src/process.h2
6 files changed, 50 insertions, 31 deletions
diff --git a/doc/misc/emacs-gnutls.texi b/doc/misc/emacs-gnutls.texi
index 1db6c517de8..75fd97c7c74 100644
--- a/doc/misc/emacs-gnutls.texi
+++ b/doc/misc/emacs-gnutls.texi
@@ -181,9 +181,6 @@ syntax are the same as those given to @code{open-network-stream}
181Manual}). The connection process is called @var{name} (made unique if 181Manual}). The connection process is called @var{name} (made unique if
182necessary). This function returns the connection process. 182necessary). This function returns the connection process.
183 183
184If called with @var{nowait}, the process is returned immediately
185(before connecting to the server).
186
187@lisp 184@lisp
188;; open a HTTPS connection 185;; open a HTTPS connection
189(open-gnutls-stream "tls" "tls-buffer" "yourserver.com" "https") 186(open-gnutls-stream "tls" "tls-buffer" "yourserver.com" "https")
@@ -194,6 +191,12 @@ If called with @var{nowait}, the process is returned immediately
194 191
195@end defun 192@end defun
196 193
194@findex gnutls-asynchronous-parameters
195If called with @var{nowait}, the process is returned immediately
196(before connecting to the server). In that case, the process object
197is told what parameters to use when negotiating the connection
198by using the @code{gnutls-asynchronous-parameters} function.
199
197The function @code{gnutls-negotiate} is not generally useful and it 200The function @code{gnutls-negotiate} is not generally useful and it
198may change as needed, so please see @file{gnutls.el} for the details. 201may change as needed, so please see @file{gnutls.el} for the details.
199 202
diff --git a/lisp/net/gnutls.el b/lisp/net/gnutls.el
index 90bfe04af9e..9e261a7b04f 100644
--- a/lisp/net/gnutls.el
+++ b/lisp/net/gnutls.el
@@ -128,8 +128,11 @@ trust and key files, and priority string."
128 :nowait nowait))) 128 :nowait nowait)))
129 (if nowait 129 (if nowait
130 (progn 130 (progn
131 (gnutls-mark-process process t) 131 (gnutls-asynchronous-parameters
132 (set-process-sentinel process 'gnutls-async-sentinel) 132 process
133 (gnutls-negotiate :type 'gnutls-x509pki
134 :return-keywords t
135 :hostname host))
133 process) 136 process)
134 (gnutls-negotiate :process (open-network-stream name buffer host service) 137 (gnutls-negotiate :process (open-network-stream name buffer host service)
135 :type 'gnutls-x509pki 138 :type 'gnutls-x509pki
@@ -153,6 +156,7 @@ trust and key files, and priority string."
153 &key process type hostname priority-string 156 &key process type hostname priority-string
154 trustfiles crlfiles keylist min-prime-bits 157 trustfiles crlfiles keylist min-prime-bits
155 verify-flags verify-error verify-hostname-error 158 verify-flags verify-error verify-hostname-error
159 return-keywords
156 &allow-other-keys) 160 &allow-other-keys)
157 "Negotiate a SSL/TLS connection. Returns proc. Signals gnutls-error. 161 "Negotiate a SSL/TLS connection. Returns proc. Signals gnutls-error.
158 162
@@ -204,7 +208,13 @@ here's a recent version of the list.
204 GNUTLS_VERIFY_DO_NOT_ALLOW_X509_V1_CA_CRT = 256 208 GNUTLS_VERIFY_DO_NOT_ALLOW_X509_V1_CA_CRT = 256
205 209
206It must be omitted, a number, or nil; if omitted or nil it 210It must be omitted, a number, or nil; if omitted or nil it
207defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT." 211defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT.
212
213If RETURN-KEYWORDS, don't connect to anything, but just return
214the computed parameters that we otherwise would be calling
215gnutls-boot with. The return value will be a list where the
216first element is the TLS type, and the rest of the list consists
217of the keywords."
208 (let* ((type (or type 'gnutls-x509pki)) 218 (let* ((type (or type 'gnutls-x509pki))
209 ;; The gnutls library doesn't understand files delivered via 219 ;; The gnutls library doesn't understand files delivered via
210 ;; the special handlers, so ignore all files found via those. 220 ;; the special handlers, so ignore all files found via those.
@@ -252,15 +262,17 @@ defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT."
252 :verify-error ,verify-error 262 :verify-error ,verify-error
253 :callbacks nil)) 263 :callbacks nil))
254 264
255 (gnutls-message-maybe 265 (if return-keywords
256 (setq ret (gnutls-boot process type params)) 266 (cons type params)
257 "boot: %s" params) 267 (gnutls-message-maybe
268 (setq ret (gnutls-boot process type params))
269 "boot: %s" params)
258 270
259 (when (gnutls-errorp ret) 271 (when (gnutls-errorp ret)
260 ;; This is a error from the underlying C code. 272 ;; This is a error from the underlying C code.
261 (signal 'gnutls-error (list process ret))) 273 (signal 'gnutls-error (list process ret)))
262 274
263 process)) 275 process)))
264 276
265(defun gnutls-trustfiles () 277(defun gnutls-trustfiles ()
266 "Return a list of usable trustfiles." 278 "Return a list of usable trustfiles."
diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el
index 43b2862e0ea..222dbc64d68 100644
--- a/lisp/url/url-http.el
+++ b/lisp/url/url-http.el
@@ -1277,17 +1277,7 @@ The return value of this function is the retrieval buffer."
1277 (pcase (process-status connection) 1277 (pcase (process-status connection)
1278 (`connect 1278 (`connect
1279 ;; Asynchronous connection 1279 ;; Asynchronous connection
1280 (if (not (process-sentinel connection)) 1280 (set-process-sentinel connection 'url-http-async-sentinel))
1281 (set-process-sentinel connection 'url-http-async-sentinel)
1282 ;; If we already have a sentinel on this process (for
1283 ;; instance on TLS connections), then chain them
1284 ;; together.
1285 (let ((old (process-sentinel connection)))
1286 (set-process-sentinel
1287 connection
1288 `(lambda (proc why)
1289 (funcall ',old proc why)
1290 (url-http-async-sentinel proc why))))))
1291 (`failed 1281 (`failed
1292 ;; Asynchronous connection failed 1282 ;; Asynchronous connection failed
1293 (error "Could not create connection to %s:%d" host port)) 1283 (error "Could not create connection to %s:%d" host port))
diff --git a/src/gnutls.c b/src/gnutls.c
index d11b11c7c54..06459fb3ccd 100644
--- a/src/gnutls.c
+++ b/src/gnutls.c
@@ -686,13 +686,16 @@ emacs_gnutls_deinit (Lisp_Object proc)
686 return Qt; 686 return Qt;
687} 687}
688 688
689DEFUN ("gnutls-mark-process", Fgnutls_mark_process, Sgnutls_mark_process, 2, 2, 0, 689DEFUN ("gnutls-asynchronous-parameters", Fgnutls_asynchronous_parameters,
690 doc: /* Mark this process as being a pre-init GnuTLS process. */) 690 Sgnutls_asynchronous_parameters, 2, 2, 0,
691 (Lisp_Object proc, Lisp_Object state) 691 doc: /* Mark this process as being a pre-init GnuTLS process.
692The second parameter is the list of parameters to feed to gnutls-boot
693to finish setting up the connection. */)
694 (Lisp_Object proc, Lisp_Object params)
692{ 695{
693 CHECK_PROCESS (proc); 696 CHECK_PROCESS (proc);
694 697
695 XPROCESS (proc)->gnutls_wait_p = !NILP (state); 698 XPROCESS (proc)->gnutls_async_parameters = params;
696 return Qnil; 699 return Qnil;
697} 700}
698 701
@@ -1703,7 +1706,7 @@ syms_of_gnutls (void)
1703 make_number (GNUTLS_E_APPLICATION_ERROR_MIN)); 1706 make_number (GNUTLS_E_APPLICATION_ERROR_MIN));
1704 1707
1705 defsubr (&Sgnutls_get_initstage); 1708 defsubr (&Sgnutls_get_initstage);
1706 defsubr (&Sgnutls_mark_process); 1709 defsubr (&Sgnutls_asynchronous_parameters);
1707 defsubr (&Sgnutls_errorp); 1710 defsubr (&Sgnutls_errorp);
1708 defsubr (&Sgnutls_error_fatalp); 1711 defsubr (&Sgnutls_error_fatalp);
1709 defsubr (&Sgnutls_error_string); 1712 defsubr (&Sgnutls_error_string);
diff --git a/src/process.c b/src/process.c
index a30dd23077c..55264058340 100644
--- a/src/process.c
+++ b/src/process.c
@@ -715,6 +715,7 @@ make_process (Lisp_Object name)
715 715
716#ifdef HAVE_GNUTLS 716#ifdef HAVE_GNUTLS
717 p->gnutls_initstage = GNUTLS_STAGE_EMPTY; 717 p->gnutls_initstage = GNUTLS_STAGE_EMPTY;
718 p->gnutls_async_parameters = Qnil;
718#endif 719#endif
719 720
720 /* If name is already in use, modify it until it is unused. */ 721 /* 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)
3305 max_process_desc = inch; 3306 max_process_desc = inch;
3306 3307
3307 set_network_socket_coding_system (proc); 3308 set_network_socket_coding_system (proc);
3309
3310#ifdef HAVE_GNUTLS
3311 if (!NILP (p->gnutls_async_parameters) && p->is_non_blocking_client) {
3312 Fgnutls_boot (proc, Fcar (p->gnutls_async_parameters),
3313 Fcdr (p->gnutls_async_parameters));
3314 p->gnutls_async_parameters = Qnil;
3315 }
3316#endif
3308} 3317}
3309 3318
3310 3319
@@ -5817,7 +5826,9 @@ send_process (Lisp_Object proc, const char *buf, ptrdiff_t len,
5817 error ("Output file descriptor of %s is closed", SDATA (p->name)); 5826 error ("Output file descriptor of %s is closed", SDATA (p->name));
5818 5827
5819#ifdef HAVE_GNUTLS 5828#ifdef HAVE_GNUTLS
5820 if (p->gnutls_wait_p) 5829 /* The TLS connection hasn't been set up yet, so we can't write
5830 anything on the socket. */
5831 if (p->gnutls_async_parameters)
5821 return; 5832 return;
5822#endif 5833#endif
5823 5834
diff --git a/src/process.h b/src/process.h
index 8bd555b83bd..eb34f5f0411 100644
--- a/src/process.h
+++ b/src/process.h
@@ -191,8 +191,8 @@ struct Lisp_Process
191 unsigned int gnutls_extra_peer_verification; 191 unsigned int gnutls_extra_peer_verification;
192 int gnutls_log_level; 192 int gnutls_log_level;
193 int gnutls_handshakes_tried; 193 int gnutls_handshakes_tried;
194 Lisp_Object gnutls_async_parameters;
194 bool_bf gnutls_p : 1; 195 bool_bf gnutls_p : 1;
195 bool_bf gnutls_wait_p : 1;
196#endif 196#endif
197}; 197};
198 198