[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Updated GNU TLS patch
|
From: |
Simon Josefsson |
|
Subject: |
Updated GNU TLS patch |
|
Date: |
Thu, 27 Dec 2001 05:16:58 +0100 |
|
User-agent: |
Gnus/5.090004 (Oort Gnus v0.04) Emacs/21.1 (i686-pc-linux-gnu) |
I've cleaned up the GNU TLS patch a bit. Open issues:
* Should the GNUTLS_*_CLIENT_CREDENTIAL stuff really be new Lisp data
types? Right now they overload the "process" data type, which
probably is sufficient for most uses, but it is a step away from the
GNU TLS abstraction. I'm not sure about the stuff that is added to
process.h:Lisp_Process right now.
* The X.509 PKI callback doesn't work. I'm going to propose a
modification of the GNU TLS API to make this easier to implement.
* The X.509 Certificate data manipulation API is not yet ported.
Right now I'm mostly looking for someone else to try it. Install
libgcrypt 1.1.5 and libgnutls 3.1, apply the patch below, rebuild
emacs, start it and load the attached gnutls.el and evaluate the
following:
(progn
(load "~/lisp/gnutls.el")
(setq jas (open-ssl-stream "foo" (current-buffer) "www.extundo.com" 443))
(when jas
(process-send-string jas "GET /\n")
(accept-process-output jas 5)
(gnutls-bye jas gnutls-shut-wr)
(gnutls-deinit jas)
(gnutls-global-deinit)
(delete-process jas)))
Do you get some HTML into your buffer?
The patch etc is also available from http://josefsson.org/securemacs/.
Index: configure.in
===================================================================
RCS file: /cvsroot/emacs/emacs/configure.in,v
retrieving revision 1.282
diff -u -r1.282 configure.in
--- configure.in 11 Dec 2001 06:01:52 -0000 1.282
+++ configure.in 27 Dec 2001 03:58:52 -0000
@@ -1915,6 +1915,13 @@
fi
fi
+AM_PATH_LIBGNUTLS( 0.3.1,, 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: 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 27 Dec 2001 03:58:53 -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.166
diff -u -r1.166 config.in
--- src/config.in 7 Dec 2001 05:51:51 -0000 1.166
+++ src/config.in 27 Dec 2001 03:58:53 -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.350
diff -u -r1.350 process.c
--- src/process.c 11 Dec 2001 22:19:28 -0000 1.350
+++ src/process.c 27 Dec 2001 03:58:54 -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
@@ -3414,8 +3490,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)
@@ -4544,6 +4627,521 @@
XPROCESS (proc)->encode_coding_system);
}
+#ifdef HAVE_GNUTLS
+
+int gnutls_callback (state, client_certs, ncerts, req_ca_cert, nreqs)
+ GNUTLS_STATE state;
+ const gnutls_datum *client_certs;
+ int ncerts;
+ const gnutls_datum* req_ca_cert;
+ int nreqs;
+{
+ if (client_certs == NULL) {
+ /* means the we will only be called again if the library cannot
+ * determine which certificate to send
+ */
+ return 0;
+ }
+
+ puts("In callback");
+
+ return -1; /* send no certificate to the peer */
+}
+
+DEFUN ("gnutls-init", Fgnutls_init, Sgnutls_init, 2, 2, 0,
+ doc: /* Initializes GNU TLS for process PROC for use as CONNECTION-END.
+CONNECTION-END is used to indicate if this process is as a server or
+client. Can be one of `gnutls-client' and `gnutls-server'. Currently
+only `gnutls-client' is supported.
+
+Processes must be initialized with this function before other GNU TLS
+functions are used. This function allocates resources which can only
+be deallocated by calling `gnutls-deinit'. Returns zero on success. */)
+ (proc, connection_end)
+ Lisp_Object proc, connection_end;
+{
+ int ret;
+
+ CHECK_PROCESS (proc);
+
+ ret = gnutls_init((GNUTLS_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.
+See also `gnutls-init'. */)
+ (proc)
+ Lisp_Object proc;
+{
+ int ret;
+ GNUTLS_STATE state;
+
+ CHECK_PROCESS (proc);
+ state = (GNUTLS_STATE) XPROCESS(proc)->gnutls_state;
+
+ gnutls_deinit(state);
+
+ return Qnil;
+}
+
+DEFUN ("gnutls-global-init", Fgnutls_global_init,
+ Sgnutls_global_init, 0, 0, 0,
+ doc: /* Initializes global GNU TLS state to defaults.
+Call `gnutls-global-deinit' when GNU TLS usage is no longer needed.
+Returns zero on success. */)
+ ()
+{
+ Lisp_Object lret;
+ int ret;
+
+ ret = gnutls_global_init();
+ XSETINT (lret, ret);
+
+ return lret;
+}
+
+DEFUN ("gnutls-global-deinit", Fgnutls_global_deinit,
+ Sgnutls_global_deinit, 0, 0, 0,
+ doc: /* Deinitializes global GNU TLS state.
+See also `gnutls-global-init'. */)
+ ()
+{
+ gnutls_global_deinit();
+
+ return Qnil;
+}
+
+Lisp_Object
+generic_set_priority (func, nargs, args)
+ int (*func)( GNUTLS_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-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_X509PKI_CLIENT_CREDENTIALS x509_cred;
+ Lisp_Object lret;
+ int ret;
+
+ CHECK_PROCESS (proc);
+ x509_cred = (GNUTLS_X509PKI_CLIENT_CREDENTIALS) XPROCESS(proc)->x509_cred;
+
+ XPROCESS(proc)->x509_callback = callback;
+ gnutls_x509pki_set_client_cert_callback (x509_cred, &gnutls_callback);
+
+ return Qnil;
+}
+
+DEFUN ("gnutls-x509pki-set-client-key-file",
+ Fgnutls_x509pki_set_client_key_file,
+ Sgnutls_x509pki_set_client_key_file, 3, 3, 0,
+ doc: /* Set X.509 client credentials for PROCESS
+CERTFILE is a PEM encoded file containing the certificate list (path)
+for the specified private key. KEYFILE is a PEM encoded file
+containing a private key. Returns zero on success.
+
+This function may be called more than once (in case multiple
+keys/certificates exist for the server).
+
+Currently only PKCS-1 PEM encoded RSA private keys are accepted by
+this function. */)
+ (proc, certfile, keyfile)
+ Lisp_Object proc;
+ Lisp_Object certfile;
+ Lisp_Object keyfile;
+{
+ GNUTLS_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-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
@@ -4714,6 +5312,25 @@
/* defsubr (&Sprocess_connection); */
defsubr (&Sset_process_coding_system);
defsubr (&Sprocess_coding_system);
+#ifdef HAVE_GNUTLS
+ defsubr (&Sgnutls_global_init);
+ defsubr (&Sgnutls_global_deinit);
+ defsubr (&Sgnutls_init);
+ defsubr (&Sgnutls_deinit);
+ defsubr (&Sgnutls_protocol_set_priority);
+ defsubr (&Sgnutls_cipher_set_priority);
+ defsubr (&Sgnutls_compression_set_priority);
+ defsubr (&Sgnutls_kx_set_priority);
+ defsubr (&Sgnutls_mac_set_priority);
+ defsubr (&Sgnutls_cred_set);
+ defsubr (&Sgnutls_handshake);
+ defsubr (&Sgnutls_rehandshake);
+ defsubr (&Sgnutls_x509pki_set_client_key_file);
+ defsubr (&Sgnutls_x509pki_set_client_trust_file);
+ defsubr (&Sgnutls_srp_set_client_cred);
+ defsubr (&Sgnutls_anon_set_client_cred);
+ defsubr (&Sgnutls_bye);
+#endif
}
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 27 Dec 2001 03:58:54 -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
gnutls.el
Description: application/emacs-lisp
- Updated GNU TLS patch,
Simon Josefsson <=