X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/d01fd55f641198bc7ba5752dd94c06a03ece7b83..d5e5e7b41166815a843148f2081d19bc14b628b2:/src/gnutls.c
diff --git a/src/gnutls.c b/src/gnutls.c
index 58f628f5d5..03f753fa8c 100644
--- a/src/gnutls.c
+++ b/src/gnutls.c
@@ -18,7 +18,6 @@ along with GNU Emacs. If not, see . */
#include
#include
-#include
#include "lisp.h"
#include "process.h"
@@ -31,15 +30,14 @@ along with GNU Emacs. If not, see . */
#include "w32.h"
#endif
-static int
-emacs_gnutls_handle_error (gnutls_session_t, int err);
+static bool emacs_gnutls_handle_error (gnutls_session_t, int);
static Lisp_Object Qgnutls_dll;
static Lisp_Object Qgnutls_code;
static Lisp_Object Qgnutls_anon, Qgnutls_x509pki;
static Lisp_Object Qgnutls_e_interrupted, Qgnutls_e_again,
Qgnutls_e_invalid_session, Qgnutls_e_not_ready_for_handshake;
-static int gnutls_global_initialized;
+static bool gnutls_global_initialized;
/* The following are for the property list of `gnutls-boot'. */
static Lisp_Object QCgnutls_bootprop_priority;
@@ -142,13 +140,13 @@ DEF_GNUTLS_FN (int, gnutls_x509_crt_import,
gnutls_x509_crt_fmt_t));
DEF_GNUTLS_FN (int, gnutls_x509_crt_init, (gnutls_x509_crt_t *));
-static int
-init_gnutls_functions (Lisp_Object libraries)
+static bool
+init_gnutls_functions (void)
{
HMODULE library;
int max_log_level = 1;
- if (!(library = w32_delayed_load (libraries, Qgnutls_dll)))
+ if (!(library = w32_delayed_load (Qgnutls_dll)))
{
GNUTLS_LOG (1, max_log_level, "GnuTLS library not found");
return 0;
@@ -200,8 +198,12 @@ init_gnutls_functions (Lisp_Object libraries)
max_log_level = global_gnutls_log_level;
- GNUTLS_LOG2 (1, max_log_level, "GnuTLS library loaded:",
- SDATA (Fget (Qgnutls_dll, QCloaded_from)));
+ {
+ Lisp_Object name = CAR_SAFE (Fget (Qgnutls_dll, QCloaded_from));
+ GNUTLS_LOG2 (1, max_log_level, "GnuTLS library loaded:",
+ STRINGP (name) ? (const char *) SDATA (name) : "unknown");
+ }
+
return 1;
}
@@ -318,8 +320,9 @@ emacs_gnutls_handshake (struct Lisp_Process *proc)
{
ret = fn_gnutls_handshake (state);
emacs_gnutls_handle_error (state, ret);
+ QUIT;
}
- while (ret == GNUTLS_E_INTERRUPTED);
+ while (ret < 0 && fn_gnutls_error_is_fatal (ret) == 0);
proc->gnutls_initstage = GNUTLS_STAGE_HANDSHAKE_TRIED;
@@ -347,21 +350,16 @@ emacs_gnutls_transport_set_errno (gnutls_session_t state, int err)
fn_gnutls_transport_set_errno (state, err);
}
-EMACS_INT
-emacs_gnutls_write (struct Lisp_Process *proc, const char *buf, EMACS_INT nbyte)
+ptrdiff_t
+emacs_gnutls_write (struct Lisp_Process *proc, const char *buf, ptrdiff_t nbyte)
{
ssize_t rtnval = 0;
- EMACS_INT bytes_written;
+ ptrdiff_t bytes_written;
gnutls_session_t state = proc->gnutls_state;
if (proc->gnutls_initstage != GNUTLS_STAGE_READY)
{
-#ifdef EWOULDBLOCK
- errno = EWOULDBLOCK;
-#endif
-#ifdef EAGAIN
errno = EAGAIN;
-#endif
return 0;
}
@@ -381,14 +379,7 @@ emacs_gnutls_write (struct Lisp_Process *proc, const char *buf, EMACS_INT nbyte)
appropriately so that send_process retries the
correct way instead of erroring out. */
if (rtnval == GNUTLS_E_AGAIN)
- {
-#ifdef EWOULDBLOCK
- errno = EWOULDBLOCK;
-#endif
-#ifdef EAGAIN
- errno = EAGAIN;
-#endif
- }
+ errno = EAGAIN;
break;
}
}
@@ -402,8 +393,8 @@ emacs_gnutls_write (struct Lisp_Process *proc, const char *buf, EMACS_INT nbyte)
return (bytes_written);
}
-EMACS_INT
-emacs_gnutls_read (struct Lisp_Process *proc, char *buf, EMACS_INT nbyte)
+ptrdiff_t
+emacs_gnutls_read (struct Lisp_Process *proc, char *buf, ptrdiff_t nbyte)
{
ssize_t rtnval;
gnutls_session_t state = proc->gnutls_state;
@@ -419,7 +410,7 @@ emacs_gnutls_read (struct Lisp_Process *proc, char *buf, EMACS_INT nbyte)
{
proc->gnutls_handshakes_tried++;
emacs_gnutls_handshake (proc);
- GNUTLS_LOG2i (5, log_level, "Retried handshake",
+ GNUTLS_LOG2i (5, log_level, "Retried handshake",
proc->gnutls_handshakes_tried);
return -1;
}
@@ -434,7 +425,7 @@ emacs_gnutls_read (struct Lisp_Process *proc, char *buf, EMACS_INT nbyte)
else if (rtnval == GNUTLS_E_UNEXPECTED_PACKET_LENGTH)
/* The peer closed the connection. */
return 0;
- else if (emacs_gnutls_handle_error (state, rtnval) == 0)
+ else if (emacs_gnutls_handle_error (state, rtnval))
/* non-fatal error */
return -1;
else {
@@ -443,19 +434,19 @@ emacs_gnutls_read (struct Lisp_Process *proc, char *buf, EMACS_INT nbyte)
}
}
-/* report a GnuTLS error to the user.
- Returns zero if the error code was successfully handled. */
-static int
+/* Report a GnuTLS error to the user.
+ Return true if the error code was successfully handled. */
+static bool
emacs_gnutls_handle_error (gnutls_session_t session, int err)
{
int max_log_level = 0;
- int ret;
+ bool ret;
const char *str;
/* TODO: use a Lisp_Object generated by gnutls_make_error? */
if (err >= 0)
- return 0;
+ return 1;
max_log_level = global_gnutls_log_level;
@@ -467,12 +458,12 @@ emacs_gnutls_handle_error (gnutls_session_t session, int err)
if (fn_gnutls_error_is_fatal (err))
{
- ret = err;
+ ret = 0;
GNUTLS_LOG2 (0, max_log_level, "fatal error:", str);
}
else
{
- ret = 0;
+ ret = 1;
GNUTLS_LOG2 (1, max_log_level, "non-fatal error:", str);
/* TODO: EAGAIN AKA Qgnutls_e_again should be level 2. */
}
@@ -595,7 +586,7 @@ usage: (gnutls-error-fatalp ERROR) */)
}
}
- if (!NUMBERP (err))
+ if (! TYPE_RANGED_INTEGERP (int, err))
error ("Not an error symbol or code");
if (0 == fn_gnutls_error_is_fatal (XINT (err)))
@@ -627,7 +618,7 @@ usage: (gnutls-error-string ERROR) */)
}
}
- if (!NUMBERP (err))
+ if (! TYPE_RANGED_INTEGERP (int, err))
return build_string ("Not an error symbol or code");
return build_string (fn_gnutls_strerror (XINT (err)));
@@ -652,7 +643,7 @@ DEFUN ("gnutls-available-p", Fgnutls_available_p, Sgnutls_available_p, 0, 0, 0,
else
{
Lisp_Object status;
- status = init_gnutls_functions (Vdynamic_library_alist) ? Qt : Qnil;
+ status = init_gnutls_functions () ? Qt : Qnil;
Vlibrary_cache = Fcons (Fcons (Qgnutls_dll, status), Vlibrary_cache);
return status;
}
@@ -800,7 +791,10 @@ one trustfile (usually a CA bundle). */)
error ("gnutls-boot: invalid :hostname parameter");
c_hostname = SSDATA (hostname);
- if (NUMBERP (loglevel))
+ state = XPROCESS (proc)->gnutls_state;
+ XPROCESS (proc)->gnutls_p = 1;
+
+ if (TYPE_RANGED_INTEGERP (int, loglevel))
{
fn_gnutls_global_set_log_function (gnutls_log_function);
fn_gnutls_global_set_log_level (XINT (loglevel));
@@ -822,7 +816,7 @@ one trustfile (usually a CA bundle). */)
XPROCESS (proc)->gnutls_state = NULL;
XPROCESS (proc)->gnutls_x509_cred = NULL;
XPROCESS (proc)->gnutls_anon_cred = NULL;
- XPROCESS (proc)->gnutls_cred_type = type;
+ pset_gnutls_cred_type (XPROCESS (proc), type);
GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_EMPTY;
GNUTLS_LOG (1, max_log_level, "allocating credentials");
@@ -863,9 +857,9 @@ one trustfile (usually a CA bundle). */)
int file_format = GNUTLS_X509_FMT_PEM;
Lisp_Object tail;
- for (tail = trustfiles; !NILP (tail); tail = Fcdr (tail))
+ for (tail = trustfiles; CONSP (tail); tail = XCDR (tail))
{
- Lisp_Object trustfile = Fcar (tail);
+ Lisp_Object trustfile = XCAR (tail);
if (STRINGP (trustfile))
{
GNUTLS_LOG2 (1, max_log_level, "setting the trustfile: ",
@@ -885,9 +879,9 @@ one trustfile (usually a CA bundle). */)
}
}
- for (tail = crlfiles; !NILP (tail); tail = Fcdr (tail))
+ for (tail = crlfiles; CONSP (tail); tail = XCDR (tail))
{
- Lisp_Object crlfile = Fcar (tail);
+ Lisp_Object crlfile = XCAR (tail);
if (STRINGP (crlfile))
{
GNUTLS_LOG2 (1, max_log_level, "setting the CRL file: ",
@@ -905,10 +899,10 @@ one trustfile (usually a CA bundle). */)
}
}
- for (tail = keylist; !NILP (tail); tail = Fcdr (tail))
+ for (tail = keylist; CONSP (tail); tail = XCDR (tail))
{
- Lisp_Object keyfile = Fcar (Fcar (tail));
- Lisp_Object certfile = Fcar (Fcdr (tail));
+ Lisp_Object keyfile = Fcar (XCAR (tail));
+ Lisp_Object certfile = Fcar (Fcdr (XCAR (tail)));
if (STRINGP (keyfile) && STRINGP (certfile))
{
GNUTLS_LOG2 (1, max_log_level, "setting the client key file: ",