emacs-devel
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[PATCH] GnuTLS support on Woe32


From: Claudio Bley
Subject: [PATCH] GnuTLS support on Woe32
Date: Sun, 06 Mar 2011 16:16:34 +0100
User-agent: Wanderlust/2.15.9 (Almost Unreal) SEMI/1.14.6 (Maruoka) FLIM/1.14.9 (Goj┼Ź) APEL/10.8 Emacs/23.1 (i686-pc-linux-gnu) MULE/6.0 (HANACHIRUSATO)

Hi.

Please find attached a patch which makes building Emacs with GnuTLS
support on Woe32 possible.

I've build it using the binaries of GnuTLS 2.10.1 by Simon Josefsson
and later also used self-built DLLs of 2.10.4.

I'm using it with SMTP, POP3 and IMAP4. (using STARTTLS and direct
TLS/SSL connections).

Cheers.

- Claudio

PS: Sorry for the delay. :)

[[text/plain; charset=us-ascii
Content-Disposition: inline; filename=GnuTLS-on-Woe32.txt][7bit]]
# Bazaar merge directive format 2 (Bazaar 0.90)
# revision_id: address@hidden
# target_branch: bzr+ssh://address@hidden/emacs/trunk
# testament_sha1: 43e7b073c148a57eec10eacd12a37d4dfe79dd81
# timestamp: 2011-03-06 16:02:27 +0100
# base_revision_id: address@hidden
# 
# Begin patch
=== modified file 'lib-src/ChangeLog'
--- lib-src/ChangeLog   2011-03-03 07:00:23 +0000
+++ lib-src/ChangeLog   2011-03-06 14:57:51 +0000
@@ -1,3 +1,7 @@
+2011-03-06  Claudio Bley  <address@hidden>
+
+       * makefile.w32-in (obj): Added gnutls.o.
+
 2011-03-03  Drake Wilson  <address@hidden>  (tiny change)
 
        * emacsclient.c (longopts): Add quiet.

=== modified file 'lib-src/makefile.w32-in'
--- lib-src/makefile.w32-in     2011-02-22 17:51:38 +0000
+++ lib-src/makefile.w32-in     2011-03-06 14:57:51 +0000
@@ -142,7 +142,8 @@
        syntax.o bytecode.o \
        process.o callproc.o unexw32.o \
        region-cache.o sound.o atimer.o \
-       doprnt.o intervals.o textprop.o composite.o
+       doprnt.o intervals.o textprop.o composite.o \
+       gnutls.o
 
 #
 # These are the lisp files that are loaded up in loadup.el

=== modified file 'lisp/ChangeLog'
--- lisp/ChangeLog      2011-03-04 08:40:00 +0000
+++ lisp/ChangeLog      2011-03-06 14:57:51 +0000
@@ -1,3 +1,9 @@
+2011-03-06  Claudio Bley  <address@hidden>
+
+       * net/gnutls.el (gnutls-negotiate): Check whether default
+       trustfile exists before going to use it. Add missing argument to
+       gnutls-message-maybe call. Return return value.
+
 2011-03-04  Glenn Morris  <address@hidden>
 
        * outline.el (outline-regexp): No longer allow nil.

=== modified file 'lisp/gnus/ChangeLog'
--- lisp/gnus/ChangeLog 2011-03-03 13:21:50 +0000
+++ lisp/gnus/ChangeLog 2011-03-06 14:57:51 +0000
@@ -1,3 +1,8 @@
+2011-03-06  Claudio Bley  <address@hidden>
+
+       * starttls.el (starttls-negotiate-gnutls, starttls-open-stream-gnutls):
+       Check for builtin GnuTLS support and use it if available.
+
 2011-03-03  Tassilo Horn  <address@hidden>
 
        * nnimap.el (nnimap-parse-flags): Add a workaround for FETCH lines with

=== modified file 'lisp/gnus/starttls.el'
--- lisp/gnus/starttls.el       2011-01-25 04:08:28 +0000
+++ lisp/gnus/starttls.el       2011-03-06 14:57:51 +0000
@@ -195,37 +195,46 @@
   :type 'regexp
   :group 'starttls)
 
+(eval-and-compile
+  (when (fboundp 'gnutls-boot) (require 'gnutls)))
+
 (defun starttls-negotiate-gnutls (process)
   "Negotiate TLS on PROCESS opened by `open-starttls-stream'.
 This should typically only be done once.  It typically returns a
 multi-line informational message with information about the
 handshake, or nil on failure."
-  (let (buffer info old-max done-ok done-bad)
-    (if (null (setq buffer (process-buffer process)))
-       ;; XXX How to remove/extract the TLS negotiation junk?
-       (signal-process (process-id process) 'SIGALRM)
-      (with-current-buffer buffer
-       (save-excursion
-         (setq old-max (goto-char (point-max)))
-         (signal-process (process-id process) 'SIGALRM)
-         (while (and (processp process)
-                     (eq (process-status process) 'run)
-                     (save-excursion
-                       (goto-char old-max)
-                       (not (or (setq done-ok (re-search-forward
-                                               starttls-success nil t))
-                                (setq done-bad (re-search-forward
-                                                starttls-failure nil t))))))
-           (accept-process-output process 1 100)
-           (sit-for 0.1))
-         (setq info (buffer-substring-no-properties old-max (point-max)))
-         (delete-region old-max (point-max))
-         (if (or (and done-ok (not done-bad))
-                 ;; Prevent mitm that fake success msg after failure msg.
-                 (and done-ok done-bad (< done-ok done-bad)))
-             info
-           (message "STARTTLS negotiation failed: %s" info)
-           nil))))))
+  (if (fboundp 'gnutls-boot)
+      (eq t (gnutls-negotiate process nil))
+    (let (buffer info old-max done-ok done-bad)
+      (if (null (setq buffer (process-buffer process)))
+          ;; XXX How to remove/extract the TLS negotiation junk?
+          ;;(signal-process (process-id process) 'SIGALRM)
+          (call-process "kill" nil nil nil
+                        "-ALRM" (format "%d" (process-id process)))
+        (with-current-buffer buffer
+          (save-excursion
+            (setq old-max (goto-char (point-max)))
+            (call-process "kill" nil nil nil
+                          "-ALRM" (format "%d" (process-id process)))
+                                        ;(signal-process (process-id process) 
'SIGALRM)
+            (while (and (processp process)
+                        (eq (process-status process) 'run)
+                        (save-excursion
+                          (goto-char old-max)
+                          (not (or (setq done-ok (re-search-forward
+                                                  starttls-success nil t))
+                                   (setq done-bad (re-search-forward
+                                                   starttls-failure nil t))))))
+              (accept-process-output process 1 100)
+              (sit-for 0.1))
+            (setq info (buffer-substring-no-properties old-max (point-max)))
+            (delete-region old-max (point-max))
+            (if (or (and done-ok (not done-bad))
+                    ;; Prevent mitm that fake success msg after failure msg.
+                    (and done-ok done-bad (< done-ok done-bad)))
+                info
+              (message "STARTTLS negotiation failed: %s" info)
+              nil)))))))
 
 (defun starttls-negotiate (process)
   (if starttls-use-gnutls
@@ -241,31 +250,34 @@
 
 (defun starttls-open-stream-gnutls (name buffer host port)
   (message "Opening STARTTLS connection to `%s:%s'..." host port)
-  (let* (done
-        (old-max (with-current-buffer buffer (point-max)))
-        (process-connection-type starttls-process-connection-type)
-        (process (apply #'start-process name buffer
-                        starttls-gnutls-program "-s" host
-                        "-p" (if (integerp port)
-                                 (int-to-string port)
-                               port)
-                        starttls-extra-arguments)))
-    (starttls-set-process-query-on-exit-flag process nil)
-    (while (and (processp process)
-               (eq (process-status process) 'run)
-               (with-current-buffer buffer
-                 (goto-char old-max)
-                 (not (setq done (re-search-forward
-                                  starttls-connect nil t)))))
-      (accept-process-output process 0 100)
-      (sit-for 0.1))
-    (if done
-       (with-current-buffer buffer
-         (delete-region old-max done))
-      (delete-process process)
-      (setq process nil))
+  (let (done process)
+    (if (fboundp 'gnutls-boot)
+        (setq process (open-network-stream name buffer host port)
+              done (process-status process))
+      (let* ((old-max (with-current-buffer buffer (point-max)))
+             (process-connection-type starttls-process-connection-type))
+        (setq process (apply #'start-process name buffer
+                             starttls-gnutls-program "-s" host
+                             "-p" (if (integerp port)
+                                      (int-to-string port)
+                                    port)
+                             starttls-extra-arguments))
+        (starttls-set-process-query-on-exit-flag process nil)
+        (while (and (processp process)
+                    (eq (process-status process) 'run)
+                    (with-current-buffer buffer
+                      (goto-char old-max)
+                      (not (setq done (re-search-forward
+                                       starttls-connect nil t)))))
+          (accept-process-output process 0 100)
+          (sit-for 0.1))
+        (if done
+            (with-current-buffer buffer
+              (delete-region old-max done))
+          (delete-process process)
+          (setq process nil))))
     (message "Opening STARTTLS connection to `%s:%s'...%s"
-            host port (if done "done" "failed"))
+             host port (if done "done" "failed"))
     process))
 
 ;;;###autoload

=== modified file 'lisp/net/gnutls.el'
--- lisp/net/gnutls.el  2011-01-25 04:08:28 +0000
+++ lisp/net/gnutls.el  2011-03-06 14:57:51 +0000
@@ -78,7 +78,8 @@
 KEYFILES is a list of client keys."
   (let* ((type (or type 'gnutls-x509pki))
          (trustfiles (or trustfiles
-                        '("/etc/ssl/certs/ca-certificates.crt")))
+                         (when (file-exists-p 
"/etc/ssl/certs/ca-certificates.crt")
+                              '("/etc/ssl/certs/ca-certificates.crt"))))
          (priority-string (or priority-string
                               (cond
                                ((eq type 'gnutls-anon)
@@ -94,9 +95,9 @@
 
     (gnutls-message-maybe
      (setq ret (gnutls-boot proc type params))
-     "boot: %s")
+     "boot: %s" params)
 
-    proc))
+    ret))
 
 (declare-function gnutls-errorp "gnutls.c" (error))
 (declare-function gnutls-error-string "gnutls.c" (error))

=== modified file 'nt/ChangeLog'
--- nt/ChangeLog        2011-02-27 19:48:31 +0000
+++ nt/ChangeLog        2011-03-06 14:57:51 +0000
@@ -1,3 +1,10 @@
+2011-03-06  Claudio Bley  <address@hidden>
+
+       * configure.bat: New options --without-gnutls and --lib, new build
+       variable USER_LIBS, automatically detect GnuTLS.
+       * INSTALL: Add instructions for GnuTLS support.
+       * gmake.defs: Prefix USER_LIB's with -l.
+
 2011-02-27  Eli Zaretskii  <address@hidden>
 
        * inc/unistd.h (readlink, symlink): Declare prototypes.

=== modified file 'nt/INSTALL'
--- nt/INSTALL  2011-01-26 08:36:39 +0000
+++ nt/INSTALL  2011-03-06 14:57:51 +0000
@@ -306,6 +306,13 @@
   `dynamic-library-alist' and the value of `libpng-version', and
   download compatible DLLs if needed.
 
+* Optional GnuTLS support
+
+  To build Emacs with GnuTLS support, make sure that the
+  gnutls/gnutls.h header file can be found in the include path and
+  link to the appropriate libraries (e.g. gnutls.dll and gcrypt.dll)
+  using the --lib option.
+
 * Experimental SVG support
 
   SVG support is currently experimental, and not built by default.

=== modified file 'nt/configure.bat'
--- nt/configure.bat    2011-01-29 12:36:11 +0000
+++ nt/configure.bat    2011-03-06 14:57:51 +0000
@@ -86,10 +86,13 @@
 set usercflags=
 set docflags=
 set userldflags=
+set userlibs=
 set doldflags=
+set dolibs=
 set sep1=
 set sep2=
 set sep3=
+set sep4=
 set distfiles=
 
 rem ----------------------------------------------------------------------
@@ -107,10 +110,12 @@
 if "%1" == "--no-cygwin" goto nocygwin
 if "%1" == "--cflags" goto usercflags
 if "%1" == "--ldflags" goto userldflags
+if "%1" == "--lib" goto userlibs
 if "%1" == "--without-png" goto withoutpng
 if "%1" == "--without-jpeg" goto withoutjpeg
 if "%1" == "--without-gif" goto withoutgif
 if "%1" == "--without-tiff" goto withouttiff
+if "%1" == "--without-gnutls" goto withoutgnutls
 if "%1" == "--without-xpm" goto withoutxpm
 if "%1" == "--with-svg" goto withsvg
 if "%1" == "--distfiles" goto distfiles
@@ -129,11 +134,13 @@
 echo.   --no-cygwin             use -mno-cygwin option with GCC
 echo.   --cflags FLAG           pass FLAG to compiler
 echo.   --ldflags FLAG          pass FLAG to compiler when linking
+echo.   --lib LIB               link to auxiliary library LIB
 echo.   --without-png           do not use PNG library even if it is installed
 echo.   --without-jpeg          do not use JPEG library even if it is installed
 echo.   --without-gif           do not use GIF library even if it is installed
 echo.   --without-tiff          do not use TIFF library even if it is installed
 echo.   --without-xpm           do not use XPM library even if it is installed
+echo.   --without-gnutls        do not use GNUTLS library even if it is 
installed
 echo.   --with-svg              use the RSVG library (experimental)
 echo.   --distfiles             path to files for make dist, e.g. libXpm.dll
 goto end
@@ -213,6 +220,14 @@
 shift
 goto again
 
+:userlibs
+shift
+echo. userlibs: %userlibs%
+set userlibs=%userlibs%%sep4%%1
+set sep4= %nothing%
+shift
+goto again
+
 rem ----------------------------------------------------------------------
 
 :withoutpng
@@ -239,6 +254,14 @@
 
 rem ----------------------------------------------------------------------
 
+:withoutgnutls
+set tlssupport=N
+set HAVE_GNUTLS=
+shift
+goto again
+
+rem ----------------------------------------------------------------------
+
 :withouttiff
 set tiffsupport=N
 set HAVE_TIFF=
@@ -467,6 +490,29 @@
 :pngDone
 rm -f junk.c junk.obj
 
+if (%tlssupport%) == (N) goto tlsDone
+
+echo Checking for libgnutls...
+echo #include "gnutls/gnutls.h" >junk.c
+echo main (){} >>junk.c
+rem   -o option is ignored with cl, but allows result to be consistent.
+echo %COMPILER% %usercflags% %mingwflag% -c junk.c -o junk.obj >>config.log
+%COMPILER% %usercflags% %mingwflag% -c junk.c -o junk.obj >junk.out 
2>>config.log
+if exist junk.obj goto haveTls
+
+echo ...gnutls.h not found, building without TLS support.
+echo The failed program was: >>config.log
+type junk.c >>config.log
+set HAVE_GNUTLS=
+goto :tlsDone
+
+:haveTls
+echo ...GNUTLS header available, building with GNUTLS support.
+set HAVE_GNUTLS=1
+
+:tlsDone
+rm -f junk.c junk.obj
+
 if (%jpegsupport%) == (N) goto jpegDone
 
 echo Checking for jpeg-6b...
@@ -639,6 +685,8 @@
 if (%docflags%)==(Y) echo USER_CFLAGS=%usercflags%>>config.settings
 for %%v in (%userldflags%) do if not (%%v)==() set doldflags=Y
 if (%doldflags%)==(Y) echo USER_LDFLAGS=%userldflags%>>config.settings
+for %%v in (%userlibs%) do if not (%%v)==() set dolibs=Y
+if (%dolibs%)==(Y) echo USER_LIBS=%userlibs%>>config.settings
 echo # End of settings from configure.bat>>config.settings
 echo. >>config.settings
 
@@ -651,6 +699,7 @@
 if (%doldflags%) == (Y) echo #define USER_LDFLAGS " %userldflags%">>config.tmp
 if (%profile%) == (Y) echo #define PROFILING 1 >>config.tmp
 if not "(%HAVE_PNG%)" == "()" echo #define HAVE_PNG 1 >>config.tmp
+if not "(%HAVE_GNUTLS%)" == "()" echo #define HAVE_GNUTLS 1 >>config.tmp
 if not "(%HAVE_JPEG%)" == "()" echo #define HAVE_JPEG 1 >>config.tmp
 if not "(%HAVE_GIF%)" == "()" echo #define HAVE_GIF 1 >>config.tmp
 if not "(%HAVE_TIFF%)" == "()" echo #define HAVE_TIFF 1 >>config.tmp
@@ -789,6 +838,7 @@
 set HAVE_DISTFILES=
 set distFilesOk=
 set pngsupport=
+set tlssupport=
 set jpegsupport=
 set gifsupport=
 set tiffsupport=

=== modified file 'nt/gmake.defs'
--- nt/gmake.defs       2011-01-25 04:08:28 +0000
+++ nt/gmake.defs       2011-03-06 14:57:51 +0000
@@ -279,6 +279,10 @@
 NOCYGWIN = -mno-cygwin
 endif
 
+ifdef USER_LIBS
+USER_LIBS := $(patsubst %,-l%,$(USER_LIBS))
+endif
+
 ifeq "$(ARCH)" "i386"
 ifdef NOOPT
 ARCH_CFLAGS     = -c $(DEBUG_FLAG) $(NOCYGWIN)

=== modified file 'src/ChangeLog'
--- src/ChangeLog       2011-03-02 21:30:51 +0000
+++ src/ChangeLog       2011-03-06 14:57:51 +0000
@@ -1,3 +1,24 @@
+2011-03-06  Claudio Bley  <address@hidden>
+
+       * process.c (wait_reading_process_output): Check if GnuTLS
+       buffered some data internally if no FDs are set for TLS
+       connections.
+
+       * makefile.w32-in (OBJ2): Add gnutls.$(O).
+       (LIBS): Link to USER_LIBS.
+       ($(BLD)/gnutls.$(0)): New target.
+
+       * gnutls.c (emacs_gnutls_handle_error): New function.
+       (wsaerror_to_errno): Likewise.
+       (emacs_gnutls_pull): New function for GnuTLS on Woe32.
+       (emacs_gnutls_push): Likewise.
+       (emacs_gnutls_handshake): Add Woe32 support. Retry handshake
+       unless a fatal error occured. Call gnutls_alert_send_appropriate
+       on error. Return error code.
+       (emacs_gnutls_write): Call emacs_gnutls_handle_error.
+       (emacs_gnutls_read): Likewise.
+       (Fgnutls_boot): Return handshake error code.
+
 2011-03-02  kbrown  <address@hidden>
 
        * sheap.c (STATIC_HEAP_SIZE): Increase to 13MB.

=== modified file 'src/gnutls.c'
--- src/gnutls.c        2011-01-25 04:08:28 +0000
+++ src/gnutls.c        2011-03-06 14:57:51 +0000
@@ -26,6 +26,88 @@
 #ifdef HAVE_GNUTLS
 #include <gnutls/gnutls.h>
 
+static int
+emacs_gnutls_handle_error (gnutls_session_t, int err);
+
+#ifdef WINDOWSNT
+#  include "sys/socket.h"
+#  include "systime.h"
+
+/* we need to translate Winsock errors because GnuTLS only checks
+ * for EAGAIN or EINTR */
+static int
+wsaerror_to_errno(int err)
+{
+  switch (err)
+    {
+    case WSAEWOULDBLOCK:
+      return EAGAIN;
+    case WSAEINTR:
+      return EINTR;
+    default:
+      return err;
+    }
+}
+
+static ssize_t
+emacs_gnutls_pull(gnutls_transport_ptr_t p, void* buf, size_t sz)
+{
+  int n, sc;
+  SELECT_TYPE fdset;
+  EMACS_TIME timeout;
+  struct Lisp_Process *proc = (struct Lisp_Process *)p;
+  int fd = proc->infd;
+
+  for (;;)
+    {
+      n = read(fd, (char*)buf, sz);
+
+      if (n >= 0)
+        return n;
+      else
+        {
+          int err = errno;
+
+          if (err == WSAEWOULDBLOCK)
+            {
+              EMACS_SET_SECS_USECS(timeout, 1, 0);
+              FD_ZERO (&fdset);
+              FD_SET ((int)fd, &fdset);
+
+              sc = select (fd + 1, &fdset, (SELECT_TYPE *)0, (SELECT_TYPE *)0, 
&timeout);
+
+              if (sc > 0)
+                continue;
+              else if (sc == 0)
+                err = EAGAIN;
+              else
+                err = wsaerror_to_errno(errno);
+            }
+          gnutls_transport_set_errno (proc->gnutls_state, err);
+
+          return -1;
+        }
+    }
+}
+
+static ssize_t
+emacs_gnutls_push(gnutls_transport_ptr_t p, const void* buf, size_t sz)
+{
+  struct Lisp_Process *proc = (struct Lisp_Process *)p;
+  int fd = proc->outfd;
+  ssize_t n = write((int)fd, buf, sz);
+
+  if (n >= 0)
+    return n;
+  else
+    {
+      gnutls_transport_set_errno (proc->gnutls_state, wsaerror_to_errno 
(errno));
+
+      return -1;
+    }
+}
+#endif  /* WINDOWSNT */
+
 Lisp_Object Qgnutls_code;
 Lisp_Object Qgnutls_anon, Qgnutls_x509pki;
 Lisp_Object Qgnutls_e_interrupted, Qgnutls_e_again,
@@ -39,7 +121,7 @@
 Lisp_Object Qgnutls_bootprop_callbacks;
 Lisp_Object Qgnutls_bootprop_loglevel;
 
-static void
+static int
 emacs_gnutls_handshake (struct Lisp_Process *proc)
 {
   gnutls_session_t state = proc->gnutls_state;
@@ -50,17 +132,45 @@
 
   if (proc->gnutls_initstage < GNUTLS_STAGE_TRANSPORT_POINTERS_SET)
     {
+#ifdef WINDOWSNT
+      /* On Windows we cannot transfer socket handles between
+       * different runtime libraries.
+       *
+       * We must handle reading / writing ourselves.
+       */
+      gnutls_transport_set_ptr2 (state,
+                                 (gnutls_transport_ptr_t) proc,
+                                 (gnutls_transport_ptr_t) proc);
+      gnutls_transport_set_push_function(state, &emacs_gnutls_push);
+      gnutls_transport_set_pull_function(state, &emacs_gnutls_pull);
+
+      /* For non blocking sockets or other custom made pull/push
+       * functions the gnutls_transport_set_lowat must be called, with
+       * a zero low water mark value. (GnuTLS 2.10.4 documentation)
+       *
+       * (note: this is probably not strictly necessary as the lowat
+       *  value is only used when no custom pull/push functions are
+       *  set) */
+      gnutls_transport_set_lowat (state, 0);
+#else
       /* 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_ptr_t) (long) proc->infd,
-                                (gnutls_transport_ptr_t) (long) proc->outfd);
+                                (gnutls_transport_ptr_t) proc->infd,
+                                (gnutls_transport_ptr_t) proc->outfd);
+#endif
 
       proc->gnutls_initstage = GNUTLS_STAGE_TRANSPORT_POINTERS_SET;
     }
 
-  ret = gnutls_handshake (state);
+  do
+    {
+      ret = gnutls_handshake (state);
+      emacs_gnutls_handle_error (state, ret);
+    }
+  while (ret < 0 && gnutls_error_is_fatal (ret) == 0);
+
   proc->gnutls_initstage = GNUTLS_STAGE_HANDSHAKE_TRIED;
 
   if (ret == GNUTLS_E_SUCCESS)
@@ -68,6 +178,11 @@
       /* here we're finally done.  */
       proc->gnutls_initstage = GNUTLS_STAGE_READY;
     }
+  else
+    {
+        gnutls_alert_send_appropriate (state, ret);
+    }
+  return ret;
 }
 
 int
@@ -98,7 +213,11 @@
           if (rtnval == GNUTLS_E_AGAIN || rtnval == GNUTLS_E_INTERRUPTED)
             continue;
           else
-            return (bytes_written ? bytes_written : -1);
+            {
+              emacs_gnutls_handle_error (state, rtnval);
+
+              return (bytes_written ? bytes_written : -1);
+            }
         }
 
       buf += rtnval;
@@ -121,19 +240,57 @@
       emacs_gnutls_handshake (proc);
       return -1;
     }
-
   rtnval = gnutls_read (state, buf, nbyte);
   if (rtnval >= 0)
     return rtnval;
+  else if (emacs_gnutls_handle_error (state, rtnval) == 0)
+    /* non-fatal error */
+    return -1;
   else {
-    if (rtnval == GNUTLS_E_AGAIN ||
-       rtnval == GNUTLS_E_INTERRUPTED)
-      return -1;
-    else
-      return 0;
+    /* a fatal error occured */
+    return 0;
   }
 }
 
+/* Returns zero if the error code was successfully handled.
+ */
+static int
+emacs_gnutls_handle_error (gnutls_session_t session, int err)
+{
+  int alert, ret;
+  const char *err_type, *str;
+
+  if (err >= 0)
+    return 0;
+
+  if (gnutls_error_is_fatal (err) == 0)
+    {
+      ret = 0;
+      err_type = "Non fatal";
+    }
+  else
+    {
+      ret = err;
+      err_type = "Fatal";
+    }
+
+  str = gnutls_strerror (err);
+  if (str == NULL)
+    str = "unknown";
+  message ("gnutls.c *** %s error: %s", err_type, str);
+
+  if (err == GNUTLS_E_WARNING_ALERT_RECEIVED
+      || err == GNUTLS_E_FATAL_ALERT_RECEIVED)
+    {
+      int alert = gnutls_alert_get (session);
+      str = gnutls_alert_get_name (alert);
+      if (str == NULL)
+       str = "unknown";
+      message ("gnutls.c *** Received alert [%d]: %s", alert, str);
+    }
+  return ret;
+}
+
 /* convert an integer error to a Lisp_Object; it will be either a
    known symbol like `gnutls_e_interrupted' and `gnutls_e_again' or
    simply the integer value of the error.  GNUTLS_E_SUCCESS is mapped
@@ -541,9 +698,7 @@
 
   GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CRED_SET;
 
-  emacs_gnutls_handshake (XPROCESS (proc));
-
-  return gnutls_make_error (GNUTLS_E_SUCCESS);
+  return gnutls_make_error(emacs_gnutls_handshake (XPROCESS (proc)));
 }
 
 DEFUN ("gnutls-bye", Fgnutls_bye,

=== modified file 'src/makefile.w32-in'
--- src/makefile.w32-in 2011-02-21 20:00:19 +0000
+++ src/makefile.w32-in 2011-03-06 14:57:51 +0000
@@ -105,6 +105,7 @@
        $(BLD)/floatfns.$(O)            \
        $(BLD)/frame.$(O)               \
        $(BLD)/gmalloc.$(O)             \
+       $(BLD)/gnutls.$(O)              \
        $(BLD)/intervals.$(O)           \
        $(BLD)/composite.$(O)           \
        $(BLD)/ralloc.$(O)              \
@@ -150,6 +151,7 @@
        $(OLE32)        \
        $(COMCTL32)     \
        $(UNISCRIBE)    \
+       $(USER_LIBS)    \
        $(libc)
 
 #
@@ -944,6 +946,14 @@
        $(EMACS_ROOT)/nt/inc/unistd.h \
        $(SRC)/getpagesize.h
 
+$(BLD)/gnutls.$(O) : \
+       $(SRC)/gnutls.h \
+       $(SRC)/gnutls.c \
+       $(CONFIG_H) \
+       $(EMACS_ROOT)/nt/inc/sys/socket.h \
+       $(SRC)/lisp.h \
+       $(SRC)/process.h
+
 $(BLD)/image.$(O) : \
        $(SRC)/image.c \
        $(CONFIG_H) \

=== modified file 'src/process.c'
--- src/process.c       2011-02-18 17:37:30 +0000
+++ src/process.c       2011-03-06 14:57:51 +0000
@@ -4785,6 +4785,21 @@
              &Available,
              (check_write ? &Writeok : (SELECT_TYPE *)0),
              (SELECT_TYPE *)0, &timeout);
+
+#ifdef HAVE_GNUTLS
+          /*
+           * GnuTLS buffers data internally. In lowat mode it leaves some data
+           * in the TCP buffers so that select works, but with custom pull/push
+           * functions we need to check if some data is available in the 
buffers
+           * manually.
+           */
+          if (nfds == 0 && wait_proc && wait_proc->gnutls_p
+              && gnutls_record_check_pending(wait_proc->gnutls_state) > 0)
+          {
+              FD_SET (wait_proc->infd, &Available);
+              nfds = 1;
+          }
+#endif
        }
 
       xerrno = errno;

# Begin bundle
IyBCYXphYXIgcmV2aXNpb24gYnVuZGxlIHY0CiMKQlpoOTFBWSZTWWTfpFcAEVb/gH3+VzLf////
///f/r////5gHZyFfd7b23nHjOKHrK96e7vbOudc95upIr3dcNKUAoCu8+V49Nx9wAejQ9mA9V3s
O+nvrvG7er7OnpmynpQvvtwHxVo+hr4aaJqaCaYCnpqBhKNkA0j01NkmRoaNADI0AAeoyDQJQgBN
GhDSmFMjU8o2U09CZABoADQANGgDIBoEpoTQiE1TINPImmQ0xDIABppkDTTRoAAAAACTUiICjIxJ
sp5J6TZTR6IyM0T0ho0BkGhpoPU00AAAEUpoCU09BPU/SnpqPFNNBpoxNBoAAAAAAAAACRITQJkB
MmmhMTU9J6EZMiCfoIyj009SYgaaDQBoA9OceQSRVCRZITEzlk0AF2QphTDzPkI75Cyk6vdOD8Mn
1aP1rj4tAgw/7HqeK/F40DOwydivOkbk5ySO5zbSCqe30hmJLul7qxhpVd69xAAlLHu2qFkgGMpR
pRRt83Nfbz9A3Xwli0j44wnnZsRUAM4lNnoNO7AlMChtLhJjI6XeOAE0wUQLEgLqRvDHeo2+6NXQ
Xu78oSkzUcTD+SOkfbwtunV5q6vx81kgFprOqYLo83Yu3HriWkrVq1CZ3SzI/sm5XJttODsjOmpk
5+fSaXfdnX3HkID2EGdcJQrlxmhtXautFyZZj0uDrpURZwyLw3zXzC8kG5h52jzV0DsgtdK2WbaZ
B35AirAAlilQXk47RVKQyvRyqCmjN56prKCq2jnGKYpsyyxCedmNM0K1p0mnxfF6xD2xe0FXd9NJ
ua54Hi9PixYdIhqY22wffodhPTpDduVyOB+fouUu78wdln7/Jqq0PgodxBhvg1sp/KT40d707V+4
q2jqgCIiUDkoCBigSaqSS4Zj96JaIc9/yG3C4B3RJdnVYm7DasqMu3wbDweYyRo9JbJ+i+e0pl7Q
kPwOf0icF8IwxbY7vf9a7seLs1fcsEeeW8YuffCp7Pr0o8pNdAWSEg5x/uUYya4Kn9XrRUsZqCe1
nCyDMOYXbQNK5NbSKVM6w60FgjjEZY326/KLQ4kmqqj+cIjck4M1TK+vJNgjv6hk2h6L5JI+HmYw
N6LFYjyGkIsUUirBQUVYsUVSWh2BOUcs1Jb+YQ65wtAbmfRvdDw6eHPkxZ2XQ37LvWmLBpqlcOpR
6epgZr3ge9GXiyCt+GN0Ys8jtWmyGqyrM2jSpwjCLoiNYynU77s8qxbCIw+Ye7vGZKviKlGE15ZO
bVKJu7GYa8GX1UPLaQPVKDCtBmMKafQ2bM+3VoQdnWMRkH0MpJJ1ihy26maJDmCAqrjkbZh25nkd
OyawhUha0E77qq2uqTsW8Ew6sGnfrUCEMIyKnRPTj/WoRC1xwSF+c0xytta60w/0aQeMSdZWyG2a
9evg3wplXsXo4nZfKspcOzcT6So/ltN+sEW5KSVX2GO/+v/axkLVj3JhlHPWaOvHwUhGMCqvnOfP
1bGxr2e0yvXFjDsa5pwMpv+IvOW+xe6BULfVc9hD3z+AMo5YOgrIGnSWUzLvW839p2UOFqzem2W5
v+tpM1jyddjPRVn3+LEedcwVd60rV68/i2lyq6o3pZXpyl4wn3Cp2ma31W9VO5SgrNIhFbxNuVpP
l7Tr7JSWljOrKpUdXURLxLlstQiTrJkxbOjjnliBpvOiwgaI93l7vqPj6WBtURNZG6nur0Lpb0lS
y2TsqaiE8HudOBfGqvA2t5p6Uk40WbBikoE74a/HgJSnhzizD59Cioeh8Ikjl2JxaAiX4GaWzBYL
bWp4tjyJpBupZZ4OWrbdOxxcKZow2CuymsY55qJ3qIehs67ngisdesVfwNWYcfGOP1eUtr6/J23h
xSmbY8ypOcrN7b7K+t5N5Si+A8Ssvwv7HQ8xmTurKWUZqbumERY36HFvFIt0SulEr0G0MPJ9PlYf
fqCBMhiLmQYKJ77JChDEQpRCCD3ChkTpX9q6QyY8Kxu5SOuOcUTnjR5K326/lExuxJ/TyBTu291B
6IXyJME40Du93x2Nd0sOg6bV40YYUtRiRv4dNg40LfTVVewetlhjz/lwk7OSg3kDrbP2Fp4ujXzt
+f7ZY8TdIq65Qrr4CrW5ga2ktuuEfueZmU/QPF4EdQFANnpqn4PMTlCnnQfRzKOEk9tG0/XbDqa4
2kMdRt6j6w6QR+zxXMcisP70Q9c2zi09J+D/hcOgXOP0s1Pq/DD3vdgHketxNH1y9yzRZU1exxJs
KhJIpBp0kN9Pn0mu20/dPtPwDNZ4fnXOa/Upus265bIbkHeBWBgymea5t7HM1EcPt+Dh49xHD9h2
kRLx93OfxqcsloWfnq8CQlZCk2ouIaqdmvxuB0LuN5tiZUcvkWlcji7U13mDtSOiOyVlOROt1N5n
/oMwaeSPej7ybSE1rMhh7ANQjfwCLDknBRYEQUN202UN8IAOYE3b6QQNmADw4CqBg11vfdDVMAuw
89NHc1T1A8oTTZ81aiRRU5RghB8g+9PMKgQCcwnXpNNjmIgIoPJKBdaBQ8FQ2bSwCyKjRKePPHXC
bJw1qUb9HCRtVacKlH2U0j54GnLp7/u2SxZoSa+VJVCi8DGvBqo7QFRINxaDTbFekgZMHjKEErIJ
9cE5RiDlOciodYi1hFdDvuA7wJ+78p4y+siBLExPjhs8zQSW5xVbYPLaylrWRXLLm+Z6wtu83dpP
BVHFzssAJOhjk/FMDYRdQmAumpASgaatfOKYwkjpptxAa6S2C6LB2wh9X6AhmCwfFMOQhKEnjKyZ
MloyCZgyzuL9BTwRYkgg9JBaAPCRN4iBkVC8bjBAzJGSEQA+MocIzRY49Jz/s1Y0q6xJg5EBpJ4i
EMmaQAoAavTklB5A7t+ZMrTQtMANwWNQyGkwQFQSakkRR1WKqj1Q/B6GSr2pKkJ9H2s0oxdKU4VJ
U6Mm+YiwkiYAYuLZxurJXg5i3bSEhF5MLzkU8c9Q6hejfdCAUxIND/TMxEgkbCJYY7JzbKTioKq9
hZ2PkMZ8Kbdej39sY5Rf4nYfmMdX45gQowREQGc5UtVzqKhMU1AF6CQa67UABqE+ZQ83Tc0JhnjC
o5MArhWFsRLkNXwWWrpLxSFTA/BfW3j1FuRTA9Ec3QJBeZHOMVDNmowIyKKOYiVCpIzFKnQ4BfG4
7+JEzMzOeuoYabDLKTAMYyXXRsawm8NQ5DvNCZX88QGQUSZisTgECDpMJgGnYd7gZgo4QRKgyO9z
kzrRkuQSuA3FaTYm+cdalOvOl5QtJkzKcWzCNs6XVpY8NgQ8Ujkk4xpbduCipFIYIa+6o3lzmzIY
ED92ogNE7T1rhuKdTQ1LGxMtsWcbm23IgHTv4q9TdG1r0hvpGT92Iuc9WhlKkIRWpiVkK2sNaEIK
JNQAYqbDnER568UDehS06KnWTHTDOCer/1AzxECAtCh4IhLKUnOOnTqbFTx5HB0yxkUMGbwZZ1yj
Mie2p1kjlwMJDZAzZ8WjKlDEwMy4RgRKXIERjsNNSYw4eRJIW3vkqqTW87q7l6i0seOYbcTiXAUA
gekC2yzs9hEDwmpnacDc1Tv6WmBms0QMzENSEgyrwKBlkVh5jAC8vnoz3XXbwkepWJoTR9LHXEzO
RWb6oXNihAjSATNEmbjnsDboidCmDBAvYqczfpuUIlDloWHEyYdqSUPkAFMKatydroSbjKUroviI
MLLbc7qqcg6bI9ysAFJS6vu4i0RepIUfpdxkPsKkloUDaxKCu0m6pnMkPeADiuA4KnPgxteWiGoX
LlimMz1RECFeXaIgReP1auznmKoc3uaRNRo4ZzgmK4e2mKgBt1al6qymV4DClzsM3F40GanJznlS
Ax3hCcbHOMuuwxjGx167qiJgyORvyLBQ43IGZUqai1HnUfY48geEO4Ohwlxq5Pf1Z3IwpGD95rKM
8O4VxIjIYrqDh4r6qzGpUdLkSkeK4ARUjfrUnkGdS6T7epIi9ToYNSZz8AC2kyC01DKPkAD6DIv3
FRkxIPGXMGkI5YSDMzcWgttNHP4m6r0mzUiEYg5Zq1WoOGHQQVyrgfMJhKKjoqbqGhCPEx44zNH5
bBLY0IGYxYYXCzNMNvE5ClSZLoT0DkbndWJUp5fU3B1YZYxrnHNprOHPE6qIgcPtyJhqcGUJqtlL
iIE2FyYK0GNixYuWqHIa0yVjwUL4NacdlZGxg1JZ2Mxh2zGSkCZsYIZE5DyBEgbEchhxu+brdS5Y
UqPNddDM23Dbc+fsAHm+t+j09V+Lu6eDtP5GIscnPLDn3wkT2ELnnylAc+63zynS2QBEACz4EGgi
JJAJ0WtUpkHkUN12sxdm1+vz7R6RjwM0qo5cECN6zajM3TEuZ4A+6nxnxco5MCQmCIkd02u0cMxD
fvawn3ipUYITmZdiFMRVUVESJyoa5I2bVUVYIyLBXRoyjlJM4so5iXueLSOSDjwZY06iylExxJs3
hChSm/CEya3Yc59D+H/HQLpIm/sfrujmBjj0/uyDFoDEAQDCp396d8wA1cxPQCjGbZk1L/3EMhuw
+KgNW52YazedFj5OGt2maYSx/pRlx4Chzr89R/oKAKYajFYMVHao07cJVXAqfbMgGVnFjETZwYaE
jE2bDhiupY5Xb0P69hiEL7yi1F5U0o1NSsHUYaEhOwDejeF6v5HxRi0SdGbVbCZ2pDDVSoPSalFN
zwpMh+lO8/u86By2FNQcXDlDq9zhCQkE6SYZgGMIhN5LfdrLZASX+JRUC/nN1xgEiY9r0GT0Y/oj
IgZqlIByIaKrmsTL8FXiPEqVkdWkmZ1M8yxpnbhDWxXCW2RNhlmNc4G673ExW2l1ZXgPUDQYPlFF
RxtvhmF7fCM5oFw73fwLSEvDrJYYxGCg9UYBRdTr0HgZLRYqmSihkAQwmJkooKQtCIMvsDH2LppP
ZRkA9cQzewSdk7J2CSCQ6w52D0j1tQsZJOsSDdUmM+nEtLi8ZI/VwDbT1e7JeB2fUkHCpyGntzL7
4NxbYjWdAM6NKZJGKA+iZUSD9gaEdZL9aOkJyhoW48jRVQZaDczzhw9hadqbo7fld4a8G/rmgLZ1
duI2M2ZiSpRJZlmZWwPI+WhbFQkkljGOeJjRJRzPZda8x1G8YGcglxDmR87uOdmhtId15puoJ0Ik
15agkWldCMzI14IV3aH49AUNWo952m88h4EHlZU1HgfAWjvKlp5bC43DPN1I+oJ3mV5eaC4keHl4
rkOYzdkiotAkE4yXb5tKxuD4WJeBcfa0rgfhD9kgXmEgcsjNi+ZIAg8qkYBcRAzfxsXwimEIO48e
s5zAAOReAHHCN4fpOgOk6i0gg6xlq8h2lbTttILShMwMzPf7p4DsOqnzBjycjYwcx4amx4k7DBI5
j5OO40lQUm2kBOILDecjk1y1XdzbbbeG1m6PK8gXeGUa2r3IG3S8vSTEu/94sdAWLiJBScvuFba5
TXfC//w+/mwPZqO5oCw4g4elMZJkbNnEzD6TgavH4WzGrifmQi2+ZZ3HctsCSESjsCsxehopN1Ag
7TwLjwPHw8SZivhKkHLrsLDOvwGYB4GIBqtJ8aEg8xpNdTBCW243VMi48xxMDA4BM3kyw3Hp+pF5
IwNJ6CkjrXW7IW+20MvR/r3B1ehXqzE2DvOg2ajgHtSVt3apxsBIgRkUP3Pkw63p7ZlNKsLRhMmT
HhgUN4Grj3gUxXF7iydKMLTIq4tRQozjvTQqCoLRcXEW815ac2HTDS+uCY4YNq2a6Vj2dg+K2vrO
do826NyoqGumlOmHUseWTG+WIVyyV5ZmTC8OfTbYJGHibc/wZ9p2HmPRxLTXy8J9+Xoe5n9Xp7I1
F54qAwOwzWk39FglziXPftYixhG9GkojoYBJAWorrOxNHSrORpxMz6evv8BNhglhfjZDXqierqyn
PYaYkm+g89BIOnYcdORtEg7OZ39+kO4ZxAenGA3SMBbNSDr16nb7YNxJesLukR8fJft4Q7cyCfmh
0ZD/VEQymPWbB9T8TAuxUqW9zRaxKJJwANVXMYKfULYwxLpSIajql4XFBiLFzW4dZdAIoprnHXah
da5NoURiJ54Vpneg2msMvh1Ue78cRQIsBUYkHMhm0GRlM2QGBPLZKFG7tuGBbC6IXZxGM5uzeBwZ
qywLNsG35b9+6ggl9wWr5CiZrEk8sgSNOtetpI3IQlMJevhqGwSwmubYmN8SOCaoa5KRWVJrigQP
QTKmgxMkZE+ftqar5BmShdO5ND2TyjonZ3num85TzOASPiVuqpwSWRzCQQhdzFuOBgkuKSbTMRGH
uzaFq3AfGJUEoN/tORcjTWtg0q2kHrmoJhiuFNdOgYdYYk2FjRJDgcCO9JRP23ClYVaIQ0AxF91r
g7QkI9wkHZ3u67PMCS5fmGrPgRmtxa5fX0zLwOcsrVUqazluXZ3fYna8AEnuKiKwZFUJ4+UMUdcU
FaKBImO2MtAyGyFjW5u0bdBaMtUGUFg7VqZANOpIxF7kLyTGX2qk9xli2Bgq7p23EUOLPLSxxYhM
24zjpX0F4cjBsBaTwzpMqQumStjRDPItRYxa10vFDUNpy13wkuXEETLtBDiTdR0UAXNG6NpVMF/r
N1HIInASetpRGd53HKSRslguG4K28oDBuMDf6lsiToAJc3Cl/fkTAYS05K244vLmTiOHSZ6vPoS5
PpfSwZkDITw9XwbcwSNZQPcNQmDEDS6fVeG5nacl86A3HMG/sxZaDgjwDtRd0FIQEVY+/z6ezQFq
QP1Iz+S8APOH4d3eawHGtjS8mm2TRMpNesACUqMWxfBJwsdEwoEjk5H2dXphgzxLvHdxMnhmccg6
USodnHw5YIcZSIoJBHx8SFYGoOzYFEBSgOockT9YsRQLmYBk3EAd9KUkGpKJNnOZ7DeuTAjZ5lYv
rFcJBhbrDBG5Ghpt8D75x6cAz7tMGBKSWhepwNoqzk8IYEOkGg5y7HH5vT7AhCaGEE84AVAZLpPB
wEkYj4u2KT1c4hJevVykmYAGxaxH2liA2SEgYw2QcDg24td6LuKFNQtJAlrULlX118KHoD2fYVOf
aAGiVuOymU0l9VSVwqDYxvgd2SH4LbyJLOq7SwrCCXLQe7BEEKabPiJLIZfNHoCSqNHj9dOP1B8t
xUSwYUMTlQAtzYZJQk23CA0JQIiShFqUmhUxhBhYJWbeU8Uu92tQkgSxWGmyoGqduK1LWL1YNFrg
0MvTL3HRyNIkGCLXg3i0KCEBm2MzCEQh06oSUgzsknKEBkJe8FdPRMGZjlENvfn9LorpsrM5ahnh
QqcOgnl7757se85mq6bjYLJnZKbtoMwZrB44IZg6mchWQ3Oy4CBByk0ru94DRyjUrqDkJAlByC3W
DOTbUhW5sMlqWQkD0qFzFDZ9Ev42IxnACu/OmAee4RcMOawUBHsRtM8IRdaugpNNhCk0Qn+SCTUz
UC5Rdz1d2SSem1Vk1M2JrQ0Ei5E2BWo0qmNe0af8RBrPHb84f09KMzXG+K1tmp9JLIg12ZL7SYUP
mYkwB8bElmlaYs0TPxb6g7WDBpXwjhz+CEZmDHP3jNYsUVTNUREWKEsUg01Hp9LdJlKdMatC2GvE
+Z3iLk8EwvV/d5PYYFEDhCXESD29svofXzlvRjejSLhBCIZQ6RjTEqF4MEisuLRVgW6t73G6b1rY
F7EhMJBBCAxLO6aSYXiqTFZoj4JdJJ9CYePDe3inO+2P16j5S2zUGKSWOFI/En75Itif2QQp/bKF
j21kks0lhMQ1o7VqymM4I+cAJWlUF8I2CCRGtBK+ZugSMgYCMGYsVQFw7rUIuBIBnSpRQzdGFKci
iUJEZEOUJVgiUIPENUmUIxSKFlZhLm56dOkop0pKUTYR1QYN2sZ85ud9GLkmJBoq7knbOOs1e3PU
aF97nsKa7Ch8nRA1y1HXeUZipdEYgwTCiliadJRLIMSBiIaUxnArl3468ICojaWICEi9oL2CMDYE
xeU6mUADjZAsjQQQsFuUWG/pN8iZ5GgwlQxCBifQrnNKiD179POXpYFzQrRK5GCvLa6CDJAMwodN
wlNZDNqDBpVm34jChcKaFh4cD0BvEJWMLVcQcyyrde7Zkgs6/zf83vXiPhE8m9lENg9wt6xyz62u
CA+bzeOWIz1YGiUc1CRo0HGybfMw4tDMoNmwgPp49OPkug0j7lM6aPQd2uZlUciGlUmQRGR3wWL2
C6ItNo4xKhWo1fLljJNsFsoi8ltlEGMVfRqECoyC1a8qGstBEVLRcsBq1M7FugVEO7llMkpdWwbd
M2K53ScDLRKFUHITIhBaCVAsaWgMWgDCb0cmaYSSYZ2fTNTfuiN+IlnOSagzbltMMxRYxTQscPOE
SmKkhNLMMLvfz28DQX5237tsQLKjDVCYAxijJGKJDLmakkOjYwzfIAHbpKamxpsbGjlzhsWDQGlc
JLmQeFANbYqF5ahW0E2jtthyjFQAbdKpMSaQSWiC07pEHv8UJZtBeJW5QhYopgjgFgJDVMWgixzZ
bRchVcjUz4wZRSuBNgHRMFBcRzCLAuHWkDC5kLJdGTDqH1wELUk8fSO5Xm6wbgUmF6BIvhO4f8rJ
nVdgtXQJBYXIZ11LVLZJAd9xTXNFpwA+wLDyrJQUBhXmKEhj7LlwklMHNPhpuW8SC+k32NlCDtu8
gkH5A9YcwXMDUm+hn3aADnMNl2ChFViI2sSBy8u+HZu6A+EOZK+vBcD5JBINGsJbg0L7gmkEPnML
gsn7IA9b8uY7wHe8/I0XURVgIwVPR/4u5IpwoSDJv0iu





reply via email to

[Prev in Thread] Current Thread [Next in Thread]