Re: Emacs core TLS support

[Ted Zlatanov <tzz@lifelogs.com>]

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

On Fri, 13 Aug 2010 07:04:49 -0400 James Cloos <cloos@jhcloos.com> wrote: 

JC> I'm just scanning though the patch for now, but the first think I notice
JC> is that it needs to be updated from k&r to ansi.  

Fixed, except for:

process.c: In function ‘Fgnutls_global_init’:
process.c:6927: warning: old-style function definition
process.c: In function ‘Fgnutls_global_deinit’:
process.c:6942: warning: old-style function definition

Those two have no parameters, so I'm not sure what to fix.

JC> (Having written that, I don't remember whether the 23 branch was also
JC> updated from k&r; so the above may only apply if it is meant just for
JC> trunk.)

I was getting compiler warnings so we're supposed to use ANSI.  I just
didn't bother because there are so many more important issues with the
patch.  I attach the revised version.

Ted


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: tls.patch --]
[-- Type: text/x-diff, Size: 23849 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 15:03:01 +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,59 @@
   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 +5172,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 +5210,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 +5625,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 +6866,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: /* 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. */)
+  ( 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. */)
+  ()
+{
+  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 (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. */)
+  (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. */)
+  (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. */)
+  (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. */)
+  (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. */)
+  (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 +8270,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