From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Ted Zlatanov Newsgroups: gmane.comp.encryption.gpg.gnutls.devel,gmane.emacs.devel Subject: Re: Emacs core TLS support Date: Mon, 06 Sep 2010 18:13:08 -0500 Organization: =?utf-8?B?0KLQtdC+0LTQvtGAINCX0LvQsNGC0LDQvdC+0LI=?= @ Cienfuegos Message-ID: <87fwxmihyz.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> <878w4actmg.fsf@lifelogs.com> <877hju123h.fsf@stupidchicken.com> <8762yklrdk.fsf@lifelogs.com> <87wrqzhrjv.fsf@lifelogs.com> NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: dough.gmane.org 1283814815 3347 80.91.229.12 (6 Sep 2010 23:13:35 GMT) X-Complaints-To: usenet@dough.gmane.org NNTP-Posting-Date: Mon, 6 Sep 2010 23:13:35 +0000 (UTC) Cc: emacs-devel@gnu.org To: gnutls-devel@gnu.org Original-X-From: gnutls-devel-bounces+pgp-gnutls-dev=m.gmane.org@gnu.org Tue Sep 07 01:13:33 2010 Return-path: Envelope-to: pgp-gnutls-dev@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 1OsksW-0000G8-Aj for pgp-gnutls-dev@m.gmane.org; Tue, 07 Sep 2010 01:13:33 +0200 Original-Received: from localhost ([127.0.0.1]:51542 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1OsksV-0007Ay-FB for pgp-gnutls-dev@m.gmane.org; Mon, 06 Sep 2010 19:13:31 -0400 Original-Received: from [140.186.70.92] (port=58616 helo=eggs.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1OsksQ-0007At-Mg for gnutls-devel@gnu.org; Mon, 06 Sep 2010 19:13:29 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.69) (envelope-from ) id 1OsksN-0004rv-SX for gnutls-devel@gnu.org; Mon, 06 Sep 2010 19:13:26 -0400 Original-Received: from lo.gmane.org ([80.91.229.12]:45563) by eggs.gnu.org with esmtp (Exim 4.69) (envelope-from ) id 1OsksN-0004rq-8I for gnutls-devel@gnu.org; Mon, 06 Sep 2010 19:13:23 -0400 Original-Received: from list by lo.gmane.org with local (Exim 4.69) (envelope-from ) id 1OsksJ-000098-IU for gnutls-devel@gnu.org; Tue, 07 Sep 2010 01:13:19 +0200 Original-Received: from c-24-14-16-248.hsd1.il.comcast.net ([24.14.16.248]) by main.gmane.org with esmtp (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Tue, 07 Sep 2010 01:13:19 +0200 Original-Received: from tzz by c-24-14-16-248.hsd1.il.comcast.net with local (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Tue, 07 Sep 2010 01:13:19 +0200 X-Injected-Via-Gmane: http://gmane.org/ Original-Lines: 921 Original-X-Complaints-To: usenet@dough.gmane.org X-Gmane-NNTP-Posting-Host: c-24-14-16-248.hsd1.il.comcast.net 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:K2BahU4yshl/8UkL3LMN2cFHfeM= X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6 (newer, 3) X-BeenThere: gnutls-devel@gnu.org X-Mailman-Version: 2.1.5 Precedence: list List-Id: GnuTLS development discussions List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Original-Sender: gnutls-devel-bounces+pgp-gnutls-dev=m.gmane.org@gnu.org Errors-To: gnutls-devel-bounces+pgp-gnutls-dev=m.gmane.org@gnu.org Xref: news.gmane.org gmane.comp.encryption.gpg.gnutls.devel:4482 gmane.emacs.devel:129732 Archived-At: --=-=-= Content-Type: text/plain On Mon, 06 Sep 2010 23:00:51 +0200 Stefan Monnier wrote: >> In this case I think that's the right approach actually so we >> shouldn't have defconsts. See new definition, it uses two local >> Lisp_Objects for the symbol names. Where should I allocate those >> constant Lisp_Objects globally properly? SM> It's typically declared as global (static or not, depending on whether SM> it's used in other files) and initialized in syms_of_. SM> Look at other syms_of_ to see what it looks like. Done, thanks. >> And should I default to anonymous? SM> I don't know what that means. If the user passes an unknown symbol to `gnutls-cred-set', should it be treated as `gnutls_anon' or generate an error? It could work either way. I'm leaning towards an error but it seems kind of rude to the user. OTOH it could be a serious problem to use encryption the user did not intend because of a typo. SM> the slots you add at the end are ignored by the GC (which is what SM> you want in your case, since they're not Lisp objects and hence the SM> GC wouldn't know what to do with them) and can be of any type. So SM> just use the types you need here such that casts aren't needed. OK. I introduced a new field `gnutls_state_usable' to indicate the session has been initialized. I could have made it a byte but it may be useful to hold Lisp-related state for this patch as it evolves. It's before the GC marker field "pid" so it will be noticed by alloc.c. SM> BTW, if it makes the code simpler, you can use the following trick: use SM> symbols, but associate an integer to each symbol by way of SM> symbol properties. I don't like the properties because they are loosely bound to the symbol (for errors I think it's better to bind meaning to value tightly). Is it OK to do the current approach, where I have the function `gnutls_make_error' to return the right thing, whether it's a known integer-as-symbol or a generic integer? I think it's the right approach and it seems semantically sensible. Plus it's easy to extend `gnutls_make_error' as we need more errors by name. SM> The type you declare should correspond to the type of the objects you SM> store there. Always. If you stick to this principle and avoid freeing SM> live objects (and stay within array bounds, and a few more such things) SM> your code will be more portable and won't dump core (hence will be SM> generally easier to debug). Got it. I think I'm doing it more correctly now and there will be no GC issues, as I mentioned above. On Mon, 06 Sep 2010 19:18:01 +0200 Andreas Schwab wrote: AS> Ted Zlatanov writes: >> +HAVE_GNUTLS=no >> +if test "${with_gnutls}" = "yes" ; then >> + PKG_CHECK_MODULES([LIBGNUTLS], [gnutls >= 2.2.4]) AS> Are you sure you want to make gnutls a required dependency of Emacs? >> + AC_DEFINE(HAVE_GNUTLS) AS> $ autoreconf AS> autoheader: warning: missing template: HAVE_GNUTLS AS> autoheader: Use AC_DEFINE([HAVE_GNUTLS], [], [Description]) AS> autoreconf: /usr/bin/autoheader failed with exit status: 1 No. What would you suggest? On Mon, 06 Sep 2010 17:53:46 +0200 Andreas Schwab wrote: AS> Ted Zlatanov writes: >>>> +DEFUN ("gnutls-init", Fgnutls_init, Sgnutls_init, 2, 2, 0, >> ... >>>> + ret = gnutls_init((gnutls_session_t*)&(XPROCESS(proc)->gnutls_state), >> AS> Aliasing violation. >> >> Can you explain please? AS> The function wants to store a value of one type into an object of a AS> different type. BAD. The compiler is allowed to assume the object was AS> never changed. OK, you mean the cast is wrong. I fixed that. That leaves only the transport cast from int in gnutls_{handshake,rehandshake} which I believe is right from the original patch. AS> IMHO all your functions should return t on success and either some error AS> symbol on failure or even raise an error. >> >> Yes, but I'm not sure which one. Can you recommend? AS> Take your pick. I don't know anything about gnutls. Well, none of the failures are fatal and there's a lot of ways to retry the connection. I think it's better to return the integer error value or t to simplify the usage. I changed the patch accordingly. >>>> === modified file 'src/process.h' >>>> + >>>> +#ifdef HAVE_GNUTLS >>>> + /* XXX Store GNU TLS state and auth mechanisms in Lisp_Objects. */ >>>> + Lisp_Object gnutls_state; >>>> + Lisp_Object x509_cred, x509_callback; >>>> + Lisp_Object anon_cred; >>>> + Lisp_Object srp_cred; >>>> +#endif >> AS> None of them should be Lisp_Objects. Also make sure the resources are AS> properly released when the process object is deleted. >> >> I don't know enough (the choice of using Lisp_Objects was in the >> original patch) to know what to do instead of using Lisp_Objects. Why >> not, first of all? AS> You never store Lisp_Object values in there, so what's the point? AS> x509_callback is never used, btw. Fixed (also see my response above to Stefan Monnier). I've attached the patch as it stands. Thanks again for all your comments. Getting there... Ted --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=tls.patch === modified file 'configure.in' --- configure.in 2010-08-23 12:54:09 +0000 +++ configure.in 2010-09-06 23:12:37 +0000 @@ -170,6 +170,7 @@ OPTION_DEFAULT_ON([dbus],[don't compile with D-Bus support]) OPTION_DEFAULT_ON([gconf],[don't compile with GConf support]) OPTION_DEFAULT_ON([selinux],[don't compile with SELinux support]) +OPTION_DEFAULT_ON([gnutls],[don't use -lgnutls for SSL/TLS support]) ## For the times when you want to build Emacs but don't have ## a suitable makeinfo, and can live without the manuals. @@ -1998,6 +1999,13 @@ fi AC_SUBST(LIBSELINUX_LIBS) +HAVE_GNUTLS=no +if test "${with_gnutls}" = "yes" ; then + PKG_CHECK_MODULES([LIBGNUTLS], [gnutls >= 2.2.4]) + AC_DEFINE(HAVE_GNUTLS) + HAVE_GNUTLS=yes +fi + dnl Do not put whitespace before the #include statements below. dnl Older compilers (eg sunos4 cc) choke on it. HAVE_XAW3D=no @@ -3682,6 +3690,7 @@ echo " Does Emacs use -ldbus? ${HAVE_DBUS}" echo " Does Emacs use -lgconf? ${HAVE_GCONF}" echo " Does Emacs use -lselinux? ${HAVE_LIBSELINUX}" +echo " Does Emacs use -lgnutls? ${HAVE_GNUTLS}" echo " Does Emacs use -lfreetype? ${HAVE_FREETYPE}" echo " Does Emacs use -lm17n-flt? ${HAVE_M17N_FLT}" === added file 'lisp/net/gnutls.el' --- lisp/net/gnutls.el 1970-01-01 00:00:00 +0000 +++ lisp/net/gnutls.el 2010-09-06 23:12:37 +0000 @@ -0,0 +1,131 @@ +;;; gnutls.el --- Support SSL and TLS connections through GnuTLS +;; Copyright (C) 2010 Free Software Foundation, Inc. + +;; Author: Ted Zlatanov +;; Keywords: comm, tls, ssl, encryption +;; Originally-By: Simon Josefsson (See http://josefsson.org/emacs-security/) + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; This package provides language bindings for the GnuTLS library +;; using the corresponding core functions in gnutls.c. + +;; Simple test: +;; +;; (setq jas (open-ssl-stream "ssl" (current-buffer) "www.pdc.kth.se" 443)) +;; (process-send-string jas "GET /\r\n\r\n") + +;;; Code: + +(defconst gnutls-version "0.3.1") + +(defun open-ssl-stream (name buffer host service) + "Open a SSL connection for a service to a host. +Returns a subprocess-object to represent the connection. +Input and output work as for subprocesses; `delete-process' closes it. +Args are NAME BUFFER HOST SERVICE. +NAME is name for process. It is modified if necessary to make it unique. +BUFFER is the buffer (or `buffer-name') to associate with the process. + Process output goes at end of that buffer, unless you specify + an output stream or filter function to handle the output. + BUFFER may be also nil, meaning that this process is not associated + with any buffer +Third arg is name of the host to connect to, or its IP address. +Fourth arg SERVICE is name of the service desired, or an integer +specifying a port number to connect to." + (let ((proc (open-network-stream name buffer host service))) + (starttls-negotiate proc))) + +(defun starttls-negotiate (proc &optional priority-string + credentials credentials-file) + "Negotiate a SSL or TLS connection. +PROC is the process returned by `starttls-open-stream'. +PRIORITY-STRING is as per the GnuTLS docs. +CREDENTIALS is `gnutls-x509pki', `gnutls-anon', or `gnutls-srp'. +CREDENTIALS-FILE is a filename with meaning dependent on CREDENTIALS." + (let* ((credentials (or credentials 'gnutls-anon)) + (priority-string (or priority-string + (cond + ((eq credentials 'gnutls-anon) + "PERFORMANCE:+ANON-DH:!ARCFOUR-128") + ((eq credentials 'gnutls-x509pki) + "PERFORMANCE"))))) + (gnutls-message-maybe + (gnutls-global-init) + "global_init: err=%s") + + (gnutls-message-maybe + (gnutls-init proc) + "init: err=%s") + + (gnutls-message-maybe + (gnutls-priority-set-direct proc priority-string) + "priority_set: err=%s") + + (gnutls-message-maybe + (gnutls-cred-set proc credentials) + "credential_set: err=%s") + + (cond + ((eq credentials 'gnutls-x509pki) + (gnutls-message-maybe + (gnutls-cert-set-x509-trust-file proc credentials-file) + "x509_trustfile: err=%s"))) + + (let ((ret 'gnutls-e-again)) + (while (or (eq ret 'gnutls-e-again) + (eq ret 'gnutls-e-interrupted)) + (gnutls-message-maybe + (setq ret (gnutls-handshake proc)) + "handshake: err=%s")) + (if (gnutls-errorp (ret)) + (progn + (message "Ouch, error return %d" ret) + (setq proc nil)) + (message "Handshake complete %d." ret))) + proc)) + +(defun starttls-open-stream (name buffer host service) + "Open a TLS connection for a service to a host. +Returns a subprocess-object to represent the connection. +Input and output work as for subprocesses; `delete-process' closes it. +Args are NAME BUFFER HOST SERVICE. +NAME is name for process. It is modified if necessary to make it unique. +BUFFER is the buffer (or `buffer-name') to associate with the process. + Process output goes at end of that buffer, unless you specify + an output stream or filter function to handle the output. + BUFFER may be also nil, meaning that this process is not associated + with any buffer +Third arg is name of the host to connect to, or its IP address. +Fourth arg SERVICE is name of the service desired, or an integer +specifying a port number to connect to." + (open-network-stream name buffer host service)) + +(defun gnutls-message-maybe (doit format &rest params) + "When DOIT, message with the caller name followed by FORMAT on PARAMS." + (when doit + (message "%s: (err=%s) %s" + (nth 1 (backtrace-frame 4)) + doit + (apply 'format format params)))) + +(provide 'ssl) +(provide 'gnutls) +(provide 'starttls) + +;;; gnutls.el ends here === modified file 'src/Makefile.in' --- src/Makefile.in 2010-08-17 21:19:11 +0000 +++ src/Makefile.in 2010-09-06 23:12:37 +0000 @@ -285,6 +285,9 @@ LIBSELINUX_LIBS = @LIBSELINUX_LIBS@ +LIBGNUTLS_LIBS = @LIBGNUTLS_LIBS@ +LIBGNUTLS_CFLAGS = @LIBGNUTLS_CFLAGS@ + INTERVALS_H = dispextern.h intervals.h composite.h GETLOADAVG_LIBS = @GETLOADAVG_LIBS@ @@ -323,6 +326,7 @@ ${C_SWITCH_X_SYSTEM} ${CFLAGS_SOUND} ${RSVG_CFLAGS} ${IMAGEMAGICK_CFLAGS} ${DBUS_CFLAGS} \ ${GCONF_CFLAGS} ${FREETYPE_CFLAGS} ${FONTCONFIG_CFLAGS} \ ${LIBOTF_CFLAGS} ${M17N_FLT_CFLAGS} ${DEPFLAGS} ${PROFILING_CFLAGS} \ + $(LIBGNUTLS_CFLAGS) \ ${C_WARNINGS_SWITCH} ${CFLAGS} ALL_OBJC_CFLAGS=$(ALL_CFLAGS) $(GNU_OBJC_CFLAGS) @@ -347,7 +351,7 @@ alloc.o data.o doc.o editfns.o callint.o \ eval.o floatfns.o fns.o font.o print.o lread.o \ syntax.o $(UNEXEC_OBJ) bytecode.o \ - process.o callproc.o \ + process.o gnutls.o callproc.o \ region-cache.o sound.o atimer.o \ doprnt.o strftime.o intervals.o textprop.o composite.o md5.o \ $(MSDOS_OBJ) $(MSDOS_X_OBJ) $(NS_OBJ) $(CYGWIN_OBJ) $(FONT_OBJ) @@ -598,6 +602,7 @@ $(RSVG_LIBS) ${IMAGEMAGICK_LIBS} $(DBUS_LIBS) $(LIBGPM) $(LIBRESOLV) $(LIBS_SYSTEM) \ $(LIBS_TERMCAP) $(GETLOADAVG_LIBS) ${GCONF_LIBS} ${LIBSELINUX_LIBS} \ $(FREETYPE_LIBS) $(FONTCONFIG_LIBS) $(LIBOTF_LIBS) $(M17N_FLT_LIBS) \ + $(LIBGNUTLS_LIBS) \ $(LIB_GCC) $(LIB_MATH) $(LIB_STANDARD) $(LIB_GCC) all: emacs${EXEEXT} $(OTHER_FILES) === modified file 'src/config.in' --- src/config.in 2010-08-17 21:19:11 +0000 +++ src/config.in 2010-09-06 23:12:37 +0000 @@ -255,6 +255,9 @@ /* Define to 1 if you have a gif (or ungif) library. */ #undef HAVE_GIF +/* Define if we have the GNU TLS library. */ +#undef HAVE_GNUTLS + /* Define to 1 if you have the gpm library (-lgpm). */ #undef HAVE_GPM @@ -1091,6 +1094,12 @@ #include config_opsysfile #include config_machfile +#if HAVE_GNUTLS +#define LIBGNUTLS $(LIBGNUTLS_LIBS) +#else /* not HAVE_GNUTLS */ +#define LIBGNUTLS +#endif /* not HAVE_GNUTLS */ + /* Set up some defines, C and LD flags for NeXTstep interface on GNUstep. (There is probably a better place to do this, but right now the Cocoa side does this in s/darwin.h and we cannot === modified file 'src/emacs.c' --- src/emacs.c 2010-08-22 21:15:20 +0000 +++ src/emacs.c 2010-09-06 23:12:37 +0000 @@ -63,6 +63,10 @@ #include "keyboard.h" #include "keymap.h" +#ifdef HAVE_GNUTLS +#include "gnutls.h" +#endif + #ifdef HAVE_NS #include "nsterm.h" #endif @@ -1569,6 +1573,10 @@ syms_of_fontset (); #endif /* HAVE_NS */ +#ifdef HAVE_GNUTLS + syms_of_gnutls (); +#endif + #ifdef HAVE_DBUS syms_of_dbusbind (); #endif /* HAVE_DBUS */ === added file 'src/gnutls.c' --- src/gnutls.c 1970-01-01 00:00:00 +0000 +++ src/gnutls.c 2010-09-06 23:12:37 +0000 @@ -0,0 +1,373 @@ +#include +#include +#include + +#include "lisp.h" +#include "process.h" + +#ifdef HAVE_GNUTLS +#include + +Lisp_Object Qgnutls_anon, Qgnutls_x509pki; +Lisp_Object Qgnutls_e_interrupted, Qgnutls_e_again; + +int +emacs_gnutls_write (int fildes, gnutls_session_t state, char *buf, + unsigned int nbyte) +{ + register int rtnval, bytes_written; + + bytes_written = 0; + + while (nbyte > 0) + { + rtnval = gnutls_write (state, buf, nbyte); + + if (rtnval == -1) + { + if (errno == EINTR) + continue; + else + return (bytes_written ? bytes_written : -1); + } + + buf += rtnval; + nbyte -= rtnval; + bytes_written += rtnval; + } + fsync (STDOUT_FILENO); + + return (bytes_written); +} + +int +emacs_gnutls_read (int fildes, gnutls_session_t state, char *buf, + unsigned int nbyte) +{ + register int rtnval; + + do { + rtnval = gnutls_read (state, buf, nbyte); + } while( rtnval==GNUTLS_E_INTERRUPTED || rtnval==GNUTLS_E_AGAIN); + fsync(STDOUT_FILENO); + + return (rtnval); +} + +int gnutls_callback (gnutls_session_t state, const gnutls_datum *client_certs, + int ncerts, const gnutls_datum* req_ca_cert, int nreqs) +{ + if (client_certs == NULL) { + /* means the we will only be called again if the library cannot + * determine which certificate to send + */ + return 0; + } + + return -1; /* send no certificate to the peer */ +} + +/* convert an integer error to a Lisp_Object; it will be either a + known symbol like `gnutls_e_interrupted' and `gnutls_e_again' or + simply the integer value of the error. GNUTLS_E_SUCCESS is mapped + to Qt. +*/ + +Lisp_Object gnutls_make_error (int error) +{ + switch (error) + { + case GNUTLS_E_SUCCESS: + return Qt; + case GNUTLS_E_AGAIN: + return Qgnutls_e_again; + case GNUTLS_E_INTERRUPTED: + return Qgnutls_e_interrupted; + } + + return make_number (error); +} + +DEFUN ("gnutls-errorp", Fgnutls_errorp, Sgnutls_errorp, 1, 1, 0, + doc: /* Returns t if ERROR (as generated by gnutls_make_error) +indicates a GnuTLS problem.*/) + (Lisp_Object error) +{ + if (EQ (error, Qt)) return Qnil; + + return Qt; +} + +DEFUN ("gnutls-init", Fgnutls_init, Sgnutls_init, 1, 1, 0, + doc: /* Initializes client-mode GnuTLS for process PROC. +Currently only client mode is supported. + +Processes must be initialized with this function before other GNU TLS +functions are used. This function allocates resources which can only +be deallocated by calling `gnutls-deinit'. Returns zero on success. */) + (Lisp_Object proc) +{ + int ret; + + CHECK_PROCESS (proc); + + ret = gnutls_init (&(XPROCESS (proc)->gnutls_state), + GNUTLS_CLIENT); + + XPROCESS (proc)->gnutls_state_usable = Qt; + + return gnutls_make_error (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 = XPROCESS (proc)->gnutls_state; + + gnutls_deinit (state); + XPROCESS (proc)->gnutls_state_usable = Qnil; + + return Qnil; +} + +DEFUN ("gnutls-global-init", Fgnutls_global_init, + Sgnutls_global_init, 0, 0, 0, + doc: /* Initializes global GNU TLS state to defaults. +Call `gnutls-global-deinit' when GNU TLS usage is no longer needed. +Returns zero on success. */) + (void) +{ + int ret = gnutls_global_init (); + + return gnutls_make_error (ret); +} + +DEFUN ("gnutls-global-deinit", Fgnutls_global_deinit, + Sgnutls_global_deinit, 0, 0, 0, + doc: /* Deinitializes global GNU TLS state. +See also `gnutls-global-init'. */) + (void) +{ + gnutls_global_deinit (); + + return Qnil; +} + +Lisp_Object +generic_set_priority (int (*func)( gnutls_session_t state, const char*, const char**), + Lisp_Object proc, Lisp_Object priority_string) +{ + gnutls_session_t state; + int ret; + + CHECK_PROCESS (proc); + CHECK_STRING (priority_string); + + state = XPROCESS (proc)->gnutls_state; + + ret = (*func) (state, (char*) SDATA (priority_string), NULL); + + return gnutls_make_error (ret); +} + +DEFUN ("gnutls-priority-set-direct", Fgnutls_priority_set_direct, + Sgnutls_priority_set_direct, 2, 2, 0, + doc: /* Sets the priority on the protocol versions supported by GNU TLS for PROCESS. + +The first parameter must be a process. Second parameter is a string +describing the priority. Note that the priority is set on the client. +The server does not use the protocols's priority except for disabling +protocols that were not specified. */) + (Lisp_Object process, Lisp_Object priority_string) +{ + Lisp_Object ret = generic_set_priority (&gnutls_priority_set_direct, + process, priority_string); + + return ret; +} + +DEFUN ("gnutls-cert-set-x509-trust-file", + Fgnutls_cert_set_x509_trust_file, + Sgnutls_cert_set_x509_trust_file, 2, 2, 0, + doc: /* Set X.509 client trust file for PROCESS +CERTFILE is a PEM encoded file. Returns zero on success. */) + (Lisp_Object proc, Lisp_Object certfile) +{ + gnutls_session_t state; + gnutls_certificate_credentials_t x509_cred; + int ret; + + CHECK_STRING (certfile); + CHECK_PROCESS (proc); + + state = XPROCESS (proc)->gnutls_state; + + x509_cred = (gnutls_certificate_credentials_t) XPROCESS (proc)->x509_cred; + + ret = gnutls_certificate_set_x509_trust_file (x509_cred, + XSTRING (certfile)->data, + GNUTLS_X509_FMT_PEM); + + return gnutls_make_error (ret); +} + +DEFUN ("gnutls-cred-set", Fgnutls_cred_set, + Sgnutls_cred_set, 2, 2, 0, + doc: /* Enables GNU TLS authentication for PROCESS. +TYPE is either `gnutls-anon' or `gnutls-x509pki'. + +Each authentication type may need additional information in order to +work. For anonymous (`gnutls-anon'), see also +`gnutls-anon-set-client-cred'. For X.509 PKI (`gnutls-x509pki'), see +also `gnutls-x509pki-set-client-trust-file', +`gnutls-x509pki-set-client-key-file', and +`gnutls-x509pki-set-cert-callback'. */) + (Lisp_Object proc, Lisp_Object type) +{ + 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 = XPROCESS (proc)->gnutls_state; + + if (EQ (type, Qgnutls_x509pki)) + { + x509_cred = XPROCESS (proc)->x509_cred; + if (gnutls_certificate_allocate_credentials (&x509_cred) < 0) + memory_full (); + ret = gnutls_cred_set (state, GNUTLS_CRD_CERTIFICATE, x509_cred); + } + else if (EQ (type, Qgnutls_anon)) + { + anon_cred = XPROCESS (proc)->anon_cred; + if (gnutls_anon_allocate_client_credentials (&anon_cred) < 0) + memory_full (); + ret = gnutls_cred_set (state, GNUTLS_CRD_ANON, anon_cred); + } + else + { + /* should this be an error or fold to gnutls-anon? */ + } + + return gnutls_make_error (ret); +} + +DEFUN ("gnutls-bye", Fgnutls_bye, + Sgnutls_bye, 2, 2, 0, + doc: /* Terminate current GNU TLS connection for PROCESS. +The connection should have been initiated using gnutls_handshake(). + +If CONT is not nil the TLS connection gets terminated and further +receives and sends will be disallowed. If the return value is zero you +may continue using the connection. If CONT is nil, GnuTLS actually +sends an alert containing a close request and waits for the peer to +reply with the same message. In order to reuse the connection you +should wait for an EOF from the peer. + +This function may also return `gnutls-e-again', or +`gnutls-e-interrupted'. */) + (Lisp_Object proc, Lisp_Object cont) +{ + gnutls_session_t state; + int ret; + + CHECK_PROCESS (proc); + + state = XPROCESS (proc)->gnutls_state; + + ret = gnutls_bye (state, + NILP (cont) ? GNUTLS_SHUT_RDWR : GNUTLS_SHUT_WR); + + return gnutls_make_error (ret); +} + +DEFUN ("gnutls-handshake", Fgnutls_handshake, + Sgnutls_handshake, 1, 1, 0, + doc: /* Perform GNU TLS handshake for PROCESS. +The identity of the peer is checked automatically. This function will +fail if any problem is encountered, and will return a negative error +code. In case of a client, if it has been asked to resume a session, +but the server didn't, then a full handshake will be performed. + +This function may also return the non-fatal errors `gnutls-e-again', +or `gnutls-e-interrupted'. In that case you may resume the handshake +(by calling this function again). */) + (Lisp_Object proc) +{ + gnutls_session_t state; + int ret; + + CHECK_PROCESS (proc); + state = XPROCESS (proc)->gnutls_state; + + gnutls_transport_set_ptr (state, XPROCESS (proc)->infd); + ret = gnutls_handshake (state); + + return gnutls_make_error (ret); +} + +DEFUN ("gnutls-rehandshake", Fgnutls_rehandshake, + Sgnutls_rehandshake, 1, 1, 0, + doc: /* Renegotiate GNU TLS security parameters for PROCESS. +This function will renegotiate security parameters with the +client. This should only be called in case of a server. + +This message informs the peer that we want to renegotiate parameters +\(perform a handshake). + +If this function succeeds (returns 0), you must call the +gnutls_handshake() function in order to negotiate the new parameters. + +If the client does not wish to renegotiate parameters he will reply +with an alert message, thus the return code will be +`gnutls-e-warning-alert-received' and the alert will be +`gnutls-e-no-renegotiation'. */) + (Lisp_Object proc) +{ + gnutls_session_t state; + int ret; + + CHECK_PROCESS (proc); + state = XPROCESS (proc)->gnutls_state; + + gnutls_transport_set_ptr (state, XPROCESS (proc)->infd); + ret = gnutls_rehandshake (state); + + return gnutls_make_error (ret); +} + +void +syms_of_gnutls (void) +{ + Qgnutls_anon = intern_c_string ("gnutls-anon"); + staticpro (&Qgnutls_anon); + Qgnutls_x509pki = intern_c_string ("gnutls-x509pki"); + staticpro (&Qgnutls_x509pki); + Qgnutls_e_interrupted = make_number(GNUTLS_E_INTERRUPTED); + staticpro (&Qgnutls_e_interrupted); + Qgnutls_e_again = make_number(GNUTLS_E_AGAIN); + staticpro (&Qgnutls_e_again); + + defsubr (&Sgnutls_errorp); + defsubr (&Sgnutls_global_init); + defsubr (&Sgnutls_global_deinit); + defsubr (&Sgnutls_init); + defsubr (&Sgnutls_deinit); + defsubr (&Sgnutls_priority_set_direct); + defsubr (&Sgnutls_cred_set); + defsubr (&Sgnutls_handshake); + defsubr (&Sgnutls_rehandshake); + defsubr (&Sgnutls_cert_set_x509_trust_file); + defsubr (&Sgnutls_bye); +} +#endif === added file 'src/gnutls.h' --- src/gnutls.h 1970-01-01 00:00:00 +0000 +++ src/gnutls.h 2010-09-06 23:12:37 +0000 @@ -0,0 +1,4 @@ +#ifdef HAVE_GNUTLS +#include + +#endif === modified file 'src/lisp.h' --- src/lisp.h 2010-08-09 19:25:41 +0000 +++ src/lisp.h 2010-09-06 23:12:37 +0000 @@ -3350,6 +3350,7 @@ extern void syms_of_process (void); extern void setup_process_coding_systems (Lisp_Object); + /* Defined in callproc.c */ extern Lisp_Object Vexec_path, Vexec_suffixes, Vexec_directory, Vdata_directory; @@ -3589,6 +3590,11 @@ void syms_of_dbusbind (void); #endif +#ifdef HAVE_GNUTLS +/* Defined in gnutls.c */ +extern void syms_of_gnutls (void); +#endif + #ifdef DOS_NT /* Defined in msdos.c, w32.c */ extern char *emacs_root_dir (void); === modified file 'src/process.c' --- src/process.c 2010-08-22 15:14:37 +0000 +++ src/process.c 2010-09-06 23:12:37 +0000 @@ -105,6 +105,9 @@ #include "sysselect.h" #include "syssignal.h" #include "syswait.h" +#ifdef HAVE_GNUTLS +#include "gnutls.h" +#endif #if defined (USE_GTK) || defined (HAVE_GCONF) #include "xgselect.h" @@ -1526,6 +1529,10 @@ XPROCESS (proc)->filter = Qnil; XPROCESS (proc)->command = Flist (nargs - 2, args + 2); +#ifdef HAVE_GNUTLS + XPROCESS (proc)->gnutls_state_usable = Qnil; +#endif + #ifdef ADAPTIVE_READ_BUFFERING XPROCESS (proc)->adaptive_read_buffering = (NILP (Vprocess_adaptive_read_buffering) ? 0 @@ -5097,7 +5104,12 @@ #endif if (proc_buffered_char[channel] < 0) { - nbytes = emacs_read (channel, chars + carryover, readmax); +#ifdef HAVE_GNUTLS + if (NETCONN_P(proc) && !NILP (XPROCESS(proc)->gnutls_state_usable)) + nbytes = emacs_gnutls_read (channel, XPROCESS(proc)->gnutls_state, chars + carryover, readmax); + else +#endif + nbytes = emacs_read (channel, chars + carryover, readmax); #ifdef ADAPTIVE_READ_BUFFERING if (nbytes > 0 && p->adaptive_read_buffering) { @@ -5130,7 +5142,12 @@ { chars[carryover] = proc_buffered_char[channel]; proc_buffered_char[channel] = -1; - nbytes = emacs_read (channel, chars + carryover + 1, readmax - 1); +#ifdef HAVE_GNUTLS + if (NETCONN_P(proc) && !NILP (XPROCESS(proc)->gnutls_state_usable)) + nbytes = emacs_gnutls_read (channel, XPROCESS(proc)->gnutls_state, chars + carryover + 1, readmax - 1); + else +#endif + nbytes = emacs_read (channel, chars + carryover + 1, readmax - 1); if (nbytes < 0) nbytes = 1; else @@ -5540,7 +5557,14 @@ else #endif { - rv = emacs_write (outfd, (char *) buf, this); +#ifdef HAVE_GNUTLS + if (NETCONN_P(proc) && !NILP (XPROCESS(proc)->gnutls_state_usable)) + rv = emacs_gnutls_write (outfd, + XPROCESS(proc)->gnutls_state, + (char *) buf, this); + else +#endif + rv = emacs_write (outfd, (char *) buf, this); #ifdef ADAPTIVE_READ_BUFFERING if (p->read_output_delay > 0 && p->adaptive_read_buffering == 1) === modified file 'src/process.h' --- src/process.h 2010-08-11 12:34:46 +0000 +++ src/process.h 2010-09-06 23:12:37 +0000 @@ -24,6 +24,10 @@ #include #endif +#ifdef HAVE_GNUTLS +#include "gnutls.h" +#endif + /* This structure records information about a subprocess or network connection. @@ -76,6 +80,10 @@ /* Working buffer for encoding. */ Lisp_Object encoding_buf; +#ifdef HAVE_GNUTLS + Lisp_Object gnutls_state_usable; +#endif + /* After this point, there are no Lisp_Objects any more. */ /* alloc.c assumes that `pid' is the first such non-Lisp slot. */ @@ -121,6 +129,12 @@ needs to be synced to `status'. */ unsigned int raw_status_new : 1; int raw_status; + +#ifdef HAVE_GNUTLS + gnutls_session_t gnutls_state; + gnutls_certificate_client_credentials x509_cred; + gnutls_anon_client_credentials_t anon_cred; +#endif }; /* Every field in the preceding structure except for the first two --=-=-= Content-Type: text/plain; charset="us-ascii" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Disposition: inline _______________________________________________ Gnutls-devel mailing list Gnutls-devel@gnu.org http://lists.gnu.org/mailman/listinfo/gnutls-devel --=-=-=--