Mercurial > hg > xemacs-beta
diff src/process.c @ 5814:a216b3c2b09e
Add TLS support. See xemacs-patches message with ID
<CAHCOHQk6FNm2xf=XiGEpPq43+7WOzNZ=SuD9V79o3wb9WVCTrQ@mail.gmail.com>.
author | Jerry James <james@xemacs.org> |
---|---|
date | Tue, 07 Oct 2014 21:16:10 -0600 |
parents | 3192994c49ca |
children | d93195c2c906 |
line wrap: on
line diff
--- a/src/process.c Thu Oct 02 10:19:00 2014 +0200 +++ b/src/process.c Tue Oct 07 21:16:10 2014 -0600 @@ -142,6 +142,15 @@ return Qnil; } +static int +tls_connection_p (Lisp_Object process) +{ + Lisp_Process *p = XPROCESS (process); + Lstream *in = XLSTREAM (DATA_INSTREAM (p)); + Lstream *out = XLSTREAM (DATA_OUTSTREAM (p)); + return Lstream_tls_p (in) || Lstream_tls_p (out); +} + static void print_process (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) { @@ -157,9 +166,11 @@ else { int netp = network_connection_p (obj); + int tlsp = netp && tls_connection_p (obj); write_ascstring (printcharfun, - netp ? GETTEXT ("#<network connection ") : - GETTEXT ("#<process ")); + tlsp ? GETTEXT ("#<tls network connection ") : + (netp ? GETTEXT ("#<network connection ") : + GETTEXT ("#<process "))); print_internal (process->name, printcharfun, 1); write_ascstring (printcharfun, (netp ? " " : " pid ")); print_internal (process->pid, printcharfun, 1); @@ -844,7 +855,7 @@ connection has no PID; you cannot signal it. All you can do is deactivate and close it via delete-process */ -DEFUN ("open-network-stream-internal", Fopen_network_stream_internal, 4, 5, +DEFUN ("open-network-stream-internal", Fopen_network_stream_internal, 4, 6, 0, /* Open a TCP connection for a service to a host. Return a process object to represent the connection. @@ -863,6 +874,9 @@ Optional fifth arg PROTOCOL is a network protocol. Currently only `tcp' (Transmission Control Protocol) and `udp' (User Datagram Protocol) are supported. When omitted, `tcp' is assumed. +Optional sixth arg TLS is a boolean. If it is NIL, a standard network stream + is opened. If it is non-NIL, a TLS network stream is opened if TLS support + is available; otherwise an error is signaled. Output via `process-send-string' and input via buffer or filter (see `set-process-filter') are stream-oriented. That means UDP datagrams are @@ -871,12 +885,13 @@ are usually fine.) Note further that the UDP protocol does not guard against lost packets. */ - (name, buffer, host, service, protocol)) + (name, buffer, host, service, protocol, tls)) { /* This function can GC */ Lisp_Object process = Qnil; struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, ngcpro1; void *inch, *outch; + int flags; GCPRO5 (name, buffer, host, service, protocol); CHECK_STRING (name); @@ -889,7 +904,7 @@ /* Since this code is inside HAVE_SOCKETS, existence of open_network_stream is mandatory */ PROCMETH (open_network_stream, (name, host, service, protocol, - &inch, &outch)); + &inch, &outch, !NILP(tls))); if (!NILP (buffer)) buffer = Fget_buffer_create (buffer); @@ -898,9 +913,11 @@ XPROCESS (process)->pid = Fcons (service, host); XPROCESS (process)->buffer = buffer; + flags = STREAM_NETWORK_CONNECTION; + if (!NILP (tls)) + flags |= STREAM_USE_TLS; init_process_io_handles (XPROCESS (process), (void *) inch, (void *) outch, - (void *) -1, - STREAM_NETWORK_CONNECTION); + (void *) -1, flags); event_stream_select_process (XPROCESS (process), 1, 1); @@ -909,6 +926,29 @@ return process; } +DEFUN ("tls-negotiate", Ftls_negotiate, 3, 3, 0, /* + "Negotiate a SSL/TLS connection. Returns PROCESS if negotiation is +successful, NIL otherwise. + +PROCESS is a process returned by `open-network-stream'. +HOSTNAME is the remote hostname. It must be a valid string. +KEYLIST is an alist of (client key file, client cert file) pairs. +*/ + (process, hostname, keylist)) +{ + Lisp_Process *p; + Lstream *in, *out; + Extbyte *ext_host; + + CHECK_PROCESS (process); + CHECK_STRING (hostname); + p = XPROCESS (process); + in = XLSTREAM (DATA_INSTREAM (p)); + out = XLSTREAM (DATA_OUTSTREAM (p)); + ext_host = LISP_STRING_TO_EXTERNAL (hostname, Qunix_host_name_encoding); + return Lstream_tls_negotiate (in, out, ext_host, keylist) ? process : Qnil; +} + #ifdef HAVE_MULTICAST DEFUN ("open-multicast-group-internal", Fopen_multicast_group_internal, 5, 5, 0, /* @@ -2601,6 +2641,7 @@ DEFSUBR (Fstart_process_internal); #ifdef HAVE_SOCKETS DEFSUBR (Fopen_network_stream_internal); + DEFSUBR (Ftls_negotiate); #ifdef HAVE_MULTICAST DEFSUBR (Fopen_multicast_group_internal); #endif /* HAVE_MULTICAST */