X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/a8e7d6d783219972c08fd49a3a2afaf26eb139c2..d5e5e7b41166815a843148f2081d19bc14b628b2:/src/gnutls.c diff --git a/src/gnutls.c b/src/gnutls.c index cf47131484..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; @@ -322,6 +320,7 @@ emacs_gnutls_handshake (struct Lisp_Process *proc) { ret = fn_gnutls_handshake (state); emacs_gnutls_handle_error (state, ret); + QUIT; } while (ret < 0 && fn_gnutls_error_is_fatal (ret) == 0); @@ -351,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; } @@ -385,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; } } @@ -406,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; @@ -438,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 { @@ -447,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; @@ -471,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. */ } @@ -599,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))) @@ -631,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))); @@ -656,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; } @@ -804,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)); @@ -826,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"); @@ -867,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: ", @@ -889,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: ", @@ -909,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: ",