From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Ted Zlatanov Newsgroups: gmane.emacs.devel Subject: Re: Emacs core TLS support Date: Fri, 13 Aug 2010 12:25:27 -0500 Organization: =?utf-8?B?0KLQtdC+0LTQvtGAINCX0LvQsNGC0LDQvdC+0LI=?= @ Cienfuegos Message-ID: <878w4actmg.fsf@lifelogs.com> References: <878wc1vfh3.fsf@lifelogs.com> <87r5ptpnz2.fsf@stupidchicken.com> <871vhsvkut.fsf@lifelogs.com> <87d41csktn.fsf@lifelogs.com> <87k4v0n0m8.fsf@lifelogs.com> <87wrrvfnc4.fsf@lifelogs.com> <87r5i2d00q.fsf@lifelogs.com> <87zkwqijye.fsf@stupidchicken.com> NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: dough.gmane.org 1281720383 28425 80.91.229.12 (13 Aug 2010 17:26:23 GMT) X-Complaints-To: usenet@dough.gmane.org NNTP-Posting-Date: Fri, 13 Aug 2010 17:26:23 +0000 (UTC) To: emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Fri Aug 13 19:26:20 2010 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([199.232.76.165]) by lo.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1Ojy15-0005gf-Gm for ged-emacs-devel@m.gmane.org; Fri, 13 Aug 2010 19:26:14 +0200 Original-Received: from localhost ([127.0.0.1]:57908 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1Ojy13-0000mb-HJ for ged-emacs-devel@m.gmane.org; Fri, 13 Aug 2010 13:26:01 -0400 Original-Received: from [140.186.70.92] (port=33642 helo=eggs.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1Ojy0t-0000kx-GZ for emacs-devel@gnu.org; Fri, 13 Aug 2010 13:25:54 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.69) (envelope-from ) id 1Ojy0q-00048W-Hc for emacs-devel@gnu.org; Fri, 13 Aug 2010 13:25:51 -0400 Original-Received: from lo.gmane.org ([80.91.229.12]:35204) by eggs.gnu.org with esmtp (Exim 4.69) (envelope-from ) id 1Ojy0p-000481-RH for emacs-devel@gnu.org; Fri, 13 Aug 2010 13:25:48 -0400 Original-Received: from list by lo.gmane.org with local (Exim 4.69) (envelope-from ) id 1Ojy0n-0005Pv-Bj for emacs-devel@gnu.org; Fri, 13 Aug 2010 19:25:45 +0200 Original-Received: from 38.98.147.130 ([38.98.147.130]) by main.gmane.org with esmtp (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Fri, 13 Aug 2010 19:25:45 +0200 Original-Received: from tzz by 38.98.147.130 with local (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Fri, 13 Aug 2010 19:25:45 +0200 X-Injected-Via-Gmane: http://gmane.org/ Original-Lines: 1044 Original-X-Complaints-To: usenet@dough.gmane.org X-Gmane-NNTP-Posting-Host: 38.98.147.130 X-Face: bd.DQ~'29fIs`T_%O%C\g%6jW)yi[zuz6; d4V0`@y-~$#3P_Ng{@m+e4o<4P'#(_GJQ%TT= D}[Ep*b!\e,fBZ'j_+#"Ps?s2!4H2-Y"sx" User-Agent: Gnus/5.110011 (No Gnus v0.11) Emacs/24.0.50 (gnu/linux) Cancel-Lock: sha1:iQTs5A6UGFPNuu0pYPkHhqJQPDY= X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6 (newer, 3) X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.5 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:128626 Archived-At: --=-=-= On Fri, 13 Aug 2010 11:57:45 -0400 Chong Yidong wrote: CY> Ted Zlatanov writes: >> + do { >> + rtnval = gnutls_read( state, buf, nbyte); >> + printf("read %d bytes\n", rtnval); >> + } while( rtnval==GNUTLS_E_INTERRUPTED || rtnval==GNUTLS_E_AGAIN); CY> You should use the GNU style here. Fixed. >> +DEFUN ("gnutls-init", Fgnutls_init, Sgnutls_init, 2, 2, 0, >> + doc: /* Initializes GNU TLS for process PROC for use as CONNECTION-END. CY> This should be "Initialize" instead of "Initializes". Fixed. CY> In general, this docstring is not very informative. I have not been CY> following this patch closely; just from reading the docstring, I'm not CY> sure what gnutls-init is supposed to do. I assume that it means that, CY> once it is called, all data sent from Emacs to the process PROC, and CY> vice versa, will be encrypted using the GnuTLS library. Is that right? CY> Does `gnutls-handshake' need to be called before, or after, this? What CY> happens if you try to send data to PROC before `gnutls-handshake'? CY> These issues should be explained in the docstring. CY> More generally, why do we need to a separate `gnutls-init' call, instead CY> of making `gnutls-handshake' and other functions automatically enable CY> GnuTLS functionality for the process? Simon's code included a gnutls.el library, attached here. It shows how to use it. It's a straightforward port of the GnuTLS calls (hence the docstrings assume familiarity with that library) so you have to call them in order just like a C client would. We could try to collect that sequence (as seen in `open-ssl-stream' and `starttls-negotiate' twice, why I don't know): 1) global init (set up static structures) 2) init the client 3) set protocol, cipher, compression, kx, mac priority 4) set credentials into one C function call. gnutls-handshake is called repeatedly (while EAGAIN is returned) until either an error happens or it succeeds. You can even rehandshake(). So I think the idea is that it should be a repeatable call while the rest of the initialization is supposed to be done just once. All of that could certainly be wrapped in a single C call, but Simon did it the other way. Writing to the stream before the handshake has succeeded will return -1 for number of bytes written, but the exact process is up to GnuTLS and errno is passing the error code back to us: (from `emacs_gnutls_write') ... rtnval = gnutls_write (state, buf, nbyte); if (rtnval == -1) { if (errno == EINTR) continue; else return (bytes_written ? bytes_written : -1); } ... This won't happen unless the process' gnutls_state is set by `gnutls_init', but it could potentially happen before a successful handshake. That's a lot to put into the docstrings for all those functions. It's probably better to point people to the gnutls.el docs. >> +DEFUN ("gnutls-deinit", Fgnutls_deinit, Sgnutls_deinit, 1, 1, 0, CY> I think this should be called `gnutls-stop' or something like that; CY> "deinit" is not a proper word. Maybe rename `gnutls-init' to CY> `gnutls-start'. >> +DEFUN ("gnutls-global-init", Fgnutls_global_init, CY> This is again not very informative. Does it mean that it is equivalent CY> to calling `gnutls-init' on every process by default? >> +DEFUN ("gnutls-global-deinit", Fgnutls_global_deinit, CY> Again, "deinit" should not be used. But those are the GnuTLS names for the functions. So it's confusing if the Emacs core process.c functions map to different names in GnuTLS. Unless we abstract the process creation at the C layer (aggregating what `open-ssl-stream' does and eliminating the one-to-one function mappings), I think it's worse to rename these functions. >> +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 CY> Use the word "argument" instead of "parameter". Also, there is some CY> formatting mix-up in this and other docstrings. That's fixed and I removed the TAB characters that came from the original patch. On Fri, 13 Aug 2010 17:53:36 +0200 David Kastrup wrote: DK> int xxx(void); Thanks, applied. Also note there's some ambition in this patch to have Emacs provide server-side SSL. I don't know if that should be removed completely or considered. Ted --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=tls.patch === modified file 'configure.in' --- configure.in 2010-08-10 14:22:29 +0000 +++ configure.in 2010-08-12 22:48:32 +0000 @@ -169,6 +169,7 @@ OPTION_DEFAULT_ON([dbus],[don't compile with D-Bus support]) OPTION_DEFAULT_ON([gconf],[don't compile with GConf support]) OPTION_DEFAULT_ON([selinux],[don't compile with SELinux support]) +OPTION_DEFAULT_ON([gnutls],[don't use -lgnutls for SSL/TLS support]) ## For the times when you want to build Emacs but don't have ## a suitable makeinfo, and can live without the manuals. @@ -1983,6 +1984,13 @@ fi AC_SUBST(LIBSELINUX_LIBS) +HAVE_GNUTLS=no +if test "${with_gnutls}" = "yes" ; then + PKG_CHECK_MODULES([LIBGNUTLS], [gnutls >= 2.2.4]) + AC_DEFINE(HAVE_GNUTLS) + HAVE_GNUTLS=yes +fi + dnl Do not put whitespace before the #include statements below. dnl Older compilers (eg sunos4 cc) choke on it. HAVE_XAW3D=no @@ -3666,6 +3674,7 @@ echo " Does Emacs use -ldbus? ${HAVE_DBUS}" echo " Does Emacs use -lgconf? ${HAVE_GCONF}" echo " Does Emacs use -lselinux? ${HAVE_LIBSELINUX}" +echo " Does Emacs use Gnu TLS? ${HAVE_GNUTLS}" echo " Does Emacs use -lfreetype? ${HAVE_FREETYPE}" echo " Does Emacs use -lm17n-flt? ${HAVE_M17N_FLT}" === modified file 'src/Makefile.in' --- src/Makefile.in 2010-07-12 14:16:38 +0000 +++ src/Makefile.in 2010-08-12 22:47:22 +0000 @@ -280,6 +280,9 @@ LIBSELINUX_LIBS = @LIBSELINUX_LIBS@ +LIBGNUTLS_LIBS = @LIBGNUTLS_LIBS@ +LIBGNUTLS_CFLAGS = @LIBGNUTLS_CFLAGS@ + INTERVALS_H = dispextern.h intervals.h composite.h GETLOADAVG_LIBS = @GETLOADAVG_LIBS@ @@ -318,6 +321,7 @@ ${C_SWITCH_X_SYSTEM} ${CFLAGS_SOUND} ${RSVG_CFLAGS} ${DBUS_CFLAGS} \ ${GCONF_CFLAGS} ${FREETYPE_CFLAGS} ${FONTCONFIG_CFLAGS} \ ${LIBOTF_CFLAGS} ${M17N_FLT_CFLAGS} ${DEPFLAGS} ${PROFILING_CFLAGS} \ + $(LIBGNUTLS_CFLAGS) \ ${C_WARNINGS_SWITCH} ${CFLAGS} ALL_OBJC_CFLAGS=$(ALL_CFLAGS) $(GNU_OBJC_CFLAGS) @@ -593,6 +597,7 @@ $(RSVG_LIBS) $(DBUS_LIBS) $(LIBGPM) $(LIBRESOLV) $(LIBS_SYSTEM) \ $(LIBS_TERMCAP) $(GETLOADAVG_LIBS) ${GCONF_LIBS} ${LIBSELINUX_LIBS} \ $(FREETYPE_LIBS) $(FONTCONFIG_LIBS) $(LIBOTF_LIBS) $(M17N_FLT_LIBS) \ + $(LIBGNUTLS_LIBS) \ $(LIB_GCC) $(LIB_MATH) $(LIB_STANDARD) $(LIB_GCC) all: emacs${EXEEXT} $(OTHER_FILES) === modified file 'src/config.in' --- src/config.in 2010-08-09 19:25:41 +0000 +++ src/config.in 2010-08-12 22:24:33 +0000 @@ -255,6 +255,9 @@ /* Define to 1 if you have a gif (or ungif) library. */ #undef HAVE_GIF +/* Define if we have the GNU TLS library. */ +#undef HAVE_GNUTLS + /* Define to 1 if you have the gpm library (-lgpm). */ #undef HAVE_GPM @@ -1085,6 +1088,12 @@ #include config_opsysfile #include config_machfile +#if HAVE_GNUTLS +#define LIBGNUTLS $(LIBGNUTLS_LIBS) +#else /* not HAVE_GNUTLS */ +#define LIBGNUTLS +#endif /* not HAVE_GNUTLS */ + /* Set up some defines, C and LD flags for NeXTstep interface on GNUstep. (There is probably a better place to do this, but right now the Cocoa side does this in s/darwin.h and we cannot === modified file 'src/process.c' --- src/process.c 2010-08-09 09:35:21 +0000 +++ src/process.c 2010-08-13 17:15:11 +0000 @@ -111,6 +111,10 @@ #include "syssignal.h" #include "syswait.h" +#ifdef HAVE_GNUTLS +#include +#endif + #if defined (USE_GTK) || defined (HAVE_GCONF) #include "xgselect.h" #endif /* defined (USE_GTK) || defined (HAVE_GCONF) */ @@ -1538,6 +1542,10 @@ XPROCESS (proc)->filter = Qnil; XPROCESS (proc)->command = Flist (nargs - 2, args + 2); +#ifdef HAVE_GNUTLS + XPROCESS (proc)->gnutls_state = Qnil; +#endif + #ifdef ADAPTIVE_READ_BUFFERING XPROCESS (proc)->adaptive_read_buffering = (NILP (Vprocess_adaptive_read_buffering) ? 0 @@ -5069,6 +5077,61 @@ return Qt; } +#ifdef HAVE_GNUTLS + +int +emacs_gnutls_write (int fildes, gnutls_session_t state, char *buf, + unsigned int nbyte) +{ + register int rtnval, bytes_written; + + puts("emacs_gnutls_write"); + + bytes_written = 0; + + while (nbyte > 0) + { + rtnval = gnutls_write (state, buf, nbyte); + + if (rtnval == -1) + { + if (errno == EINTR) + continue; + else + return (bytes_written ? bytes_written : -1); + } + + buf += rtnval; + nbyte -= rtnval; + bytes_written += rtnval; + } + printf("wrote %d bytes\n", bytes_written); + fsync(STDOUT_FILENO); + + return (bytes_written); +} + +int +emacs_gnutls_read (int fildes, gnutls_session_t state, char *buf, + unsigned int nbyte) +{ + register int rtnval; + + puts("emacs_gnutls_read"); + + do + { + rtnval = gnutls_read( state, buf, nbyte); + printf("read %d bytes\n", rtnval); + } + while( rtnval==GNUTLS_E_INTERRUPTED || rtnval==GNUTLS_E_AGAIN); + printf("read %d bytes\n", rtnval); + fsync(STDOUT_FILENO); + + return (rtnval); +} +#endif + /* Read pending output from the process channel, starting with our buffered-ahead character if we have one. Yield number of decoded characters read. @@ -5111,7 +5174,12 @@ #endif if (proc_buffered_char[channel] < 0) { - nbytes = emacs_read (channel, chars + carryover, readmax); +#ifdef HAVE_GNUTLS + if (NETCONN_P(proc) && !NILP (XPROCESS(proc)->gnutls_state)) + nbytes = emacs_gnutls_read (channel, XPROCESS(proc)->gnutls_state, chars + carryover, readmax); + else +#endif + nbytes = emacs_read (channel, chars + carryover, readmax); #ifdef ADAPTIVE_READ_BUFFERING if (nbytes > 0 && p->adaptive_read_buffering) { @@ -5144,7 +5212,12 @@ { chars[carryover] = proc_buffered_char[channel]; proc_buffered_char[channel] = -1; - nbytes = emacs_read (channel, chars + carryover + 1, readmax - 1); +#ifdef HAVE_GNUTLS + if (NETCONN_P(proc) && !NILP (XPROCESS(proc)->gnutls_state)) + nbytes = emacs_gnutls_read (channel, XPROCESS(proc)->gnutls_state, chars + carryover + 1, readmax - 1); + else +#endif + nbytes = emacs_read (channel, chars + carryover + 1, readmax - 1); if (nbytes < 0) nbytes = 1; else @@ -5554,7 +5627,14 @@ else #endif { - rv = emacs_write (outfd, (char *) buf, this); +#ifdef HAVE_GNUTLS + if (NETCONN_P(proc) && !NILP (XPROCESS(proc)->gnutls_state)) + rv = emacs_gnutls_write (outfd, + XPROCESS(proc)->gnutls_state, + (char *) buf, this); + else +#endif + rv = emacs_write (outfd, (char *) buf, this); #ifdef ADAPTIVE_READ_BUFFERING if (p->read_output_delay > 0 && p->adaptive_read_buffering == 1) @@ -6788,6 +6868,490 @@ +#ifdef HAVE_GNUTLS + +int gnutls_callback (gnutls_session_t state, const gnutls_datum *client_certs, + int ncerts, const gnutls_datum* req_ca_cert, int nreqs) +{ + if (client_certs == NULL) { + /* means the we will only be called again if the library cannot + * determine which certificate to send + */ + return 0; + } + + puts("In callback"); + + return -1; /* send no certificate to the peer */ +} + +DEFUN ("gnutls-init", Fgnutls_init, Sgnutls_init, 2, 2, 0, + doc: /* Initialize GNU TLS for process PROC for use as CONNECTION-END. +CONNECTION-END is used to indicate if this process is as a server or +client. Can be one of `gnutls-client' and `gnutls-server'. Currently +only `gnutls-client' is supported. + +Processes must be initialized with this function before other GNU TLS +functions are used. This function allocates resources which can only +be deallocated by calling `gnutls-deinit'. Returns zero on success. */) + ( Lisp_Object proc, Lisp_Object connection_end) +{ + int ret; + + CHECK_PROCESS (proc); + + ret = gnutls_init((gnutls_session_t*)&(XPROCESS(proc)->gnutls_state), + connection_end); + + return XINT(ret); +} + +DEFUN ("gnutls-deinit", Fgnutls_deinit, Sgnutls_deinit, 1, 1, 0, + doc: /* Deallocate GNU TLS resources associated with PROCESS. +See also `gnutls-init'. */) + (Lisp_Object proc) +{ + int ret; + gnutls_session_t state; + + CHECK_PROCESS (proc); + state = (gnutls_session_t) XPROCESS(proc)->gnutls_state; + + gnutls_deinit(state); + + return Qnil; +} + +DEFUN ("gnutls-global-init", Fgnutls_global_init, + Sgnutls_global_init, 0, 0, 0, + doc: /* Initializes global GNU TLS state to defaults. +Call `gnutls-global-deinit' when GNU TLS usage is no longer needed. +Returns zero on success. */) + (void) +{ + Lisp_Object lret; + int ret; + + ret = gnutls_global_init(); + XSETINT (lret, ret); + + return lret; +} + +DEFUN ("gnutls-global-deinit", Fgnutls_global_deinit, + Sgnutls_global_deinit, 0, 0, 0, + doc: /* Deinitializes global GNU TLS state. +See also `gnutls-global-init'. */) + (void) +{ + gnutls_global_deinit(); + + return Qnil; +} + +Lisp_Object +generic_set_priority (int (*func)( gnutls_session_t state, const int*), + int nargs, Lisp_Object *args) +{ + Lisp_Object proc; + Lisp_Object lret; + gnutls_session_t state; + int *algs; + size_t len; + int ret; + int i; + + proc = args[0]; + CHECK_PROCESS (proc); + state = (gnutls_session_t) 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 argument must be a process. Subsequent arguments 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. */) + (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 argument must be a process. Subsequent arguments 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. */) + (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 argument must be a process. Subsequent arguments 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. */) + (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 argument must be a process. Subsequent arguments 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. */) + (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 argument must be a process. Subsequent arguments 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. */) + (int nargs, Lisp_Object *args) +{ + Lisp_Object ret; + + ret = generic_set_priority (&gnutls_mac_set_priority, nargs, args); + + return ret; +} + +/* BROKEN: can't figure out how to use this */ +// DEFUN ("gnutls-x509pki-set-client-cert-callback", +// Fgnutls_x509pki_set_client_cert_callback, +// Sgnutls_x509pki_set_client_cert_callback, 2, 2, 0, +// doc: /* XXX Not completely implemented yet. */) +// (proc, callback) +// Lisp_Object proc, callback; +// { +// gnutls_certificate_credentials_t x509_cred; +// Lisp_Object lret; +// int ret; + +// CHECK_PROCESS (proc); +// x509_cred = (gnutls_certificate_credentials_t) XPROCESS(proc)->x509_cred; + +// XPROCESS(proc)->x509_callback = callback; +// gnutls_x509pki_set_client_cert_callback (x509_cred, &gnutls_callback); + +// return Qnil; +// } + +DEFUN ("gnutls-x509pki-set-client-key-file", + Fgnutls_x509pki_set_client_key_file, + Sgnutls_x509pki_set_client_key_file, 3, 3, 0, + doc: /* Set X.509 client credentials for PROCESS +CERTFILE is a PEM encoded file containing the certificate list (path) +for the specified private key. KEYFILE is a PEM encoded file +containing a private key. Returns zero on success. + +This function may be called more than once (in case multiple +keys/certificates exist for the server). + +Currently only PKCS-1 PEM encoded RSA private keys are accepted by +this function. */) + (Lisp_Object proc, Lisp_Object certfile, Lisp_Object keyfile) +{ + gnutls_session_t state; + gnutls_certificate_credentials_t x509_cred; + Lisp_Object lret; + int ret; + + CHECK_STRING(certfile); + CHECK_STRING(keyfile); + + CHECK_PROCESS (proc); + state = (gnutls_session_t) XPROCESS(proc)->gnutls_state; + + x509_cred = (gnutls_certificate_credentials_t) XPROCESS(proc)->x509_cred; + + ret = gnutls_x509pki_set_client_key_file (x509_cred, + XSTRING (certfile)->data, + XSTRING (keyfile)->data); + + XSETINT (lret, ret); + return lret; +} + +DEFUN ("gnutls-x509pki-set-client-trust-file", + Fgnutls_x509pki_set_client_trust_file, + Sgnutls_x509pki_set_client_trust_file, 3, 3, 0, + doc: /* Set X.509 trusted credentials for PROCESS +CAFILE is a PEM encoded file containing trusted CAs. CRLFILE is a PEM +encoded file containing CRLs (ignored for now). Returns zero on +success. */) + (Lisp_Object proc, Lisp_Object cafile, Lisp_Object crlfile) +{ + gnutls_session_t state; + gnutls_certificate_credentials_t x509_cred; + Lisp_Object lret; + int ret; + + CHECK_STRING(cafile); + CHECK_STRING(crlfile); + + CHECK_PROCESS (proc); + state = (gnutls_session_t) XPROCESS(proc)->gnutls_state; + + x509_cred = (gnutls_certificate_credentials_t) XPROCESS(proc)->x509_cred; + + ret = gnutls_x509pki_set_client_trust_file (x509_cred, + NILP (cafile) ? NULL : + XSTRING (cafile)->data, + NILP (crlfile) ? NULL : + XSTRING (crlfile)->data); + + XSETINT (lret, ret); + return lret; +} + +DEFUN ("gnutls-srp-set-client-cred", Fgnutls_srp_set_client_cred, + Sgnutls_srp_set_client_cred, 3, 3, 0, + doc: /* Set SRP username and password for PROCESS. +PROCESS must be a process. USERNAME is the user's userid. PASSWORD is +the user's password. Returns zero on success. */) + (Lisp_Object proc, Lisp_Object username, Lisp_Object password) +{ + gnutls_session_t state; + gnutls_srp_client_credentials_t srp_cred; + Lisp_Object lret; + int ret; + + CHECK_PROCESS (proc); + state = (gnutls_session_t) XPROCESS(proc)->gnutls_state; + + srp_cred = (gnutls_srp_client_credentials_t) XPROCESS(proc)->srp_cred; + + ret = gnutls_srp_set_client_credentials (srp_cred, + NILP (username) ? NULL : + XSTRING(username)->data, + NILP (password) ? NULL : + XSTRING(password)->data); + + XSETINT (lret, ret); + return lret; +} + +DEFUN ("gnutls-anon-set-client-cred", Fgnutls_anon_set_client_cred, + Sgnutls_anon_set_client_cred, 2, 2, 0, + doc: /* Set the number of bits to use in anonymous Diffie-Hellman exchange for PROCESS. +DH_BITS is the number of bits in DH key exchange. Returns zero on +success. */) + (Lisp_Object proc, Lisp_Object dh_bits) +{ + gnutls_session_t state; + gnutls_anon_client_credentials_t anon_cred; + Lisp_Object lret; + int ret; + + CHECK_PROCESS (proc); + state = (gnutls_session_t) XPROCESS(proc)->gnutls_state; + + anon_cred = (gnutls_anon_client_credentials_t) XPROCESS(proc)->anon_cred; + + ret = gnutls_anon_set_client_dh_params (anon_cred, XINT(dh_bits)); + + XSETINT (lret, ret); + return lret; +} + +DEFUN ("gnutls-cred-set", Fgnutls_cred_set, + Sgnutls_cred_set, 2, 2, 0, + doc: /* Enables GNU TLS authentication for PROCESS. +TYPE is an integer indicating the type of the credentials, either +`gnutls-anon', `gnutls-srp' or `gnutls-x509pki'. + +Each authentication type may need additional information in order to +work. For anonymous (`gnutls-anon'), see also +`gnutls-anon-set-client-cred'. For SRP (`gnutls-srp'), see also +`gnutls-srp-set-client-cred'. For X.509 PKI (`gnutls-x509pki'), see +also `gnutls-x509pki-set-client-trust-file', +`gnutls-x509pki-set-client-key-file', and +`gnutls-x509pki-set-cert-callback'. */) + (Lisp_Object proc, Lisp_Object type) +{ + gnutls_session_t state; + gnutls_certificate_credentials_t x509_cred; + gnutls_anon_client_credentials_t anon_cred; + gnutls_srp_client_credentials_t srp_cred; + int ret; + + CHECK_PROCESS (proc); + state = (gnutls_session_t) XPROCESS(proc)->gnutls_state; + + x509_cred = (gnutls_certificate_client_credentials) XPROCESS(proc)->x509_cred; + anon_cred = (gnutls_anon_client_credentials_t) XPROCESS(proc)->anon_cred; + srp_cred = (gnutls_srp_client_credentials_t) XPROCESS(proc)->srp_cred; + + switch (XINT (type)) + { + case GNUTLS_CRD_CERTIFICATE: + if (gnutls_crd_allocate_client_credentials (&x509_cred, 1) < 0) + memory_full (); + ret = gnutls_cred_set (state, GNUTLS_CRD_CERTIFICATE, x509_cred); + break; + + case GNUTLS_CRD_ANON: + if (gnutls_anon_allocate_client_credentials (&anon_cred) < 0) + memory_full (); + ret = gnutls_cred_set (state, GNUTLS_CRD_ANON, anon_cred); + break; + + case GNUTLS_CRD_SRP: + if (gnutls_srp_allocate_client_credentials (&srp_cred) < 0) + memory_full (); + ret = gnutls_cred_set (state, GNUTLS_CRD_SRP, srp_cred); + break; + } + + return XINT(ret); +} + +DEFUN ("gnutls-bye", Fgnutls_bye, + Sgnutls_bye, 2, 2, 0, + doc: /* Terminate current GNU TLS connection for PROCESS. +The connection should have been initiated using gnutls_handshake(). +HOW should be one of `gnutls-shut-rdwr', `gnutls-shut-wr'. + +In case of `gnutls-shut-rdwr' then the TLS connection gets terminated +and further receives and sends will be disallowed. If the return value +is zero you may continue using the connection. `gnutls-shut-rdwr' +actually sends an alert containing a close request and waits for the +peer to reply with the same message. + +In case of `gnutls-shut-wr' then the TLS connection gets terminated +and further sends will be disallowed. In order to reuse the connection +you should wait for an EOF from the peer. `gnutls-shut-wr' sends an +alert containing a close request. + +This function may also return `gnutls-e-again', or +`gnutls-e-interrupted'. */) + (Lisp_Object proc, Lisp_Object how) +{ + gnutls_session_t state; + int ret; + + CHECK_PROCESS (proc); + CHECK_NUMBER (how); + + state = (gnutls_session_t) XPROCESS(proc)->gnutls_state; + + ret = gnutls_bye(state, XFASTINT(how)); + + return XINT(ret); +} + +DEFUN ("gnutls-handshake", Fgnutls_handshake, + Sgnutls_handshake, 1, 1, 0, + doc: /* Perform GNU TLS handshake for PROCESS. +The identity of the peer is checked automatically. This function will +fail if any problem is encountered, and will return a negative error +code. In case of a client, if it has been asked to resume a session, +but the server didn't, then a full handshake will be performed. + +This function may also return the non-fatal errors `gnutls-e-again', +or `gnutls-e-interrupted'. In that case you may resume the handshake +(by calling this function again). */) + (Lisp_Object proc) +{ + gnutls_session_t state; + Lisp_Object lret; + int ret; + + CHECK_PROCESS (proc); + state = (gnutls_session_t) XPROCESS(proc)->gnutls_state; + + gnutls_transport_set_ptr( state, XPROCESS(proc)->infd); + ret = gnutls_handshake( state); + XSETINT(lret, ret); + + return lret; +} + +DEFUN ("gnutls-rehandshake", Fgnutls_rehandshake, + Sgnutls_rehandshake, 1, 1, 0, + doc: /* Renegotiate GNU TLS security parameters for PROCESS. +This function will renegotiate security parameters with the +client. This should only be called in case of a server. + +This message informs the peer that we want to renegotiate parameters +\(perform a handshake). + +If this function succeeds (returns 0), you must call the +gnutls_handshake() function in order to negotiate the new parameters. + +If the client does not wish to renegotiate parameters he will reply +with an alert message, thus the return code will be +`gnutls-e-warning-alert-received' and the alert will be +`gnutls-e-no-renegotiation'. */) + (Lisp_Object proc) +{ + gnutls_session_t state; + Lisp_Object lret; + int ret; + + CHECK_PROCESS (proc); + state = (gnutls_session_t) XPROCESS(proc)->gnutls_state; + + gnutls_transport_set_ptr( state, XPROCESS(proc)->infd); + ret = gnutls_rehandshake( state); + XSETINT(lret, ret); + + return lret; +} +#endif + + + static int add_gpm_wait_descriptor_called_flag; void @@ -7708,6 +8272,25 @@ defsubr (&Sprocess_coding_system); defsubr (&Sset_process_filter_multibyte); defsubr (&Sprocess_filter_multibyte_p); +#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 /* HAVE_GNUTLS */ #endif /* subprocesses */ === modified file 'src/process.h' --- src/process.h 2010-08-11 12:34:46 +0000 +++ src/process.h 2010-08-12 22:35:18 +0000 @@ -121,6 +121,14 @@ needs to be synced to `status'. */ unsigned int raw_status_new : 1; int raw_status; + +#ifdef HAVE_GNUTLS + /* XXX Store GNU TLS state and auth mechanisms in Lisp_Objects. */ + Lisp_Object gnutls_state; + Lisp_Object x509_cred, x509_callback; + Lisp_Object anon_cred; + Lisp_Object srp_cred; +#endif }; /* Every field in the preceding structure except for the first two --=-=-= Content-Type: application/emacs-lisp Content-Disposition: attachment; filename=gnutls.el Content-Transfer-Encoding: quoted-printable ;; By Simon Josefsson 2001-12-01 ;; See http://josefsson.org/emacs-security/ ;; Simple test: ;; ;; (setq jas (open-ssl-stream "ssl" (current-buffer) "www.pdc.kth.se" 443)) ;; (process-send-string jas "GET /\r\n\r\n") (defconst gnutls-version "0.3.1") (defconst gnutls-server 1) (defconst gnutls-client 2) (defconst gnutls-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 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=3D%s" (gnutls-global-init)) (message "err=3D%s" (gnutls-init proc gnutls-client)) (message "err=3D%s" (gnutls-protocol-set-priority proc=20 gnutls-tls1 gnutls-ssl3)) (message "err=3D%s" (gnutls-cipher-set-priority proc=20 gnutls-cipher-rijndael-cbc gnutls-cipher-3des-cbc gnutls-cipher-arcfour)) (message "err=3D%s" (gnutls-compression-set-priority proc=20 gnutls-comp-zlib gnutls-comp-null)) (message "err=3D%s" (gnutls-kx-set-priority proc=20 gnutls-kx-x509pki-rsa gnutls-kx-x509pki-dhe-rsa gnutls-kx-srp gnutls-kx-anon-dh)) (message "err=3D%s" (gnutls-mac-set-priority proc=20 gnutls-mac-sha gnutls-mac-md5)) (message "err=3D%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=3D%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)) (defvar starttls-host nil) (defun starttls-negotiate (proc) (message "err=3D%s" (gnutls-global-init)) (message "err=3D%s" (gnutls-init proc gnutls-client)) (message "err=3D%s" (gnutls-protocol-set-priority proc=20 gnutls-tls1 gnutls-ssl3)) (message "err=3D%s" (gnutls-cipher-set-priority proc=20 gnutls-cipher-rijndael-cbc gnutls-cipher-3des-cbc gnutls-cipher-arcfour)) (message "err=3D%s" (gnutls-compression-set-priority proc=20 gnutls-comp-zlib gnutls-comp-null)) (message "err=3D%s" (gnutls-kx-set-priority proc=20 gnutls-kx-x509pki-rsa gnutls-kx-x509pki-dhe-rsa gnutls-kx-srp gnutls-kx-anon-dh)) (message "err=3D%s" (gnutls-mac-set-priority proc=20 gnutls-mac-sha gnutls-mac-md5)) (message "err=3D%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=3D%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) (defun starttls-open-stream (name buffer host service) "Open a TLS connection for a service to a host. Returns a subprocess-object to represent the connection. Input and output work as for subprocesses; `delete-process' closes it. Args are NAME BUFFER HOST SERVICE. NAME is name for process. It is modified if necessary to make it unique. BUFFER is the buffer (or `buffer-name') to associate with the process. Process output goes at end of that buffer, unless you specify an output stream or filter function to handle the output. BUFFER may be also nil, meaning that this process is not associated with any buffer Third arg is name of the host to connect to, or its IP address. Fourth arg SERVICE is name of the service desired, or an integer specifying a port number to connect to." (prog1 (open-network-stream name buffer host service) (set (make-variable-buffer-local 'starttls-host) host))) (provide 'ssl) (provide 'gnutls) (provide 'starttls) ;;; gnutls.el ends here --=-=-=--