=== 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);