Re: Emacs core TLS support

[Ted Zlatanov <tzz@lifelogs.com>]

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

On Fri, 29 Jan 2010 13:59:27 -0600 Ted Zlatanov <tzz@lifelogs.com> wrote: 

TZ> On Thu, 14 Jan 2010 10:38:44 -0600 Ted Zlatanov <tzz@lifelogs.com> wrote: 
TZ> On Thu, 14 Jan 2010 10:44:13 -0500 Stefan Monnier <monnier@iro.umontreal.ca> wrote: 
>>>> Simon Josefsson already put a patch together at
>>>> http://josefsson.org/securemacs but it will probably need to be revised
>>>> a bit, the last change was in 2002.  It offers gnutls.el as an
>>>> alternative to starttls.el, with a similar API.  As long as this is
>>>> optional and autodetected through configure, I don't see a downside.  It
>>>> may need to be folded into starttls.el but that's not a big deal.  I'm
>>>> cc-ing Simon in case he has any comments.

SM> I think I'd be OK with adding a --with-gnutls configure option that
SM> links Emacs against that library.  Especially if we can provide
SM> a compatibility footls.el library that works both --with-gnutls
SM> and without.

TZ> Is anyone interested in reviewing Simon's patch?  I think it does
TZ> exactly what you suggest except the compatibility layer, which should be
TZ> trivial since Simon kept the invocation semantics the same between
TZ> gnutls.el and starttls.el.

I posted a revised version of the patch on the gnutls-devel mailing
list and asked for help there:
http://thread.gmane.org/gmane.comp.encryption.gpg.gnutls.devel/4430

(note there's a minor revision of the patch posted today at
http://thread.gmane.org/gmane.comp.encryption.gpg.gnutls.devel/4442)

Simon Josefsson is active on that list but doesn't seem interested in
further supporting that patch.  So it's up to the Emacs developers to
take this on.

The patch is far from done but at least all the wrapper code is written
and it has no issues AFAIK.  All that remains is for someone with good C
knowledge to look through process.c and process.h and adjust the API
calls appropriately.  Unfortunately I haven't done C in a long time and
don't know the Emacs internals well, so it's really inefficient for me
to dig through it.

I'm attaching the latest patch here for completeness.

Ted


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: tls.patch --]
[-- Type: text/x-diff, Size: 24375 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-12 22:41:55 +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,65 @@
   return Qt;
 }
 
+#ifdef HAVE_GNUTLS
+
+int
+emacs_gnutls_write (fildes, state, buf, nbyte)
+     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 (fildes, state, buf, nbyte)
+     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 +5178,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 +5216,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 +5631,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 +6872,523 @@
 
 \f
 
+#ifdef HAVE_GNUTLS
+
+int gnutls_callback (state, client_certs, ncerts, req_ca_cert, nreqs)
+     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: /* Initializes 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. */)
+     (proc, connection_end)
+     Lisp_Object proc, 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'. */)
+     (proc)
+     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. */)
+     ()
+{
+  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'. */)
+     ()
+{
+  gnutls_global_deinit();
+
+  return Qnil;
+}
+
+Lisp_Object
+generic_set_priority (func, nargs, args)
+     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 parameter must be a process.	Subsequent parameters 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. */)
+     (nargs, args)
+     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 parameter must be a process.	Subsequent parameters 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. */)
+     (nargs, args)
+     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 parameter must be a process.	Subsequent parameters 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. */)
+     (nargs, args)
+     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 parameter must be a process.	Subsequent parameters 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. */)
+     (nargs, args)
+     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 parameter must be a process.	Subsequent parameters 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. */)
+     (nargs, args)
+     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. */)
+     (proc, certfile, keyfile)
+     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. */)
+     (proc, cafile, crlfile)
+     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. */)
+     (proc, username, password)
+     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. */)
+     (proc, dh_bits)
+     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'. */)
+     (proc, type)
+     Lisp_Object proc, 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'. */)
+     (proc, how)
+     Lisp_Object proc, 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). */)
+     (proc)
+     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'. */)
+     (proc)
+     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 +8309,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