Commit c1ae068b authored by Lars Magne Ingebrigtsen's avatar Lars Magne Ingebrigtsen
Browse files

Rework the gnutls boot interface.

From Teodor Zlatanov.
parent 5589b70e
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> 2010-10-03 Glenn Morris <rgm@gnu.org>
   
* subr.el (directory-sep-char): Remove obsolete variable. * subr.el (directory-sep-char): Remove obsolete variable.
......
...@@ -57,34 +57,36 @@ Third arg is name of the host to connect to, or its IP address. ...@@ -57,34 +57,36 @@ 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 Fourth arg SERVICE is name of the service desired, or an integer
specifying a port number to connect to." specifying a port number to connect to."
(let ((proc (open-network-stream name buffer host service))) (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") ;; (open-ssl-stream "tls" "tls-buffer" "yourserver.com" "https")
(defun starttls-negotiate (proc &optional priority-string ;; (open-ssl-stream "tls" "tls-buffer" "imap.gmail.com" "imaps")
credentials credentials-file) (defun starttls-negotiate (proc type &optional priority-string
trustfiles keyfiles)
"Negotiate a SSL or TLS connection. "Negotiate a SSL or TLS connection.
PROC is the process returned by `starttls-open-stream'. TYPE is `gnutls-x509pki' (default) or `gnutls-anon'. Use nil for the default.
PRIORITY-STRING is as per the GnuTLS docs. PROC is a process returned by `open-network-stream'.
CREDENTIALS is `gnutls-x509pki' or `gnutls-anon'. PRIORITY-STRING is as per the GnuTLS docs, default is \"NORMAL\".
CREDENTIALS-FILE is a filename with meaning dependent on CREDENTIALS." TRUSTFILES is a list of CA bundles.
(let* ((credentials (or credentials 'gnutls-x509pki)) KEYFILES is a list of client keys."
(credentials-file (or credentials-file (let* ((type (or type 'gnutls-x509pki))
"/etc/ssl/certs/ca-certificates.crt" (trusfiles (or trustfiles
;"/etc/ssl/certs/ca.pem" '("/etc/ssl/certs/ca-certificates.crt")))
))
(priority-string (or priority-string (priority-string (or priority-string
(cond (cond
((eq credentials 'gnutls-anon) ((eq type 'gnutls-anon)
"NORMAL:+ANON-DH:!ARCFOUR-128") "NORMAL:+ANON-DH:!ARCFOUR-128")
((eq credentials 'gnutls-x509pki) ((eq type 'gnutls-x509pki)
"NORMAL")))) "NORMAL"))))
(params `(:priority ,priority-string
:loglevel ,gnutls-log-level
:trustfiles ,trustfiles
:keyfiles ,keyfiles
:callbacks nil))
ret) ret)
(gnutls-message-maybe (gnutls-message-maybe
(setq ret (gnutls-boot proc priority-string (setq ret (gnutls-boot proc type params))
credentials credentials-file
nil nil gnutls-log-level))
"boot: %s") "boot: %s")
proc)) proc))
......
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> 2010-10-03 Glenn Morris <rgm@gnu.org>
   
* fileio.c (Vdirectory_sep_char): Remove. * fileio.c (Vdirectory_sep_char): Remove.
......
...@@ -32,6 +32,13 @@ Lisp_Object Qgnutls_e_interrupted, Qgnutls_e_again, ...@@ -32,6 +32,13 @@ Lisp_Object Qgnutls_e_interrupted, Qgnutls_e_again,
Qgnutls_e_invalid_session, Qgnutls_e_not_ready_for_handshake; Qgnutls_e_invalid_session, Qgnutls_e_not_ready_for_handshake;
int global_initialized; 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 static void
emacs_gnutls_handshake (struct Lisp_Process *proc) emacs_gnutls_handshake (struct Lisp_Process *proc)
{ {
...@@ -43,6 +50,9 @@ emacs_gnutls_handshake (struct Lisp_Process *proc) ...@@ -43,6 +50,9 @@ emacs_gnutls_handshake (struct Lisp_Process *proc)
if (proc->gnutls_initstage < GNUTLS_STAGE_TRANSPORT_POINTERS_SET) 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_set_ptr2 (state,
(gnutls_transport_ptr_t) (long) proc->infd, (gnutls_transport_ptr_t) (long) proc->infd,
(gnutls_transport_ptr_t) (long) proc->outfd); (gnutls_transport_ptr_t) (long) proc->outfd);
...@@ -271,20 +281,29 @@ gnutls_log_function (int level, const char* string) ...@@ -271,20 +281,29 @@ gnutls_log_function (int level, const char* string)
message ("gnutls.c: [%d] %s", level, string); message ("gnutls.c: [%d] %s", level, string);
} }
DEFUN ("gnutls-boot", Fgnutls_boot, Sgnutls_boot, 3, 7, 0, static void
doc: /* Initialize client-mode GnuTLS for process PROC. 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 Currently only client mode is supported. Returns a success/failure
value you can check with `gnutls-errorp'. value you can check with `gnutls-errorp'.
PRIORITY-STRING is a string describing the priority. TYPE is a symbol, either `gnutls-anon' or `gnutls-x509pki'.
TYPE is either `gnutls-anon' or `gnutls-x509pki'. PROPLIST is a property list with the following keys:
TRUSTFILE is a PEM encoded trust file for `gnutls-x509pki'.
KEYFILE is ... for `gnutls-x509pki' (TODO). :priority is a GnuTLS priority string, defaults to "NORMAL".
CALLBACK is ... for `gnutls-x509pki' (TODO). :trustfiles is a list of PEM-encoded trust files for `gnutls-x509pki'.
LOGLEVEL is the debug level requested from GnuTLS, try 4. :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.
LOGLEVEL will be set for this process AND globally for GnuTLS. So if The debug level will be set for this process AND globally for GnuTLS.
you set it higher or lower at any point, it affects global debugging. 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 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 the protocols's priority except for disabling protocols that were not
...@@ -295,11 +314,9 @@ functions are used. This function allocates resources which can only ...@@ -295,11 +314,9 @@ functions are used. This function allocates resources which can only
be deallocated by calling `gnutls-deinit' or by calling it again. be deallocated by calling `gnutls-deinit' or by calling it again.
Each authentication type may need additional information in order to Each authentication type may need additional information in order to
work. For X.509 PKI (`gnutls-x509pki'), you need TRUSTFILE and work. For X.509 PKI (`gnutls-x509pki'), you probably need at least
KEYFILE and optionally CALLBACK. */) one trustfile (usually a CA bundle). */)
(Lisp_Object proc, Lisp_Object priority_string, Lisp_Object type, (Lisp_Object proc, Lisp_Object type, Lisp_Object proplist)
Lisp_Object trustfile, Lisp_Object keyfile, Lisp_Object callback,
Lisp_Object loglevel)
{ {
int ret = GNUTLS_E_SUCCESS; int ret = GNUTLS_E_SUCCESS;
...@@ -312,10 +329,25 @@ KEYFILE and optionally CALLBACK. */) ...@@ -312,10 +329,25 @@ KEYFILE and optionally CALLBACK. */)
gnutls_certificate_credentials_t x509_cred; gnutls_certificate_credentials_t x509_cred;
gnutls_anon_client_credentials_t anon_cred; gnutls_anon_client_credentials_t anon_cred;
Lisp_Object global_init; 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_PROCESS (proc);
CHECK_SYMBOL (type); 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; state = XPROCESS (proc)->gnutls_state;
XPROCESS (proc)->gnutls_p = 1; XPROCESS (proc)->gnutls_p = 1;
...@@ -394,29 +426,49 @@ KEYFILE and optionally CALLBACK. */) ...@@ -394,29 +426,49 @@ KEYFILE and optionally CALLBACK. */)
if (EQ (type, Qgnutls_x509pki)) 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"); Lisp_Object trustfile = Fcar (tail);
ret = gnutls_certificate_set_x509_trust_file if (STRINGP (trustfile))
(x509_cred, {
SDATA (trustfile), GNUTLS_LOG2 (1, max_log_level, "setting the trustfile: ",
file_format); SDATA (trustfile));
ret = gnutls_certificate_set_x509_trust_file
if (ret < GNUTLS_E_SUCCESS) (x509_cred,
return gnutls_make_error (ret); 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"); Lisp_Object keyfile = Fcar (tail);
ret = gnutls_certificate_set_x509_crl_file if (STRINGP (keyfile))
(x509_cred, {
SDATA (keyfile), GNUTLS_LOG2 (1, max_log_level, "setting the keyfile: ",
file_format); SDATA (keyfile));
ret = gnutls_certificate_set_x509_crl_file
if (ret < GNUTLS_E_SUCCESS) (x509_cred,
return gnutls_make_error (ret); 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; GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_FILES;
...@@ -432,10 +484,22 @@ KEYFILE and optionally CALLBACK. */) ...@@ -432,10 +484,22 @@ KEYFILE and optionally CALLBACK. */)
GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_INIT; 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"); GNUTLS_LOG (1, max_log_level, "setting the priority string");
ret = gnutls_priority_set_direct (state, ret = gnutls_priority_set_direct (state,
(char*) SDATA (priority_string), priority_string_ptr,
NULL); NULL);
if (ret < GNUTLS_E_SUCCESS) if (ret < GNUTLS_E_SUCCESS)
...@@ -514,6 +578,21 @@ syms_of_gnutls (void) ...@@ -514,6 +578,21 @@ syms_of_gnutls (void)
Qgnutls_x509pki = intern_c_string ("gnutls-x509pki"); Qgnutls_x509pki = intern_c_string ("gnutls-x509pki");
staticpro (&Qgnutls_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"); Qgnutls_e_interrupted = intern_c_string ("gnutls-e-interrupted");
staticpro (&Qgnutls_e_interrupted); staticpro (&Qgnutls_e_interrupted);
Fput (Qgnutls_e_interrupted, Qgnutls_code, Fput (Qgnutls_e_interrupted, Qgnutls_code,
......
...@@ -48,6 +48,8 @@ typedef enum ...@@ -48,6 +48,8 @@ typedef enum
#define GNUTLS_LOG(level, max, string) if (level <= max) { gnutls_log_function (level, "(Emacs) " string); } #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 int
emacs_gnutls_write (int fildes, struct Lisp_Process *proc, char *buf, emacs_gnutls_write (int fildes, struct Lisp_Process *proc, char *buf,
unsigned int nbyte); unsigned int nbyte);
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment