[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: GNU TLS lisp bindings
|
From: |
Simon Josefsson |
|
Subject: |
Re: GNU TLS lisp bindings |
|
Date: |
Fri, 07 Dec 2001 16:35:53 +0100 |
|
User-agent: |
Gnus/5.090004 (Oort Gnus v0.04) Emacs/21.1 (i686-pc-linux-gnu) |
Simon Josefsson <address@hidden> writes:
> I rewrote my native TLS support for Emacs using GNU TLS instead of
> Open SSL:
>
> http://josefsson.org/securemacs/
>
> Beware, the patch is very ugly but at least it allows me to read my
> mail over TLS with Gnus.
>
> Install GNU TLS, do "aclocal" and "autoconf" in the Emacs directory
> after applying the patch, build Emacs and load "gnutls.el" and you
> should have the usual `open-ssl-stream' available.
I was asked to post the patch. As you can see, this is not meant for
inclusion but rather to demonstrate that it works. I'm not requesting
that anyone invests time in working on this, I will do so if you think
this is a useful addition to Emacs.
Index: configure.in
===================================================================
RCS file: /cvsroot/emacs/emacs/configure.in,v
retrieving revision 1.280
diff -u -r1.280 configure.in
--- configure.in 2001/11/29 12:06:35 1.280
+++ configure.in 2001/12/01 23:46:32
@@ -1911,6 +1911,13 @@
fi
fi
+AM_PATH_LIBGNUTLS( 0.2.3,, 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,
@@ -2264,6 +2271,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.238
diff -u -r1.238 Makefile.in
--- src/Makefile.in 2001/11/29 00:52:02 1.238
+++ src/Makefile.in 2001/12/01 23:46:37
@@ -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. */
@@ -818,7 +827,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.165
diff -u -r1.165 config.in
--- src/config.in 2001/11/16 14:25:54 1.165
+++ src/config.in 2001/12/01 23:46:37
@@ -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.348
diff -u -r1.348 process.c
--- src/process.c 2001/11/02 20:32:44 1.348
+++ src/process.c 2001/12/01 23:46:39
@@ -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);
+
+ 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);
+
+ 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,537 @@
XPROCESS (proc)->encode_coding_system);
}
+#ifdef HAVE_GNUTLS
+
+int cert_callback( gnutls_DN *client_cert, gnutls_DN *issuer_cert, int ncerts,
gnutls_DN* req_ca_cert, int nreqs) {
+
+ if (client_cert==NULL) {
+ return 0; /* means the we will only be called again
+ * if the library cannot determine which
+ * certificate to send
+ */
+ }
+
+#if 0
+ /* here we should prompt the user and ask him
+ * which certificate to choose. Too bored to
+ * implement that. --nmav
+ */
+ for (i=0;i<ncerts;i++){
+ fprintf(stderr, "%s.", client_cert->common_name);
+ fprintf(stderr, "%s\n", issuer_cert->common_name);
+ }
+ for (i=0;i<nreqs;i++){
+ fprintf(stderr, "%s.", req_ca_cert->common_name);
+ }
+ fprintf(stderr, "\n");
+ return 0;
+#endif
+
+ return -1; /* send no certificate to the peer */
+}
+
+DEFUN ("gnutls-init", Fgnutls_init, Sgnutls_init, 2, 2, 0,
+ doc: /* gnutls_init. */)
+ (proc, connection_end)
+ Lisp_Object proc, connection_end;
+{
+ int ret;
+
+ CHECK_PROCESS (proc);
+
+ ret = gnutls_init((GNUTLS_STATE*)&(XPROCESS(proc)->gnutls_state),
+ connection_end);
+
+ {
+ X509PKI_CLIENT_CREDENTIALS xcred;
+
+#define CAFILE "x509/ca.pem"
+#define CRLFILE NULL
+#define CLIKEYFILE "x509/clikey.pem"
+#define CLICERTFILE "x509/clicert.pem"
+
+ /* X509 stuff */
+ if (gnutls_allocate_x509_client_sc( &xcred, 1) < 0) { /* space for 1
certificate */
+ fprintf(stderr, "memory error\n");
+ exit(1);
+ }
+ gnutls_set_x509_client_trust( xcred, CAFILE, CRLFILE);
+ gnutls_set_x509_client_key( xcred, CLICERTFILE, CLIKEYFILE);
+ gnutls_set_x509_cert_callback( xcred, cert_callback);
+ gnutls_set_cred( XPROCESS(proc)->gnutls_state, GNUTLS_X509PKI, xcred);
+ }
+
+ return XINT(ret);
+}
+
+DEFUN ("gnutls-deinit", Fgnutls_deinit, Sgnutls_deinit, 1, 1, 0,
+ doc: /* gnutls_deinit. */)
+ (proc)
+ Lisp_Object proc;
+{
+ int ret;
+ GNUTLS_STATE state;
+
+ CHECK_PROCESS (proc);
+ state = (GNUTLS_STATE) XPROCESS(proc)->gnutls_state;
+
+ ret = gnutls_deinit(state);
+
+ return XINT(ret);
+}
+
+DEFUN ("gnutls-global-init", Fgnutls_global_init,
+ Sgnutls_global_init, 0, 0, 0,
+ doc: /* foo. */)
+ ()
+{
+ int ret;
+
+ ret = gnutls_global_init();
+
+ return XINT(ret);
+}
+
+DEFUN ("gnutls-global-deinit", Fgnutls_global_deinit,
+ Sgnutls_global_deinit, 0, 0, 0,
+ doc: /* foo. */)
+ ()
+{
+ gnutls_global_deinit();
+
+ return Qnil;
+}
+
+DEFUN ("gnutls-set-protocol-priority", Fgnutls_set_protocol_priority,
+ Sgnutls_set_protocol_priority, 1, MANY, 0,
+ doc: /* foo. */)
+ (nargs, args)
+ int nargs;
+ Lisp_Object *args;
+{
+ Lisp_Object proc;
+ GNUTLS_STATE state;
+ int ret;
+
+ proc = args[0];
+ CHECK_PROCESS (proc);
+ state = (GNUTLS_STATE) XPROCESS(proc)->gnutls_state;
+
+ ret = gnutls_set_protocol_priority(state, XFASTINT(args[1]), 0);
+
+ return XINT(ret);
+}
+
+DEFUN ("gnutls-set-cipher-priority", Fgnutls_set_cipher_priority,
+ Sgnutls_set_cipher_priority, 1, MANY, 0,
+ doc: /* foo. */)
+ (nargs, args)
+ int nargs;
+ Lisp_Object *args;
+{
+ Lisp_Object proc;
+ GNUTLS_STATE state;
+ int ret;
+
+ proc = args[0];
+ CHECK_PROCESS (proc);
+ state = (GNUTLS_STATE) XPROCESS(proc)->gnutls_state;
+
+ ret = gnutls_set_cipher_priority(state, XFASTINT(args[1]), 0);
+
+ return XINT(ret);
+}
+
+DEFUN ("gnutls-set-compression-priority", Fgnutls_set_compression_priority,
+ Sgnutls_set_compression_priority, 1, MANY, 0,
+ doc: /* foo. */)
+ (nargs, args)
+ int nargs;
+ Lisp_Object *args;
+{
+ Lisp_Object proc;
+ GNUTLS_STATE state;
+ int ret;
+
+ proc = args[0];
+ CHECK_PROCESS (proc);
+ state = (GNUTLS_STATE) XPROCESS(proc)->gnutls_state;
+
+ ret = gnutls_set_compression_priority(state, XFASTINT(args[1]), 0);
+
+ return XINT(ret);
+}
+
+DEFUN ("gnutls-set-kx-priority", Fgnutls_set_kx_priority,
+ Sgnutls_set_kx_priority, 1, MANY, 0,
+ doc: /* foo. */)
+ (nargs, args)
+ int nargs;
+ Lisp_Object *args;
+{
+ Lisp_Object proc;
+ GNUTLS_STATE state;
+ int ret;
+
+ proc = args[0];
+ CHECK_PROCESS (proc);
+ state = (GNUTLS_STATE) XPROCESS(proc)->gnutls_state;
+
+ ret = gnutls_set_kx_priority(state, XFASTINT(args[1]), 0);
+ ret = gnutls_set_kx_priority( state, GNUTLS_KX_DHE_RSA, GNUTLS_KX_RSA,
GNUTLS_KX_DH_ANON, 0);
+
+ return XINT(ret);
+}
+
+DEFUN ("gnutls-set-mac-priority", Fgnutls_set_mac_priority,
+ Sgnutls_set_mac_priority, 1, MANY, 0,
+ doc: /* foo. */)
+ (nargs, args)
+ int nargs;
+ Lisp_Object *args;
+{
+ Lisp_Object proc;
+ GNUTLS_STATE state;
+ int ret;
+
+ proc = args[0];
+ CHECK_PROCESS (proc);
+ state = (GNUTLS_STATE) XPROCESS(proc)->gnutls_state;
+
+ ret = gnutls_set_mac_priority(state, XFASTINT(args[1]), 0);
+
+ return XINT(ret);
+}
+
+DEFUN ("gnutls-set-cred", Fgnutls_set_cred,
+ Sgnutls_set_cred, 2, 3, 0,
+ doc: /* foo. */)
+ (proc, type, cred)
+ Lisp_Object proc, type, cred;
+{
+ GNUTLS_STATE state;
+ int ret;
+
+ CHECK_PROCESS (proc);
+ if (!NILP (cred))
+ CHECK_STRING (cred);
+ state = (GNUTLS_STATE) XPROCESS(proc)->gnutls_state;
+
+ ret = gnutls_set_cred(state,
+ XFASTINT(type),
+ EQ (cred, Qnil) ? NULL : XSTRING(cred));
+
+ return XINT(ret);
+}
+
+DEFUN ("gnutls-bye", Fgnutls_bye,
+ Sgnutls_bye, 2, 2, 0,
+ doc: /* foo. */)
+ (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: /* foo. */)
+ (proc)
+ Lisp_Object proc;
+{
+ GNUTLS_STATE state;
+ int ret;
+
+ CHECK_PROCESS (proc);
+ state = (GNUTLS_STATE) XPROCESS(proc)->gnutls_state;
+
+ gnutls_set_transport_ptr( state, XPROCESS(proc)->infd);
+ do {
+ ret = gnutls_handshake( state);
+ } while (ret == GNUTLS_E_INTERRUPTED || ret == GNUTLS_E_AGAIN);
+
+ if (ret < 0) {
+ if (ret==GNUTLS_E_WARNING_ALERT_RECEIVED ||
ret==GNUTLS_E_FATAL_ALERT_RECEIVED)
+ printf("*** Received alert [%d]\n", gnutls_get_last_alert(state));
+
+ fprintf(stderr, "*** Handshake has failed\n");
+ gnutls_perror(ret);
+ return Qnil;
+ }
+
+ return XINT(ret);
+}
+
+#ifndef SHUT_WR
+# define SHUT_WR 1
+#endif
+
+#ifndef SHUT_RDWR
+# define SHUT_RDWR 2
+#endif
+
+#define SA struct sockaddr
+#define ERR(err,s) if (err==-1) {perror(s);return(1);}
+#define MAX_BUF 4096
+
+#define RESUME
+
+#define MAX(X,Y) (X >= Y ? X : Y);
+#define CAFILE "x509/ca.pem"
+#define CRLFILE NULL
+#define CLIKEYFILE "x509/clikey.pem"
+#define CLICERTFILE "x509/clicert.pem"
+
+#define PRINTX(x,y) if (y[0]!=0) printf(" - %s %s\n", x, y)
+#define PRINT_DN(X) PRINTX( "CN:", X->common_name); \
+ PRINTX( "OU:", X->organizational_unit_name); \
+ PRINTX( "O:", X->organization); \
+ PRINTX( "L:", X->locality_name); \
+ PRINTX( "S:", X->state_or_province_name); \
+ PRINTX( "C:", X->country); \
+ PRINTX( "E:", X->email); \
+ PRINTX( "SAN:", gnutls_x509pki_client_get_subject_dns_name(state))
+
+static int print_info( GNUTLS_STATE state) {
+const char *tmp;
+CredType cred;
+const gnutls_DN* dn;
+CertificateStatus status;
+
+
+ tmp = gnutls_kx_get_name(gnutls_get_current_kx( state));
+ printf("- Key Exchange: %s\n", tmp);
+
+ cred = gnutls_get_auth_type(state);
+ switch(cred) {
+ case GNUTLS_ANON:
+ printf("- Anonymous DH using prime of %d bits\n",
+ gnutls_anon_client_get_dh_bits( state));
+
+ case GNUTLS_X509PKI:
+ status =
gnutls_x509pki_client_get_peer_certificate_status( state);
+ switch( status) {
+ case GNUTLS_CERT_NOT_TRUSTED:
+ printf("- Peer's X509 Certificate was NOT
verified\n");
+ break;
+ case GNUTLS_CERT_EXPIRED:
+ printf("- Peer's X509 Certificate was verified
but is expired\n");
+ break;
+ case GNUTLS_CERT_TRUSTED:
+ printf("- Peer's X509 Certificate was
verified\n");
+ break;
+ case GNUTLS_CERT_NONE:
+ printf("- Peer did not send any X509
Certificate.\n");
+ break;
+ case GNUTLS_CERT_INVALID:
+ printf("- Peer's X509 Certificate was
invalid\n");
+ break;
+ }
+
+ if (status!=GNUTLS_CERT_NONE &&
status!=GNUTLS_CERT_INVALID) {
+ printf(" - Certificate info:\n");
+ printf(" - Certificate version: #%d\n",
gnutls_x509pki_client_get_peer_certificate_version( state));
+
+ dn = gnutls_x509pki_client_get_peer_dn( state);
+ PRINT_DN( dn);
+
+ dn = gnutls_x509pki_client_get_issuer_dn(
state);
+ printf(" - Certificate Issuer's info:\n");
+ PRINT_DN( dn);
+ }
+ }
+
+ tmp = gnutls_version_get_name(gnutls_get_current_version(state));
+ printf("- Version: %s\n", tmp);
+
+ tmp =
gnutls_compression_get_name(gnutls_get_current_compression_method( state));
+ printf("- Compression: %s\n", tmp);
+
+ tmp = gnutls_cipher_get_name(gnutls_get_current_cipher( state));
+ printf("- Cipher: %s\n", tmp);
+
+ tmp = gnutls_mac_get_name(gnutls_get_current_mac_algorithm( state));
+ printf("- MAC: %s\n", tmp);
+
+ return 0;
+}
+
+DEFUN ("gnutls-foo", Fgnutls_foo,
+ Sgnutls_foo, 1, 1, 0,
+ doc: /* foo. */)
+ (proc)
+ Lisp_Object proc;
+{
+ int err, ret;
+ int sd, ii;
+ struct sockaddr_in sa;
+ GNUTLS_STATE state;
+ char buffer[MAX_BUF+1];
+ fd_set rset;
+ int maxfd;
+ struct timeval tv;
+ int user_term = 0;
+ struct hostent* server_host;
+
+ CHECK_PROCESS (proc);
+ state = (GNUTLS_STATE) XPROCESS(proc)->gnutls_state;
+
+ /* get server name */
+ server_host = gethostbyname( "localhost");
+ if (server_host==NULL) {
+ fprintf(stderr, "Cannot resolve %s\n", "localhost");
+ exit(1);
+ }
+
+ sd = XPROCESS(proc)->infd;
+
+ memset(&sa, '\0', sizeof(sa));
+ sa.sin_family = AF_INET;
+ sa.sin_port = htons(atoi("5556"));
+
+ sa.sin_addr.s_addr = *((unsigned int*)server_host->h_addr);
+
+ inet_ntop( AF_INET, &sa.sin_addr, buffer, MAX_BUF);
+ fprintf(stderr, "Connecting to '%s'...\n", buffer);
+
+/* print some information */
+ print_info( state);
+
+ printf("- Disconnecting\n");
+ do {
+ ret = gnutls_bye( state, GNUTLS_SHUT_RDWR);
+ } while( ret==GNUTLS_E_INTERRUPTED || ret==GNUTLS_E_AGAIN);
+
+ shutdown( sd, SHUT_WR);
+ close(sd);
+ gnutls_deinit( state);
+
+ sd = socket(AF_INET, SOCK_STREAM, 0);
+ ERR(sd, "socket");
+
+ err = connect(sd, (SA *) & sa, sizeof(sa));
+ ERR(err, "connect");
+
+ /* Begin handshake again */
+ gnutls_init(&state, GNUTLS_CLIENT);
+
+ gnutls_set_protocol_priority( state, GNUTLS_TLS1, GNUTLS_SSL3, 0);
+ gnutls_set_cipher_priority( state, GNUTLS_3DES_CBC, GNUTLS_TWOFISH_CBC,
GNUTLS_RIJNDAEL_CBC, 0);
+ gnutls_set_compression_priority( state, GNUTLS_NULL_COMPRESSION, 0);
+ gnutls_set_kx_priority( state, GNUTLS_KX_DH_ANON, 0);
+
+ gnutls_set_cred( state, GNUTLS_ANON, NULL);
+
+ gnutls_ext_set_name_ind( state, GNUTLS_DNSNAME, "hello.server.org");
+
+ gnutls_set_mac_priority( state, GNUTLS_MAC_SHA, GNUTLS_MAC_MD5, 0);
+
+
+ gnutls_set_transport_ptr( state, sd);
+ do {
+ ret = gnutls_handshake( state);
+ } while( ret==GNUTLS_E_INTERRUPTED || ret==GNUTLS_E_AGAIN);
+
+ if (ret < 0) {
+ if (ret==GNUTLS_E_WARNING_ALERT_RECEIVED ||
ret==GNUTLS_E_FATAL_ALERT_RECEIVED)
+ printf("*** Received alert [%d]\n",
gnutls_get_last_alert(state));
+ fprintf(stderr, "*** Handshake failed\n");
+ gnutls_perror(ret);
+ gnutls_deinit(state);
+ return 1;
+ } else {
+ printf("- Handshake was completed\n");
+ }
+
+
+/* print some information */
+ print_info( state);
+
+ printf("\n- Simple Client Mode:\n\n");
+
+ FD_ZERO(&rset);
+ for(;;) {
+ FD_SET(fileno(stdin), &rset);
+ FD_SET(sd, &rset);
+
+ maxfd = MAX(fileno(stdin), sd);
+ tv.tv_sec = 3;
+ tv.tv_usec = 0;
+ select(maxfd+1, &rset, NULL, NULL, &tv);
+
+ if (FD_ISSET(sd, &rset)) {
+ bzero(buffer, MAX_BUF+1);
+ do {
+ ret = gnutls_read( state, buffer, MAX_BUF);
+ } while( ret==GNUTLS_E_INTERRUPTED ||
ret==GNUTLS_E_AGAIN);
+ /* remove new line */
+
+ if (gnutls_is_fatal_error(ret) == 1 || ret==0) {
+ if (ret == 0) {
+ printf("- Peer has closed the GNUTLS
connection\n");
+ break;
+ } else {
+ fprintf(stderr, "*** Received corrupted
data(%d) - server has terminated the connection abnormally\n",
+ ret);
+ break;
+ }
+ } else {
+ if (ret==GNUTLS_E_WARNING_ALERT_RECEIVED ||
ret==GNUTLS_E_FATAL_ALERT_RECEIVED)
+ printf("* Received alert [%d]\n",
gnutls_get_last_alert(state));
+ if (ret==GNUTLS_E_REHANDSHAKE) {
+ do {
+ ret = gnutls_handshake( state);
+ } while( ret==GNUTLS_E_AGAIN ||
ret==GNUTLS_E_INTERRUPTED);
+ if (ret==0) printf("* Rehandshake was
performed\n");
+ else {
+ printf("* Rehandshake Failed
[%d]\n", ret);
+ }
+ }
+ if (ret > 0) {
+ printf("- Received[%d]: ", ret);
+ for (ii=0;ii<ret;ii++) {
+ fputc(buffer[ii], stdout);
+ }
+ fputs("\n", stdout);
+ }
+ }
+ if (user_term!=0) break;
+ }
+ if (FD_ISSET(fileno(stdin), &rset)) {
+
+ if( fgets(buffer, MAX_BUF, stdin) == NULL) {
+ do {
+ ret = gnutls_bye( state,
GNUTLS_SHUT_WR);
+ } while( ret==GNUTLS_E_INTERRUPTED ||
ret==GNUTLS_E_AGAIN);
+ user_term = 1;
+ continue;
+ }
+ do {
+ ret = gnutls_write( state, buffer,
strlen(buffer));
+ } while(ret==GNUTLS_E_AGAIN ||
ret==GNUTLS_E_INTERRUPTED);
+ printf("- Sent: %d bytes\n", ret);
+
+ }
+ }
+ if (user_term!=0) do ret = gnutls_bye( state, GNUTLS_SHUT_RDWR);
+ while( ret==GNUTLS_E_INTERRUPTED || ret==GNUTLS_E_AGAIN);
+
+}
+
+#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 +5328,20 @@
/* defsubr (&Sprocess_connection); */
defsubr (&Sset_process_coding_system);
defsubr (&Sprocess_coding_system);
+
+ defsubr (&Sgnutls_global_init);
+ defsubr (&Sgnutls_global_deinit);
+ defsubr (&Sgnutls_init);
+ defsubr (&Sgnutls_deinit);
+ defsubr (&Sgnutls_set_protocol_priority);
+ defsubr (&Sgnutls_set_cipher_priority);
+ defsubr (&Sgnutls_set_compression_priority);
+ defsubr (&Sgnutls_set_kx_priority);
+ defsubr (&Sgnutls_set_mac_priority);
+ defsubr (&Sgnutls_set_cred);
+ defsubr (&Sgnutls_handshake);
+ defsubr (&Sgnutls_bye);
+ defsubr (&Sgnutls_foo);
}
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 2001/10/14 20:14:49 1.18
+++ src/process.h 2001/12/01 23:46:39
@@ -91,6 +91,10 @@
/* 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
+ /* Store GNU TLS state in a Lisp_Object. */
+ Lisp_Object gnutls_state;
+#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 Sun Dec 2 00:43:16 2001
@@ -0,0 +1,77 @@
+;; By Simon Josefsson 2001-12-01
+;; See http://josefsson.org/emacs-security/
+
+;; Simple test:
+;;
+;; (setq jas (open-ssl-stream "ssl" (current-buffer) "www.pdc.kth.se" 443))
+;; (process-send-string jas "GET /\r\n\r\n")
+
+(defconst gnutls-connection-end-server 1)
+(defconst gnutls-connection-end-client 2)
+
+(defconst gnutls-version-ssl3 1)
+(defconst gnutls-version-tls1 2)
+
+(defconst gnutls-bulkcipheralgorithm-null-cipher 1)
+(defconst gnutls-bulkcipheralgorithm-arcfour 2)
+(defconst gnutls-bulkcipheralgorithm-3des_cbc 3)
+(defconst gnutls-bulkcipheralgorithm-rijndael_cbc 4)
+(defconst gnutls-bulkcipheralgorithm-twofish_cbc 5)
+(defconst gnutls-bulkcipheralgorithm-rijndael256_cbc 6)
+
+(defconst gnutls-compressionmethod-null-compression 1)
+(defconst gnutls-compressionmethod-zlib 2)
+
+(defconst gnutls-kxalgorithm-kx-rsa 1)
+(defconst gnutls-kxalgorithm-kx-dhe-dss 2)
+(defconst gnutls-kxalgorithm-kx-dhe-rsa 3)
+(defconst gnutls-kxalgorithm-kx-dh-dss 4)
+(defconst gnutls-kxalgorithm-kx-dh-rsa 5)
+(defconst gnutls-kxalgorithm-kx-dh-anon 6)
+(defconst gnutls-kxalgorithm-kx-srp 7)
+
+(defconst gnutls-macalgorithm-null-mac 1)
+(defconst gnutls-macalgorithm-mac-md5 2)
+(defconst gnutls-macalgorithm-mac-sha 3)
+
+(defconst gnutls-credtype-x509pki 1)
+(defconst gnutls-credtype-anon 2)
+(defconst gnutls-credtype-srp 3)
+
+(defconst gnutls-shut-rdwr 0)
+(defconst gnutls-shut-wr 1)
+
+(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)))
+ (message "err=%s" (gnutls-global-init))
+ (message "err=%s" (gnutls-init proc gnutls-connection-end-client))
+ (message "err=%s" (gnutls-set-protocol-priority proc gnutls-version-tls1))
+ (message "err=%s" (gnutls-set-cipher-priority
+ proc gnutls-bulkcipheralgorithm-3des_cbc))
+ (message "err=%s" (gnutls-set-compression-priority
+ proc gnutls-compressionmethod-null-compression))
+ (message "err=%s" (gnutls-set-kx-priority
+ proc gnutls-kxalgorithm-kx-dh-anon))
+ (message "err=%s" (gnutls-set-mac-priority
+ proc gnutls-macalgorithm-mac-sha))
+ (message "err=%s" (gnutls-set-cred proc gnutls-credtype-anon))
+ (message "err=%s" (gnutls-handshake proc))
+ proc))
+
+(provide 'ssl)
+(provide 'gnutls)
+
+;;; gnutls.el ends here
- GNU TLS lisp bindings, Simon Josefsson, 2001/12/01
- Re: GNU TLS lisp bindings,
Simon Josefsson <=
- Re: GNU TLS lisp bindings, William M. Perry, 2001/12/12
- Re: GNU TLS lisp bindings, Richard Stallman, 2001/12/13
- Re: GNU TLS lisp bindings, Rajesh Vaidheeswarran, 2001/12/13
- Re: GNU TLS lisp bindings, Scott Lanning, 2001/12/13
- Re: GNU TLS lisp bindings, Simon Josefsson, 2001/12/13
- Re: GNU TLS lisp bindings, Scott Lanning, 2001/12/14
- Re: GNU TLS lisp bindings, William M. Perry, 2001/12/14
- Re: GNU TLS lisp bindings, Miles Bader, 2001/12/14
- Re: GNU TLS lisp bindings, Richard Stallman, 2001/12/15
- Re: GNU TLS lisp bindings, Stefan Monnier, 2001/12/15