Re: Emacs core TLS support

[Ted Zlatanov <tzz@lifelogs.com>]

[-- Attachment #1: Type: text/plain, Size: 4580 bytes --]

On Fri, 13 Aug 2010 11:57:45 -0400 Chong Yidong <cyd@stupidchicken.com> wrote: 

CY> Ted Zlatanov <tzz@lifelogs.com> writes:

>> +  do {
>> +    rtnval = gnutls_read( state, buf, nbyte);
>> +    printf("read %d bytes\n", rtnval);
>> +  } while( rtnval==GNUTLS_E_INTERRUPTED || rtnval==GNUTLS_E_AGAIN);

CY> You should use the GNU style here.

Fixed.

>> +DEFUN ("gnutls-init", Fgnutls_init, Sgnutls_init, 2, 2, 0,
>> +       doc: /* Initializes GNU TLS for process PROC for use as CONNECTION-END.

CY> This should be "Initialize" instead of "Initializes".

Fixed.

CY> In general, this docstring is not very informative.  I have not been
CY> following this patch closely; just from reading the docstring, I'm not
CY> sure what gnutls-init is supposed to do.  I assume that it means that,
CY> once it is called, all data sent from Emacs to the process PROC, and
CY> vice versa, will be encrypted using the GnuTLS library.  Is that right?
CY> Does `gnutls-handshake' need to be called before, or after, this?  What
CY> happens if you try to send data to PROC before `gnutls-handshake'?
CY> These issues should be explained in the docstring.

CY> More generally, why do we need to a separate `gnutls-init' call, instead
CY> of making `gnutls-handshake' and other functions automatically enable
CY> GnuTLS functionality for the process?

Simon's code included a gnutls.el library, attached here.  It shows how
to use it.  It's a straightforward port of the GnuTLS calls (hence the
docstrings assume familiarity with that library) so you have to call
them in order just like a C client would.  We could try to collect that
sequence (as seen in `open-ssl-stream' and `starttls-negotiate' twice,
why I don't know):

1) global init (set up static structures)
2) init the client
3) set protocol, cipher, compression, kx, mac priority
4) set credentials

into one C function call.  gnutls-handshake is called repeatedly (while
EAGAIN is returned) until either an error happens or it succeeds.  You
can even rehandshake().  So I think the idea is that it should be a
repeatable call while the rest of the initialization is supposed to be
done just once.  All of that could certainly be wrapped in a single C
call, but Simon did it the other way.

Writing to the stream before the handshake has succeeded will return -1
for number of bytes written, but the exact process is up to GnuTLS and
errno is passing the error code back to us:

(from `emacs_gnutls_write')
...
rtnval = gnutls_write (state, buf, nbyte);

if (rtnval == -1)
{
  if (errno == EINTR)
    continue;
  else
    return (bytes_written ? bytes_written : -1);
}
...

This won't happen unless the process' gnutls_state is set by
`gnutls_init', but it could potentially happen before a successful
handshake.

That's a lot to put into the docstrings for all those functions.  It's
probably better to point people to the gnutls.el docs.

>> +DEFUN ("gnutls-deinit", Fgnutls_deinit, Sgnutls_deinit, 1, 1, 0,

CY> I think this should be called `gnutls-stop' or something like that;
CY> "deinit" is not a proper word.  Maybe rename `gnutls-init' to
CY> `gnutls-start'.

>> +DEFUN ("gnutls-global-init", Fgnutls_global_init,

CY> This is again not very informative.  Does it mean that it is equivalent
CY> to calling `gnutls-init' on every process by default?

>> +DEFUN ("gnutls-global-deinit", Fgnutls_global_deinit,

CY> Again, "deinit" should not be used.

But those are the GnuTLS names for the functions.  So it's confusing if
the Emacs core process.c functions map to different names in GnuTLS.
Unless we abstract the process creation at the C layer (aggregating what
`open-ssl-stream' does and eliminating the one-to-one function
mappings), I think it's worse to rename these functions.

>> +DEFUN ("gnutls-protocol-set-priority", Fgnutls_protocol_set_priority,
>> +       Sgnutls_protocol_set_priority, 1, MANY, 0,
>> +       doc: /* Sets the priority on the protocol versions supported by GNU TLS for PROCESS.
>> +The first parameter must be a process.	Subsequent parameters should
>> +be integers.  Priority is higher for protocols specified before

CY> Use the word "argument" instead of "parameter".  Also, there is some
CY> formatting mix-up in this and other docstrings.

That's fixed and I removed the TAB characters that came from the
original patch.

On Fri, 13 Aug 2010 17:53:36 +0200 David Kastrup <dak@gnu.org> wrote: 

DK> int xxx(void);

Thanks, applied.

Also note there's some ambition in this patch to have Emacs provide
server-side SSL.  I don't know if that should be removed completely or
considered.

Ted


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: tls.patch --]
[-- Type: text/x-diff, Size: 23866 bytes --]

=== modified file 'configure.in'
--- configure.in	2010-08-10 14:22:29 +0000
+++ configure.in	2010-08-12 22:48:32 +0000
@@ -169,6 +169,7 @@
 OPTION_DEFAULT_ON([dbus],[don't compile with D-Bus support])
 OPTION_DEFAULT_ON([gconf],[don't compile with GConf support])
 OPTION_DEFAULT_ON([selinux],[don't compile with SELinux support])
+OPTION_DEFAULT_ON([gnutls],[don't use -lgnutls for SSL/TLS support])
 
 ## For the times when you want to build Emacs but don't have
 ## a suitable makeinfo, and can live without the manuals.
@@ -1983,6 +1984,13 @@
 fi
 AC_SUBST(LIBSELINUX_LIBS)
 
+HAVE_GNUTLS=no
+if test "${with_gnutls}" = "yes" ; then
+  PKG_CHECK_MODULES([LIBGNUTLS], [gnutls >= 2.2.4])
+  AC_DEFINE(HAVE_GNUTLS)
+  HAVE_GNUTLS=yes
+fi
+
 dnl Do not put whitespace before the #include statements below.
 dnl Older compilers (eg sunos4 cc) choke on it.
 HAVE_XAW3D=no
@@ -3666,6 +3674,7 @@
 echo "  Does Emacs use -ldbus?                                  ${HAVE_DBUS}"
 echo "  Does Emacs use -lgconf?                                 ${HAVE_GCONF}"
 echo "  Does Emacs use -lselinux?                               ${HAVE_LIBSELINUX}"
+echo "  Does Emacs use Gnu TLS?                                 ${HAVE_GNUTLS}"
 
 echo "  Does Emacs use -lfreetype?                              ${HAVE_FREETYPE}"
 echo "  Does Emacs use -lm17n-flt?                              ${HAVE_M17N_FLT}"

=== modified file 'src/Makefile.in'
--- src/Makefile.in	2010-07-12 14:16:38 +0000
+++ src/Makefile.in	2010-08-12 22:47:22 +0000
@@ -280,6 +280,9 @@
 
 LIBSELINUX_LIBS = @LIBSELINUX_LIBS@
 
+LIBGNUTLS_LIBS = @LIBGNUTLS_LIBS@
+LIBGNUTLS_CFLAGS = @LIBGNUTLS_CFLAGS@
+
 INTERVALS_H = dispextern.h intervals.h composite.h
 
 GETLOADAVG_LIBS = @GETLOADAVG_LIBS@
@@ -318,6 +321,7 @@
   ${C_SWITCH_X_SYSTEM} ${CFLAGS_SOUND} ${RSVG_CFLAGS} ${DBUS_CFLAGS} \
   ${GCONF_CFLAGS} ${FREETYPE_CFLAGS} ${FONTCONFIG_CFLAGS} \
   ${LIBOTF_CFLAGS} ${M17N_FLT_CFLAGS} ${DEPFLAGS} ${PROFILING_CFLAGS} \
+  $(LIBGNUTLS_CFLAGS) \
   ${C_WARNINGS_SWITCH} ${CFLAGS}
 ALL_OBJC_CFLAGS=$(ALL_CFLAGS) $(GNU_OBJC_CFLAGS)
 
@@ -593,6 +597,7 @@
    $(RSVG_LIBS) $(DBUS_LIBS) $(LIBGPM) $(LIBRESOLV) $(LIBS_SYSTEM) \
    $(LIBS_TERMCAP) $(GETLOADAVG_LIBS) ${GCONF_LIBS} ${LIBSELINUX_LIBS} \
    $(FREETYPE_LIBS) $(FONTCONFIG_LIBS) $(LIBOTF_LIBS) $(M17N_FLT_LIBS) \
+   $(LIBGNUTLS_LIBS) \
    $(LIB_GCC) $(LIB_MATH) $(LIB_STANDARD) $(LIB_GCC)
 
 all: emacs${EXEEXT} $(OTHER_FILES)

=== modified file 'src/config.in'
--- src/config.in	2010-08-09 19:25:41 +0000
+++ src/config.in	2010-08-12 22:24:33 +0000
@@ -255,6 +255,9 @@
 /* Define to 1 if you have a gif (or ungif) library. */
 #undef HAVE_GIF
 
+/* Define if we have the GNU TLS library.  */
+#undef HAVE_GNUTLS
+
 /* Define to 1 if you have the gpm library (-lgpm). */
 #undef HAVE_GPM
 
@@ -1085,6 +1088,12 @@
 #include config_opsysfile
 #include config_machfile
 
+#if HAVE_GNUTLS
+#define LIBGNUTLS $(LIBGNUTLS_LIBS)
+#else /* not HAVE_GNUTLS */
+#define LIBGNUTLS
+#endif /* not HAVE_GNUTLS */
+
 /* Set up some defines, C and LD flags for NeXTstep interface on GNUstep.
   (There is probably a better place to do this, but right now the Cocoa
    side does this in s/darwin.h and we cannot

=== modified file 'src/process.c'
--- src/process.c	2010-08-09 09:35:21 +0000
+++ src/process.c	2010-08-13 17:15:11 +0000
@@ -111,6 +111,10 @@
 #include "syssignal.h"
 #include "syswait.h"
 
+#ifdef HAVE_GNUTLS
+#include <gnutls/gnutls.h>
+#endif
+
 #if defined (USE_GTK) || defined (HAVE_GCONF)
 #include "xgselect.h"
 #endif /* defined (USE_GTK) || defined (HAVE_GCONF) */
@@ -1538,6 +1542,10 @@
   XPROCESS (proc)->filter = Qnil;
   XPROCESS (proc)->command = Flist (nargs - 2, args + 2);
 
+#ifdef HAVE_GNUTLS
+  XPROCESS (proc)->gnutls_state = Qnil;
+#endif
+
 #ifdef ADAPTIVE_READ_BUFFERING
   XPROCESS (proc)->adaptive_read_buffering
     = (NILP (Vprocess_adaptive_read_buffering) ? 0
@@ -5069,6 +5077,61 @@
   return Qt;
 }
 
+#ifdef HAVE_GNUTLS
+
+int
+emacs_gnutls_write (int fildes, gnutls_session_t state, char *buf,
+                    unsigned int nbyte)
+{
+  register int rtnval, bytes_written;
+
+  puts("emacs_gnutls_write");
+
+  bytes_written = 0;
+
+  while (nbyte > 0)
+    {
+      rtnval = gnutls_write (state, buf, nbyte);
+
+      if (rtnval == -1)
+	{
+	  if (errno == EINTR)
+	    continue;
+	  else
+	    return (bytes_written ? bytes_written : -1);
+	}
+
+      buf += rtnval;
+      nbyte -= rtnval;
+      bytes_written += rtnval;
+    }
+  printf("wrote %d bytes\n", bytes_written);
+  fsync(STDOUT_FILENO);
+
+  return (bytes_written);
+}
+
+int
+emacs_gnutls_read (int fildes, gnutls_session_t state, char *buf,
+                   unsigned int nbyte)
+{
+  register int rtnval;
+
+  puts("emacs_gnutls_read");
+
+  do
+    {
+      rtnval = gnutls_read( state, buf, nbyte);
+      printf("read %d bytes\n", rtnval);
+    }
+  while( rtnval==GNUTLS_E_INTERRUPTED || rtnval==GNUTLS_E_AGAIN);
+  printf("read %d bytes\n", rtnval);
+  fsync(STDOUT_FILENO);
+
+  return (rtnval);
+}
+#endif
+
 /* Read pending output from the process channel,
    starting with our buffered-ahead character if we have one.
    Yield number of decoded characters read.
@@ -5111,7 +5174,12 @@
 #endif
   if (proc_buffered_char[channel] < 0)
     {
-      nbytes = emacs_read (channel, chars + carryover, readmax);
+#ifdef HAVE_GNUTLS
+      if (NETCONN_P(proc) && !NILP (XPROCESS(proc)->gnutls_state))
+	nbytes = emacs_gnutls_read (channel, XPROCESS(proc)->gnutls_state, chars + carryover, readmax);
+      else
+#endif
+	nbytes = emacs_read (channel, chars + carryover, readmax);
 #ifdef ADAPTIVE_READ_BUFFERING
       if (nbytes > 0 && p->adaptive_read_buffering)
 	{
@@ -5144,7 +5212,12 @@
     {
       chars[carryover] = proc_buffered_char[channel];
       proc_buffered_char[channel] = -1;
-      nbytes = emacs_read (channel, chars + carryover + 1,  readmax - 1);
+#ifdef HAVE_GNUTLS
+      if (NETCONN_P(proc) && !NILP (XPROCESS(proc)->gnutls_state))
+	nbytes = emacs_gnutls_read (channel, XPROCESS(proc)->gnutls_state, chars + carryover + 1, readmax - 1);
+      else
+#endif
+	nbytes = emacs_read (channel, chars + carryover + 1,  readmax - 1);
       if (nbytes < 0)
 	nbytes = 1;
       else
@@ -5554,7 +5627,14 @@
 	      else
 #endif
 		{
-		  rv = emacs_write (outfd, (char *) buf, this);
+#ifdef HAVE_GNUTLS
+		  if (NETCONN_P(proc) && !NILP (XPROCESS(proc)->gnutls_state))
+		    rv = emacs_gnutls_write (outfd,
+					     XPROCESS(proc)->gnutls_state, 
+					     (char *) buf, this);
+		  else
+#endif
+		    rv = emacs_write (outfd, (char *) buf, this);
 #ifdef ADAPTIVE_READ_BUFFERING
 		  if (p->read_output_delay > 0
 		      && p->adaptive_read_buffering == 1)
@@ -6788,6 +6868,490 @@
 
 \f
 
+#ifdef HAVE_GNUTLS
+
+int gnutls_callback (gnutls_session_t state, const gnutls_datum *client_certs,
+                     int ncerts, const gnutls_datum* req_ca_cert, int nreqs)
+{
+  if (client_certs == NULL) {
+    /* means the we will only be called again if the library cannot
+     * determine which certificate to send
+     */
+    return 0;
+  }
+
+  puts("In callback");
+
+  return -1; /* send no certificate to the peer */
+}
+
+DEFUN ("gnutls-init", Fgnutls_init, Sgnutls_init, 2, 2, 0,
+       doc: /* Initialize GNU TLS for process PROC for use as CONNECTION-END.
+CONNECTION-END is used to indicate if this process is as a server or
+client. Can be one of `gnutls-client' and `gnutls-server'.  Currently
+only `gnutls-client' is supported.
+
+Processes must be initialized with this function before other GNU TLS
+functions are used.  This function allocates resources which can only
+be deallocated by calling `gnutls-deinit'. Returns zero on success. */)
+  ( Lisp_Object proc, Lisp_Object connection_end)
+{
+  int ret;
+  
+  CHECK_PROCESS (proc);
+
+  ret = gnutls_init((gnutls_session_t*)&(XPROCESS(proc)->gnutls_state), 
+		    connection_end);
+
+  return XINT(ret);
+}
+
+DEFUN ("gnutls-deinit", Fgnutls_deinit, Sgnutls_deinit, 1, 1, 0,
+       doc: /* Deallocate GNU TLS resources associated with PROCESS.
+See also `gnutls-init'. */)
+  (Lisp_Object proc)
+{
+  int ret;
+  gnutls_session_t state;
+
+  CHECK_PROCESS (proc);
+  state = (gnutls_session_t) XPROCESS(proc)->gnutls_state;
+
+  gnutls_deinit(state);
+
+  return Qnil;
+}
+
+DEFUN ("gnutls-global-init", Fgnutls_global_init, 
+       Sgnutls_global_init, 0, 0, 0,
+       doc: /* Initializes global GNU TLS state to defaults.
+Call `gnutls-global-deinit' when GNU TLS usage is no longer needed.
+Returns zero on success. */)
+  (void)
+{
+  Lisp_Object lret;
+  int ret;
+
+  ret = gnutls_global_init();
+  XSETINT (lret, ret);
+
+  return lret;
+}
+
+DEFUN ("gnutls-global-deinit", Fgnutls_global_deinit, 
+       Sgnutls_global_deinit, 0, 0, 0,
+       doc: /* Deinitializes global GNU TLS state.
+See also `gnutls-global-init'. */)
+  (void)
+{
+  gnutls_global_deinit();
+
+  return Qnil;
+}
+
+Lisp_Object
+generic_set_priority (int (*func)( gnutls_session_t state, const int*),
+                      int nargs, Lisp_Object *args)
+{
+  Lisp_Object proc;
+  Lisp_Object lret;
+  gnutls_session_t state;
+  int *algs;
+  size_t len;
+  int ret;
+  int i;
+  
+  proc = args[0];
+  CHECK_PROCESS (proc);
+  state = (gnutls_session_t) XPROCESS(proc)->gnutls_state;
+
+  for (i = 1; i < nargs; i++)
+      CHECK_NUMBER (args[i]);
+
+  len = nargs * sizeof(int);
+  algs = xmalloc (len);
+  for (i = 1; i < nargs; i++)
+      algs[i-1] = XFASTINT(args[i]);
+  algs[i-1] = 0;
+  ret = (*func) (state, algs);
+  xfree(algs);
+
+  XSETINT (lret, ret);
+  return lret;
+}
+
+DEFUN ("gnutls-protocol-set-priority", Fgnutls_protocol_set_priority, 
+       Sgnutls_protocol_set_priority, 1, MANY, 0,
+       doc: /* Sets the priority on the protocol versions supported by GNU TLS for PROCESS.
+The first argument must be a process.  Subsequent arguments should
+be integers.  Priority is higher for protocols specified before
+others.  Note that the priority is set on the client.  The server does
+not use the protocols's priority except for disabling protocols that
+were not specified. */)
+  (int nargs, Lisp_Object *args)
+{
+  Lisp_Object ret;
+
+  ret = generic_set_priority (&gnutls_protocol_set_priority, nargs, args);
+  
+  return ret;
+}
+
+DEFUN ("gnutls-cipher-set-priority", Fgnutls_cipher_set_priority, 
+       Sgnutls_cipher_set_priority, 1, MANY, 0,
+       doc: /* Sets the priority on the bulk ciphers supported by GNU TLS for PROCESS.
+The first argument must be a process.  Subsequent arguments should
+be integers.  Priority is higher for protocols specified before
+others.  Note that the priority is set on the client.  The server does
+not use the protocols's priority except for disabling protocols that
+were not specified. */)
+  (int nargs, Lisp_Object *args)
+{
+  Lisp_Object ret;
+
+  ret = generic_set_priority (&gnutls_cipher_set_priority, nargs, args);
+  
+  return ret;
+}
+
+DEFUN ("gnutls-compression-set-priority", Fgnutls_compression_set_priority, 
+       Sgnutls_compression_set_priority, 1, MANY, 0,
+       doc: /* Sets the priority on compression algorithms supported by GNU TLS for PROCESS.
+The first argument must be a process.  Subsequent arguments should
+be integers.  Priority is higher for protocols specified before
+others.  Note that the priority is set on the client.  The server does
+not use the protocols's priority except for disabling protocols that
+were not specified. */)
+  (int nargs, Lisp_Object *args)
+{
+  Lisp_Object ret;
+
+  ret = generic_set_priority (&gnutls_compression_set_priority, nargs, args);
+  
+  return ret;
+}
+
+DEFUN ("gnutls-kx-set-priority", Fgnutls_kx_set_priority, 
+       Sgnutls_kx_set_priority, 1, MANY, 0,
+       doc: /* Sets the priority on key exchange algorithms supported by GNU TLS for PROCESS.
+The first argument must be a process.  Subsequent arguments should
+be integers.  Priority is higher for protocols specified before
+others.  Note that the priority is set on the client.  The server does
+not use the protocols's priority except for disabling protocols that
+were not specified. */)
+  (int nargs, Lisp_Object *args)
+{
+  Lisp_Object ret;
+
+  ret = generic_set_priority (&gnutls_kx_set_priority, nargs, args);
+
+  return ret;
+}
+
+DEFUN ("gnutls-mac-set-priority", Fgnutls_mac_set_priority, 
+       Sgnutls_mac_set_priority, 1, MANY, 0,
+       doc: /* Sets the priority on MAC algorithms supported by GNU TLS for PROCESS.
+The first argument must be a process.  Subsequent arguments should
+be integers.  Priority is higher for protocols specified before
+others.  Note that the priority is set on the client.  The server does
+not use the protocols's priority except for disabling protocols that
+were not specified. */)
+  (int nargs, Lisp_Object *args)
+{
+  Lisp_Object ret;
+
+  ret = generic_set_priority (&gnutls_mac_set_priority, nargs, args);
+  
+  return ret;
+}
+
+/* BROKEN: can't figure out how to use this */
+// DEFUN ("gnutls-x509pki-set-client-cert-callback", 
+//	  Fgnutls_x509pki_set_client_cert_callback, 
+//	  Sgnutls_x509pki_set_client_cert_callback, 2, 2, 0,
+//	  doc: /* XXX Not completely implemented yet. */)
+//	(proc, callback)
+//	Lisp_Object proc, callback;
+// {
+//   gnutls_certificate_credentials_t x509_cred;
+//   Lisp_Object lret;
+//   int ret;
+
+//   CHECK_PROCESS (proc);
+//   x509_cred = (gnutls_certificate_credentials_t) XPROCESS(proc)->x509_cred;
+
+//   XPROCESS(proc)->x509_callback = callback;
+//   gnutls_x509pki_set_client_cert_callback (x509_cred, &gnutls_callback);
+
+//   return Qnil;
+// }
+
+DEFUN ("gnutls-x509pki-set-client-key-file", 
+       Fgnutls_x509pki_set_client_key_file,
+       Sgnutls_x509pki_set_client_key_file, 3, 3, 0,
+       doc: /* Set X.509 client credentials for PROCESS
+CERTFILE is a PEM encoded file containing the certificate list (path)
+for the specified private key. KEYFILE is a PEM encoded file
+containing a private key.  Returns zero on success.
+
+This function may be called more than once (in case multiple
+keys/certificates exist for the server).
+
+Currently only PKCS-1 PEM encoded RSA private keys are accepted by
+this function. */)
+  (Lisp_Object proc, Lisp_Object certfile, Lisp_Object keyfile)
+{
+  gnutls_session_t state;
+  gnutls_certificate_credentials_t x509_cred;
+  Lisp_Object lret;
+  int ret;
+
+  CHECK_STRING(certfile);
+  CHECK_STRING(keyfile);
+
+  CHECK_PROCESS (proc);
+  state = (gnutls_session_t) XPROCESS(proc)->gnutls_state;
+
+  x509_cred = (gnutls_certificate_credentials_t) XPROCESS(proc)->x509_cred;
+
+  ret = gnutls_x509pki_set_client_key_file (x509_cred, 
+					    XSTRING (certfile)->data, 
+					    XSTRING (keyfile)->data);
+
+  XSETINT (lret, ret);
+  return lret;
+}
+
+DEFUN ("gnutls-x509pki-set-client-trust-file", 
+       Fgnutls_x509pki_set_client_trust_file,
+       Sgnutls_x509pki_set_client_trust_file, 3, 3, 0,
+       doc: /* Set X.509 trusted credentials for PROCESS
+CAFILE is a PEM encoded file containing trusted CAs. CRLFILE is a PEM
+encoded file containing CRLs (ignored for now). Returns zero on
+success. */)
+  (Lisp_Object proc, Lisp_Object cafile, Lisp_Object crlfile)
+{
+  gnutls_session_t state;
+  gnutls_certificate_credentials_t x509_cred;
+  Lisp_Object lret;
+  int ret;
+
+  CHECK_STRING(cafile);
+  CHECK_STRING(crlfile);
+
+  CHECK_PROCESS (proc);
+  state = (gnutls_session_t) XPROCESS(proc)->gnutls_state;
+
+  x509_cred = (gnutls_certificate_credentials_t) XPROCESS(proc)->x509_cred;
+
+  ret = gnutls_x509pki_set_client_trust_file (x509_cred, 
+					    NILP (cafile) ? NULL : 
+					    XSTRING (cafile)->data,
+					    NILP (crlfile) ? NULL : 
+					    XSTRING (crlfile)->data);
+
+  XSETINT (lret, ret);
+  return lret;
+}
+
+DEFUN ("gnutls-srp-set-client-cred", Fgnutls_srp_set_client_cred,
+       Sgnutls_srp_set_client_cred, 3, 3, 0,
+       doc: /* Set SRP username and password for PROCESS.  
+PROCESS must be a process. USERNAME is the user's userid. PASSWORD is
+the user's password. Returns zero on success. */)
+  (Lisp_Object proc, Lisp_Object username, Lisp_Object password)
+{
+  gnutls_session_t state;
+  gnutls_srp_client_credentials_t srp_cred;
+  Lisp_Object lret;
+  int ret;
+
+  CHECK_PROCESS (proc);
+  state = (gnutls_session_t) XPROCESS(proc)->gnutls_state;
+
+  srp_cred = (gnutls_srp_client_credentials_t) XPROCESS(proc)->srp_cred;
+
+  ret = gnutls_srp_set_client_credentials (srp_cred,
+					   NILP (username) ? NULL :
+					   XSTRING(username)->data, 
+					   NILP (password) ? NULL :
+					   XSTRING(password)->data);
+
+  XSETINT (lret, ret);
+  return lret;
+}
+
+DEFUN ("gnutls-anon-set-client-cred", Fgnutls_anon_set_client_cred,
+       Sgnutls_anon_set_client_cred, 2, 2, 0,
+       doc: /* Set the number of bits to use in anonymous Diffie-Hellman exchange for PROCESS.
+DH_BITS is the number of bits in DH key exchange. Returns zero on
+success. */)
+  (Lisp_Object proc, Lisp_Object dh_bits)
+{
+  gnutls_session_t state;
+  gnutls_anon_client_credentials_t anon_cred;
+  Lisp_Object lret;
+  int ret;
+
+  CHECK_PROCESS (proc);
+  state = (gnutls_session_t) XPROCESS(proc)->gnutls_state;
+
+  anon_cred = (gnutls_anon_client_credentials_t) XPROCESS(proc)->anon_cred;
+
+  ret = gnutls_anon_set_client_dh_params (anon_cred, XINT(dh_bits));
+
+  XSETINT (lret, ret);
+  return lret;
+}
+
+DEFUN ("gnutls-cred-set", Fgnutls_cred_set, 
+       Sgnutls_cred_set, 2, 2, 0,
+       doc: /* Enables GNU TLS authentication for PROCESS.
+TYPE is an integer indicating the type of the credentials, either
+`gnutls-anon', `gnutls-srp' or `gnutls-x509pki'.
+
+Each authentication type may need additional information in order to
+work.  For anonymous (`gnutls-anon'), see also
+`gnutls-anon-set-client-cred'.  For SRP (`gnutls-srp'), see also
+`gnutls-srp-set-client-cred'.  For X.509 PKI (`gnutls-x509pki'), see
+also `gnutls-x509pki-set-client-trust-file',
+`gnutls-x509pki-set-client-key-file', and
+`gnutls-x509pki-set-cert-callback'. */)
+  (Lisp_Object proc, Lisp_Object type)
+{
+  gnutls_session_t state;
+  gnutls_certificate_credentials_t x509_cred;
+  gnutls_anon_client_credentials_t anon_cred;
+  gnutls_srp_client_credentials_t srp_cred;
+  int ret;
+
+  CHECK_PROCESS (proc);
+  state = (gnutls_session_t) XPROCESS(proc)->gnutls_state;
+
+  x509_cred = (gnutls_certificate_client_credentials) XPROCESS(proc)->x509_cred;
+  anon_cred = (gnutls_anon_client_credentials_t) XPROCESS(proc)->anon_cred;
+  srp_cred = (gnutls_srp_client_credentials_t) XPROCESS(proc)->srp_cred;
+
+  switch (XINT (type))
+    {
+    case GNUTLS_CRD_CERTIFICATE: 
+      if (gnutls_crd_allocate_client_credentials (&x509_cred, 1) < 0)
+	memory_full ();
+      ret = gnutls_cred_set (state, GNUTLS_CRD_CERTIFICATE, x509_cred);
+      break;
+
+    case GNUTLS_CRD_ANON:
+      if (gnutls_anon_allocate_client_credentials (&anon_cred) < 0)
+	memory_full ();
+      ret = gnutls_cred_set (state, GNUTLS_CRD_ANON, anon_cred);
+      break;
+
+    case GNUTLS_CRD_SRP:
+      if (gnutls_srp_allocate_client_credentials (&srp_cred) < 0)
+	memory_full ();
+      ret = gnutls_cred_set (state, GNUTLS_CRD_SRP, srp_cred);
+      break;
+    }
+
+  return XINT(ret);
+}
+
+DEFUN ("gnutls-bye", Fgnutls_bye, 
+       Sgnutls_bye, 2, 2, 0,
+       doc: /* Terminate current GNU TLS connection for PROCESS.
+The connection should have been initiated using gnutls_handshake().
+HOW should be one of `gnutls-shut-rdwr', `gnutls-shut-wr'.
+
+In case of `gnutls-shut-rdwr' then the TLS connection gets terminated
+and further receives and sends will be disallowed. If the return value
+is zero you may continue using the connection.  `gnutls-shut-rdwr'
+actually sends an alert containing a close request and waits for the
+peer to reply with the same message.
+  
+In case of `gnutls-shut-wr' then the TLS connection gets terminated
+and further sends will be disallowed. In order to reuse the connection
+you should wait for an EOF from the peer.  `gnutls-shut-wr' sends an
+alert containing a close request.
+  
+This function may also return `gnutls-e-again', or
+`gnutls-e-interrupted'. */)
+  (Lisp_Object proc, Lisp_Object how)
+{
+  gnutls_session_t state;
+  int ret;
+
+  CHECK_PROCESS (proc);
+  CHECK_NUMBER (how);
+
+  state = (gnutls_session_t) XPROCESS(proc)->gnutls_state;
+
+  ret = gnutls_bye(state, XFASTINT(how));
+  
+  return XINT(ret);
+}
+
+DEFUN ("gnutls-handshake", Fgnutls_handshake, 
+       Sgnutls_handshake, 1, 1, 0,
+       doc: /* Perform GNU TLS handshake for PROCESS.
+The identity of the peer is checked automatically.  This function will
+fail if any problem is encountered, and will return a negative error
+code. In case of a client, if it has been asked to resume a session,
+but the server didn't, then a full handshake will be performed.
+  
+This function may also return the non-fatal errors `gnutls-e-again',
+or `gnutls-e-interrupted'. In that case you may resume the handshake
+(by calling this function again). */)
+  (Lisp_Object proc)
+{
+  gnutls_session_t state;
+  Lisp_Object lret;
+  int ret;
+
+  CHECK_PROCESS (proc);
+  state = (gnutls_session_t) XPROCESS(proc)->gnutls_state;
+
+  gnutls_transport_set_ptr( state, XPROCESS(proc)->infd);
+  ret = gnutls_handshake( state);
+  XSETINT(lret, ret);
+  
+  return lret;
+}
+
+DEFUN ("gnutls-rehandshake", Fgnutls_rehandshake, 
+       Sgnutls_rehandshake, 1, 1, 0,
+       doc: /* Renegotiate GNU TLS security parameters for PROCESS.
+This function will renegotiate security parameters with the
+client. This should only be called in case of a server.
+
+This message informs the peer that we want to renegotiate parameters
+\(perform a handshake).
+  
+If this function succeeds (returns 0), you must call the
+gnutls_handshake() function in order to negotiate the new parameters.
+  
+If the client does not wish to renegotiate parameters he will reply
+with an alert message, thus the return code will be
+`gnutls-e-warning-alert-received' and the alert will be
+`gnutls-e-no-renegotiation'. */)
+  (Lisp_Object proc)
+{
+  gnutls_session_t state;
+  Lisp_Object lret;
+  int ret;
+
+  CHECK_PROCESS (proc);
+  state = (gnutls_session_t) XPROCESS(proc)->gnutls_state;
+
+  gnutls_transport_set_ptr( state, XPROCESS(proc)->infd);
+  ret = gnutls_rehandshake( state);
+  XSETINT(lret, ret);
+  
+  return lret;
+}
+#endif
+
+\f
+
 static int add_gpm_wait_descriptor_called_flag;
 
 void
@@ -7708,6 +8272,25 @@
   defsubr (&Sprocess_coding_system);
   defsubr (&Sset_process_filter_multibyte);
   defsubr (&Sprocess_filter_multibyte_p);
+#ifdef HAVE_GNUTLS
+  defsubr (&Sgnutls_global_init);
+  defsubr (&Sgnutls_global_deinit);
+  defsubr (&Sgnutls_init);
+  defsubr (&Sgnutls_deinit);
+  defsubr (&Sgnutls_protocol_set_priority);
+  defsubr (&Sgnutls_cipher_set_priority);
+  defsubr (&Sgnutls_compression_set_priority);
+  defsubr (&Sgnutls_kx_set_priority);
+  defsubr (&Sgnutls_mac_set_priority);
+  defsubr (&Sgnutls_cred_set);
+  defsubr (&Sgnutls_handshake);
+  defsubr (&Sgnutls_rehandshake);
+  defsubr (&Sgnutls_x509pki_set_client_key_file);
+  defsubr (&Sgnutls_x509pki_set_client_trust_file);
+  defsubr (&Sgnutls_srp_set_client_cred);
+  defsubr (&Sgnutls_anon_set_client_cred);
+  defsubr (&Sgnutls_bye);
+#endif /* HAVE_GNUTLS */
 
 #endif	/* subprocesses */
 

=== modified file 'src/process.h'
--- src/process.h	2010-08-11 12:34:46 +0000
+++ src/process.h	2010-08-12 22:35:18 +0000
@@ -121,6 +121,14 @@
        needs to be synced to `status'.  */
     unsigned int raw_status_new : 1;
     int raw_status;
+
+#ifdef HAVE_GNUTLS
+    /* XXX Store GNU TLS state and auth mechanisms in Lisp_Objects. */
+    Lisp_Object gnutls_state;
+    Lisp_Object x509_cred, x509_callback;
+    Lisp_Object anon_cred;
+    Lisp_Object srp_cred;
+#endif
 };
 
 /* Every field in the preceding structure except for the first two


[-- Attachment #3: gnutls.el --]
[-- Type: application/emacs-lisp, Size: 5389 bytes --]