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: Sun, 03 Oct 2010 09:48:25 -0500 Organization: =?utf-8?B?0KLQtdC+0LTQvtGAINCX0LvQsNGC0LDQvdC+0LI=?= @ Cienfuegos Message-ID: <87aamvib7q.fsf@lifelogs.com> References: <878wc1vfh3.fsf@lifelogs.com> <87zkwqijye.fsf@stupidchicken.com> <878w4actmg.fsf@lifelogs.com> <877hju123h.fsf@stupidchicken.com> <8762yklrdk.fsf@lifelogs.com> <87wrqzhrjv.fsf@lifelogs.com> <87fwxmihyz.fsf@lifelogs.com> <8762ycfhqo.fsf@lifelogs.com> <87d3sf9soo.fsf@lifelogs.com> <87r5gh2fzj.fsf@lifelogs.com> <87zkv38cy5.fsf@lifelogs.com> <87k4m4zdgn.fsf@lifelogs.com> <87eic7icg2.fsf@lifelogs.com> NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: dough.gmane.org 1286118042 14354 80.91.229.12 (3 Oct 2010 15:00:42 GMT) X-Complaints-To: usenet@dough.gmane.org NNTP-Posting-Date: Sun, 3 Oct 2010 15:00:42 +0000 (UTC) To: emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Sun Oct 03 17:00:40 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 1P2Q2s-0000Aq-QF for ged-emacs-devel@m.gmane.org; Sun, 03 Oct 2010 17:00:39 +0200 Original-Received: from localhost ([127.0.0.1]:46023 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1P2Q2o-0004n6-Jq for ged-emacs-devel@m.gmane.org; Sun, 03 Oct 2010 11:00:06 -0400 Original-Received: from [140.186.70.92] (port=49719 helo=eggs.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1P2Q1D-0003iP-0B for emacs-devel@gnu.org; Sun, 03 Oct 2010 10:58:30 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1P2PrZ-0001TC-6g for emacs-devel@gnu.org; Sun, 03 Oct 2010 10:48:31 -0400 Original-Received: from blockstar.com ([208.100.47.114]:53245 helo=mail.blockstar.com) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1P2PrZ-0001T6-0O for emacs-devel@gnu.org; Sun, 03 Oct 2010 10:48:29 -0400 Original-Received: from heechee (c-24-14-16-248.hsd1.il.comcast.net [24.14.16.248]) by mail.blockstar.com (Postfix) with ESMTP id CD5D13E0758 for ; Sun, 3 Oct 2010 09:48:30 -0500 (CDT) 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" In-Reply-To: <87eic7icg2.fsf@lifelogs.com> (Ted Zlatanov's message of "Sun, 03 Oct 2010 09:21:49 -0500") User-Agent: Gnus/5.110011 (No Gnus v0.11) Emacs/24.0.50 (gnu/linux) X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6, seldom 2.4 (older, 4) 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:131293 Archived-At: --=-=-= Content-Type: text/plain On Sun, 03 Oct 2010 09:21:49 -0500 Ted Zlatanov wrote: TZ> I pushed the last version of gnutls.{c,el} using the old API, but with TZ> plists for gnutls-boot. Please test and let me know if it works for TZ> you. It worked for me. TZ> If there are no problems I'll rework gnutls.el to be a standalone TZ> library and change the API as we discussed. I had trouble committing so the patches are below. I'll commit when I can or Lars can push them. Ted --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=tls-plist1.patch === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2010-10-03 04:31:59 +0000 +++ lisp/ChangeLog 2010-10-03 14:19:04 +0000 @@ -1,3 +1,10 @@ +2010-10-03 Teodor Zlatanov + + * net/gnutls.el (starttls-negotiate): Use the plist interface to + `gnutls-boot'. Make TYPE the only required parameter. Allow + TRUSTFILES and KEYFILES to be lists. + (open-ssl-stream): Use it. + 2010-10-03 Chong Yidong * emacs-lisp/bytecomp.el (byte-compile-from-buffer): Remove === modified file 'lisp/net/gnutls.el' --- lisp/net/gnutls.el 2010-09-29 13:25:24 +0000 +++ lisp/net/gnutls.el 2010-10-03 14:19:04 +0000 @@ -57,34 +57,36 @@ 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 nil 'gnutls-x509pki))) + (starttls-negotiate proc 'gnutls-x509pki))) ;; (open-ssl-stream "tls" "tls-buffer" "yourserver.com" "https") -(defun starttls-negotiate (proc &optional priority-string - credentials credentials-file) +;; (open-ssl-stream "tls" "tls-buffer" "imap.gmail.com" "imaps") +(defun starttls-negotiate (proc type &optional priority-string + trustfiles keyfiles) "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' or `gnutls-anon'. -CREDENTIALS-FILE is a filename with meaning dependent on CREDENTIALS." - (let* ((credentials (or credentials 'gnutls-x509pki)) - (credentials-file (or credentials-file - "/etc/ssl/certs/ca-certificates.crt" - ;"/etc/ssl/certs/ca.pem" - )) - +TYPE is `gnutls-x509pki' (default) or `gnutls-anon'. Use nil for the default. +PROC is a process returned by `open-network-stream'. +PRIORITY-STRING is as per the GnuTLS docs, default is \"NORMAL\". +TRUSTFILES is a list of CA bundles. +KEYFILES is a list of client keys." + (let* ((type (or type 'gnutls-x509pki)) + (trusfiles (or trustfiles + '("/etc/ssl/certs/ca-certificates.crt"))) (priority-string (or priority-string (cond - ((eq credentials 'gnutls-anon) + ((eq type 'gnutls-anon) "NORMAL:+ANON-DH:!ARCFOUR-128") - ((eq credentials 'gnutls-x509pki) + ((eq type 'gnutls-x509pki) "NORMAL")))) + (params `(:priority ,priority-string + :loglevel ,gnutls-log-level + :trustfiles ,trustfiles + :keyfiles ,keyfiles + :callbacks nil)) ret) (gnutls-message-maybe - (setq ret (gnutls-boot proc priority-string - credentials credentials-file - nil nil gnutls-log-level)) + (setq ret (gnutls-boot proc type params)) "boot: %s") proc)) --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=tls-plist2.patch === modified file 'src/ChangeLog' --- src/ChangeLog 2010-10-03 12:36:19 +0000 +++ src/ChangeLog 2010-10-03 14:18:40 +0000 @@ -1,3 +1,15 @@ +2010-10-03 Teodor Zlatanov + + * gnutls.h (GNUTLS_LOG2): Convenience macro. + + * gnutls.c: Add property list symbol holders. + (emacs_gnutls_handshake): Clarify how sockets are passed to + GnuTLS. + (gnutls_log_function2): Convenience function using GNUTLS_LOG2. + (Fgnutls_boot): Get all parameters from a plist. Require trustfiles + and keyfiles to be a list of file names. Default to "NORMAL" for + the priority string. Improve logging. + 2010-10-03 Juanma Barranquero * makefile.w32-in (TAGS, TAGS-LISP, TAGS-gmake): Add $(FONTOBJ). === modified file 'src/gnutls.c' --- src/gnutls.c 2010-10-03 04:12:15 +0000 +++ src/gnutls.c 2010-10-03 14:18:40 +0000 @@ -32,6 +32,13 @@ Qgnutls_e_invalid_session, Qgnutls_e_not_ready_for_handshake; int global_initialized; +/* The following are for the property list of `gnutls-boot'. */ +Lisp_Object Qgnutls_bootprop_priority; +Lisp_Object Qgnutls_bootprop_trustfiles; +Lisp_Object Qgnutls_bootprop_keyfiles; +Lisp_Object Qgnutls_bootprop_callbacks; +Lisp_Object Qgnutls_bootprop_loglevel; + static void emacs_gnutls_handshake (struct Lisp_Process *proc) { @@ -43,6 +50,9 @@ if (proc->gnutls_initstage < GNUTLS_STAGE_TRANSPORT_POINTERS_SET) { + /* This is how GnuTLS takes sockets: as file descriptors passed + in. For an Emacs process socket, infd and outfd are the + same but we use this two-argument version for clarity. */ gnutls_transport_set_ptr2 (state, (gnutls_transport_ptr_t) (long) proc->infd, (gnutls_transport_ptr_t) (long) proc->outfd); @@ -271,20 +281,29 @@ message ("gnutls.c: [%d] %s", level, string); } -DEFUN ("gnutls-boot", Fgnutls_boot, Sgnutls_boot, 3, 7, 0, - doc: /* Initialize client-mode GnuTLS for process PROC. +static void +gnutls_log_function2 (int level, const char* string, const char* extra) +{ + message ("gnutls.c: [%d] %s %s", level, string, extra); +} + +DEFUN ("gnutls-boot", Fgnutls_boot, Sgnutls_boot, 3, 3, 0, + doc: /* Initialize GnuTLS client for process PROC with TYPE+PROPLIST. Currently only client mode is supported. Returns a success/failure value you can check with `gnutls-errorp'. -PRIORITY-STRING is a string describing the priority. -TYPE is either `gnutls-anon' or `gnutls-x509pki'. -TRUSTFILE is a PEM encoded trust file for `gnutls-x509pki'. -KEYFILE is ... for `gnutls-x509pki' (TODO). -CALLBACK is ... for `gnutls-x509pki' (TODO). -LOGLEVEL is the debug level requested from GnuTLS, try 4. - -LOGLEVEL will be set for this process AND globally for GnuTLS. So if -you set it higher or lower at any point, it affects global debugging. +TYPE is a symbol, either `gnutls-anon' or `gnutls-x509pki'. +PROPLIST is a property list with the following keys: + +:priority is a GnuTLS priority string, defaults to "NORMAL". +:trustfiles is a list of PEM-encoded trust files for `gnutls-x509pki'. +:keyfiles is a list of PEM-encoded key files for `gnutls-x509pki'. +:callbacks is an alist of callback functions (TODO). +:loglevel is the debug level requested from GnuTLS, try 4. + +The debug level will be set for this process AND globally for GnuTLS. +So if you set it higher or lower at any point, it affects global +debugging. 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 @@ -295,11 +314,9 @@ be deallocated by calling `gnutls-deinit' or by calling it again. Each authentication type may need additional information in order to -work. For X.509 PKI (`gnutls-x509pki'), you need TRUSTFILE and -KEYFILE and optionally CALLBACK. */) - (Lisp_Object proc, Lisp_Object priority_string, Lisp_Object type, - Lisp_Object trustfile, Lisp_Object keyfile, Lisp_Object callback, - Lisp_Object loglevel) +work. For X.509 PKI (`gnutls-x509pki'), you probably need at least +one trustfile (usually a CA bundle). */) + (Lisp_Object proc, Lisp_Object type, Lisp_Object proplist) { int ret = GNUTLS_E_SUCCESS; @@ -312,10 +329,25 @@ gnutls_certificate_credentials_t x509_cred; gnutls_anon_client_credentials_t anon_cred; Lisp_Object global_init; + char* priority_string_ptr = "NORMAL"; /* default priority string. */ + Lisp_Object tail; + + /* Placeholders for the property list elements. */ + Lisp_Object priority_string; + Lisp_Object trustfiles; + Lisp_Object keyfiles; + Lisp_Object callbacks; + Lisp_Object loglevel; CHECK_PROCESS (proc); CHECK_SYMBOL (type); - CHECK_STRING (priority_string); + CHECK_LIST (proplist); + + priority_string = Fplist_get (proplist, Qgnutls_bootprop_priority); + trustfiles = Fplist_get (proplist, Qgnutls_bootprop_trustfiles); + keyfiles = Fplist_get (proplist, Qgnutls_bootprop_keyfiles); + callbacks = Fplist_get (proplist, Qgnutls_bootprop_callbacks); + loglevel = Fplist_get (proplist, Qgnutls_bootprop_loglevel); state = XPROCESS (proc)->gnutls_state; XPROCESS (proc)->gnutls_p = 1; @@ -394,29 +426,49 @@ if (EQ (type, Qgnutls_x509pki)) { - if (STRINGP (trustfile)) - { - GNUTLS_LOG (1, max_log_level, "setting the trustfile"); - ret = gnutls_certificate_set_x509_trust_file - (x509_cred, - SDATA (trustfile), - file_format); - - if (ret < GNUTLS_E_SUCCESS) - return gnutls_make_error (ret); - } - - if (STRINGP (keyfile)) - { - GNUTLS_LOG (1, max_log_level, "setting the keyfile"); - ret = gnutls_certificate_set_x509_crl_file - (x509_cred, - SDATA (keyfile), - file_format); - - if (ret < GNUTLS_E_SUCCESS) - return gnutls_make_error (ret); - } + for (tail = trustfiles; !NILP (tail); tail = Fcdr (tail)) + { + Lisp_Object trustfile = Fcar (tail); + if (STRINGP (trustfile)) + { + GNUTLS_LOG2 (1, max_log_level, "setting the trustfile: ", + SDATA (trustfile)); + ret = gnutls_certificate_set_x509_trust_file + (x509_cred, + SDATA (trustfile), + file_format); + + if (ret < GNUTLS_E_SUCCESS) + return gnutls_make_error (ret); + } + else + { + error ("Sorry, GnuTLS can't use non-string trustfile %s", + trustfile); + } + } + + for (tail = keyfiles; !NILP (tail); tail = Fcdr (tail)) + { + Lisp_Object keyfile = Fcar (tail); + if (STRINGP (keyfile)) + { + GNUTLS_LOG2 (1, max_log_level, "setting the keyfile: ", + SDATA (keyfile)); + ret = gnutls_certificate_set_x509_crl_file + (x509_cred, + SDATA (keyfile), + file_format); + + if (ret < GNUTLS_E_SUCCESS) + return gnutls_make_error (ret); + } + else + { + error ("Sorry, GnuTLS can't use non-string keyfile %s", + keyfile); + } + } } GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_FILES; @@ -432,10 +484,22 @@ GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_INIT; + if (STRINGP (priority_string)) + { + priority_string_ptr = (char*) SDATA (priority_string); + GNUTLS_LOG2 (1, max_log_level, "got non-default priority string:", + priority_string_ptr); + } + else + { + GNUTLS_LOG2 (1, max_log_level, "using default priority string:", + priority_string_ptr); + } + GNUTLS_LOG (1, max_log_level, "setting the priority string"); ret = gnutls_priority_set_direct (state, - (char*) SDATA (priority_string), + priority_string_ptr, NULL); if (ret < GNUTLS_E_SUCCESS) @@ -514,6 +578,21 @@ Qgnutls_x509pki = intern_c_string ("gnutls-x509pki"); staticpro (&Qgnutls_x509pki); + Qgnutls_bootprop_priority = intern_c_string ("priority"); + staticpro (&Qgnutls_bootprop_priority); + + Qgnutls_bootprop_trustfiles = intern_c_string ("trustfiles"); + staticpro (&Qgnutls_bootprop_trustfiles); + + Qgnutls_bootprop_keyfiles = intern_c_string ("keyfiles"); + staticpro (&Qgnutls_bootprop_keyfiles); + + Qgnutls_bootprop_callbacks = intern_c_string ("callbacks"); + staticpro (&Qgnutls_bootprop_callbacks); + + Qgnutls_bootprop_loglevel = intern_c_string ("loglevel"); + staticpro (&Qgnutls_bootprop_loglevel); + Qgnutls_e_interrupted = intern_c_string ("gnutls-e-interrupted"); staticpro (&Qgnutls_e_interrupted); Fput (Qgnutls_e_interrupted, Qgnutls_code, === modified file 'src/gnutls.h' --- src/gnutls.h 2010-09-29 12:48:29 +0000 +++ src/gnutls.h 2010-10-03 14:18:40 +0000 @@ -48,6 +48,8 @@ #define GNUTLS_LOG(level, max, string) if (level <= max) { gnutls_log_function (level, "(Emacs) " string); } +#define GNUTLS_LOG2(level, max, string, extra) if (level <= max) { gnutls_log_function2 (level, "(Emacs) " string, extra); } + int emacs_gnutls_write (int fildes, struct Lisp_Process *proc, char *buf, unsigned int nbyte); --=-=-=--