]> code.delx.au - gnu-emacs/blobdiff - src/gnutls.c
Merge from emacs-24; up to 2012-12-06T01:39:03Z!monnier@iro.umontreal.ca
[gnu-emacs] / src / gnutls.c
index 70eea3b0b8925964ffede9896d666f4c7f450126..db0a6dac01cb4bec2c30bc8201e0c57fd21e76d0 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,7 +18,6 @@ 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"
@@ -31,15 +30,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;
@@ -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,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);
 
@@ -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: ",