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 */