emacs-devel
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Updated GNU TLS bindings


From: Simon Josefsson
Subject: Updated GNU TLS bindings
Date: Fri, 25 Jan 2002 23:08:02 +0100
User-agent: Gnus/5.090006 (Oort Gnus v0.06) Emacs/21.1.80 (i686-pc-linux-gnu)

I have cleaned up my GNU TLS support for Emacs, and written some
documentation as well (included below, it can use to help of someone
who knows english).  One person has reported that the previous patch
worked.  I am now fairly happy with the patch as it stands, and
decided that not all of the GNU TLS library need to mirrored by Lisp
bindings -- if someone feel the need for the X.509 related stuff in
the future, they can easily be added.  They are not needed to make
HTTP over TLS, IMAP over TLS, NNTP over TLS etc work, which was my
goal with it.

There is one main problem left that I don't know how to solve, quoting
the patched 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

In these Lisp_Objects I am storing pointes to C structures.  I
understand this is a no-no, and I think it might cause crashes in the
garbage collector.  How should I fix this?  As I understand it, I need
to change GC code if I want to add non-Lisp_Objects to Lisp_Process,
but I don't know how to do this.  Help!

Minor issues left:

 * Improve the docstrings.
 * Adapt docstrings for lisp reference manual.

How to test it:

Checkout libgcrypt:
cvs -d :pserver:address@hidden:/cvs/gnupg co libgcrypt -r V1-1-4
Build libgcrypt:
./autogen.sh, ./configure, make install
Checkout libgnutls:
cvs -d :pserver:address@hidden:/cvs/gnutls co libgcrypt -r gnutls_0_3_5
Build libgnutls:
./buildconf, ./configure, make install
Apply the patch below to Emacs HEAD from CVS.
Build Emacs:
aclocal, autoconf, ./configure, make
Try it by evaling (you should get some HTML junk in your buffer):
(require 'gnutls)
(setq jas (open-ssl-stream "ssl" (current-buffer) "www.pdc.kth.se" 443))
(process-send-string jas "GET /\r\n\r\n")

The documentation:

Security Layer for Network Connections
======================================

   Network connections (*note Network::) opened by Emacs Lisp can
optionally use a security layer, provided by the GNU TLS library.  This
functionality is only available if Emacs was compiled against the GNU
TLS library.

   For casual uses, the Lisp library `gnutls' provides functionality
for opening TLS streams (`open-ssl-stream') and negotiating TLS on
already opened network streams (`starttls-negotiate').  The first
function merely opens a network stream and negotiates TLS directly.
The `gnutls' library is implemented using the low-level primitives
described here.

   The way reading and writing to network connections works in Emacs
Lisp is not modified.  When a process has been initialized for the GNU
TLS library (using `gnutls-init'), the GNU TLS functions for reading
from and writing to the network connection are used automatically by
Emacs.  When a succesful TLS handshake has been performed, data that is
read and written is protected by the TLS library.

   There are utility functions to investigate which algorithms are used;
`gnutls-cipher-get-algo', `gnutls-kx-get-algo', `gnutls-mac-get-algo',
`gnutls-compression-get-algo', and `gnutls-protocol-get-version'.
Converting the integers returned by the previous functions into
readable strings is done with `gnutls-cipher-get-name',
`gnutls-kx-get-name' `gnutls-mac-get-name',
`gnutls-compression-get-name', and `gnutls-protocol-get-name'
respectively.

   If you wish to return to using the operating system reading and
writing primitives, you must deregister the network connection from GNU
TLS (using `gnutls-deinit').

   Initializing a process:

 - Function: gnutls-init proc connection_end

 - Function: gnutls-deinit proc

   Functions that perform TLS communication:

 - Function: gnutls-handshake proc

 - Function: gnutls-rehandshake proc

 - Function: gnutls-bye proc how

   Specifying algorithm priorities:

 - Function: gnutls-protocol-set-priority proc &rest algs

 - Function: gnutls-cipher-set-priority proc &rest algs

 - Function: gnutls-compression-set-priority proc &rest algs

 - Function: gnutls-kx-set-priority proc &rest algs

 - Function: gnutls-mac-set-priority proc &rest algs

   Specifying authentication information for X.509:

 - Function: gnutls-x509pki-set-client-key-file proc certfile keyfile

 - Function: gnutls-x509pki-set-client-trust-file proc cafile crlfile

   Specifying authentication information for SRP:

 - Function: gnutls-srp-set-client-cred-file proc username password

   Specifying authentication information for anonymous connections:

 - Function: gnutls-anon-set-client-cred-file proc dh_bits

   Specifying which authenticator to use:

 - Function: gnutls-cred-set proc type

   Utility functions:

 - Function: gnutls-protocol-get-version proc

 - Function: gnutls-cipher-get-algo proc

 - Function: gnutls-kx-get-algo proc

 - Function: gnutls-mac-get-algo proc

 - Function: gnutls-compression-get-algo proc

 - Function: gnutls-protocol-get-name proc version

 - Function: gnutls-cipher-get-name proc alg

 - Function: gnutls-mac-get-name proc alg

 - Function: gnutls-kx-get-name proc alg

 - Function: gnutls-compression-get-name proc alg

Index: configure.in
===================================================================
RCS file: /cvsroot/emacs/emacs/configure.in,v
retrieving revision 1.283
diff -u -r1.283 configure.in
--- configure.in        28 Dec 2001 19:06:40 -0000      1.283
+++ configure.in        25 Jan 2002 21:58:39 -0000
@@ -1915,6 +1915,13 @@
   fi
 fi
 
+AM_PATH_LIBGNUTLS( 0.3.2,, AC_MSG_ERROR([[*** gnutls was not found]]))
+HAVE_GNUTLS=no
+if test "x$no_libgnutls" = x ; then
+  HAVE_GNUTLS=yes
+  AC_DEFINE(HAVE_GNUTLS)
+fi
+
 # If netdb.h doesn't declare h_errno, we must declare it by hand.
 AC_CACHE_CHECK(whether netdb declares h_errno,
               emacs_cv_netdb_declares_h_errno,
@@ -2268,6 +2275,7 @@
 echo "  Does Emacs use -ltiff?                                  ${HAVE_TIFF}"
 echo "  Does Emacs use -lungif?                                 ${HAVE_GIF}"
 echo "  Does Emacs use -lpng?                                   ${HAVE_PNG}"
+echo "  Does Emacs use GNU TLS?                                 ${HAVE_GNUTLS}"
 echo "  Does Emacs use X toolkit scroll bars?                   
${USE_TOOLKIT_SCROLL_BARS}"
 echo
 
Index: lispref/processes.texi
===================================================================
RCS file: /cvsroot/emacs/emacs/lispref/processes.texi,v
retrieving revision 1.24
diff -u -r1.24 processes.texi
--- lispref/processes.texi      24 Sep 2001 19:00:26 -0000      1.24
+++ lispref/processes.texi      25 Jan 2002 21:58:45 -0000
@@ -47,6 +47,7 @@
 * Sentinels::                Sentinels run when process run-status changes.
 * Transaction Queues::      Transaction-based communication with subprocesses.
 * Network::                  Opening network connections.
+* Security Layer::           Using a security layer on network connections.
 @end menu
 
 @node Subprocess Creation
@@ -1360,4 +1361,117 @@
 The arguments @var{host} and @var{service} specify where to connect to;
 @var{host} is the host name (a string), and @var{service} is the name of
 a defined network service (a string) or a port number (an integer).
address@hidden defun
+
address@hidden Security Layer
address@hidden Security Layer for Network Connections
address@hidden transport layer security
address@hidden TLS
address@hidden SSL
+
+Network connections (@pxref{Network}) opened by Emacs Lisp can
+optionally use a security layer, provided by the GNU TLS library.
+This functionality is only available if Emacs was compiled against the
+GNU TLS library.
+
+For casual uses, the Lisp library @code{gnutls} provides functionality
+for opening TLS streams (@code{open-ssl-stream}) and negotiating TLS
+on already opened network streams (@code{starttls-negotiate}).  The
+first function merely opens a network stream and negotiates TLS
+directly.  The @code{gnutls} library is implemented using the
+low-level primitives described here.
+
+The way reading and writing to network connections works in Emacs Lisp
+is not modified.  When a process has been initialized for the GNU TLS
+library (using @code{gnutls-init}), the GNU TLS functions for reading
+from and writing to the network connection are used automatically by
+Emacs.  When a succesful TLS handshake has been performed, data that
+is read and written is protected by the TLS library.
+
+There are utility functions to investigate which algorithms are used;
address@hidden, @code{gnutls-kx-get-algo},
address@hidden, @code{gnutls-compression-get-algo}, and
address@hidden  Converting the integers returned
+by the previous functions into readable strings is done with
address@hidden, @code{gnutls-kx-get-name}
address@hidden, @code{gnutls-compression-get-name}, and
address@hidden respectively.
+
+If you wish to return to using the operating system reading and
+writing primitives, you must deregister the network connection from
+GNU TLS (using @code{gnutls-deinit}).
+
+Initializing a process:
+
address@hidden gnutls-init proc connection_end
address@hidden defun
address@hidden gnutls-deinit proc
address@hidden defun
+
+Functions that perform TLS communication:
+
address@hidden gnutls-handshake proc
address@hidden defun
address@hidden gnutls-rehandshake proc
address@hidden defun
address@hidden gnutls-bye proc how
address@hidden defun
+
+Specifying algorithm priorities:
+
address@hidden gnutls-protocol-set-priority proc &rest algs
address@hidden defun
address@hidden gnutls-cipher-set-priority proc &rest algs
address@hidden defun
address@hidden gnutls-compression-set-priority proc &rest algs
address@hidden defun
address@hidden gnutls-kx-set-priority proc &rest algs
address@hidden defun
address@hidden gnutls-mac-set-priority proc &rest algs
address@hidden defun
+
+Specifying authentication information for X.509:
+
address@hidden gnutls-x509pki-set-client-key-file proc certfile keyfile
address@hidden defun
address@hidden gnutls-x509pki-set-client-trust-file proc cafile crlfile
address@hidden defun
+
+Specifying authentication information for SRP:
+
address@hidden gnutls-srp-set-client-cred-file proc username password
address@hidden defun
+
+Specifying authentication information for anonymous connections:
+
address@hidden gnutls-anon-set-client-cred-file proc dh_bits
address@hidden defun
+
+Specifying which authenticator to use:
+
address@hidden gnutls-cred-set proc type
address@hidden defun
+
+Utility functions:
+
address@hidden gnutls-protocol-get-version proc
address@hidden defun
address@hidden gnutls-cipher-get-algo proc
address@hidden defun
address@hidden gnutls-kx-get-algo proc
address@hidden defun
address@hidden gnutls-mac-get-algo proc
address@hidden defun
address@hidden gnutls-compression-get-algo proc
address@hidden defun
+
address@hidden gnutls-protocol-get-name proc version
address@hidden defun
address@hidden gnutls-cipher-get-name proc alg
address@hidden defun
address@hidden gnutls-mac-get-name proc alg
address@hidden defun
address@hidden gnutls-kx-get-name proc alg
address@hidden defun
address@hidden gnutls-compression-get-name proc alg
 @end defun
Index: src/Makefile.in
===================================================================
RCS file: /cvsroot/emacs/emacs/src/Makefile.in,v
retrieving revision 1.244
diff -u -r1.244 Makefile.in
--- src/Makefile.in     22 Dec 2001 13:55:02 -0000      1.244
+++ src/Makefile.in     25 Jan 2002 21:58:45 -0000
@@ -45,6 +45,9 @@
 # LIBS = @LIBS@
 LIBOBJS = @LIBOBJS@
 
+LIBGNUTLS_LIBS = @LIBGNUTLS_LIBS@
+LIBGNUTLS_CFLAGS = @LIBGNUTLS_CFLAGS@
+
 # On Xenix and the IBM RS6000, double-dot gets screwed up.
 dot = .
 dotdot = ${dot}${dot}
@@ -266,7 +269,7 @@
 
 /* C_SWITCH_X_SITE must come before C_SWITCH_X_MACHINE and C_SWITCH_X_SYSTEM
    since it may have -I options that should override those two.  */
-ALL_CFLAGS=-Demacs -DHAVE_CONFIG_H $(TOOLKIT_DEFINES) $(MYCPPFLAG) -I. 
-I${srcdir} C_SWITCH_MACHINE C_SWITCH_SYSTEM C_SWITCH_SITE C_SWITCH_X_SITE 
C_SWITCH_X_MACHINE C_SWITCH_X_SYSTEM ${CFLAGS}
+ALL_CFLAGS=-Demacs -DHAVE_CONFIG_H $(TOOLKIT_DEFINES) $(MYCPPFLAG) -I. 
-I${srcdir} C_SWITCH_MACHINE C_SWITCH_SYSTEM C_SWITCH_SITE C_SWITCH_X_SITE 
C_SWITCH_X_MACHINE C_SWITCH_X_SYSTEM $(LIBGNUTLS_CFLAGS) ${CFLAGS}
 .c.o:
        $(CC) -c $(CPPFLAGS) $(ALL_CFLAGS) $<
 
@@ -409,6 +412,12 @@
 #define LIBGIF
 #endif /* not HAVE_GIF */
 
+#if HAVE_GNUTLS
+#define LIBGNUTLS $(LIBGNUTLS_LIBS)
+#else /* not HAVE_GNUTLS */
+#define LIBGNUTLS
+#endif /* not HAVE_GNUTLS */
+
 #ifdef HAVE_X11
 /* LD_SWITCH_X_DEFAULT comes after everything else that specifies
    options for where to find X libraries, but before those libraries.  */
@@ -822,7 +831,7 @@
 LIBES = $(LOADLIBES) $(LIBS) $(LIBX) $(LIBSOUND) \
    LIBS_SYSTEM LIBS_MACHINE LIBS_TERMCAP \
    LIBS_DEBUG $(GETLOADAVG_LIBS) $(GNULIB_VAR) LIB_MATH LIB_STANDARD \
-   $(GNULIB_VAR)
+   $(GNULIB_VAR) LIBGNUTLS
 
 /* Enable recompilation of certain other files depending on system type.  */
 
Index: src/config.in
===================================================================
RCS file: /cvsroot/emacs/emacs/src/config.in,v
retrieving revision 1.167
diff -u -r1.167 config.in
--- src/config.in       28 Dec 2001 19:06:08 -0000      1.167
+++ src/config.in       25 Jan 2002 21:58:45 -0000
@@ -83,6 +83,9 @@
 /* Define if we have the GIF library.  */
 #undef HAVE_GIF
 
+/* Define if we have the GNU TLS library.  */
+#undef HAVE_GNUTLS
+
 /* Define if libXaw3d is available.  */
 #undef HAVE_XAW3D
 
Index: src/process.c
===================================================================
RCS file: /cvsroot/emacs/emacs/src/process.c,v
retrieving revision 1.351
diff -u -r1.351 process.c
--- src/process.c       7 Jan 2002 21:16:38 -0000       1.351
+++ src/process.c       25 Jan 2002 21:58:46 -0000
@@ -175,6 +175,10 @@
 
 #include "sysselect.h"
 
+#ifdef HAVE_GNUTLS
+#include <gnutls.h>
+#endif
+
 extern int keyboard_bit_set P_ ((SELECT_TYPE *));
 
 /* If we support a window system, turn on the code to poll periodically
@@ -1109,6 +1113,9 @@
   XPROCESS (proc)->sentinel = Qnil;
   XPROCESS (proc)->filter = Qnil;
   XPROCESS (proc)->command = Flist (nargs - 2, args + 2);
+#ifdef HAVE_GNUTLS
+  XPROCESS (proc)->gnutls_state = Qnil;
+#endif
 
   /* Make the process marker point into the process buffer (if any).  */
   if (!NILP (buffer))
@@ -2883,6 +2890,65 @@
   return Qt;
 }
 
+#ifdef HAVE_GNUTLS
+
+int
+emacs_gnutls_write (fildes, state, buf, nbyte)
+     int fildes;
+     GNUTLS_STATE 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_STATE 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.
@@ -2944,12 +3010,22 @@
     bcopy (XSTRING (p->decoding_buf)->data, chars, carryover);
 
   if (proc_buffered_char[channel] < 0)
-    nbytes = emacs_read (channel, chars + carryover, 1024 - carryover);
+#ifdef HAVE_GNUTLS
+    if (NETCONN_P(proc) && !NILP (XPROCESS(proc)->gnutls_state))
+      nbytes = emacs_gnutls_read (channel, XPROCESS(proc)->gnutls_state, chars 
+ carryover, 1024 - carryover);
+    else
+#endif
+      nbytes = emacs_read (channel, chars + carryover, 1024 - carryover);
   else
     {
       chars[carryover] = proc_buffered_char[channel];
       proc_buffered_char[channel] = -1;
-      nbytes = emacs_read (channel, chars + carryover + 1,  1023 - carryover);
+#ifdef HAVE_GNUTLS
+      if (NETCONN_P(proc) && !NILP (XPROCESS(proc)->gnutls_state))
+       nbytes = emacs_gnutls_read (channel, XPROCESS(proc)->gnutls_state, 
chars + carryover + 1, 1023 - carryover);
+      else
+#endif
+       nbytes = emacs_read (channel, chars + carryover + 1,  1023 - carryover);
       if (nbytes < 0)
        nbytes = 1;
       else
@@ -3416,8 +3492,15 @@
          while (this > 0)
            {
              old_sigpipe = (SIGTYPE (*) ()) signal (SIGPIPE, 
send_process_trap);
-             rv = emacs_write (XINT (XPROCESS (proc)->outfd),
-                               (char *) buf, this);
+#ifdef HAVE_GNUTLS
+             if (NETCONN_P(proc) && !NILP (XPROCESS(proc)->gnutls_state))
+               rv = emacs_gnutls_write (XINT (XPROCESS (proc)->outfd),
+                                        XPROCESS(proc)->gnutls_state, 
+                                        (char *) buf, this);
+             else
+#endif
+               rv = emacs_write (XINT (XPROCESS (proc)->outfd),
+                                 (char *) buf, this);
              signal (SIGPIPE, old_sigpipe);
 
              if (rv < 0)
@@ -4546,6 +4629,670 @@
                XPROCESS (proc)->encode_coding_system);
 }
 
+#ifdef HAVE_GNUTLS
+
+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_STATE*)&(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 PROC.
+See also `gnutls-init'. */)
+     (proc)
+     Lisp_Object proc;
+{
+  CHECK_PROCESS (proc);
+
+  if (!EQ (XPROCESS(proc)->gnutls_state, Qnil))
+    {
+      GNUTLS_STATE state;
+
+      state = (GNUTLS_STATE) XPROCESS(proc)->gnutls_state;
+      
+      gnutls_deinit(state);
+    }
+
+  XPROCESS(proc)->gnutls_state = Qnil;
+
+  return Qnil;
+}
+
+Lisp_Object
+generic_set_priority (func, nargs, args)
+     int (*func)( GNUTLS_STATE state, GNUTLS_LIST);
+     int nargs;
+     Lisp_Object *args;
+{
+  Lisp_Object proc;
+  Lisp_Object lret;
+  GNUTLS_STATE state;
+  int *algs;
+  size_t len;
+  int ret;
+  int i;
+  
+  proc = args[0];
+  CHECK_PROCESS (proc);
+  state = (GNUTLS_STATE) 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;
+}
+
+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_STATE state;
+  GNUTLS_X509PKI_CLIENT_CREDENTIALS x509_cred;
+  Lisp_Object lret;
+  int ret;
+
+  CHECK_STRING(certfile);
+  CHECK_STRING(keyfile);
+
+  CHECK_PROCESS (proc);
+  state = (GNUTLS_STATE) XPROCESS(proc)->gnutls_state;
+
+  x509_cred = (GNUTLS_X509PKI_CLIENT_CREDENTIALS) 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_STATE state;
+  GNUTLS_X509PKI_CLIENT_CREDENTIALS x509_cred;
+  Lisp_Object lret;
+  int ret;
+
+  CHECK_STRING(cafile);
+  CHECK_STRING(crlfile);
+
+  CHECK_PROCESS (proc);
+  state = (GNUTLS_STATE) XPROCESS(proc)->gnutls_state;
+
+  x509_cred = (GNUTLS_X509PKI_CLIENT_CREDENTIALS) 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_STATE state;
+  GNUTLS_SRP_CLIENT_CREDENTIALS srp_cred;
+  Lisp_Object lret;
+  int ret;
+
+  CHECK_PROCESS (proc);
+  state = (GNUTLS_STATE) XPROCESS(proc)->gnutls_state;
+
+  srp_cred = (GNUTLS_SRP_CLIENT_CREDENTIALS) XPROCESS(proc)->srp_cred;
+
+  ret = gnutls_srp_set_client_cred (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_STATE state;
+  GNUTLS_ANON_CLIENT_CREDENTIALS anon_cred;
+  Lisp_Object lret;
+  int ret;
+
+  CHECK_PROCESS (proc);
+  state = (GNUTLS_STATE) XPROCESS(proc)->gnutls_state;
+
+  anon_cred = (GNUTLS_ANON_CLIENT_CREDENTIALS) XPROCESS(proc)->anon_cred;
+
+  ret = gnutls_anon_set_server_cred (anon_cred, XINT(dh_bits));
+
+  XSETINT (lret, ret);
+  return lret;
+}
+
+DEFUN ("gnutls-cipher-get-algo", Fgnutls_cipher_get_algo, 
+       Sgnutls_cipher_get_algo, 1, 1, 0,
+       doc: /* Returns the currently used cipher for process PROC. */)
+     (proc)
+     Lisp_Object proc;
+{
+  GNUTLS_STATE state;
+  Lisp_Object ret;
+  GNUTLS_BulkCipherAlgorithm alg;
+
+  CHECK_PROCESS (proc);
+  state = (GNUTLS_STATE) XPROCESS(proc)->gnutls_state;
+
+  alg = gnutls_cipher_get_algo(state);
+  XSETINT (ret, alg);
+
+  return ret;
+}
+
+DEFUN ("gnutls-kx-get-algo", Fgnutls_kx_get_algo, Sgnutls_kx_get_algo,
+       1, 1, 0,
+       doc: /* Returns the key exchange used in the last handshake for process 
PROC. */)
+     (proc)
+     Lisp_Object proc;
+{
+  GNUTLS_STATE state;
+  Lisp_Object ret;
+  GNUTLS_KXAlgorithm alg;
+
+  CHECK_PROCESS (proc);
+  state = (GNUTLS_STATE) XPROCESS(proc)->gnutls_state;
+
+  alg = gnutls_kx_get_algo(state);
+  XSETINT (ret, alg);
+
+  return ret;
+}
+
+DEFUN ("gnutls-mac-get-algo", Fgnutls_mac_get_algo, Sgnutls_mac_get_algo,
+       1, 1, 0,
+       doc: /* Returns the currently used MAC algorithm for process PROC. */)
+     (proc)
+     Lisp_Object proc;
+{
+  GNUTLS_STATE state;
+  Lisp_Object ret;
+  GNUTLS_MACAlgorithm alg;
+
+  CHECK_PROCESS (proc);
+  state = (GNUTLS_STATE) XPROCESS(proc)->gnutls_state;
+
+  alg = gnutls_mac_get_algo(state);
+  XSETINT (ret, alg);
+
+  return ret;
+}
+
+DEFUN ("gnutls-compression-get-algo", Fgnutls_compression_get_algo, 
+       Sgnutls_compression_get_algo, 1, 1, 0,
+       doc: /* Returns the currently used compression algorithm for process 
PROC. */)
+     (proc)
+     Lisp_Object proc;
+{
+  GNUTLS_STATE state;
+  Lisp_Object ret;
+  GNUTLS_CompressionMethod alg;
+
+  CHECK_PROCESS (proc);
+  state = (GNUTLS_STATE) XPROCESS(proc)->gnutls_state;
+
+  alg = gnutls_compression_get_algo(state);
+  XSETINT (ret, alg);
+
+  return ret;
+}
+
+DEFUN ("gnutls-protocol-get-version", Fgnutls_protocol_get_version, 
+       Sgnutls_protocol_get_version, 1, 1, 0,
+       doc: /* Returns the version of the currently used protocol for process 
PROC. */)
+     (proc)
+     Lisp_Object proc;
+{
+  GNUTLS_STATE state;
+  Lisp_Object ret;
+  GNUTLS_Version version;
+
+  CHECK_PROCESS (proc);
+  state = (GNUTLS_STATE) XPROCESS(proc)->gnutls_state;
+
+  version = gnutls_protocol_get_version(state);
+  XSETINT (ret, version);
+
+  return ret;
+}
+
+DEFUN ("gnutls-protocol-get-name", Fgnutls_protocol_get_name, 
+       Sgnutls_protocol_get_name, 1, 1, 0,
+       doc: /* Returns a string that contains the name of protocol version 
VERSION. */)
+     (version)
+     Lisp_Object version;
+{
+  Lisp_Object ret;
+  char *name;
+  GNUTLS_Version cversion;
+
+  CHECK_NUMBER (version);
+
+  cversion = XINT(version);
+  name = gnutls_cipher_get_name(cversion);
+
+  if (name)
+    ret = build_string (name);
+  else
+    ret = Qnil;
+
+  return ret;
+}
+
+DEFUN ("gnutls-cipher-get-name", Fgnutls_cipher_get_name, 
+       Sgnutls_cipher_get_name, 1, 1, 0,
+       doc: /* Returns a string that contains the name of cipher algorithm 
ALG. */)
+     (alg)
+     Lisp_Object alg;
+{
+  Lisp_Object ret;
+  char *name;
+  GNUTLS_BulkCipherAlgorithm calg;
+
+  CHECK_NUMBER (alg);
+
+  calg = XINT(alg);
+  name = gnutls_cipher_get_name(calg);
+
+  if (name)
+    ret = build_string (name);
+  else
+    ret = Qnil;
+
+  return ret;
+}
+
+DEFUN ("gnutls-mac-get-name", Fgnutls_mac_get_name, Sgnutls_mac_get_name,
+       1, 1, 0,
+       doc: /* Returns a string that contains the name of MAC algorithm ALG. 
*/)
+     (alg)
+     Lisp_Object alg;
+{
+  Lisp_Object ret;
+  char *name;
+  GNUTLS_MACAlgorithm calg;
+
+  CHECK_NUMBER (alg);
+
+  calg = XINT(alg);
+  name = gnutls_mac_get_name(calg);
+
+  if (name)
+    ret = build_string (name);
+  else
+    ret = Qnil;
+
+  return ret;
+}
+
+DEFUN ("gnutls-kx-get-name", Fgnutls_kx_get_name, 
+       Sgnutls_kx_get_name, 1, 1, 0,
+       doc: /* Returns a string that contains the name of key exchange 
algorithm ALG. */)
+     (alg)
+     Lisp_Object alg;
+{
+  Lisp_Object ret;
+  char *name;
+  GNUTLS_KXAlgorithm calg;
+
+  CHECK_NUMBER (alg);
+
+  calg = XINT(alg);
+  name = gnutls_kx_get_name(calg);
+
+  if (name)
+    ret = build_string (name);
+  else
+    ret = Qnil;
+
+  return ret;
+}
+
+DEFUN ("gnutls-compression-get-name", Fgnutls_compression_get_name, 
+       Sgnutls_compression_get_name, 1, 1, 0,
+       doc: /* Returns a string that contains the name of compression method 
ALG. */)
+     (alg)
+     Lisp_Object alg;
+{
+  Lisp_Object ret;
+  char *name;
+  GNUTLS_CompressionMethod calg;
+
+  CHECK_NUMBER (alg);
+
+  calg = XINT(alg);
+  name = gnutls_compression_get_name(calg);
+
+  if (name)
+    ret = build_string (name);
+  else
+    ret = Qnil;
+
+  return ret;
+}
+
+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_STATE state;
+  GNUTLS_X509PKI_CLIENT_CREDENTIALS x509_cred;
+  GNUTLS_ANON_CLIENT_CREDENTIALS anon_cred;
+  GNUTLS_SRP_CLIENT_CREDENTIALS srp_cred;
+  int ret;
+
+  CHECK_PROCESS (proc);
+  state = (GNUTLS_STATE) XPROCESS(proc)->gnutls_state;
+
+  x509_cred = (GNUTLS_X509PKI_CLIENT_CREDENTIALS) XPROCESS(proc)->x509_cred;
+  anon_cred = (GNUTLS_ANON_CLIENT_CREDENTIALS) XPROCESS(proc)->anon_cred;
+  srp_cred = (GNUTLS_SRP_CLIENT_CREDENTIALS) XPROCESS(proc)->srp_cred;
+
+  switch (XINT (type))
+    {
+    case GNUTLS_X509PKI: 
+      if (gnutls_x509pki_allocate_client_sc (&x509_cred, 1) < 0)
+       memory_full ();
+      ret = gnutls_cred_set (state, GNUTLS_X509PKI, x509_cred);
+      break;
+
+    case GNUTLS_ANON:
+      if (gnutls_anon_allocate_client_sc (&anon_cred) < 0)
+       memory_full ();
+      ret = gnutls_cred_set (state, GNUTLS_ANON, anon_cred);
+      break;
+
+    case GNUTLS_SRP:
+      if (gnutls_srp_allocate_client_sc (&srp_cred) < 0)
+       memory_full ();
+      ret = gnutls_cred_set (state, GNUTLS_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_STATE state;
+  int ret;
+
+  CHECK_PROCESS (proc);
+  CHECK_NUMBER (how);
+
+  state = (GNUTLS_STATE) 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_STATE state;
+  Lisp_Object lret;
+  int ret;
+
+  CHECK_PROCESS (proc);
+  state = (GNUTLS_STATE) 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_STATE state;
+  Lisp_Object lret;
+  int ret;
+
+  CHECK_PROCESS (proc);
+  state = (GNUTLS_STATE) XPROCESS(proc)->gnutls_state;
+
+  gnutls_transport_set_ptr( state, XPROCESS(proc)->infd);
+  ret = gnutls_rehandshake( state);
+  XSETINT(lret, ret);
+  
+  return lret;
+}
+#endif
+
+
 /* The first time this is called, assume keyboard input comes from DESC
    instead of from where we used to expect it.
    Subsequent calls mean assume input keyboard can come from DESC
@@ -4629,6 +5376,10 @@
     }
   bzero (proc_decode_coding_system, sizeof proc_decode_coding_system);
   bzero (proc_encode_coding_system, sizeof proc_encode_coding_system);
+
+#ifdef HAVE_GNUTLS
+  gnutls_global_init();
+#endif
 }
 
 void
@@ -4716,6 +5467,33 @@
 /*  defsubr (&Sprocess_connection); */
   defsubr (&Sset_process_coding_system);
   defsubr (&Sprocess_coding_system);
+#ifdef HAVE_GNUTLS
+  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);
+  defsubr (&Sgnutls_cipher_get_algo);
+  defsubr (&Sgnutls_kx_get_algo);
+  defsubr (&Sgnutls_mac_get_algo);
+  defsubr (&Sgnutls_compression_get_algo);
+  defsubr (&Sgnutls_protocol_get_version);
+  defsubr (&Sgnutls_protocol_get_name);
+  defsubr (&Sgnutls_cipher_get_name);
+  defsubr (&Sgnutls_mac_get_name);
+  defsubr (&Sgnutls_kx_get_name);
+  defsubr (&Sgnutls_compression_get_name);
+#endif
 }
 
 
Index: src/process.h
===================================================================
RCS file: /cvsroot/emacs/emacs/src/process.h,v
retrieving revision 1.18
diff -u -r1.18 process.h
--- src/process.h       14 Oct 2001 20:14:49 -0000      1.18
+++ src/process.h       25 Jan 2002 21:58:46 -0000
@@ -91,6 +91,13 @@
     /* Flag to set coding-system of the process buffer from the
        coding_system used to decode process output.  */
     Lisp_Object inherit_coding_system_flag;
+#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
--- /dev/null   Thu Aug 30 22:30:55 2001
+++ lisp/net/gnutls.el  Fri Jan 25 22:59:48 2002
@@ -0,0 +1,134 @@
+;;; gnutls.el --- various TLS related functionality for Emacs
+
+;; Copyright (C) 2001, 2002 Free Software Foundation, Inc.
+
+;; Author: Simon Josefsson <address@hidden>
+;; Keywords: comm
+
+;; 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 2, 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; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; See also 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")
+
+;;; Code:
+
+(defconst gnutls-version "0.3.1")
+
+(defconst gnutls-server 1)
+(defconst gnutls-client 2)
+
+(defconst gnutls-ssl3 1)
+(defconst gnutls-tls1 2)
+
+(defconst gnutls-cipher-null 1)
+(defconst gnutls-cipher-arcfour 2)
+(defconst gnutls-cipher-3des-cbc 3)
+(defconst gnutls-cipher-rijndael-cbc 4)
+(defconst gnutls-cipher-twofish-cbc 5)
+(defconst gnutls-cipher-rijndael256-cbc 6)
+
+(defconst gnutls-comp-null 1)
+(defconst gnutls-comp-zlib 2)
+
+(defconst gnutls-kx-x509pki-rsa 1)
+(defconst gnutls-kx-x509pki-dhe-dss 2)
+(defconst gnutls-kx-x509pki-dhe-rsa 3)
+(defconst gnutls-kx-anon-dh 4)
+(defconst gnutls-kx-srp 5)
+
+(defconst gnutls-mac-null 1)
+(defconst gnutls-mac-md5 2)
+(defconst gnutls-mac-sha 3)
+
+(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 starttls-negotiate (proc)
+  (if (fboundp 'gnutls-global-init)
+      (gnutls-global-init))
+  (message "err=%s" (gnutls-init proc gnutls-client))
+  (message "err=%s"  (gnutls-protocol-set-priority proc 
+                                                  gnutls-tls1 gnutls-ssl3))
+  (message "err=%s"  (gnutls-cipher-set-priority proc 
+                                                gnutls-cipher-rijndael-cbc
+                                                gnutls-cipher-3des-cbc
+                                                gnutls-cipher-arcfour))
+  (message "err=%s"  (gnutls-compression-set-priority proc 
+                                                     gnutls-comp-zlib
+                                                     gnutls-comp-null))
+  (message "err=%s"  (gnutls-kx-set-priority proc 
+                                            gnutls-kx-x509pki-rsa
+                                            gnutls-kx-x509pki-dhe-rsa
+                                            gnutls-kx-srp
+                                            gnutls-kx-anon-dh))
+  (message "err=%s"  (gnutls-mac-set-priority proc 
+                                             gnutls-mac-sha
+                                             gnutls-mac-md5))
+  (message "err=%s"  (gnutls-cred-set proc gnutls-x509pki))
+  (let ((ret gnutls-e-again))
+    (while (or (eq ret gnutls-e-again)
+              (eq ret gnutls-e-interrupted))
+      (message "err=%s" (setq ret (gnutls-handshake proc))))
+    (if (< ret 0)
+       (progn
+         (message "Ouch, error return %d" ret)
+         (setq proc nil))
+      (message "Handshake complete %d." ret)))
+  proc)
+
+(defalias 'starttls-open-stream 'open-network-stream)
+(make-obsolete 'starttls-open-stream 'open-network-stream)
+
+(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)
+    (if (setq proc (open-network-stream name buffer host service))
+       (starttls-negotiate proc))))
+
+
+(provide 'ssl)      ;; gnutls.el supersedes William M. Perry's ssl.el
+(provide 'starttls) ;; gnutls.el supersedes Daiki Ueno's starttls.el
+
+(provide 'gnutls)
+
+;;; gnutls.el ends here

reply via email to

[Prev in Thread] Current Thread [Next in Thread]