Re: Emacs core TLS support

[Ted Zlatanov <tzz@lifelogs.com>]

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

On Mon, 06 Sep 2010 00:47:39 +0200 Stefan Monnier <monnier@iro.umontreal.ca> wrote: 

SM> For symmetry, I'd say "Does Emacs use -lgnutls?".

Fixed.
 
SM> Use C-u M-x checkdoc-current-buffer which will help you follow the usual
SM> coding conventions (e.g. inserting the GPL blurb).

Fixed.

>> +(defvar starttls-host nil)

SM> What is this for?  It seems to only ever be set and never read.

I think Simon Josefsson intended to do more with it but you're right,
right now it's unused.  I removed it.

>> +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.

SM> This formulation means that the symbols (rather than the value of the
SM> corresponding variables) `gnutls-client' and `gnutls-server' are the
SM> valid values.

We don't support server mode anyhow so I removed the connection-end
argument altogether (hardcoding the init to GNUTLS_CLIENT).

`gnutls-bye' still mentions `gnutls-e-again' and `gnutls-e-interrupted'.
I'm not sure if I should return a symbol or the numeric value there.

SM> This said, while I understand the general desire to just bring the C API
SM> of GNU TLS into Elisp, as long as you do it by hand, you might as well
SM> use here a Lisp boolean for connection_end.

Yeah, I'll do that for `gnutls-bye' with a CONT parameter.  It's just a
NILP check to handle booleans IIUC (there's no CHECK_BOOLEAN, so it's
either NILP or EQ to Qt).

>> +  state = (gnutls_session_t) XPROCESS(proc)->gnutls_state;
>> +  gnutls_deinit(state);

SM> Please always put a space before the open paren of a macro or
SM> function call.  Applies to the rest of the code as well, of course.

Fixed.

SM>    return make_number (lret);

Fixed everywhere, I think, and I condensed the code when possible (argh,
no C99 :)

>> +CERTFILE is a PEM encoded file.  Returns zero on success.
>> +*/)

SM> By convention we keep the closing */) at the end of the previous line.

Fixed.

>> +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'.

SM> Again, the above formulation means that the caller should pass those
SM> symbols rather than value associated with the corresponding variables.

In this case I think that's the right approach actually so we shouldn't
have defconsts.  See new definition, it uses two local Lisp_Objects for
the symbol names.  Where should I allocate those constant Lisp_Objects
globally properly?  And should I default to anonymous?

>> +      if (gnutls_certificate_allocate_credentials (&x509_cred) < 0)
>> +	memory_full ();

SM> Can it really only mean "memory is full"?

I think so.

>> === added file 'src/gnutls.h'
SM> Why add this file?  Doesn't seem worth the trouble.

As gnutls.c grows, I think it will be necessary.  It can be removed now
if you want.

>> +#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

SM> Rather than hardcode variables in gnutls.el, an alternative could be to
SM> define those variables in gnutls.c so you can initialize them to the
SM> values taken from gnutls/gnutls.h.

I'd like to take the direction of a more Lisp-y API on top of the GnuTLS
API.  So any constants should be limited to the function bodies and I'd
like to stick to symbols (as with gnutls-cred-set in the new patch).

On Sun, 05 Sep 2010 10:06:09 +0200 Andreas Schwab <schwab@linux-m68k.org> wrote: 

AS> You should remove the debugging output.

Fixed.

>> +DEFUN ("gnutls-init", Fgnutls_init, Sgnutls_init, 2, 2, 0,
...
>> +  ret = gnutls_init((gnutls_session_t*)&(XPROCESS(proc)->gnutls_state), 

AS> Aliasing violation.

Can you explain please?

AS> IMHO all your functions should return t on success and either some error
AS> symbol on failure or even raise an error.

Yes, but I'm not sure which one.  Can you recommend?

AS> No C99.

Yes, sorry for leaving that in the patch.  Removed.

>> === modified file 'src/process.h'
>> +
>> +#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

AS> None of them should be Lisp_Objects.  Also make sure the resources are
AS> properly released when the process object is deleted.

I don't know enough (the choice of using Lisp_Objects was in the
original patch) to know what to do instead of using Lisp_Objects.  Why
not, first of all?

Revised patch is attached (it compiles but the changes are mostly
cosmetic so it's still not usable).  Thank you for the comments, they
were very helpful.  I hope to get this in a usable state ASAP.

Ted


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

=== modified file 'configure.in'
--- configure.in	2010-08-23 12:54:09 +0000
+++ configure.in	2010-09-06 14:25:55 +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 -lgnutls?                                ${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-06 14:25:55 +0000
@@ -0,0 +1,134 @@
+;;; gnutls.el --- Support SSL and TLS connections through GnuTLS
+;; Copyright (C) 2010 Free Software Foundation, Inc.
+
+;; Author: Ted Zlatanov <tzz@lifelogs.com>
+;; Keywords: comm, tls, ssl, encryption
+;; Originally-By: Simon Josefsson (See http://josefsson.org/emacs-security/)
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This package provides language bindings for the GnuTLS library
+;; using the corresponding core functions in gnutls.c.
+
+;; Simple test:
+;;
+;; (setq jas (open-ssl-stream "ssl" (current-buffer) "www.pdc.kth.se" 443))
+;; (process-send-string jas "GET /\r\n\r\n")
+
+;;; Code:
+
+(defconst gnutls-version "0.3.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)))
+
+(defun starttls-negotiate (proc &optional priority-string
+                                credentials credentials-file)
+  "Negotiate a SSL or TLS connection.
+PROC is the process returned by `starttls-open-stream'.
+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)
+     "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."
+  (open-network-stream name buffer host service))
+
+(defun gnutls-message-maybe (doit format &rest params)
+  "When DOIT, message with the caller name followed by FORMAT on PARAMS."
+  (when doit
+    (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-06 14:25:55 +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-06 14:25:55 +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-06 14:25:55 +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-06 14:25:55 +0000
@@ -0,0 +1,327 @@
+#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;
+
+  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;
+    }
+  fsync (STDOUT_FILENO);
+
+  return (bytes_written);
+}
+
+int
+emacs_gnutls_read (int fildes, gnutls_session_t state, char *buf,
+                   unsigned int nbyte)
+{
+  register int rtnval;
+
+  do {
+    rtnval = gnutls_read (state, buf, nbyte);
+  } while( rtnval==GNUTLS_E_INTERRUPTED || rtnval==GNUTLS_E_AGAIN);
+  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;
+  }
+
+  return -1; /* send no certificate to the peer */
+}
+
+DEFUN ("gnutls-init", Fgnutls_init, Sgnutls_init, 1, 1, 0,
+       doc: /* Initializes client-mode GnuTLS for process PROC.
+Currently only client mode 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)
+{
+  int ret;
+  
+  CHECK_PROCESS (proc);
+
+  ret = gnutls_init ((gnutls_session_t*)&(XPROCESS (proc)->gnutls_state), 
+                     GNUTLS_CLIENT);
+
+  return make_number (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)
+{
+  int ret = gnutls_global_init ();
+
+  return make_number (ret);
+}
+
+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)
+{
+  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);
+
+  return make_number (ret);
+}
+
+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 = 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;
+  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);
+
+  return make_number (ret);
+}
+
+DEFUN ("gnutls-cred-set", Fgnutls_cred_set, 
+       Sgnutls_cred_set, 2, 2, 0,
+       doc: /* Enables GNU TLS authentication for PROCESS.
+TYPE is either `gnutls-anon' 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 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)
+{
+  Lisp_Object Qgnutls_anon = intern_c_string ("gnutls-anon");
+  Lisp_Object Qgnutls_x509 = intern_c_string ("gnutls-x509pki");
+  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;
+
+  if (EQ (type, Qgnutls_x509))
+  {
+      if (gnutls_certificate_allocate_credentials (&x509_cred) < 0)
+	memory_full ();
+      ret = gnutls_cred_set (state, GNUTLS_CRD_CERTIFICATE, x509_cred);
+  }
+  else if (EQ (type, Qgnutls_anon))
+  {
+      if (gnutls_anon_allocate_client_credentials (&anon_cred) < 0)
+	memory_full ();
+      ret = gnutls_cred_set (state, GNUTLS_CRD_ANON, anon_cred);
+  }
+  else
+  {
+   /* should this be an error or fold to gnutls-anon? */
+  }
+
+  return make_number (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().
+
+If CONT is not nil 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.  If CONT is nil, GnuTLS actually
+sends an alert containing a close request and waits for the peer to
+reply with the same message.  In order to reuse the connection you
+should wait for an EOF from the peer.
+  
+This function may also return `gnutls-e-again', or
+`gnutls-e-interrupted'. */)
+    (Lisp_Object proc, Lisp_Object cont)
+{
+  gnutls_session_t state;
+  int ret;
+
+  CHECK_PROCESS (proc);
+
+  state = (gnutls_session_t) XPROCESS (proc)->gnutls_state;
+
+  ret = gnutls_bye (state,
+                    NILP (cont) ? GNUTLS_SHUT_RDWR : GNUTLS_SHUT_WR);
+  
+  return make_number (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;
+  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);
+
+  return make_number (ret);
+}
+
+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;
+  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);
+
+  return make_number (ret);
+}
+
+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_bye);
+}
+#endif

=== added file 'src/gnutls.h'
--- src/gnutls.h	1970-01-01 00:00:00 +0000
+++ src/gnutls.h	2010-09-06 14:25:55 +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-06 14:25:55 +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-06 14:25:55 +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-06 14:25:55 +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