Re: Emacs core TLS support

[Ted Zlatanov <tzz@lifelogs.com>]

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

On Fri, 13 Aug 2010 20:15:30 -0400 Chong Yidong <cyd@stupidchicken.com> wrote: 

CY> instead of

CY>    (gnutls-protocol-set-priority proc gnutls-tls1 gnutls-ssl3)

CY> it should be called as

CY>    (gnutls-protocol-set-priority proc 'gnutls-tls1 'gnutls-ssl3),
...
CY> I realize this is a rather invasive change to the patch.  I suggest
CY> separating the GnuTLS code into a separate file, gnutls.c, adding it to
CY> the Emacs repository, and work from there.

CY> Then you don't have to keep sending the patch to the mailing list.

Simon Josefsson had the suggestion that I use the string version of the
priority set and I did.  That reduces the need for this change greatly;
please take a look at gnutls.el.  There's only 

(defconst gnutls-x509pki 1)
(defconst gnutls-anon 2)
(defconst gnutls-srp 3)

for which there's actually no get_id function to look the credentials
type by name in GnuTLS.  So if that's the only thing we need to #define,
I'd rather not do anything fancy and just handle it explicitly in
`gnutls-cred-set'.

Note I've never worked with the Emacs internals at this depth so I did
not commit any of my changes to the Emacs repo and will not until you or
Stefan Monnier say it's OK.

I changed lisp.h and emacs.c to call syms_of_gnutls() and made other
changes so the patch compiles cleanly and the functions are available.
It's far from ready (it won't do anything but crash emacs) but at least
it won't break the build and doesn't affect anything else.  So it's
attached here for structural review more than any real testing.

Everything in gnutls.c that's commented out is for reference only and I
don't think will be back.  I think we should start without SRP support
and generally do just enough to get SSL and TLS to work in the simplest
cases.  When those cases work we can proceed to the fancier uses.  So
that's the current aim of the patch.

Also I think trying to make gnutls.el a drop-in replacement for
starttls.el is not a good idea.  I'd rather make it a standalone library
so we can make the API fit better.

Ted


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

=== modified file 'configure.in'
--- configure.in	2010-08-23 12:54:09 +0000
+++ configure.in	2010-09-05 04:42:32 +0000
@@ -170,6 +170,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.
@@ -1998,6 +1999,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
@@ -3682,6 +3690,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}"

=== added file 'lisp/net/gnutls.el'
--- lisp/net/gnutls.el	1970-01-01 00:00:00 +0000
+++ lisp/net/gnutls.el	2010-09-05 04:42:32 +0000
@@ -0,0 +1,120 @@
+;; By Simon Josefsson 2001-12-01
+;; See http://josefsson.org/emacs-security/
+
+;; Simple test:
+;;
+;; (setq jas (open-ssl-stream "ssl" (current-buffer) "www.pdc.kth.se" 443))
+;; (process-send-string jas "GET /\r\n\r\n")
+
+(defconst gnutls-version "0.3.1")
+
+(defconst gnutls-server 1)
+(defconst gnutls-client 2)
+
+(defconst gnutls-x509pki 1)
+(defconst gnutls-anon 2)
+(defconst gnutls-srp 3)
+
+(defconst gnutls-shut-rdwr 0)
+(defconst gnutls-shut-wr 1)
+
+(defconst gnutls-e-interrupted -52)
+(defconst gnutls-e-again -28)
+
+(defun open-ssl-stream (name buffer host service)
+  "Open a SSL connection for a service to a host.
+Returns a subprocess-object to represent the connection.
+Input and output work as for subprocesses; `delete-process' closes it.
+Args are NAME BUFFER HOST SERVICE.
+NAME is name for process.  It is modified if necessary to make it unique.
+BUFFER is the buffer (or buffer-name) to associate with the process.
+ Process output goes at end of that buffer, unless you specify
+ an output stream or filter function to handle the output.
+ BUFFER may be also nil, meaning that this process is not associated
+ with any buffer
+Third arg is name of the host to connect to, or its IP address.
+Fourth arg SERVICE is name of the service desired, or an integer
+specifying a port number to connect to."
+  (let ((proc (open-network-stream name buffer host service)))
+    (starttls-negotiate proc)))
+
+(defvar starttls-host nil)
+
+(defun starttls-negotiate (proc &optional priority-string
+                                credentials credentials-file)
+  "Negotiate a SSL or TLS connection.
+PRIORITY-STRING is as per the GnuTLS docs.
+CREDENTIALS is `gnutls-x509pki', `gnutls-anon', or `gnutls-srp'.
+CREDENTIALS-FILE is a filename with meaning dependent on CREDENTIALS."
+  (let* ((credentials (or credentials gnutls-anon))
+         (priority-string (or priority-string
+                              (cond
+                               ((eq credentials gnutls-anon)
+                                "PERFORMANCE:+ANON-DH:!ARCFOUR-128")
+                               ((eq credentials gnutls-x509pki)
+                               "PERFORMANCE")))))
+    (gnutls-message-maybe
+     (gnutls-global-init)
+     "global_init: err=%s")
+
+    (gnutls-message-maybe
+     (gnutls-init proc gnutls-client)
+     "init: err=%s")
+
+    (gnutls-message-maybe
+     (gnutls-priority-set-direct proc priority-string)
+     "priority_set: err=%s")
+
+    (gnutls-message-maybe
+     (gnutls-cred-set proc credentials)
+     "credential_set: err=%s")
+
+    (cond
+     ((eq credentials gnutls-x509pki)
+      (gnutls-message-maybe
+       (gnutls-cert-set-x509-trust-file proc credentials-file)
+       "x509_trustfile: err=%s")))
+
+    (let ((ret gnutls-e-again))
+      (while (or (eq ret gnutls-e-again)
+                 (eq ret gnutls-e-interrupted))
+        (gnutls-message-maybe
+         (setq ret (gnutls-handshake proc))
+         "handshake: err=%s"))
+      (if (< ret 0)
+          (progn
+            (message "Ouch, error return %d" ret)
+            (setq proc nil))
+        (message "Handshake complete %d." ret)))
+     proc))
+
+(defun starttls-open-stream (name buffer host service)
+  "Open a TLS connection for a service to a host.
+Returns a subprocess-object to represent the connection.
+Input and output work as for subprocesses; `delete-process' closes it.
+Args are NAME BUFFER HOST SERVICE.
+NAME is name for process.  It is modified if necessary to make it unique.
+BUFFER is the buffer (or `buffer-name') to associate with the process.
+ Process output goes at end of that buffer, unless you specify
+ an output stream or filter function to handle the output.
+ BUFFER may be also nil, meaning that this process is not associated
+ with any buffer
+Third arg is name of the host to connect to, or its IP address.
+Fourth arg SERVICE is name of the service desired, or an integer
+specifying a port number to connect to."
+  (prog1
+      (open-network-stream name buffer host service)
+    (set (make-variable-buffer-local 'starttls-host) host)))
+
+(defun gnutls-message-maybe (doit format &rest params)
+  "When DOIT, message with the caller name followed by FORMAT on PARAMS."
+  (message "%s: (err=%s) %s"
+           (nth 1 (backtrace-frame 4))
+           doit
+           (apply 'format format params)))
+
+(provide 'ssl)
+(provide 'gnutls)
+(provide 'starttls)
+
+;;; gnutls.el ends here

=== modified file 'src/Makefile.in'
--- src/Makefile.in	2010-08-17 21:19:11 +0000
+++ src/Makefile.in	2010-09-05 04:42:32 +0000
@@ -285,6 +285,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@
@@ -323,6 +326,7 @@
   ${C_SWITCH_X_SYSTEM} ${CFLAGS_SOUND} ${RSVG_CFLAGS} ${IMAGEMAGICK_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)
 
@@ -347,7 +351,7 @@
 	alloc.o data.o doc.o editfns.o callint.o \
 	eval.o floatfns.o fns.o font.o print.o lread.o \
 	syntax.o $(UNEXEC_OBJ) bytecode.o \
-	process.o callproc.o \
+	process.o gnutls.o callproc.o \
 	region-cache.o sound.o atimer.o \
 	doprnt.o strftime.o intervals.o textprop.o composite.o md5.o \
 	$(MSDOS_OBJ) $(MSDOS_X_OBJ) $(NS_OBJ) $(CYGWIN_OBJ) $(FONT_OBJ)
@@ -598,6 +602,7 @@
    $(RSVG_LIBS) ${IMAGEMAGICK_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-17 21:19:11 +0000
+++ src/config.in	2010-09-05 04:42:32 +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
 
@@ -1091,6 +1094,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/emacs.c'
--- src/emacs.c	2010-08-22 21:15:20 +0000
+++ src/emacs.c	2010-09-05 04:42:32 +0000
@@ -63,6 +63,10 @@
 #include "keyboard.h"
 #include "keymap.h"
 
+#ifdef HAVE_GNUTLS
+#include "gnutls.h"
+#endif
+
 #ifdef HAVE_NS
 #include "nsterm.h"
 #endif
@@ -1569,6 +1573,10 @@
       syms_of_fontset ();
 #endif /* HAVE_NS */
 
+#ifdef HAVE_GNUTLS
+      syms_of_gnutls ();
+#endif
+
 #ifdef HAVE_DBUS
       syms_of_dbusbind ();
 #endif /* HAVE_DBUS */

=== added file 'src/gnutls.c'
--- src/gnutls.c	1970-01-01 00:00:00 +0000
+++ src/gnutls.c	2010-09-05 04:42:32 +0000
@@ -0,0 +1,503 @@
+#include <config.h>
+#include <errno.h>
+#include <setjmp.h>
+
+#include "lisp.h"
+#include "process.h"
+
+#ifdef HAVE_GNUTLS
+#include <gnutls/gnutls.h>
+
+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);
+}
+
+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. */)
+     (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 char*, const char**),
+                      Lisp_Object proc, Lisp_Object priority_string)
+{
+  Lisp_Object lret;
+  gnutls_session_t state;
+  int ret;
+  
+  CHECK_PROCESS (proc);
+  CHECK_STRING(priority_string);
+  
+  state = (gnutls_session_t) XPROCESS(proc)->gnutls_state;
+
+  ret = (*func) (state, (char*) SDATA (priority_string), NULL);
+
+  XSETINT (lret, ret);
+  return lret;
+}
+
+DEFUN ("gnutls-priority-set-direct", Fgnutls_priority_set_direct, 
+       Sgnutls_priority_set_direct, 2, 2, 0,
+       doc: /* Sets the priority on the protocol versions supported by GNU TLS for PROCESS.
+
+The first parameter must be a process. Second parameter is a string
+describing the priority.  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. */)
+    (Lisp_Object process, Lisp_Object priority_string)
+{
+  Lisp_Object ret;
+
+  ret = generic_set_priority (&gnutls_priority_set_direct, process, priority_string);
+  
+  return ret;
+}
+
+DEFUN ("gnutls-cert-set-x509-trust-file", 
+       Fgnutls_cert_set_x509_trust_file,
+       Sgnutls_cert_set_x509_trust_file, 2, 2, 0,
+       doc: /* Set X.509 client trust file for PROCESS
+CERTFILE is a PEM encoded file.  Returns zero on success.
+*/)
+    (Lisp_Object proc, Lisp_Object certfile)
+{
+  gnutls_session_t state;
+  gnutls_certificate_credentials_t x509_cred;
+  Lisp_Object lret;
+  int ret;
+
+  CHECK_STRING(certfile);
+
+  CHECK_PROCESS (proc);
+  state = (gnutls_session_t) XPROCESS(proc)->gnutls_state;
+
+  x509_cred = (gnutls_certificate_credentials_t) XPROCESS(proc)->x509_cred;
+
+  ret = gnutls_certificate_set_x509_trust_file (x509_cred, XSTRING (certfile)->data, GNUTLS_X509_FMT_PEM);
+
+  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_certificate_allocate_credentials (&x509_cred) < 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;
+}
+
+// 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;
+// }
+
+void
+syms_of_gnutls (void)
+{
+  defsubr (&Sgnutls_global_init);
+  defsubr (&Sgnutls_global_deinit);
+  defsubr (&Sgnutls_init);
+  defsubr (&Sgnutls_deinit);
+  defsubr (&Sgnutls_priority_set_direct);
+  defsubr (&Sgnutls_cred_set);
+  defsubr (&Sgnutls_handshake);
+  defsubr (&Sgnutls_rehandshake);
+  defsubr (&Sgnutls_cert_set_x509_trust_file);
+  // 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

=== added file 'src/gnutls.h'
--- src/gnutls.h	1970-01-01 00:00:00 +0000
+++ src/gnutls.h	2010-09-05 04:42:32 +0000
@@ -0,0 +1,4 @@
+#ifdef HAVE_GNUTLS
+#include <gnutls/gnutls.h>
+
+#endif

=== modified file 'src/lisp.h'
--- src/lisp.h	2010-08-09 19:25:41 +0000
+++ src/lisp.h	2010-09-05 04:42:32 +0000
@@ -3350,6 +3350,7 @@
 extern void syms_of_process (void);
 extern void setup_process_coding_systems (Lisp_Object);
 
+
 /* Defined in callproc.c */
 extern Lisp_Object Vexec_path, Vexec_suffixes,
                    Vexec_directory, Vdata_directory;
@@ -3589,6 +3590,11 @@
 void syms_of_dbusbind (void);
 #endif
 
+#ifdef HAVE_GNUTLS
+/* Defined in gnutls.c */
+extern void syms_of_gnutls (void);
+#endif
+
 #ifdef DOS_NT
 /* Defined in msdos.c, w32.c */
 extern char *emacs_root_dir (void);

=== modified file 'src/process.c'
--- src/process.c	2010-08-22 15:14:37 +0000
+++ src/process.c	2010-09-05 04:42:32 +0000
@@ -105,6 +105,9 @@
 #include "sysselect.h"
 #include "syssignal.h"
 #include "syswait.h"
+#ifdef HAVE_GNUTLS
+#include "gnutls.h"
+#endif
 
 #if defined (USE_GTK) || defined (HAVE_GCONF)
 #include "xgselect.h"
@@ -1526,6 +1529,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
@@ -5097,7 +5104,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)
 	{
@@ -5130,7 +5142,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
@@ -5540,7 +5557,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)

=== modified file 'src/process.h'
--- src/process.h	2010-08-11 12:34:46 +0000
+++ src/process.h	2010-09-05 04:42:32 +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