Mercurial > emacs
changeset 110745:af2db97ca17a
Rework the gnutls boot interface.
From Teodor Zlatanov.
| author | Lars Magne Ingebrigtsen <larsi@gnus.org> |
|---|---|
| date | Mon, 04 Oct 2010 00:37:37 +0200 |
| parents | dab4cfd7ea71 |
| children | 5c1a707ab452 |
| files | lisp/ChangeLog lisp/net/gnutls.el src/ChangeLog src/gnutls.c src/gnutls.h |
| diffstat | 5 files changed, 157 insertions(+), 55 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/ChangeLog Sun Oct 03 14:37:41 2010 -0700 +++ b/lisp/ChangeLog Mon Oct 04 00:37:37 2010 +0200 @@ -1,3 +1,10 @@ +2010-10-03 Teodor Zlatanov <tzz@lifelogs.com> + + * 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 Glenn Morris <rgm@gnu.org> * subr.el (directory-sep-char): Remove obsolete variable.
--- a/lisp/net/gnutls.el Sun Oct 03 14:37:41 2010 -0700 +++ b/lisp/net/gnutls.el Mon Oct 04 00:37:37 2010 +0200 @@ -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))
--- a/src/ChangeLog Sun Oct 03 14:37:41 2010 -0700 +++ b/src/ChangeLog Mon Oct 04 00:37:37 2010 +0200 @@ -1,3 +1,15 @@ +2010-10-03 Teodor Zlatanov <tzz@lifelogs.com> + + * 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 Glenn Morris <rgm@gnu.org> * fileio.c (Vdirectory_sep_char): Remove.
--- a/src/gnutls.c Sun Oct 03 14:37:41 2010 -0700 +++ b/src/gnutls.c Mon Oct 04 00:37:37 2010 +0200 @@ -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. +TYPE is a symbol, either `gnutls-anon' or `gnutls-x509pki'. +PROPLIST is a property list with the following keys: -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. +: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)) + for (tail = trustfiles; !NILP (tail); tail = Fcdr (tail)) { - 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); - } + 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); + } + } - if (STRINGP (keyfile)) + for (tail = keyfiles; !NILP (tail); tail = Fcdr (tail)) { - 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); - } + 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,
--- a/src/gnutls.h Sun Oct 03 14:37:41 2010 -0700 +++ b/src/gnutls.h Mon Oct 04 00:37:37 2010 +0200 @@ -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);