Merge from trunk.
[bpt/emacs.git] / src / gnutls.c
index 5189f20..9ea3f59 100644 (file)
@@ -1,5 +1,5 @@
 /* GnuTLS glue for GNU Emacs.
-   Copyright (C) 2010-201 Free Software Foundation, Inc.
+   Copyright (C) 2010-2013 Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
 
@@ -18,10 +18,10 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 
 #include <config.h>
 #include <errno.h>
-#include <setjmp.h>
 
 #include "lisp.h"
 #include "process.h"
+#include "coding.h"
 
 #ifdef HAVE_GNUTLS
 #include <gnutls/gnutls.h>
@@ -31,15 +31,14 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 #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;
@@ -58,6 +57,9 @@ static Lisp_Object QCgnutls_bootprop_callbacks_verify;
 
 static void gnutls_log_function (int, const char *);
 static void gnutls_log_function2 (int, const char*, const char*);
+#ifdef HAVE_GNUTLS3
+static void gnutls_audit_log_function (gnutls_session_t, const char *);
+#endif
 
 \f
 #ifdef WINDOWSNT
@@ -110,6 +112,9 @@ DEF_GNUTLS_FN (void, gnutls_dh_set_prime_bits,
 DEF_GNUTLS_FN (int, gnutls_error_is_fatal, (int));
 DEF_GNUTLS_FN (int, gnutls_global_init, (void));
 DEF_GNUTLS_FN (void, gnutls_global_set_log_function, (gnutls_log_func));
+#ifdef HAVE_GNUTLS3
+DEF_GNUTLS_FN (void, gnutls_global_set_audit_log_function, (gnutls_audit_log_func));
+#endif
 DEF_GNUTLS_FN (void, gnutls_global_set_log_level, (int));
 DEF_GNUTLS_FN (void, gnutls_global_set_mem_functions,
               (gnutls_alloc_function, gnutls_alloc_function,
@@ -142,13 +147,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;
@@ -175,6 +180,9 @@ init_gnutls_functions (Lisp_Object libraries)
   LOAD_GNUTLS_FN (library, gnutls_error_is_fatal);
   LOAD_GNUTLS_FN (library, gnutls_global_init);
   LOAD_GNUTLS_FN (library, gnutls_global_set_log_function);
+#ifdef HAVE_GNUTLS3
+  LOAD_GNUTLS_FN (library, gnutls_global_set_audit_log_function);
+#endif
   LOAD_GNUTLS_FN (library, gnutls_global_set_log_level);
   LOAD_GNUTLS_FN (library, gnutls_global_set_mem_functions);
   LOAD_GNUTLS_FN (library, gnutls_handshake);
@@ -232,6 +240,9 @@ init_gnutls_functions (Lisp_Object libraries)
 #define fn_gnutls_error_is_fatal               gnutls_error_is_fatal
 #define fn_gnutls_global_init                  gnutls_global_init
 #define fn_gnutls_global_set_log_function      gnutls_global_set_log_function
+#ifdef HAVE_GNUTLS3
+#define fn_gnutls_global_set_audit_log_function        gnutls_global_set_audit_log_function
+#endif
 #define fn_gnutls_global_set_log_level         gnutls_global_set_log_level
 #define fn_gnutls_global_set_mem_functions     gnutls_global_set_mem_functions
 #define fn_gnutls_handshake                    gnutls_handshake
@@ -241,7 +252,9 @@ init_gnutls_functions (Lisp_Object libraries)
 #define fn_gnutls_record_recv                  gnutls_record_recv
 #define fn_gnutls_record_send                  gnutls_record_send
 #define fn_gnutls_strerror                     gnutls_strerror
+#ifdef WINDOWSNT
 #define fn_gnutls_transport_set_errno          gnutls_transport_set_errno
+#endif
 #define fn_gnutls_transport_set_ptr2           gnutls_transport_set_ptr2
 #define fn_gnutls_x509_crt_check_hostname      gnutls_x509_crt_check_hostname
 #define fn_gnutls_x509_crt_deinit              gnutls_x509_crt_deinit
@@ -251,6 +264,18 @@ init_gnutls_functions (Lisp_Object libraries)
 #endif /* !WINDOWSNT */
 
 \f
+#ifdef HAVE_GNUTLS3
+/* Function to log a simple audit message.  */
+static void
+gnutls_audit_log_function (gnutls_session_t session, const char* string)
+{
+  if (global_gnutls_log_level >= 1)
+    {
+      message ("gnutls.c: [audit] %s", string);
+    }
+}
+#endif
+
 /* Function to log a simple message.  */
 static void
 gnutls_log_function (int level, const char* string)
@@ -346,11 +371,13 @@ emacs_gnutls_record_check_pending (gnutls_session_t state)
   return fn_gnutls_record_check_pending (state);
 }
 
+#ifdef WINDOWSNT
 void
 emacs_gnutls_transport_set_errno (gnutls_session_t state, int err)
 {
   fn_gnutls_transport_set_errno (state, err);
 }
+#endif
 
 ptrdiff_t
 emacs_gnutls_write (struct Lisp_Process *proc, const char *buf, ptrdiff_t nbyte)
@@ -361,12 +388,7 @@ emacs_gnutls_write (struct Lisp_Process *proc, const char *buf, ptrdiff_t nbyte)
 
   if (proc->gnutls_initstage != GNUTLS_STAGE_READY)
     {
-#ifdef EWOULDBLOCK
-      errno = EWOULDBLOCK;
-#endif
-#ifdef EAGAIN
       errno = EAGAIN;
-#endif
       return 0;
     }
 
@@ -386,14 +408,7 @@ emacs_gnutls_write (struct Lisp_Process *proc, const char *buf, ptrdiff_t 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;
            }
        }
@@ -439,7 +454,7 @@ emacs_gnutls_read (struct Lisp_Process *proc, char *buf, ptrdiff_t 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 {
@@ -448,19 +463,19 @@ emacs_gnutls_read (struct Lisp_Process *proc, char *buf, ptrdiff_t 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;
 
@@ -472,14 +487,26 @@ 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;
-      GNUTLS_LOG2 (1, max_log_level, "non-fatal error:", str);
-      /* TODO: EAGAIN AKA Qgnutls_e_again should be level 2.  */
+      ret = 1;
+
+      switch (err)
+        {
+        case GNUTLS_E_AGAIN:
+          GNUTLS_LOG2 (3,
+                       max_log_level,
+                       "retry:",
+                       str);
+        default:
+          GNUTLS_LOG2 (1,
+                       max_log_level,
+                       "non-fatal error:",
+                       str);
+        }
     }
 
   if (err == GNUTLS_E_WARNING_ALERT_RECEIVED
@@ -657,7 +684,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;
     }
@@ -781,16 +808,10 @@ one trustfile (usually a CA bundle).  */)
   CHECK_LIST (proplist);
 
   if (NILP (Fgnutls_available_p ()))
-    {
-      error ("GnuTLS not available");
-      return gnutls_make_error (GNUTLS_EMACS_ERROR_NOT_LOADED);
-    }
+    error ("GnuTLS not available");
 
   if (!EQ (type, Qgnutls_x509pki) && !EQ (type, Qgnutls_anon))
-    {
-      error ("Invalid GnuTLS credential type");
-      return gnutls_make_error (GNUTLS_EMACS_ERROR_INVALID_TYPE);
-    }
+    error ("Invalid GnuTLS credential type");
 
   hostname              = Fplist_get (proplist, QCgnutls_bootprop_hostname);
   priority_string       = Fplist_get (proplist, QCgnutls_bootprop_priority);
@@ -806,11 +827,13 @@ one trustfile (usually a CA bundle).  */)
   c_hostname = SSDATA (hostname);
 
   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);
+#ifdef HAVE_GNUTLS3
+      fn_gnutls_global_set_audit_log_function (gnutls_audit_log_function);
+#endif
       fn_gnutls_global_set_log_level (XINT (loglevel));
       max_log_level = XINT (loglevel);
       XPROCESS (proc)->gnutls_log_level = max_log_level;
@@ -826,11 +849,10 @@ one trustfile (usually a CA bundle).  */)
   emacs_gnutls_deinit (proc);
 
   /* Mark PROC as a GnuTLS process.  */
-  XPROCESS (proc)->gnutls_p = 1;
   XPROCESS (proc)->gnutls_state = NULL;
   XPROCESS (proc)->gnutls_x509_cred = NULL;
   XPROCESS (proc)->gnutls_anon_cred = NULL;
-  PSET (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");
@@ -878,6 +900,13 @@ one trustfile (usually a CA bundle).  */)
            {
              GNUTLS_LOG2 (1, max_log_level, "setting the trustfile: ",
                           SSDATA (trustfile));
+             trustfile = ENCODE_FILE (trustfile);
+#ifdef WINDOWSNT
+             /* Since GnuTLS doesn't support UTF-8 or UTF-16 encoded
+                file names on Windows, we need to re-encode the file
+                name using the current ANSI codepage.  */
+             trustfile = ansi_encode_filename (trustfile);
+#endif
              ret = fn_gnutls_certificate_set_x509_trust_file
                (x509_cred,
                 SSDATA (trustfile),
@@ -900,6 +929,10 @@ one trustfile (usually a CA bundle).  */)
            {
              GNUTLS_LOG2 (1, max_log_level, "setting the CRL file: ",
                           SSDATA (crlfile));
+             crlfile = ENCODE_FILE (crlfile);
+#ifdef WINDOWSNT
+             crlfile = ansi_encode_filename (crlfile);
+#endif
              ret = fn_gnutls_certificate_set_x509_crl_file
                (x509_cred, SSDATA (crlfile), file_format);
 
@@ -923,6 +956,12 @@ one trustfile (usually a CA bundle).  */)
                           SSDATA (keyfile));
              GNUTLS_LOG2 (1, max_log_level, "setting the client cert file: ",
                           SSDATA (certfile));
+             keyfile = ENCODE_FILE (keyfile);
+             certfile = ENCODE_FILE (certfile);
+#ifdef WINDOWSNT
+             keyfile = ansi_encode_filename (keyfile);
+             certfile = ansi_encode_filename (certfile);
+#endif
              ret = fn_gnutls_certificate_set_x509_key_file
                (x509_cred, SSDATA (certfile), SSDATA (keyfile), file_format);
 
@@ -1086,6 +1125,9 @@ one trustfile (usually a CA bundle).  */)
       fn_gnutls_x509_crt_deinit (gnutls_verify_cert);
     }
 
+  /* Set this flag only if the whole initialization succeeded.  */
+  XPROCESS (proc)->gnutls_p = 1;
+
   return gnutls_make_error (ret);
 }