diff options
| -rw-r--r-- | doc/misc/emacs-gnutls.texi | 9 | ||||
| -rw-r--r-- | lisp/net/gnutls.el | 32 | ||||
| -rw-r--r-- | lisp/url/url-http.el | 12 | ||||
| -rw-r--r-- | src/gnutls.c | 13 | ||||
| -rw-r--r-- | src/process.c | 13 | ||||
| -rw-r--r-- | src/process.h | 2 |
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} | |||
| 181 | Manual}). The connection process is called @var{name} (made unique if | 181 | Manual}). The connection process is called @var{name} (made unique if |
| 182 | necessary). This function returns the connection process. | 182 | necessary). This function returns the connection process. |
| 183 | 183 | ||
| 184 | If 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 | ||
| 195 | If called with @var{nowait}, the process is returned immediately | ||
| 196 | (before connecting to the server). In that case, the process object | ||
| 197 | is told what parameters to use when negotiating the connection | ||
| 198 | by using the @code{gnutls-asynchronous-parameters} function. | ||
| 199 | |||
| 197 | The function @code{gnutls-negotiate} is not generally useful and it | 200 | The function @code{gnutls-negotiate} is not generally useful and it |
| 198 | may change as needed, so please see @file{gnutls.el} for the details. | 201 | may 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 | ||
| 206 | It must be omitted, a number, or nil; if omitted or nil it | 210 | It must be omitted, a number, or nil; if omitted or nil it |
| 207 | defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT." | 211 | defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT. |
| 212 | |||
| 213 | If RETURN-KEYWORDS, don't connect to anything, but just return | ||
| 214 | the computed parameters that we otherwise would be calling | ||
| 215 | gnutls-boot with. The return value will be a list where the | ||
| 216 | first element is the TLS type, and the rest of the list consists | ||
| 217 | of 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 | ||
| 689 | DEFUN ("gnutls-mark-process", Fgnutls_mark_process, Sgnutls_mark_process, 2, 2, 0, | 689 | DEFUN ("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. |
| 692 | The second parameter is the list of parameters to feed to gnutls-boot | ||
| 693 | to 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 | ||