[PATCH] GnuTLS support on Woe32

[PATCH] GnuTLS support on Woe32

[Claudio Bley]

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: claudio.bley@gmail.com-20110306145751-7c0k4tmlsc09rj4q
# target_branch: bzr+ssh://USERNAME@bzr.savannah.gnu.org/emacs/trunk
# testament_sha1: 43e7b073c148a57eec10eacd12a37d4dfe79dd81
# timestamp: 2011-03-06 16:02:27 +0100
# base_revision_id: rgm@gnu.org-20110304084000-8thi67w6o3ze71wz
# 
# 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  <claudio.bley@gmail.com>
+
+	* makefile.w32-in (obj): Added gnutls.o.
+
 2011-03-03  Drake Wilson  <drake@begriffli.ch>  (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  <claudio.bley@gmail.com>
+
+	* 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  <rgm@gnu.org>
 
 	* 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  <claudio.bley@gmail.com>
+
+	* starttls.el (starttls-negotiate-gnutls, starttls-open-stream-gnutls):
+	Check for builtin GnuTLS support and use it if available.
+
 2011-03-03  Tassilo Horn  <tassilo@member.fsf.org>
 
 	* 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  <claudio.bley@gmail.com>
+
+	* 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  <eliz@gnu.org>
 
 	* 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  <claudio.bley@gmail.com>
+
+	* 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  <kbrown@cornell.edu>
 
 	* 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

Re: [PATCH] GnuTLS support on Woe32

[Eli Zaretskii]

> From: claudio.bley@gmail.com (Claudio Bley)
> Date: Sun, 06 Mar 2011 16:16:34 +0100
> 
> Please find attached a patch which makes building Emacs with GnuTLS
> support on Woe32 possible.

Thanks.

I have a few initial comments, based on reading through the patch.

> --- 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)))

Can you explain why are these fboundp calls needed?

> --- 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"))))

Can a file name that starts with a slash work reliably on Windows?

> +2011-03-06  Claudio Bley  <claudio.bley@gmail.com>
> +
> +	* 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.

Why do we need the --lib switch?  We don't require it for any other
optional libraries.  Can we arrange for GnuTLS support configury to
work like the other optional libraries?

> +* 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.

Is it possible to mention here good sites to look for the GnuTLS
header and libraries?

> +#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;
> +    }
> +}

Why is this function needed?  Can you extend w32.c:set_errno instead
(if it doesn't already support all the values of WSA* errors that you
need)?

> +static ssize_t
> +emacs_gnutls_pull(gnutls_transport_ptr_t p, void* buf, size_t sz)

Can we move the Windows-specific functions to w32.c, and only call
them from gnutls.c?  I think we want to keep the Windows-related code
outside w32*.c to the bare minimum.

> +      /* On Windows we cannot transfer socket handles between
> +       * different runtime libraries.
> +       *
> +       * We must handle reading / writing ourselves.
> +       */

This is not the Emacs style of comments.

> -  ret = gnutls_handshake (state);
> +  do
> +    {
> +      ret = gnutls_handshake (state);
> +      emacs_gnutls_handle_error (state, ret);
> +    }
> +  while (ret < 0 && gnutls_error_is_fatal (ret) == 0);

This change is not Windows-specific.  What problem(s) does it solve,
and are those problems relevant to platforms other than Windows?

> +  else
> +    {
> +        gnutls_alert_send_appropriate (state, ret);
> +    }
> +  return ret;

Likewise here.

> -            return (bytes_written ? bytes_written : -1);
> +            {
> +              emacs_gnutls_handle_error (state, rtnval);
> +
> +              return (bytes_written ? bytes_written : -1);
> +            }

And here.  Why do you introduce emacs_gnutls_handle_error?

> --- 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

Is this for Windows only?  If so, please mention that in a comment.
If not, what problems does it solve on other platforms?

Last, but not least: I don't see your name on file with the FSF
copyright assignments.  A contribution of this size will require you
to sign legal papers.

Thanks again for working on this.

Re: [PATCH] GnuTLS support on Woe32

[Robert Pluim]

Eli Zaretskii <eliz@gnu.org> writes:

>> From: claudio.bley@gmail.com (Claudio Bley)
>> Date: Sun, 06 Mar 2011 16:16:34 +0100
>> 
>> Please find attached a patch which makes building Emacs with GnuTLS
>> support on Woe32 possible.
>
> Thanks.
>
> I have a few initial comments, based on reading through the patch.
>
>> --- 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)))
>
> Can you explain why are these fboundp calls needed?
>

Please don't install this bit of the patch.  Builtin TLS support builds
on my platform, but doesn't actually work, so forcing it to be used
would not be good for me.

Thanks

Robert

Re: [PATCH] GnuTLS support on Woe32

[Robert Pluim]

Robert Pluim <rpluim@gmail.com> writes:

> Eli Zaretskii <eliz@gnu.org> writes:
>
>>> From: claudio.bley@gmail.com (Claudio Bley)
>>> Date: Sun, 06 Mar 2011 16:16:34 +0100
>>> 
>>> Please find attached a patch which makes building Emacs with GnuTLS
>>> support on Woe32 possible.
>>
>> Thanks.
>>
>> I have a few initial comments, based on reading through the patch.
>>
>>> --- 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)))
>>
>> Can you explain why are these fboundp calls needed?
>>
>
> Please don't install this bit of the patch.  Builtin TLS support builds
> on my platform, but doesn't actually work, so forcing it to be used
> would not be good for me.

I modify that comment: builtin TLS support works for me if I set
'trustfiles' to nil in gnutls-negotiate, instead of
"/etc/ssl/certs/ca-certificates.crt", which I don't have.  What is that
file, and why do I need it all of a sudden? (builtin TLS worked fine for
me several months ago).

Thanks

Robert

PS The error message I got could be improved: "Err [-64] File not found"
is not really helpful

Re: [PATCH] GnuTLS support on Woe32

[Ted Zlatanov]

On Mon, 07 Mar 2011 11:44:56 +0100 Robert Pluim <rpluim@gmail.com> wrote: 

RP> I modify that comment: builtin TLS support works for me if I set
RP> 'trustfiles' to nil in gnutls-negotiate, instead of
RP> "/etc/ssl/certs/ca-certificates.crt", which I don't have.  What is that
RP> file, and why do I need it all of a sudden? (builtin TLS worked fine for
RP> me several months ago).

Let us know what the file should be on your platform, if you know.  This
is the CA bundle which determines if the signers of any presented
certificates can be trusted.  I think Emacs should have its own default
bundle and the user should be able to override to their own preference.

I'll add code to test for the file's existence and to customize that file.

RP> PS The error message I got could be improved: "Err [-64] File not found"
RP> is not really helpful

This error is coming from the GnuTLS library.  It only reports errors
numerically so gnutls.c needs to be improved to present the error better.

Ted

Re: [PATCH] GnuTLS support on Woe32

[Eli Zaretskii]

> From: Robert Pluim <rpluim@gmail.com>
> Date: Mon, 07 Mar 2011 08:44:47 +0100
> 
> Please don't install this bit of the patch.  Builtin TLS support builds
> on my platform, but doesn't actually work, so forcing it to be used
> would not be good for me.

What is your platform, and why did you think this patch forces you to
use the TLS support?

Re: [PATCH] GnuTLS support on Woe32

[Robert Pluim]

Eli Zaretskii <eliz@gnu.org> writes:

>> From: Robert Pluim <rpluim@gmail.com>
>> Date: Mon, 07 Mar 2011 08:44:47 +0100
>> 
>> Please don't install this bit of the patch.  Builtin TLS support builds
>> on my platform, but doesn't actually work, so forcing it to be used
>> would not be good for me.
>
> What is your platform, and why did you think this patch forces you to
> use the TLS support?

cygwin. And because if you do (require 'gnutls), gnus will use the
builtin TLS support instead of starttls et al (it checks fboundp for a
symbol defined in gnutls.el).

Robert

Re: [PATCH] GnuTLS support on Woe32

[Robert Pluim]

Ted Zlatanov <tzz@lifelogs.com> writes:

> On Mon, 07 Mar 2011 11:44:56 +0100 Robert Pluim <rpluim@gmail.com> wrote: 
>
> RP> I modify that comment: builtin TLS support works for me if I set
> RP> 'trustfiles' to nil in gnutls-negotiate, instead of
> RP> "/etc/ssl/certs/ca-certificates.crt", which I don't have.  What is that
> RP> file, and why do I need it all of a sudden? (builtin TLS worked fine for
> RP> me several months ago).
>
> Let us know what the file should be on your platform, if you know.

I wish I did. This is on cygwin, is there a CA bundle you can install
there?

>  This
> is the CA bundle which determines if the signers of any presented
> certificates can be trusted.  I think Emacs should have its own default
> bundle and the user should be able to override to their own preference.

Yes, that would be good.

> I'll add code to test for the file's existence and to customize that file.
>
> RP> PS The error message I got could be improved: "Err [-64] File not found"
> RP> is not really helpful
>
> This error is coming from the GnuTLS library.  It only reports errors
> numerically so gnutls.c needs to be improved to present the error better.

Actually, I'm not sure gnutls.c can do much in that case except show the
parameters it passed to GnuTLS.

Thanks

Robert

Re: [PATCH] GnuTLS support on Woe32

[Lars Magne Ingebrigtsen]

claudio.bley@gmail.com (Claudio Bley) writes:

> +(eval-and-compile
> +  (when (fboundp 'gnutls-boot) (require 'gnutls)))
> +
>  (defun starttls-negotiate-gnutls (process)

I think starttls.el should probably be left as is -- that is, use it
only for doing the STARTTLS connections based on the external programs.
That way it can be decided on a higher level whether to use the built-in
version or not.  Which is particularly important since there are still
rather serious bugs in the built-in gnutls support.

Have a look at proto-stream.el (currently residing in the Gnus
directory, but should be moved to the net directory at some point),
which provides comprehensive support for TLS/STARTTLS based on
starttls.el and/or gnutls.c (including opportunistic upgrades based on
the capabilities of the server).

I've been meaning to change pop3.el and smtpmail.el to use
open-protocol-stream to get these nice features working automatically
there, too, but I haven't gotten around to it yet.

-- 
(domestic pets only, the antidote for overdose, milk.)
  larsi@gnus.org * Lars Magne Ingebrigtsen

Re: [PATCH] GnuTLS support on Woe32

[Claudio Bley]

At Sun, 06 Mar 2011 18:58:46 +0200,
Eli Zaretskii wrote:
> 
> > From: claudio.bley@gmail.com (Claudio Bley)
> > Date: Sun, 06 Mar 2011 16:16:34 +0100
> > 
> > Please find attached a patch which makes building Emacs with GnuTLS
> > support on Woe32 possible.
> 
> Thanks.
> 
> I have a few initial comments, based on reading through the patch.

I'll try to answer as best as I can...
 
> > --- 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)))
> 
> Can you explain why are these fboundp calls needed?

I want to detect whether the current Emacs instance has been built
with GnuTLS support. If so, load gnutls, otherwise use the old
starttls / gnutls-cli approach.

> > --- 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"))))
> 
> Can a file name that starts with a slash work reliably on Windows?

[A] No. It will refer to the drive of CWD. This was just a fix I dropped
in because on Windows there usually is no /etc directory at all and
hence the function failed when passing nil or '() as argument.

The parameter probably should be tri-state: use a default value, use
the given trustfiles or use no trustfiles at all.

> > +2011-03-06  Claudio Bley  <claudio.bley@gmail.com>
> > +
> > +	* 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.
> 
> Why do we need the --lib switch?  We don't require it for any other
> optional libraries.  Can we arrange for GnuTLS support configury to
> work like the other optional libraries?

The difference is that the other libraries are not linked implicitly
but explicitly / dynamically at runtime.

Of course, one could also do this for GnuTLS, but that would need some
refactoring.

Furthermore, using --lib you may easily choose whether to link GnuTLS
statically or as a DLL.

> > +* 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.
> 
> Is it possible to mention here good sites to look for the GnuTLS
> header and libraries?

Sure.

> > +#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;
> > +    }
> > +}
> 
> Why is this function needed?  Can you extend w32.c:set_errno instead
> (if it doesn't already support all the values of WSA* errors that you
> need)?

Yes, I could extend w32.c:set_errno, if I move the Windows-specific
function to w32.c proper...

> > +static ssize_t
> > +emacs_gnutls_pull(gnutls_transport_ptr_t p, void* buf, size_t sz)
> 
> Can we move the Windows-specific functions to w32.c, and only call
> them from gnutls.c?  I think we want to keep the Windows-related code
> outside w32*.c to the bare minimum.

OK.

> > +      /* On Windows we cannot transfer socket handles between
> > +       * different runtime libraries.
> > +       *
> > +       * We must handle reading / writing ourselves.
> > +       */
> 
> This is not the Emacs style of comments.

OK.

> > -  ret = gnutls_handshake (state);
> > +  do
> > +    {
> > +      ret = gnutls_handshake (state);
> > +      emacs_gnutls_handle_error (state, ret);
> > +    }
> > +  while (ret < 0 && gnutls_error_is_fatal (ret) == 0);
> 
> This change is not Windows-specific.  What problem(s) does it solve,
> and are those problems relevant to platforms other than Windows?

According to GnuTLS documentation, one should retry calling
gnutls_handshake until it returns 0 (and no fatal error occurred of
course).

For non-blocking sockets handshaking could fail with various non-fatal
errors (e.g. EAGAIN).

> > +  else
> > +    {
> > +        gnutls_alert_send_appropriate (state, ret);
> > +    }
> > +  return ret;
> 
> Likewise here.

This is for alarm handling. If the TLS Server sends an alarm, the
client should react appropriately.

> > -            return (bytes_written ? bytes_written : -1);
> > +            {
> > +              emacs_gnutls_handle_error (state, rtnval);
> > +
> > +              return (bytes_written ? bytes_written : -1);
> > +            }
> 
> And here.  Why do you introduce emacs_gnutls_handle_error?

That function is just a convenience to report errors using
message(). I copied this function shamelessly from gnutls/src/cli.c,
BTW.

> > --- 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
> 
> Is this for Windows only?  If so, please mention that in a comment.
> If not, what problems does it solve on other platforms?

I'm not quite sure. Quoting the GnuTLS manual
(http://www.gnu.org/software/gnutls/manual/html_node/The-transport-layer.html):

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.

AFAIU, this means that if using non-blocking sockets (which Emacs does
on other platforms I guess?) you would need to check for pending data
in the GnuTLS buffers or else Emacs might hang, waiting for data on
the socket which will never arrive because it was already transferred
to the internal buffers.

> Last, but not least: I don't see your name on file with the FSF
> copyright assignments.  A contribution of this size will require you
> to sign legal papers.

OK, I'll see to get this done.

At Mon, 07 Mar 2011 08:44:47 +0100,
Robert Pluim wrote:
> 
> >> --- 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)))
> >
> > Can you explain why are these fboundp calls needed?
> >
> 
> Please don't install this bit of the patch.  Builtin TLS support builds
> on my platform, but doesn't actually work, so forcing it to be used
> would not be good for me.

Why do you build it if you know it doesn't work?

Anyway, that is a bug which should be fixed.

At Mon, 07 Mar 2011 11:44:56 +0100,
Robert Pluim wrote:
> I modify that comment: builtin TLS support works for me if I set
> 'trustfiles' to nil in gnutls-negotiate, instead of
> "/etc/ssl/certs/ca-certificates.crt", which I don't have.  What is that
> file, and why do I need it all of a sudden? (builtin TLS worked fine for
> me several months ago).

That issue would be fixed by part [A] of the patch (see above).

- Claudio

Re: [PATCH] GnuTLS support on Woe32

[Claudio Bley]

At Mon, 07 Mar 2011 17:34:56 +0100,
Lars Magne Ingebrigtsen wrote:
> 
> claudio.bley@gmail.com (Claudio Bley) writes:
> 
> > +(eval-and-compile
> > +  (when (fboundp 'gnutls-boot) (require 'gnutls)))
> > +
> >  (defun starttls-negotiate-gnutls (process)
> 
> I think starttls.el should probably be left as is -- that is, use it
> only for doing the STARTTLS connections based on the external
> programs.

For me, external programs don't work (reliably, satisfactory, fast).

> That way it can be decided on a higher level whether to use the built-in
> version or not.  Which is particularly important since there are still
> rather serious bugs in the built-in gnutls support.

OK, but changing starttls.el in this manner, makes a whole bunch of
other libraries suddenly work which require starttls.el.

> Have a look at proto-stream.el (currently residing in the Gnus
> directory, but should be moved to the net directory at some point),
> which provides comprehensive support for TLS/STARTTLS based on
> starttls.el and/or gnutls.c (including opportunistic upgrades based on
> the capabilities of the server).

I'll look into it. Thanks.

> I've been meaning to change pop3.el and smtpmail.el to use
> open-protocol-stream to get these nice features working automatically
> there, too, but I haven't gotten around to it yet.

But I want to receive/send Emails now ;-) As you can see I'm using
Wanderlust because Gnus just didn't cut it (haven't tried the trunk
version, though). Has POP3 UIDL support been implemented in the
meantime?

- Claudio

Re: [PATCH] GnuTLS support on Woe32

[Ted Zlatanov]

[-- Attachment #1: Type: text/plain, Size: 5105 bytes --]

On Sun, 06 Mar 2011 16:16:34 +0100 claudio.bley@gmail.com (Claudio Bley) wrote: 

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

Claudio, thanks so much for looking at this.  My C is very rusty and I
appreciate all your help.  I also don't know GnuTLS very well so your
insight is very good.

I'll comment and at the end will show my own work on verification and
callbacks.  Whatever I don't comment, assume it's excellent :)  I hope
you can take what I've done, which is much less capable than your patch,
and bring it into yours to improve the GnuTLS support on all platforms.

CB> +2011-03-06  Claudio Bley  <claudio.bley@gmail.com>
CB> +
CB> +	* net/gnutls.el (gnutls-negotiate): Check whether default
CB> +	trustfile exists before going to use it. Add missing argument to
CB> +	gnutls-message-maybe call. Return return value.
CB> +

Thanks for these fixes.  I had some of them but didn't notice the empty
%s and that we should return ret.  My patch incorporates your fixes.

CB> +2011-03-06  Claudio Bley  <claudio.bley@gmail.com>
CB> +
CB> +	* starttls.el (starttls-negotiate-gnutls, starttls-open-stream-gnutls):
CB> +	Check for builtin GnuTLS support and use it if available.
CB> +

I think this should be optional.  GnuTLS locks up Emacs hard with
concurrent connections (see Lars' email about that from earlier this
week on emacs-devel).  Also I intentionally made gnutls.el a separate
file to avoid overriding starttls.el.  It shouldn't just take over the
starttls.el functionality.  There are too many parameters and no way to
tune them right now; starttls.el is not tunable at all.  

But it's good to have a way to just swap all the starttls.el
functionality for gnutls.el functionality, for testing and for brave
users, so I'm OK with making it optional.  I hope we can phase out
starttls.el out completely eventually.

CB> +2011-03-06  Claudio Bley  <claudio.bley@gmail.com>
CB> +
CB> +	* configure.bat: New options --without-gnutls and --lib, new build
CB> +	variable USER_LIBS, automatically detect GnuTLS.
CB> +	* INSTALL: Add instructions for GnuTLS support.
CB> +	* gmake.defs: Prefix USER_LIB's with -l.
CB> +

I'm OK with whatever you and Eli decide here.  I don't know much about
the W32 platform.

CB> +2011-03-06  Claudio Bley  <claudio.bley@gmail.com>
CB> +
CB> +	* process.c (wait_reading_process_output): Check if GnuTLS
CB> +	buffered some data internally if no FDs are set for TLS
CB> +	connections.

Thanks for catching this.

CB> +	* gnutls.c (emacs_gnutls_handle_error): New function.
CB> +	(wsaerror_to_errno): Likewise.
CB> +	(emacs_gnutls_pull): New function for GnuTLS on Woe32.
CB> +	(emacs_gnutls_push): Likewise.
CB> +	(emacs_gnutls_handshake): Add Woe32 support. Retry handshake
CB> +	unless a fatal error occured. Call gnutls_alert_send_appropriate
CB> +	on error. Return error code.
CB> +	(emacs_gnutls_write): Call emacs_gnutls_handle_error.
CB> +	(emacs_gnutls_read): Likewise.
CB> +	(Fgnutls_boot): Return handshake error code.

I'm OK with your approach here and it's much better done than what I
had.  See if you can use my work on verify_flags, but see below about
that.

CB> The [trustfiles] probably should be tri-state: use a default value,
CB> use the given trustfiles or use no trustfiles at all.

There is no default on every platform, that's the problem.  Let's leave
this nil if /etc/ssl/certs/ca-certificates.crt doesn't exist.  I'll work
on a more general way of collecting trust files for every platform.  I
think the default should be an Emacs ca-certificates.crt file and we
should add to the list whatever we find and whatever the user requests.

CB> According to GnuTLS documentation, one should retry calling
CB> gnutls_handshake until it returns 0 (and no fatal error occurred of
CB> course).

CB> For non-blocking sockets handshaking could fail with various non-fatal
CB> errors (e.g. EAGAIN).
...
CB> This is for alarm handling. If the TLS Server sends an alarm, the
CB> client should react appropriately.

Cool, thanks for thinking of these cases.  I appreciate your thoroughness.

OK, my patch:

- detects gnutls_certificate_set_verify_function() and sets
  HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY if it exists.

- sets a buffer-local variable `gnutls-hostname' on every connection
  that can be used to verify the certificate's hostname later

- adds a numeric `verify-flags' parameter to `gnutls-negotiate' and then
  gnutls_boot() uses it to gnutls_certificate_set_verify_flags()
  (I'm not sure I'm doing it correctly, though.)

- sets up the verify callback structure but it's not used right now
  because GnuTLS 2.8.x is still too popular.  I was hoping to get by
  with just the verify flags.  It also adds a new GNUTLS_STAGE_CALLBACKS
  stage that does nothing currently.

- it attempts to verify the peer certificate and hostname.  I'm pretty
  sure I'm doing this wrong because I get a NULL gnutls_verify_cert_list
  every time.

- renames global_initialized to gnutls_global_initialized

I hope you find something useful in it to merge with your patch.

Thanks
Ted


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: callbacks.patch --]
[-- Type: text/x-diff, Size: 12703 bytes --]

=== modified file 'configure.in'
--- configure.in	2011-03-06 01:42:13 +0000
+++ configure.in	2011-03-07 02:07:34 +0000
@@ -1972,12 +1972,22 @@
 AC_SUBST(LIBSELINUX_LIBS)
 
 HAVE_GNUTLS=no
+HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY=no
 if test "${with_gnutls}" = "yes" ; then
   PKG_CHECK_MODULES([LIBGNUTLS], [gnutls >= 2.2.4], HAVE_GNUTLS=yes, HAVE_GNUTLS=no)
   if test "${HAVE_GNUTLS}" = "yes"; then
     AC_DEFINE(HAVE_GNUTLS, 1, [Define if using GnuTLS.])
   fi
+
+  CFLAGS="$CFLAGS $LIBGNUTLS_CFLAGS"
+  LIBS="$LIBGNUTLS_LIBS $LIBS"
+  AC_CHECK_FUNCS(gnutls_certificate_set_verify_function, HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY=yes)
+
+  if test "${HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY}" = "yes"; then
+    AC_DEFINE(HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY, 1, [Define if using GnuTLS certificate verification callbacks.])
+  fi
 fi
+
 AC_SUBST(LIBGNUTLS_LIBS)
 AC_SUBST(LIBGNUTLS_CFLAGS)
 
@@ -3666,6 +3676,7 @@
 echo "  Does Emacs use -lgconf?                                 ${HAVE_GCONF}"
 echo "  Does Emacs use -lselinux?                               ${HAVE_LIBSELINUX}"
 echo "  Does Emacs use -lgnutls?                                ${HAVE_GNUTLS}"
+echo "  Does Emacs use -lgnutls certificate verify callbacks?   ${HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY}"
 echo "  Does Emacs use -lxml2?                                  ${HAVE_LIBXML2}"
 
 echo "  Does Emacs use -lfreetype?                              ${HAVE_FREETYPE}"

=== modified file 'lisp/net/gnutls.el'
--- lisp/net/gnutls.el	2011-01-25 04:08:28 +0000
+++ lisp/net/gnutls.el	2011-03-08 02:44:11 +0000
@@ -44,6 +44,10 @@
   :type 'integer
   :group 'gnutls)
 
+(defvar gnutls-hostname nil
+  "Remote hostname.  Always buffer-local.")
+(make-variable-buffer-local 'gnutls-hostname)
+
 (defun open-gnutls-stream (name buffer host service)
   "Open a SSL/TLS connection for a service to a host.
 Returns a subprocess-object to represent the connection.
@@ -64,21 +68,44 @@
 GnuTLS connection, including specifying the credential type,
 trust and key files, and priority string."
   (let ((proc (open-network-stream name buffer host service)))
+    ;; remember the hostname associated with this buffer
+    (with-current-buffer buffer
+      (setq gnutls-hostname host))
     (gnutls-negotiate proc 'gnutls-x509pki)))
 
 (declare-function gnutls-boot "gnutls.c" (proc type proplist))
 
 (defun gnutls-negotiate (proc type &optional priority-string
-                              trustfiles keyfiles)
-  "Negotiate a SSL/TLS connection.
+                              trustfiles keyfiles verify-flags)
+  "Negotiate a SSL/TLS connection.  Returns t if successful.
+
 TYPE is `gnutls-x509pki' (default) or `gnutls-anon'.  Use nil for the default.
 PROC is a process returned by `open-network-stream'.
 PRIORITY-STRING is as per the GnuTLS docs, default is \"NORMAL\".
 TRUSTFILES is a list of CA bundles.
-KEYFILES is a list of client keys."
+KEYFILES is a list of client keys.
+
+VERIFY-FLAGS is a numeric OR of verification flags only for
+`gnutls-x509pki' connections.  See GnuTLS' x509.h for details;
+here's a recent version of the list.
+
+    GNUTLS_VERIFY_DISABLE_CA_SIGN = 1,
+    GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT = 2,
+    GNUTLS_VERIFY_DO_NOT_ALLOW_SAME = 4,
+    GNUTLS_VERIFY_ALLOW_ANY_X509_V1_CA_CRT = 8,
+    GNUTLS_VERIFY_ALLOW_SIGN_RSA_MD2 = 16,
+    GNUTLS_VERIFY_ALLOW_SIGN_RSA_MD5 = 32,
+    GNUTLS_VERIFY_DISABLE_TIME_CHECKS = 64,
+    GNUTLS_VERIFY_DISABLE_TRUSTED_TIME_CHECKS = 128,
+    GNUTLS_VERIFY_DO_NOT_ALLOW_X509_V1_CA_CRT = 256
+
+It must be omitted, a number, or nil; if omitted or nil it
+defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT."
   (let* ((type (or type 'gnutls-x509pki))
+         (default-trustfile "/etc/ssl/certs/ca-certificates.crt")
          (trustfiles (or trustfiles
-                        '("/etc/ssl/certs/ca-certificates.crt")))
+                         (when (file-exists-p default-trustfile)
+                           (list default-trustfile))))
          (priority-string (or priority-string
                               (cond
                                ((eq type 'gnutls-anon)
@@ -89,14 +116,15 @@
                              :loglevel ,gnutls-log-level
                              :trustfiles ,trustfiles
                              :keyfiles ,keyfiles
+                             :verify-flags ,verify-flags
                              :callbacks nil))
          ret)
 
     (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 'src/gnutls.c'
--- src/gnutls.c	2011-01-25 04:08:28 +0000
+++ src/gnutls.c	2011-03-08 03:21:34 +0000
@@ -30,7 +30,9 @@
 Lisp_Object Qgnutls_anon, Qgnutls_x509pki;
 Lisp_Object Qgnutls_e_interrupted, Qgnutls_e_again,
   Qgnutls_e_invalid_session, Qgnutls_e_not_ready_for_handshake;
-int global_initialized;
+int gnutls_global_initialized;
+
+Lisp_Object Qgnutls_hostname;
 
 /* The following are for the property list of `gnutls-boot'.  */
 Lisp_Object Qgnutls_bootprop_priority;
@@ -38,6 +40,10 @@
 Lisp_Object Qgnutls_bootprop_keyfiles;
 Lisp_Object Qgnutls_bootprop_callbacks;
 Lisp_Object Qgnutls_bootprop_loglevel;
+Lisp_Object Qgnutls_bootprop_verify_flags;
+
+/* Callback keys for `gnutls-boot'.  Unused currently.  */
+Lisp_Object Qgnutls_bootprop_callbacks_verify;
 
 static void
 emacs_gnutls_handshake (struct Lisp_Process *proc)
@@ -265,10 +271,10 @@
 {
   int ret = GNUTLS_E_SUCCESS;
 
-  if (!global_initialized)
+  if (!gnutls_global_initialized)
     ret = gnutls_global_init ();
 
-  global_initialized = 1;
+  gnutls_global_initialized = 1;
 
   return gnutls_make_error (ret);
 }
@@ -278,10 +284,10 @@
 static Lisp_Object
 gnutls_emacs_global_deinit (void)
 {
-  if (global_initialized)
+  if (gnutls_global_initialized)
     gnutls_global_deinit ();
 
-  global_initialized = 0;
+  gnutls_global_initialized = 0;
 
   return gnutls_make_error (GNUTLS_E_SUCCESS);
 }
@@ -309,7 +315,7 @@
 :priority is a GnuTLS priority string, defaults to "NORMAL".
 :trustfiles is a list of PEM-encoded trust files for `gnutls-x509pki'.
 :keyfiles is a list of PEM-encoded key files for `gnutls-x509pki'.
-:callbacks is an alist of callback functions (TODO).
+:callbacks is an alist of callback functions, see below.
 :loglevel is the debug level requested from GnuTLS, try 4.
 
 The debug level will be set for this process AND globally for GnuTLS.
@@ -324,6 +330,9 @@
 functions are used.  This function allocates resources which can only
 be deallocated by calling `gnutls-deinit' or by calling it again.
 
+The callbacks alist can have a `verify' key, associated with a
+verification function.
+
 Each authentication type may need additional information in order to
 work.  For X.509 PKI (`gnutls-x509pki'), you probably need at least
 one trustfile (usually a CA bundle).  */)
@@ -336,6 +345,11 @@
   /* TODO: GNUTLS_X509_FMT_DER is also an option.  */
   int file_format = GNUTLS_X509_FMT_PEM;
 
+  unsigned int gnutls_verify_flags = GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT;
+  gnutls_x509_crt_t gnutls_verify_cert;
+  unsigned int gnutls_verify_cert_list_size;
+  const gnutls_datum_t *gnutls_verify_cert_list;
+
   gnutls_session_t state;
   gnutls_certificate_credentials_t x509_cred;
   gnutls_anon_client_credentials_t anon_cred;
@@ -349,6 +363,7 @@
   Lisp_Object keyfiles;
   Lisp_Object callbacks;
   Lisp_Object loglevel;
+  Lisp_Object verify_flags;
 
   CHECK_PROCESS (proc);
   CHECK_SYMBOL (type);
@@ -359,6 +374,7 @@
   keyfiles        = Fplist_get (proplist, Qgnutls_bootprop_keyfiles);
   callbacks       = Fplist_get (proplist, Qgnutls_bootprop_callbacks);
   loglevel        = Fplist_get (proplist, Qgnutls_bootprop_loglevel);
+  verify_flags    = Fplist_get (proplist, Qgnutls_bootprop_verify_flags);
 
   state = XPROCESS (proc)->gnutls_state;
   XPROCESS (proc)->gnutls_p = 1;
@@ -416,6 +432,23 @@
       x509_cred = XPROCESS (proc)->gnutls_x509_cred;
       if (gnutls_certificate_allocate_credentials (&x509_cred) < 0)
         memory_full ();
+
+      if (NUMBERP (verify_flags))
+        {
+          gnutls_verify_flags = XINT (verify_flags);
+          GNUTLS_LOG (2, max_log_level, "setting verification flags");
+        }
+      else if (NILP (verify_flags))
+        {
+          /* The default is already GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT.  */
+          GNUTLS_LOG (2, max_log_level, "using default verification flags");
+        }
+      else
+        {
+          /* The default is already GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT.  */
+          GNUTLS_LOG (2, max_log_level, "ignoring invalid verify-flags");
+        }
+      gnutls_certificate_set_verify_flags (x509_cred, gnutls_verify_flags);
     }
   else if (EQ (type, Qgnutls_anon))
     {
@@ -484,6 +517,14 @@
 
   GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_FILES;
 
+  GNUTLS_LOG (1, max_log_level, "gnutls callbacks");
+
+  GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CALLBACKS;
+
+#ifdef HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY
+#else
+#endif
+
   GNUTLS_LOG (1, max_log_level, "gnutls_init");
 
   ret = gnutls_init (&state, GNUTLS_CLIENT);
@@ -543,6 +584,51 @@
 
   emacs_gnutls_handshake (XPROCESS (proc));
 
+
+  /* Now verify the peer, following
+     http://www.gnu.org/software/gnutls/manual/html_node/Verifying-peer_0027s-certificate.html.
+     The peer should present at least one certificate in the chain; do a
+     check of the certificate's hostname with
+     gnutls_x509_crt_check_hostname() against gnutls-hostname (which is
+     buffer-local and set by `open-gnutls-stream'.  */
+
+  /* We should be calling gnutls_verify_peers2 around here I think?  */
+
+  /* Up to here the process is the same for X.509 certificates and
+     OpenPGP keys. From now on X.509 certificates are assumed. This can
+     be easily extended to work with openpgp keys as well.
+  */
+  if (gnutls_certificate_type_get (state) == GNUTLS_CRT_X509)
+    {
+      ret = gnutls_x509_crt_init (&gnutls_verify_cert);
+
+      if (ret < GNUTLS_E_SUCCESS)
+        return gnutls_make_error (ret);
+      
+      gnutls_verify_cert_list = gnutls_certificate_get_peers (state, &gnutls_verify_cert_list_size);
+      if (NULL == gnutls_verify_cert_list)
+        {
+          error ("No certificate was found!\n");
+        }
+
+      /* We only check the first certificate in the given chain.  */
+      ret = gnutls_x509_crt_import (gnutls_verify_cert, &gnutls_verify_cert_list[0], GNUTLS_X509_FMT_DER);
+
+      if (ret < GNUTLS_E_SUCCESS)
+        {
+          gnutls_x509_crt_deinit (gnutls_verify_cert);
+          return gnutls_make_error (ret);
+        }
+
+      if (!gnutls_x509_crt_check_hostname (gnutls_verify_cert, SSDATA (intern_c_string ("gnutls-hostname"))))
+        {
+          gnutls_x509_crt_deinit (gnutls_verify_cert);
+          error ("The certificate's hostname does not match gnutls-hostname");
+        }
+
+      gnutls_x509_crt_deinit (gnutls_verify_cert);
+    }
+
   return gnutls_make_error (GNUTLS_E_SUCCESS);
 }
 
@@ -578,7 +664,7 @@
 void
 syms_of_gnutls (void)
 {
-  global_initialized = 0;
+  gnutls_global_initialized = 0;
 
   Qgnutls_code = intern_c_string ("gnutls-code");
   staticpro (&Qgnutls_code);
@@ -589,6 +675,9 @@
   Qgnutls_x509pki = intern_c_string ("gnutls-x509pki");
   staticpro (&Qgnutls_x509pki);
 
+  Qgnutls_hostname = intern_c_string ("gnutls-hostname");
+  staticpro (&Qgnutls_hostname);
+
   Qgnutls_bootprop_priority = intern_c_string (":priority");
   staticpro (&Qgnutls_bootprop_priority);
 
@@ -601,9 +690,15 @@
   Qgnutls_bootprop_callbacks = intern_c_string (":callbacks");
   staticpro (&Qgnutls_bootprop_callbacks);
 
+  Qgnutls_bootprop_callbacks_verify = intern_c_string ("verify");
+  staticpro (&Qgnutls_bootprop_callbacks_verify);
+
   Qgnutls_bootprop_loglevel = intern_c_string (":loglevel");
   staticpro (&Qgnutls_bootprop_loglevel);
 
+  Qgnutls_bootprop_verify_flags = intern_c_string (":verify-flags");
+  staticpro (&Qgnutls_bootprop_verify_flags);
+
   Qgnutls_e_interrupted = intern_c_string ("gnutls-e-interrupted");
   staticpro (&Qgnutls_e_interrupted);
   Fput (Qgnutls_e_interrupted, Qgnutls_code,

=== modified file 'src/gnutls.h'
--- src/gnutls.h	2011-01-25 04:08:28 +0000
+++ src/gnutls.h	2011-03-07 02:10:15 +0000
@@ -21,6 +21,7 @@
 
 #ifdef HAVE_GNUTLS
 #include <gnutls/gnutls.h>
+#include <gnutls/x509.h>
 
 typedef enum
 {
@@ -28,6 +29,7 @@
   GNUTLS_STAGE_EMPTY = 0,
   GNUTLS_STAGE_CRED_ALLOC,
   GNUTLS_STAGE_FILES,
+  GNUTLS_STAGE_CALLBACKS,
   GNUTLS_STAGE_INIT,
   GNUTLS_STAGE_PRIORITY,
   GNUTLS_STAGE_CRED_SET,

Re: [PATCH] GnuTLS support on Woe32

[Robert Pluim]

claudio.bley@gmail.com (Claudio Bley) writes:

> I want to detect whether the current Emacs instance has been built
> with GnuTLS support. If so, load gnutls, otherwise use the old
> starttls / gnutls-cli approach.

I prefer Lars's suggestion to leave that decision to higher levels of
the code.

> Why do you build it if you know it doesn't work?

I take what ./configure gives me :)

Regards

Robert

Re: [PATCH] GnuTLS support on Woe32

[Eli Zaretskii]

> From: Robert Pluim <rpluim@gmail.com>
> Date: Tue, 08 Mar 2011 09:29:56 +0100
> Mail-Copies-To: never
> 
> claudio.bley@gmail.com (Claudio Bley) writes:
> 
> > I want to detect whether the current Emacs instance has been built
> > with GnuTLS support. If so, load gnutls, otherwise use the old
> > starttls / gnutls-cli approach.
> 
> I prefer Lars's suggestion to leave that decision to higher levels of
> the code.

It should probably simply be a defcustom.  I don't see how ``higher
levels of code'' could ever DTRT in this respect.  If they can know
something about that, so can gnutls.el.

Re: [PATCH] GnuTLS support on Woe32

[Robert Pluim]

Eli Zaretskii <eliz@gnu.org> writes:

>> From: Robert Pluim <rpluim@gmail.com>
>> Date: Tue, 08 Mar 2011 09:29:56 +0100
>> Mail-Copies-To: never
>> 
>> claudio.bley@gmail.com (Claudio Bley) writes:
>> 
>> > I want to detect whether the current Emacs instance has been built
>> > with GnuTLS support. If so, load gnutls, otherwise use the old
>> > starttls / gnutls-cli approach.
>> 
>> I prefer Lars's suggestion to leave that decision to higher levels of
>> the code.
>
> It should probably simply be a defcustom.  I don't see how ``higher
> levels of code'' could ever DTRT in this respect.  If they can know
> something about that, so can gnutls.el.

One thing that springs to mind is that eg gnus could ask 'use builtin
TLS (o)nce (n)ever (a)lways' or similar, although I agree you could put
that in gnutls as well.

Anyway, as long as I can turn if off without being overridden elsewhere,
I don't mind what the implementation is like.

Robert

Re: [PATCH] GnuTLS support on Woe32

[Lars Magne Ingebrigtsen]

Eli Zaretskii <eliz@gnu.org> writes:

> It should probably simply be a defcustom.  I don't see how ``higher
> levels of code'' could ever DTRT in this respect.  If they can know
> something about that, so can gnutls.el.

Well, there are several issues here.

1) gnutls is still not stable, so it should not be used by people who
are developers for now.  The way to turn on gnutls now is to say
(require 'gnutls), which I think is fine.

2) Virtually all network protocols that exist now support STARTTLS.
Littering every connect function with this code (which can be rather
subtle in when to use it or not (you may require that the server support
it, or you want to bail out, or you may want to use opportunistically if
the server does support it, but only if it's "free" to do so (i.e.,
gnutls is compiled in), or you may want to always have it be used
opportunistically, even though it's significantly slower using
starttls.el (i.e. using the external gnutls-cli program)).

(That was a long sentence.)

This functionality is provided by `open-protocol-stream', and the only
option the user has to consider is really
`proto-stream-always-use-starttls'.

If the basic starttls.el library also starts doing various decisions
here, it gets even more confusing.

So I'd prefer that starttls.el does one thing, and one thing only: Do
the grufty stuff to talk to gnutls-cli.  For now, at least.

This can be revisited later when the built-in gnutls stuff actually
works reliably.

-- 
(domestic pets only, the antidote for overdose, milk.)
  larsi@gnus.org * Lars Magne Ingebrigtsen

Re: [PATCH] GnuTLS support on Woe32

[Lars Magne Ingebrigtsen]

claudio.bley@gmail.com (Claudio Bley) writes:

> But I want to receive/send Emails now ;-)

Then adapt smtpmail.el to use `open-protocol-stream'.  :-)

I'll take a whack at it later this week, I think.

> As you can see I'm using Wanderlust because Gnus just didn't cut it
> (haven't tried the trunk version, though). Has POP3 UIDL support been
> implemented in the meantime?

What's POP3 UIDL, then?

-- 
(domestic pets only, the antidote for overdose, milk.)
  larsi@gnus.org * Lars Magne Ingebrigtsen

Re: [PATCH] GnuTLS support on Woe32

[Eli Zaretskii]

> From: Lars Magne Ingebrigtsen <larsi@gnus.org>
> Date: Tue, 08 Mar 2011 10:14:04 +0100
> Mail-Copies-To: never
> 
> Eli Zaretskii <eliz@gnu.org> writes:
> 
> > It should probably simply be a defcustom.  I don't see how ``higher
> > levels of code'' could ever DTRT in this respect.  If they can know
> > something about that, so can gnutls.el.
> 
> Well, there are several issues here. [...]

If what you wrote was supposed to explain why a defcustom would not be
a good idea, then I must admit I didn't understand what you wrote.

Re: [PATCH] GnuTLS support on Woe32

[Claudio Bley]

At Mon, 07 Mar 2011 22:03:46 +0100,
Claudio Bley wrote:
> 
> At Sun, 06 Mar 2011 18:58:46 +0200,
> Eli Zaretskii wrote:
> > > +#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;
> > > +    }
> > > +}
> > 
> > Why is this function needed?  Can you extend w32.c:set_errno instead
> > (if it doesn't already support all the values of WSA* errors that you
> > need)?
> 
> Yes, I could extend w32.c:set_errno, if I move the Windows-specific
> function to w32.c proper...

I just had a look at this again. It's not so easy.

For GnuTLS, I have to map WSAEWOULDBLOCK to EAGAIN. This is set in
stone.

Doing this in w32.c:set_errno would break a lot of other stuff that
checks for EWOULDBLOCK because that happens to be #define'd to
WSAEWOULDBLOCK in sys/socket.h:129 (which seems reasonable after all).

It works alright when EWOULDBLOCK is #define'd to EAGAIN. In the end
it doesn't matter what EWOULDBLOCK is defined to because on Windows
MinGWs GCC doesn't define it at all, MSVC has it, but WinSock uses
it's own error codes anyway.

> > > +static ssize_t
> > > +emacs_gnutls_pull(gnutls_transport_ptr_t p, void* buf, size_t sz)
> > 
> > Can we move the Windows-specific functions to w32.c, and only call
> > them from gnutls.c?  I think we want to keep the Windows-related code
> > outside w32*.c to the bare minimum.
> 
> OK.

Maybe the GnuTLS specific stuff should also be kept to the bare
minimum outside of gnutls.c?

Considering that these functions would have to be non-static in this
case to be accessible by gnutls.c.

- Claudio

Re: [PATCH] GnuTLS support on Woe32

[Claudio Bley]

At Mon, 07 Mar 2011 21:26:57 -0600,
Ted Zlatanov wrote:
> 
> [1  <text/plain (7bit)>]
> On Sun, 06 Mar 2011 16:16:34 +0100 claudio.bley@gmail.com (Claudio Bley) wrote: 
> 
> CB> Please find attached a patch which makes building Emacs with GnuTLS
> CB> support on Woe32 possible.
> 
> Claudio, thanks so much for looking at this.  My C is very rusty and I
> appreciate all your help.  I also don't know GnuTLS very well so your
> insight is very good.

Thank you so much for your encouraging words, but I thought you would
be the expert in GnuTLS + Emacs business.. :)

> I'll comment and at the end will show my own work on verification and
> callbacks.  Whatever I don't comment, assume it's excellent :)  I hope
> you can take what I've done, which is much less capable than your patch,
> and bring it into yours to improve the GnuTLS support on all platforms.

I'll take a look at your patch when I find the time.

> CB> +2011-03-06  Claudio Bley  <claudio.bley@gmail.com>
> CB> +
> CB> +	* starttls.el (starttls-negotiate-gnutls, starttls-open-stream-gnutls):
> CB> +	Check for builtin GnuTLS support and use it if available.
> CB> +
> 
> I think this should be optional.  GnuTLS locks up Emacs hard with
> concurrent connections (see Lars' email about that from earlier this
> week on emacs-devel).  Also I intentionally made gnutls.el a separate
> file to avoid overriding starttls.el.  It shouldn't just take over the
> starttls.el functionality.  There are too many parameters and no way to
> tune them right now; starttls.el is not tunable at all.
> But it's good to have a way to just swap all the starttls.el
> functionality for gnutls.el functionality, for testing and for brave
> users, so I'm OK with making it optional.

Having thought about that twice I second that. I'll probably write
some defadvice to that matter.

- Claudio

Re: [PATCH] GnuTLS support on Woe32

[Claudio Bley]

At Tue, 08 Mar 2011 10:16:15 +0100,
Lars Magne Ingebrigtsen wrote:
> 
> claudio.bley@gmail.com (Claudio Bley) writes:
> > As you can see I'm using Wanderlust because Gnus just didn't cut it
> > (haven't tried the trunk version, though). Has POP3 UIDL support been
> > implemented in the meantime?
> 
> What's POP3 UIDL, then?

I guess the answer is "no", then?! It retrieves unique message IDs and
is pretty vital in implementing leave-messages-on-server support for
POP3 (which I require).

- Claudio

Re: [PATCH] GnuTLS support on Woe32

[Lars Magne Ingebrigtsen]

claudio.bley@gmail.com (Claudio Bley) writes:

> I guess the answer is "no", then?!

I guess so.  :-)

> It retrieves unique message IDs and is pretty vital in implementing
> leave-messages-on-server support for POP3 (which I require).

I didn't know that was actually possible.  Do many people use that?  And
why not just use IMAP instead?

If it's a popular way to read email, I can certainly have a peek at
implementing an nnpop backend for Gnus...

-- 
(domestic pets only, the antidote for overdose, milk.)
  larsi@gnus.org * Lars Magne Ingebrigtsen

POP3 UIDL - pop3-leave-mail-on-server (was: [PATCH] GnuTLS support on Woe32)

[Reiner Steib]

On Wed, Mar 09 2011, Lars Magne Ingebrigtsen wrote:

> claudio.bley@gmail.com (Claudio Bley) writes:
[...]
>> It retrieves unique message IDs and is pretty vital in implementing
>> leave-messages-on-server support for POP3 (which I require).
>
> I didn't know that was actually possible.  Do many people use that?  

It has been requested quite often.  See the comments around
`pop3-leave-mail-on-server'...

,----[ gnus/lisp/pop3.el ]
| (defcustom pop3-leave-mail-on-server nil
|   "*Non-nil if the mail is to be left on the POP server after fetching.
| 
| If `pop3-leave-mail-on-server' is non-nil the mail is to be left
| on the POP server after fetching.  Note that POP servers maintain
| no state information between sessions, so what the client
| believes is there and what is actually there may not match up.
| If they do not, then you may get duplicate mails or the whole
| thing can fall apart and leave you with a corrupt mailbox."
|   ;; We can't use the UILD support from XEmacs mail-lib or cvs.m17n.org:
|   ;; http://thread.gmane.org/v9lld8fml4.fsf@marauder.physik.uni-ulm.de
|   ;; http://thread.gmane.org/b9yy8hzy9ej.fsf@jpl.org
|   ;; Any volunteer to re-implement this?
|   :version "22.1" ;; Oort Gnus
|   :type 'boolean
|   :group 'pop3)
`----

BTW, I don't know why you removed the corresponding warnings from
`pop3-movemail' with this commit:

,----[ git log - gnus/lisp/pop3.el ]
| commit 119a867afc587c9261730362a6478fc3801df1b5
| Author: Lars Magne Ingebrigtsen <larsi@quimbies.gnus.org>
| Date:   Thu Sep 9 16:06:38 2010 +0200
| 
|     Remove pop3-movemail and rename pop3-streaming-movemail to pop3-movemail.
`----

> And why not just use IMAP instead?

Some mail providers don't offer IMAP (for free).

> If it's a popular way to read email, I can certainly have a peek at
> implementing an nnpop backend for Gnus...

Bye, Reiner.
-- 
       ,,,
      (o o)
---ooO-(_)-Ooo---  |  PGP key available  |  http://rsteib.home.pages.de/

Re: [PATCH] GnuTLS support on Woe32

[Eli Zaretskii]

> From: claudio.bley@gmail.com (Claudio Bley)
> Date: Wed, 09 Mar 2011 22:12:33 +0100
> 
> > > > +static int
> > > > +wsaerror_to_errno(int err)
> > > > +{
> > > > +  switch (err)
> > > > +    {
> > > > +    case WSAEWOULDBLOCK:
> > > > +      return EAGAIN;
> > > > +    case WSAEINTR:
> > > > +      return EINTR;
> > > > +    default:
> > > > +      return err;
> > > > +    }
> > > > +}
> > > 
> > > Why is this function needed?  Can you extend w32.c:set_errno instead
> > > (if it doesn't already support all the values of WSA* errors that you
> > > need)?
> > 
> > Yes, I could extend w32.c:set_errno, if I move the Windows-specific
> > function to w32.c proper...
> 
> I just had a look at this again. It's not so easy.
> 
> For GnuTLS, I have to map WSAEWOULDBLOCK to EAGAIN. This is set in
> stone.

Set in stone where?  I see this in gnutls.c:

  int
  emacs_gnutls_write (int fildes, struct Lisp_Process *proc, char *buf,
		      unsigned int nbyte)
  {
    register int rtnval, 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 -1;
    }

So it looks like it already is prepared to deal with EWOULDBLOCK if
EAGAIN is not available.

> Doing this in w32.c:set_errno would break a lot of other stuff that
> checks for EWOULDBLOCK because that happens to be #define'd to
> WSAEWOULDBLOCK in sys/socket.h:129 (which seems reasonable after all).

If all you need is to produce EAGAIN when you have EWOULDBLOCK (the
other mapping is already in set_errno), it hardly justifies a
function.

But I would like to understand better why you must produce EAGAIN in
the first place.

> It works alright when EWOULDBLOCK is #define'd to EAGAIN. In the end
> it doesn't matter what EWOULDBLOCK is defined to because on Windows
> MinGWs GCC doesn't define it at all, MSVC has it, but WinSock uses
> it's own error codes anyway.

Sorry, I don't follow.  What were you trying to say or suggest here?

> > > > +static ssize_t
> > > > +emacs_gnutls_pull(gnutls_transport_ptr_t p, void* buf, size_t sz)
> > > 
> > > Can we move the Windows-specific functions to w32.c, and only call
> > > them from gnutls.c?  I think we want to keep the Windows-related code
> > > outside w32*.c to the bare minimum.
> > 
> > OK.
> 
> Maybe the GnuTLS specific stuff should also be kept to the bare
> minimum outside of gnutls.c?

What stuff did you have in mind?

> Considering that these functions would have to be non-static in this
> case to be accessible by gnutls.c.

Sure, but I see no problem with that.

Re: [PATCH] GnuTLS support on Woe32

[Claudio Bley]

At Sat, 12 Mar 2011 14:48:35 +0200,
Eli Zaretskii wrote:
> 
> > From: claudio.bley@gmail.com (Claudio Bley)
> > Date: Wed, 09 Mar 2011 22:12:33 +0100
> > 
> > > > > +static int
> > > > > +wsaerror_to_errno(int err)
> > > > > +{
> > > > > +  switch (err)
> > > > > +    {
> > > > > +    case WSAEWOULDBLOCK:
> > > > > +      return EAGAIN;
> > > > > +    case WSAEINTR:
> > > > > +      return EINTR;
> > > > > +    default:
> > > > > +      return err;
> > > > > +    }
> > > > > +}
> > > > 
> > > > Why is this function needed?  Can you extend w32.c:set_errno instead
> > > > (if it doesn't already support all the values of WSA* errors that you
> > > > need)?
> > > 
> > > Yes, I could extend w32.c:set_errno, if I move the Windows-specific
> > > function to w32.c proper...
> > 
> > I just had a look at this again. It's not so easy.
> > 
> > For GnuTLS, I have to map WSAEWOULDBLOCK to EAGAIN. This is set in
> > stone.
> 
> Set in stone where?  I see this in gnutls.c:
> ...
> So it looks like it already is prepared to deal with EWOULDBLOCK if
> EAGAIN is not available.

You missed the point. I was talking about GnuTLS internals. GnuTLS
only checks for EINTR and EAGAIN. So, I *have* to translate
WSAEWOULDBLOCK to EAGAIN when reporting errors to GnuTLS.

> > Doing this in w32.c:set_errno would break a lot of other stuff that
> > checks for EWOULDBLOCK because that happens to be #define'd to
> > WSAEWOULDBLOCK in sys/socket.h:129 (which seems reasonable after all).
> 
> If all you need is to produce EAGAIN when you have EWOULDBLOCK (the
> other mapping is already in set_errno), it hardly justifies a
> function.

That's true, WSAEINTR already gets mapped. Must have missed that.

> > It works alright when EWOULDBLOCK is #define'd to EAGAIN. In the end
> > it doesn't matter what EWOULDBLOCK is defined to because on Windows
> > MinGWs GCC doesn't define it at all, MSVC has it, but WinSock uses
> > it's own error codes anyway.
> 
> Sorry, I don't follow.  What were you trying to say or suggest here?

That it is OK to mess with EWOULDBLOCK's definition.

> > > > > +static ssize_t
> > > > > +emacs_gnutls_pull(gnutls_transport_ptr_t p, void* buf, size_t sz)
> > > > 
> > > > Can we move the Windows-specific functions to w32.c, and only call
> > > > them from gnutls.c?  I think we want to keep the Windows-related code
> > > > outside w32*.c to the bare minimum.
> > > 
> > > OK.
> > 
> > Maybe the GnuTLS specific stuff should also be kept to the bare
> > minimum outside of gnutls.c?
> 
> What stuff did you have in mind?

All the GnuTLS related functions (even if Windows specific).

> > Considering that these functions would have to be non-static in this
> > case to be accessible by gnutls.c.
> 
> Sure, but I see no problem with that.

I'm usually a bit reluctant to create public functions in a module
which only serve a special purpose in one single other module.

- Claudio

Re: [PATCH] GnuTLS support on Woe32

[Eli Zaretskii]

> From: claudio.bley@gmail.com (Claudio Bley)
> Date: Sun, 13 Mar 2011 14:53:12 +0100
> 
> > If all you need is to produce EAGAIN when you have EWOULDBLOCK (the
> > other mapping is already in set_errno), it hardly justifies a
> > function.
> 
> That's true, WSAEINTR already gets mapped. Must have missed that.

So are we in agreement that a separate new function is not required?

> > > > > > +static ssize_t
> > > > > > +emacs_gnutls_pull(gnutls_transport_ptr_t p, void* buf, size_t sz)
> > > > > 
> > > > > Can we move the Windows-specific functions to w32.c, and only call
> > > > > them from gnutls.c?  I think we want to keep the Windows-related code
> > > > > outside w32*.c to the bare minimum.
> > > > 
> > > > OK.
> > > 
> > > Maybe the GnuTLS specific stuff should also be kept to the bare
> > > minimum outside of gnutls.c?
> > 
> > What stuff did you have in mind?
> 
> All the GnuTLS related functions (even if Windows specific).

That's not what we do in Emacs.  OS-specific #define's are best kept
to a minimum, the sole exception being sysdep.c.  Otherwise, we try to
keep code of non-Posix and niche platforms on their specific sources
files.

> > > Considering that these functions would have to be non-static in this
> > > case to be accessible by gnutls.c.
> > 
> > Sure, but I see no problem with that.
> 
> I'm usually a bit reluctant to create public functions in a module
> which only serve a special purpose in one single other module.

Why?  Emacs is a program, not a general-purpose library.  Invading
some unknown namespace should not be an issue.

Re: [PATCH] GnuTLS support on Woe32

[Claudio Bley]

At Sun, 13 Mar 2011 20:41:28 +0200,
Eli Zaretskii wrote:
> 
> > From: claudio.bley@gmail.com (Claudio Bley)
> > Date: Sun, 13 Mar 2011 14:53:12 +0100
> > 
> > > If all you need is to produce EAGAIN when you have EWOULDBLOCK (the
> > > other mapping is already in set_errno), it hardly justifies a
> > > function.
> > 
> > That's true, WSAEINTR already gets mapped. Must have missed that.
> 
> So are we in agreement that a separate new function is not required?

Yes, absolutely.

> > > > > > > +static ssize_t
> > > > > > > +emacs_gnutls_pull(gnutls_transport_ptr_t p, void* buf, size_t sz)
> > > > > > 
> > > > > > Can we move the Windows-specific functions to w32.c, and only call
> > > > > > them from gnutls.c?  I think we want to keep the Windows-related code
> > > > > > outside w32*.c to the bare minimum.
> > > > > 
> > > > > OK.
> > > > 
> > > > Maybe the GnuTLS specific stuff should also be kept to the bare
> > > > minimum outside of gnutls.c?
> > > 
> > > What stuff did you have in mind?
> > 
> > All the GnuTLS related functions (even if Windows specific).
> 
> That's not what we do in Emacs.  OS-specific #define's are best kept
> to a minimum, the sole exception being sysdep.c.  Otherwise, we try to
> keep code of non-Posix and niche platforms on their specific sources
> files.

It's just that these functions are not really OS-specific in any
way. I'd rather say they are GnuTLS specific.

> > > > Considering that these functions would have to be non-static in this
> > > > case to be accessible by gnutls.c.
> > > 
> > > Sure, but I see no problem with that.
> > 
> > I'm usually a bit reluctant to create public functions in a module
> > which only serve a special purpose in one single other module.
> 
> Why?  Emacs is a program, not a general-purpose library.  Invading
> some unknown namespace should not be an issue.

Never mind. I'm OK with moving them to w32.c. Consider this done.

- Claudio

Re: [PATCH] GnuTLS support on Woe32

[Ted Zlatanov]

On Mon, 14 Mar 2011 08:43:50 +0100 claudio.bley@gmail.com (Claudio Bley) wrote: 
...
CB> Never mind. I'm OK with moving them to w32.c. Consider this done.

Any update on the integration of our patches (I had some verify-flags
support started, also the buffer-local hostname and initial C-level
callback support)?  Or are you waiting for me?

Thanks
Ted

Re: [PATCH] GnuTLS support on Woe32

[Claudio Bley]

Ted Zlatanov wrote:
> On Mon, 14 Mar 2011 08:43:50 +0100 claudio.bley@gmail.com (Claudio Bley) wrote:
> ...
> CB> Never mind. I'm OK with moving them to w32.c. Consider this done.

> Any update on the integration of our patches (I had some verify-flags
> support started, also the buffer-local hostname and initial C-level
> callback support)?  Or are you waiting for me?

No, I'm not waiting for you, not at all. I haven't made any
progress. I'm just very busy these days and am not 25 anymore where I
could hack away all night...

I've send a mail to assign@gnu.org and are awaiting the papers now.

I'll see if I can get something done this weekend.

- Claudio

Re: [PATCH] GnuTLS support on Woe32

[Ted Zlatanov]

On Tue, 15 Mar 2011 08:57:05 +0100 claudio.bley@gmail.com (Claudio Bley) wrote: 

CB> Ted Zlatanov wrote:
>> Any update on the integration of our patches (I had some verify-flags
>> support started, also the buffer-local hostname and initial C-level
>> callback support)?  Or are you waiting for me?

CB> No, I'm not waiting for you, not at all. I haven't made any
CB> progress. I'm just very busy these days and am not 25 anymore where I
CB> could hack away all night...

I know the feeling :)

CB> I've send a mail to assign@gnu.org and are awaiting the papers now.

CB> I'll see if I can get something done this weekend.

OK.  I just wanted to make sure we're not waiting for each other.

Thanks
Ted

Re: POP3 UIDL - pop3-leave-mail-on-server

[Lars Magne Ingebrigtsen]

Reiner Steib <reinersteib+gmane@imap.cc> writes:

> |   ;; We can't use the UILD support from XEmacs mail-lib or cvs.m17n.org:
> |   ;; http://thread.gmane.org/v9lld8fml4.fsf@marauder.physik.uni-ulm.de
> |   ;; http://thread.gmane.org/b9yy8hzy9ej.fsf@jpl.org
> |   ;; Any volunteer to re-implement this?

Right.  So pop3 can't leave mail on the server because nobody has
bothered to reimplement the UIDL library?  How much work could that be? 

> BTW, I don't know why you removed the corresponding warnings from
> `pop3-movemail' with this commit:
>
> ,----[ git log - gnus/lisp/pop3.el ]
> | commit 119a867afc587c9261730362a6478fc3801df1b5

It didn't seem like a message that it's relevant to flash to the user
each and every time they use pop3.

>> And why not just use IMAP instead?
>
> Some mail providers don't offer IMAP (for free).
>
>> If it's a popular way to read email, I can certainly have a peek at
>> implementing an nnpop backend for Gnus...

Since nobody has spoken up and said "yes, I would use nnpop", I'm
guessing that there aren't many users (if any) that would still prefer
to read mail (and leave it there) from their pop servers instead of from
their IMAP servers.

-- 
(domestic pets only, the antidote for overdose, milk.)
  larsi@gnus.org * Lars Magne Ingebrigtsen

Re: POP3 UIDL - pop3-leave-mail-on-server

[chad]

On Mar 15, 2011, at 12:08 PM, Lars Magne Ingebrigtsen wrote:

> Right.  So pop3 can't leave mail on the server because nobody has
> bothered to reimplement the UIDL library?  How much work could that be? 
> [...]
> Since nobody has spoken up and said "yes, I would use nnpop", I'm
> guessing that there aren't many users (if any) that would still prefer
> to read mail (and leave it there) from their pop servers instead of from
> their IMAP servers.

FWIW, pop3 UIDL wasn't widely adopted (on either servers or clients) because (IMHO) it requires that the clients all be able to share a store of id's. That excludes a large subset of the desired users (for example, people who want to be able to also check mail from their mobile phone client).

It's still worth implementing, mind you - but these days most users will still prefer IMAP for a variety of reasons. (All IMHO, of course).

Hope that helps,
*Chad

Re: [PATCH] GnuTLS support on Woe32

[Claudio Bley]

[-- Attachment #1: Type: text/plain, Size: 1918 bytes --]

At Tue, 15 Mar 2011 04:24:40 -0500,
Ted Zlatanov wrote:
> 
> On Tue, 15 Mar 2011 08:57:05 +0100 claudio.bley@gmail.com (Claudio Bley) wrote: 
> 
> CB> Ted Zlatanov wrote:
> >> Any update on the integration of our patches (I had some verify-flags
> >> support started, also the buffer-local hostname and initial C-level
> >> callback support)?  Or are you waiting for me?
> 
> CB> No, I'm not waiting for you, not at all. I haven't made any
> CB> progress. I'm just very busy these days and am not 25 anymore where I
> CB> could hack away all night...
> 
> I know the feeling :)
> 
> CB> I've send a mail to assign@gnu.org and are awaiting the papers now.
> 
> CB> I'll see if I can get something done this weekend.
> 
> OK.  I just wanted to make sure we're not waiting for each other.

I'm sorry that I'm responding so infrequently, but unfortunately I
really have little time working on this right now.

I made some minor changes and integrated your patch into my branch.

Basically, the changes are in correspondence to what Eli requested.

I backed out the changes to starttls.el, moved the pull/push functions
to w32.c.

Additionally, I reverted the change to gnutls-negotiate where I signal
an error now instead of returning an error value since I had realized
that some more code depended upon returning the given process. As the
GnuTLS functionality should be almost transparent to other libraries
making network connections I think this is the better solution. What
do you think about that?

Otherwise, your patch looks good so far. Except that I always got
hostname mismatches for www.google.no and www.google.com.

Btw, I could not reproduce the problem reported by Lars Magne
Ingebrigsten, ie. this

(progn
  (require 'gnutls)
  (url-retrieve "https://www.google.no" #'ignore)
  (url-retrieve "https://www.google.no" #'ignore))

works flawlessly and does not hang (tested on Windows and Linux).

- Claudio

[-- Attachment #2: gnutls-win32_4.txt --]
[-- Type: text/plain, Size: 46942 bytes --]

# Bazaar merge directive format 2 (Bazaar 0.90)
# revision_id: claudio.bley@gmail.com-20110320213233-nboi8zv43ji1rb2g
# target_branch: bzr+ssh://USERNAME@bzr.savannah.gnu.org/emacs/trunk
# testament_sha1: 1ba258fef53672775845666969738bf0b4484a11
# timestamp: 2011-03-20 22:36:44 +0100
# source_branch: ../trunk/
# base_revision_id: rgm@gnu.org-20110304084000-8thi67w6o3ze71wz
# 
# Begin patch
=== modified file 'configure.in'
--- configure.in	2011-03-03 08:03:01 +0000
+++ configure.in	2011-03-20 21:32:33 +0000
@@ -1972,12 +1972,22 @@
 AC_SUBST(LIBSELINUX_LIBS)
 
 HAVE_GNUTLS=no
+HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY=no
 if test "${with_gnutls}" = "yes" ; then
   PKG_CHECK_MODULES([LIBGNUTLS], [gnutls >= 2.2.4], HAVE_GNUTLS=yes, HAVE_GNUTLS=no)
   if test "${HAVE_GNUTLS}" = "yes"; then
     AC_DEFINE(HAVE_GNUTLS, 1, [Define if using GnuTLS.])
   fi
+
+  CFLAGS="$CFLAGS $LIBGNUTLS_CFLAGS"
+  LIBS="$LIBGNUTLS_LIBS $LIBS"
+  AC_CHECK_FUNCS(gnutls_certificate_set_verify_function, HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY=yes)
+
+  if test "${HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY}" = "yes"; then
+    AC_DEFINE(HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY, 1, [Define if using GnuTLS certificate verification callbacks.])
+  fi
 fi
+
 AC_SUBST(LIBGNUTLS_LIBS)
 AC_SUBST(LIBGNUTLS_CFLAGS)
 
@@ -3658,6 +3668,7 @@
 echo "  Does Emacs use -lgconf?                                 ${HAVE_GCONF}"
 echo "  Does Emacs use -lselinux?                               ${HAVE_LIBSELINUX}"
 echo "  Does Emacs use -lgnutls?                                ${HAVE_GNUTLS}"
+echo "  Does Emacs use -lgnutls certificate verify callbacks?   ${HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY}"
 echo "  Does Emacs use -lxml2?                                  ${HAVE_LIBXML2}"
 
 echo "  Does Emacs use -lfreetype?                              ${HAVE_FREETYPE}"

=== 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  <claudio.bley@gmail.com>
+
+	* makefile.w32-in (obj): Added gnutls.o.
+
 2011-03-03  Drake Wilson  <drake@begriffli.ch>  (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  <claudio.bley@gmail.com>
+
+	* 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  <rgm@gnu.org>
 
 	* outline.el (outline-regexp): No longer allow nil.

=== modified file 'lisp/net/gnutls.el'
--- lisp/net/gnutls.el	2011-01-25 04:08:28 +0000
+++ lisp/net/gnutls.el	2011-03-20 21:32:33 +0000
@@ -44,6 +44,10 @@
   :type 'integer
   :group 'gnutls)
 
+(defvar gnutls-hostname nil
+  "Remote hostname.  Always buffer-local.")
+(make-variable-buffer-local 'gnutls-hostname)
+
 (defun open-gnutls-stream (name buffer host service)
   "Open a SSL/TLS connection for a service to a host.
 Returns a subprocess-object to represent the connection.
@@ -63,22 +67,50 @@
 documentation for the specific parameters you can use to open a
 GnuTLS connection, including specifying the credential type,
 trust and key files, and priority string."
-  (let ((proc (open-network-stream name buffer host service)))
-    (gnutls-negotiate proc 'gnutls-x509pki)))
+  ;; remember the hostname associated with this buffer
+  (with-current-buffer buffer
+    (setq gnutls-hostname host))
+  (gnutls-negotiate (open-network-stream name buffer host service)
+                    'gnutls-x509pki))
+
+(put 'gnutls-error
+     'error-conditions
+     '(error gnutls-error))
+(put 'gnutls-error
+     'error-message "GnuTLS error")
 
 (declare-function gnutls-boot "gnutls.c" (proc type proplist))
 
 (defun gnutls-negotiate (proc type &optional priority-string
-                              trustfiles keyfiles)
-  "Negotiate a SSL/TLS connection.
+                              trustfiles keyfiles verify-flags)
+  "Negotiate a SSL/TLS connection.  Returns proc. Signals gnutls-error.
 TYPE is `gnutls-x509pki' (default) or `gnutls-anon'.  Use nil for the default.
 PROC is a process returned by `open-network-stream'.
 PRIORITY-STRING is as per the GnuTLS docs, default is \"NORMAL\".
 TRUSTFILES is a list of CA bundles.
-KEYFILES is a list of client keys."
+KEYFILES is a list of client keys.
+
+VERIFY-FLAGS is a numeric OR of verification flags only for
+`gnutls-x509pki' connections.  See GnuTLS' x509.h for details;
+here's a recent version of the list.
+
+    GNUTLS_VERIFY_DISABLE_CA_SIGN = 1,
+    GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT = 2,
+    GNUTLS_VERIFY_DO_NOT_ALLOW_SAME = 4,
+    GNUTLS_VERIFY_ALLOW_ANY_X509_V1_CA_CRT = 8,
+    GNUTLS_VERIFY_ALLOW_SIGN_RSA_MD2 = 16,
+    GNUTLS_VERIFY_ALLOW_SIGN_RSA_MD5 = 32,
+    GNUTLS_VERIFY_DISABLE_TIME_CHECKS = 64,
+    GNUTLS_VERIFY_DISABLE_TRUSTED_TIME_CHECKS = 128,
+    GNUTLS_VERIFY_DO_NOT_ALLOW_X509_V1_CA_CRT = 256
+
+It must be omitted, a number, or nil; if omitted or nil it
+defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT."
   (let* ((type (or type 'gnutls-x509pki))
+         (default-trustfile "/etc/ssl/certs/ca-certificates.crt")
          (trustfiles (or trustfiles
-                        '("/etc/ssl/certs/ca-certificates.crt")))
+                         (when (file-exists-p default-trustfile)
+                           (list default-trustfile))))
          (priority-string (or priority-string
                               (cond
                                ((eq type 'gnutls-anon)
@@ -89,12 +121,16 @@
                              :loglevel ,gnutls-log-level
                              :trustfiles ,trustfiles
                              :keyfiles ,keyfiles
+                             :verify-flags ,verify-flags
                              :callbacks nil))
          ret)
 
     (gnutls-message-maybe
      (setq ret (gnutls-boot proc type params))
-     "boot: %s")
+     "boot: %s" params)
+
+    (when (gnutls-errorp ret)
+      (signal 'gnutls-error (list proc ret)))
 
     proc))
 

=== 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  <claudio.bley@gmail.com>
+
+	* 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  <eliz@gnu.org>
 
 	* inc/unistd.h (readlink, symlink): Declare prototypes.

=== modified file 'nt/INSTALL'
--- nt/INSTALL	2011-01-26 08:36:39 +0000
+++ nt/INSTALL	2011-03-20 18:30:26 +0000
@@ -306,6 +306,16 @@
   `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.
+
+  Pre-built binaries and an installer can be found at
+  http://josefsson.org/gnutls4win/.
+
 * 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-16 20:42:30 +0000
@@ -1,3 +1,30 @@
+2011-03-16  vtc  <vtc@ubuntu.ubuntu-domain>
+
+	* w32.h: (emacs_gnutls_pull): Add prototype.
+	(emacs_gnutls_push): Likewise.
+
+	* w32.c: (emacs_gnutls_pull): New function for GnuTLS on Woe32.
+	(emacs_gnutls_push): Likewise.
+
+2011-03-06  Claudio Bley  <claudio.bley@gmail.com>
+
+	* 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_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  <kbrown@cornell.edu>
 
 	* 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-20 21:32:33 +0000
@@ -26,11 +26,21 @@
 #ifdef HAVE_GNUTLS
 #include <gnutls/gnutls.h>
 
+#ifdef WINDOWSNT
+#include <windows.h>
+#include "w32.h"
+#endif
+
+static int
+emacs_gnutls_handle_error (gnutls_session_t, int err);
+
 Lisp_Object Qgnutls_code;
 Lisp_Object Qgnutls_anon, Qgnutls_x509pki;
 Lisp_Object Qgnutls_e_interrupted, Qgnutls_e_again,
   Qgnutls_e_invalid_session, Qgnutls_e_not_ready_for_handshake;
-int global_initialized;
+int gnutls_global_initialized;
+
+Lisp_Object Qgnutls_hostname;
 
 /* The following are for the property list of `gnutls-boot'.  */
 Lisp_Object Qgnutls_bootprop_priority;
@@ -38,8 +48,12 @@
 Lisp_Object Qgnutls_bootprop_keyfiles;
 Lisp_Object Qgnutls_bootprop_callbacks;
 Lisp_Object Qgnutls_bootprop_loglevel;
-
-static void
+Lisp_Object Qgnutls_bootprop_verify_flags;
+
+/* Callback keys for `gnutls-boot'.  Unused currently.  */
+Lisp_Object Qgnutls_bootprop_callbacks_verify;
+
+static int
 emacs_gnutls_handshake (struct Lisp_Process *proc)
 {
   gnutls_session_t state = proc->gnutls_state;
@@ -50,17 +64,44 @@
 
   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 +109,11 @@
       /* here we're finally done.  */
       proc->gnutls_initstage = GNUTLS_STAGE_READY;
     }
+  else
+    {
+        gnutls_alert_send_appropriate (state, ret);
+    }
+  return ret;
 }
 
 int
@@ -98,7 +144,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 +171,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;
   }
 }
 
+/* report a GnuTLS error to the user.
+   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
@@ -265,10 +353,10 @@
 {
   int ret = GNUTLS_E_SUCCESS;
 
-  if (!global_initialized)
+  if (!gnutls_global_initialized)
     ret = gnutls_global_init ();
 
-  global_initialized = 1;
+  gnutls_global_initialized = 1;
 
   return gnutls_make_error (ret);
 }
@@ -278,10 +366,10 @@
 static Lisp_Object
 gnutls_emacs_global_deinit (void)
 {
-  if (global_initialized)
+  if (gnutls_global_initialized)
     gnutls_global_deinit ();
 
-  global_initialized = 0;
+  gnutls_global_initialized = 0;
 
   return gnutls_make_error (GNUTLS_E_SUCCESS);
 }
@@ -309,7 +397,7 @@
 :priority is a GnuTLS priority string, defaults to "NORMAL".
 :trustfiles is a list of PEM-encoded trust files for `gnutls-x509pki'.
 :keyfiles is a list of PEM-encoded key files for `gnutls-x509pki'.
-:callbacks is an alist of callback functions (TODO).
+:callbacks is an alist of callback functions, see below.
 :loglevel is the debug level requested from GnuTLS, try 4.
 
 The debug level will be set for this process AND globally for GnuTLS.
@@ -324,6 +412,9 @@
 functions are used.  This function allocates resources which can only
 be deallocated by calling `gnutls-deinit' or by calling it again.
 
+The callbacks alist can have a `verify' key, associated with a
+verification function.
+
 Each authentication type may need additional information in order to
 work.  For X.509 PKI (`gnutls-x509pki'), you probably need at least
 one trustfile (usually a CA bundle).  */)
@@ -336,6 +427,11 @@
   /* TODO: GNUTLS_X509_FMT_DER is also an option.  */
   int file_format = GNUTLS_X509_FMT_PEM;
 
+  unsigned int gnutls_verify_flags = GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT;
+  gnutls_x509_crt_t gnutls_verify_cert;
+  unsigned int gnutls_verify_cert_list_size;
+  const gnutls_datum_t *gnutls_verify_cert_list;
+
   gnutls_session_t state;
   gnutls_certificate_credentials_t x509_cred;
   gnutls_anon_client_credentials_t anon_cred;
@@ -349,6 +445,7 @@
   Lisp_Object keyfiles;
   Lisp_Object callbacks;
   Lisp_Object loglevel;
+  Lisp_Object verify_flags;
 
   CHECK_PROCESS (proc);
   CHECK_SYMBOL (type);
@@ -359,6 +456,7 @@
   keyfiles        = Fplist_get (proplist, Qgnutls_bootprop_keyfiles);
   callbacks       = Fplist_get (proplist, Qgnutls_bootprop_callbacks);
   loglevel        = Fplist_get (proplist, Qgnutls_bootprop_loglevel);
+  verify_flags    = Fplist_get (proplist, Qgnutls_bootprop_verify_flags);
 
   state = XPROCESS (proc)->gnutls_state;
   XPROCESS (proc)->gnutls_p = 1;
@@ -416,6 +514,23 @@
       x509_cred = XPROCESS (proc)->gnutls_x509_cred;
       if (gnutls_certificate_allocate_credentials (&x509_cred) < 0)
         memory_full ();
+
+      if (NUMBERP (verify_flags))
+        {
+          gnutls_verify_flags = XINT (verify_flags);
+          GNUTLS_LOG (2, max_log_level, "setting verification flags");
+        }
+      else if (NILP (verify_flags))
+        {
+          /* The default is already GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT.  */
+          GNUTLS_LOG (2, max_log_level, "using default verification flags");
+        }
+      else
+        {
+          /* The default is already GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT.  */
+          GNUTLS_LOG (2, max_log_level, "ignoring invalid verify-flags");
+        }
+      gnutls_certificate_set_verify_flags (x509_cred, gnutls_verify_flags);
     }
   else if (EQ (type, Qgnutls_anon))
     {
@@ -484,6 +599,14 @@
 
   GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_FILES;
 
+  GNUTLS_LOG (1, max_log_level, "gnutls callbacks");
+
+  GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CALLBACKS;
+
+#ifdef HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY
+#else
+#endif
+
   GNUTLS_LOG (1, max_log_level, "gnutls_init");
 
   ret = gnutls_init (&state, GNUTLS_CLIENT);
@@ -541,9 +664,56 @@
 
   GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CRED_SET;
 
-  emacs_gnutls_handshake (XPROCESS (proc));
-
-  return gnutls_make_error (GNUTLS_E_SUCCESS);
+  ret = emacs_gnutls_handshake (XPROCESS (proc));
+
+  if (ret < GNUTLS_E_SUCCESS)
+    return gnutls_make_error (ret);
+
+  /* Now verify the peer, following
+     http://www.gnu.org/software/gnutls/manual/html_node/Verifying-peer_0027s-certificate.html.
+     The peer should present at least one certificate in the chain; do a
+     check of the certificate's hostname with
+     gnutls_x509_crt_check_hostname() against gnutls-hostname (which is
+     buffer-local and set by `open-gnutls-stream'.  */
+
+  /* We should be calling gnutls_verify_peers2 around here I think?  */
+
+  /* Up to here the process is the same for X.509 certificates and
+     OpenPGP keys. From now on X.509 certificates are assumed. This can
+     be easily extended to work with openpgp keys as well.
+  */
+  if (gnutls_certificate_type_get (state) == GNUTLS_CRT_X509)
+    {
+      ret = gnutls_x509_crt_init (&gnutls_verify_cert);
+
+      if (ret < GNUTLS_E_SUCCESS)
+        return gnutls_make_error (ret);
+
+      gnutls_verify_cert_list = gnutls_certificate_get_peers (state, &gnutls_verify_cert_list_size);
+      if (NULL == gnutls_verify_cert_list)
+        {
+          error ("No certificate was found!\n");
+        }
+
+      /* We only check the first certificate in the given chain.  */
+      ret = gnutls_x509_crt_import (gnutls_verify_cert, &gnutls_verify_cert_list[0], GNUTLS_X509_FMT_DER);
+
+      if (ret < GNUTLS_E_SUCCESS)
+        {
+          gnutls_x509_crt_deinit (gnutls_verify_cert);
+          return gnutls_make_error (ret);
+        }
+
+      if (!gnutls_x509_crt_check_hostname (gnutls_verify_cert, SSDATA (intern_c_string ("gnutls-hostname"))))
+        {
+          gnutls_x509_crt_deinit (gnutls_verify_cert);
+          error ("The certificate's hostname does not match gnutls-hostname");
+        }
+
+      gnutls_x509_crt_deinit (gnutls_verify_cert);
+    }
+
+  return gnutls_make_error (ret);
 }
 
 DEFUN ("gnutls-bye", Fgnutls_bye,
@@ -578,7 +748,7 @@
 void
 syms_of_gnutls (void)
 {
-  global_initialized = 0;
+  gnutls_global_initialized = 0;
 
   Qgnutls_code = intern_c_string ("gnutls-code");
   staticpro (&Qgnutls_code);
@@ -589,6 +759,9 @@
   Qgnutls_x509pki = intern_c_string ("gnutls-x509pki");
   staticpro (&Qgnutls_x509pki);
 
+  Qgnutls_hostname = intern_c_string ("gnutls-hostname");
+  staticpro (&Qgnutls_hostname);
+
   Qgnutls_bootprop_priority = intern_c_string (":priority");
   staticpro (&Qgnutls_bootprop_priority);
 
@@ -601,9 +774,15 @@
   Qgnutls_bootprop_callbacks = intern_c_string (":callbacks");
   staticpro (&Qgnutls_bootprop_callbacks);
 
+  Qgnutls_bootprop_callbacks_verify = intern_c_string ("verify");
+  staticpro (&Qgnutls_bootprop_callbacks_verify);
+
   Qgnutls_bootprop_loglevel = intern_c_string (":loglevel");
   staticpro (&Qgnutls_bootprop_loglevel);
 
+  Qgnutls_bootprop_verify_flags = intern_c_string (":verify-flags");
+  staticpro (&Qgnutls_bootprop_verify_flags);
+
   Qgnutls_e_interrupted = intern_c_string ("gnutls-e-interrupted");
   staticpro (&Qgnutls_e_interrupted);
   Fput (Qgnutls_e_interrupted, Qgnutls_code,

=== modified file 'src/gnutls.h'
--- src/gnutls.h	2011-01-25 04:08:28 +0000
+++ src/gnutls.h	2011-03-20 21:32:33 +0000
@@ -21,6 +21,7 @@
 
 #ifdef HAVE_GNUTLS
 #include <gnutls/gnutls.h>
+#include <gnutls/x509.h>
 
 typedef enum
 {
@@ -28,6 +29,7 @@
   GNUTLS_STAGE_EMPTY = 0,
   GNUTLS_STAGE_CRED_ALLOC,
   GNUTLS_STAGE_FILES,
+  GNUTLS_STAGE_CALLBACKS,
   GNUTLS_STAGE_INIT,
   GNUTLS_STAGE_PRIORITY,
   GNUTLS_STAGE_CRED_SET,

=== 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-16 16:56:17 +0000
@@ -4785,6 +4785,19 @@
              &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;

=== modified file 'src/w32.c'
--- src/w32.c	2011-02-27 19:48:31 +0000
+++ src/w32.c	2011-03-18 14:29:56 +0000
@@ -6089,5 +6089,74 @@
   p->childp = childp2;
 }
 
+#ifdef HAVE_GNUTLS
+
+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 = sys_read(fd, (char*)buf, sz);
+
+      if (n >= 0)
+        return n;
+      else
+        {
+          int err = errno;
+
+          if (err == EWOULDBLOCK)
+            {
+              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 || errno == EWOULDBLOCK)
+                /* we have to translate WSAEWOULDBLOCK alias
+		   EWOULDBLOCK to EAGAIN for GnuTLS */
+                err = EAGAIN;
+              else
+                err = errno;
+            }
+          gnutls_transport_set_errno (proc->gnutls_state, err);
+
+          return -1;
+        }
+    }
+}
+
+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 = sys_write((int)fd, buf, sz);
+
+  if (n >= 0)
+    return n;
+  else
+    {
+      gnutls_transport_set_errno (proc->gnutls_state,
+                                  /* translate WSAEWOULDBLOCK alias
+                                     EWOULDBLOCK to EAGAIN for
+                                     GnuTLS */
+                                  errno == EWOULDBLOCK
+                                  ? EAGAIN
+                                  : errno);
+
+      return -1;
+    }
+}
+#endif /* HAVE_GNUTLS */
+
 /* end of w32.c */
 

=== modified file 'src/w32.h'
--- src/w32.h	2011-01-25 04:08:28 +0000
+++ src/w32.h	2011-03-16 20:42:30 +0000
@@ -143,5 +143,14 @@
 extern int _sys_read_ahead (int fd);
 extern int _sys_wait_accept (int fd);
 
+#ifdef HAVE_GNUTLS
+#include <gnutls/gnutls.h>
+
+extern ssize_t emacs_gnutls_pull(gnutls_transport_ptr_t p,
+				 void* buf, size_t sz);
+extern ssize_t emacs_gnutls_push(gnutls_transport_ptr_t p,
+				 const void* buf, size_t sz);
+#endif /* HAVE_GNUTLS */
+
 #endif /* EMACS_W32_H */
 

# Begin bundle
IyBCYXphYXIgcmV2aXNpb24gYnVuZGxlIHY0CiMKQlpoOTFBWSZTWe5dcaYAKkr/gH/+V7P/////
/////v////5gO77z756WRG9s+3vjZV1z74B31NfE7udEpLfZN9j571G7vvnptu7vV977va+09zc+
410T2bvd7zQ3Z3rSe9YOl1r73O9tB3YdWwO7Ab5dnxFbqk2F7O7EPXjzO82u8mLJveMTerzzuquX
dwN67LaW89bwL22w1pvWUdDRVNFNJBpqtti2sL777576bWy689r1IhqqJa0EoQQAE0yZAFNMapPJ
NkjJ5I9TTaIAAAyekAANNACUEACCTEmIptU9T2Sno1NB+qeo9I0AD1AD1AAAAAAGmQQQRMRU/U9B
E0D1B6mg0epoYepAAAAAAADTQCTSiIBTU8jSnlNMhjEnlPIT1GjI0xDQNDamgDEaaNBpoABEkQjR
MRoARPSaY0JkACeRT0ZNNJjU9GSeUaBo0GgBpoJEgQJkAmg0JT9GijxNTYk9Se1ExD0Q9QaMgaaA
yDQGgz1QzTpU8qwQqKtiAxqlRkKggNAnKBuGQsFHLCiiKoIMRIDM0rJFlRjD3cncGnx3+v87Pj7+
cBzfFT0EyyzP8WT/KJ3CK/drIzbAt9r8ZvyxurpGv72IwbY3/vNbiv3iW75eHA/jMvYkewgzwgwo
d62IAmw9hw59PvWBPr9+fZG15czEh/ZsntPcG5gDbfZ+zyhyTUC9djoveOf/JnEe9g5uk7qSQVYh
2KMKgOpVcsoO2JA57tI7T4jUlMayXTsliL7aVTy1n92dm5eLfw+FeHu8Ee2P8j3L+PN7Qfbp8GKm
mMFx7gejBrcW1H9Rpx46ZLVWsN0e9zmc4fTRaznN2eBMgNYdy0LYvfzDRQ3f9V2fdZtHkGD6Yios
22V7czr8mc/0ejn8moDX/c88xtPb1PcTKJtDk2bGpuZ6VT+TDZv9H7xs3unf03C1NXtd6sUgW2E8
3PXKaKceFQ718ale2wZK6yDhiFmuZ2u7buxiGSzKdJkaWuab5fFr5y3E4qjKnRXXjPZFDUtNgxcq
Tr/lSca9xhK0VjvD1HxFJA1Eg3hVSpqu6jid+y+7ap+yN479s3QKFGeZnbzppUyuVuMTNzhqb5QD
N0fVnTIc0SZVPLGleGzz7Lv8412m2/TqbweXq8Z48fV7z0PlujGI6ZauyJW7MtMoyIIFcxNrQaUO
Gkcn3F6fERKxFqmay9lCDoDVJSpvvG7NnfXus+OrmsdcFC8TdFkB4IqO6IKdfBwb1hM90JooNhKv
G12vGTYM0iEm02N+zJWnqugdo3G/SuL0ZqelrO961IrD2k4dDBJuI2Zha9r5is4oGRIjN1Y1kPGc
5IxOHV7HNPMTWMXzdVmXCxnaMLDO8KwjIxfcZ6zi87lVRVLIhUqLWdiTTZSg1MbbYVI31cifjt2i
2ckYJHYfzd2Cl5/xB2x+TlfI0PJMbyDDfJdQp2SPjM7vlon+8q0RuRBBBE8+8FWGqQ6WYYEFixQA
WQDCSQnOwhNAPP4H+cGzS+FhRmJVcWUFddQroFO03S+jDour5kO9TYwM2lVCT2hgYYe9qGCh1cg9
vTkNb5s1azl2TikOAzPbD4DgoMzXlJI5fGL46oaEb/bQcL65lUiG0K7koPKPDWb7BSQWLznan7R/
lLoeoJztOJroSNwVokhjmVFhJIqGqlb9/EhHw4ZZTMrxnWPKVqKxzJhp85YvHMch8Pa5JnoN8pe4
qpvqeUFSToq+rkXITPFmC09AUZhjEaQ47ZZrfiEItIZ6Jm5ddKW9ucpWV52B+c7jnianct7/EGCR
40WZvyo+ukIpBFLf3y4uHxVG+Wm8In5OaPOW+pdtLu4fmOkgO5CT/s67CR6BNpNgxiIwOYQqSIkR
UPRSsFkRigKpBSIkUVYpEVgsigjCQC6HpYb3kDibPzCr5vQHomdwOjU2A8jsCzDxZ/ON29XT1bY2
SBlBEblp9ZDncK8Xh/JaVUltc04ogPRSJIFXy4GeqhV5uDUjR9LK9DKiIurJBhoQ5zgXDCYWlGdx
ra18pEHTIcYOitUQQ02SKiz6m15jSbg4umvnDhoIl4TjIwoMdWAwl9qUWFsrMwLghEOVqmIdTCs9
PrIQJuZveWxqKctizuA8ZcsHeaicnNlRwRgtBcJBoIzdgQnIfKGhtSh1cyDQspLI6GiNCAiBnCD3
0IBkQ0pK+lmqpNB7M2HwWe1pEPFhhjFZ3Ure51wHWl8sWbfDTr5GwGj3JHMhpsNuYdCT257n7e4y
74uoLYk44FVRVGqsnC4rFC2ivuoQN7CgyIR+eJkrB88vP1/HGleNV6WRkAKzvZYe8TzDBTJ0GaA4
tZg1O79UtEaZOrjvRZ0XElbt62FBV9K2mBVZ5IEIQNs6TjnI6j+o+F5b8t+IizgbchDC/gIp/XCs
dkjOgow5aeajYcSL+lcdlW+PzvI+L0V6Fislo2LFKwtH1WXccdSllGvBz5qyzQpUbMmYnpZ/nBTm
DJFbqeRDDhf3bD3iVm+Ym/WcicsjzIqz7iVSNURZMfjDjqfIfQf+XnQWbJf2rXSxzs6PRpKLiFoH
4BRvp6SpMsdcYCUec/0Y9hwfc7WwWJpQKPUs+na+2yrju9knlNQaHQxGFHil44Uedxsl60VIceyk
P/KaCzPc87BwRnIqxvHZ3Yx1KywFyKjyk4D2GulUtrEiq2fKYWOqRQzxuiM+2XOWCRUnVe6a/nuN
CceDD0/HrOmnhfNX8i6tu0aHP65ZPswhbiEp4dHJx+f19yh2FW/mszT87vQ6EjqLkUUBUXti+K+2
JJydP/cW7xByY3iZNFdd5U+yFe4oOKdk9aW7NeJeVxGrWoelbHBUsFZqCMh2y+HKHVU10JpZhhdF
9DGj7T9vUlzDharhuWGRRULA5Y8UETRJNBi/UhliZUuRGQj1wNVztHBvqvBU3wL0z93yGMClygav
0T24d6JvT7+fx7dp49DAjdhETIOeUWzZ00pDknAVR2A8JpRzLKNAYlBkKGVdFIZhhQa3mfLEmouq
44Gaq8F1gIOMClkrHCXa4SrqkEwjdWJ8mTJUPyvqW1zjmQQNhgWJg6mVQ+3CXPJZQmEUzeJtvxEE
SvQUol14DD2JFU4teZM9xymaTb/Pl1OpCpPIEtY7QblgQddWRvg0s+4U0IPhnDUVb5pHWvpVu+xW
U9PvTVZGhU+2++y/ZLJ5XLRFFXpg2tTJLSkjRNoZIHsPqK1V/mse4+kyGP7D2fR5fIOSpP6nAmPo
lB5vpejzehIMvg8/ukXq0YyufIt/lgXNj85UIkt8obCBsQIZZ3sELDb0hnyL0ASimPrR6CefTA5O
pXcb+TU5Jcc2CjDOb6rjpkPCT1Dv+DGHlM3GNHPUF7qs56rMdmcnAYtRaIQdqveyzK/wnIDroeDA
avdtZkzVlJT4f0t8ah3VAALzJyXfv4cK83XO17KkSsUeohaniSQmASOAoBREZAWAMLQrH7oxAFB6
+fTymIw7+h6ao9HQnqCHjec+B/Ke2fp5EPveB7ShgKSbii48wEWLSxAIhIH5OXX/dyfFuyCxAP64
Hffr+ssfDAOmccUxZN+MfCgMNKetaGIwSJp9r9fr9fQDqMmfds9zTZpnRyw8HCqw1dvgxmB3efbi
HmxA7LD6nlInwGIHF9/0L1UeV58e9g5vKheyw0dj8Dz5bDjwvFnyEN6LpYIqwCwwDCXLjNI/OzJ7
G9hdZzu/gLTphUnaF7xguga9TX5isDrlkY0nPskUf7Qj8njDPm9mjPc76O96H1e5j0qyxkZDsF5/
bV7leydlBsUn7vj3j/qS3zrR548JEHY7UFBelaUSA/AJ66oDtHVbL8ndRe+LCx/1VB/p9xsP/At0
wE6ZenzUyQrP79Y/q/HEHvWsQdmh070w+bv18DcU9b9UJOQk2IQzZceSDCKa4osmdYzk0zk6dvcs
9PG39m+sfugbbfY1/G+54/K4Ec7Dpxvyx37WnxA/QvrkQKLdj2FKrh4FNJzt2J/RyEWwh52iHAth
ZS2ZH9PPir0MOf5j8bJTIkf5NetnzVhFGniKl8DswKLoqiMyHNENgyTVmqAflPlff7viy5vV9e3Y
nAHMKSGp2wGHo54rjr4uDiEd3S1yTLRxOSBPvK9y/CfXKhFSRb9kRXg4kLliPsO5/mKaVJsH7E/i
XiAVEaTmNgRH4wd4Q3O0hgUXDbiFiB4TFKAowHID7oGcE+pEQoLgGxh8OYpCiRohIaRzSxEtht58
kb9NDlE2CcYb0IWOQrB8Y1oXnzsPKhcXh6gC65jyFGqFazuJA7iZj/ODZ6NOg0d5DosjZQkiGAig
fXk7hwnIBMC725BFC5siHoWTrOwSAsleI3l6XWXdQtRUoQJnI3kEwixQ2NCnyrSfeTdoOEsZp14B
puPG9NHEgbN18fXUzVaWnhSTvKlL1j1WMTy/onleYVvfpN7dLeelKz7j6zE3zFy73lVncfEfklrG
I1DKLn1jnXsHUU9G+Jxf7ya8Oy7HgGiECOZIGm2GLbQwYD0bRAhZoD04vZZAzduDTufNwa524VEc
0yHSERWsjAPMJYtLg5XcHLPAD2IFQ+/7foiSiUiRJ9oz8R8ReXvGsJPY4c8557h674U3dvYSWrS2
lq0BJJJIlJIB+nlZw/wgDe9dsdj1qEbrW1tPg3clahzSCPJe9LXRkf31qqzx38Obe0x8R4Xwe3UZ
FIwrBG0QMJ44XJfChvEJh4tORgmEDR46HOaJEYapowDLJhk2M1QMuiBsYKAbELMFDSIuKX4JGmmG
F6GxttfFhwCSWeQguFTS5zQXoMVut61//aAuR94paIKBkAdV5BsSKbzHCVFE5XAFmkCRtqKrV89e
yKTGQNc0HLhecbgDxBJDKjTmOiUENJJAwkNBiYGgwdmftjS5ZqaYimMWVKQB+EUMMWXd4JASKJtI
igGShqpARAKQNjYLmM5rI2IIBSJYJDUFIC5wQlsgw8kSWh2QRDxKJcQpFmpHvgWE7LUrXColqjnF
0kCqHHpaG3TS4yu1Q4c5kyQpQQlN6XFZTK6ibUGsSEZlC8okG5CRcJBZoUqJIu4I/LW1i+VxmPJz
PYlRjUzUSpvMjOiaOhwfeEB9FMkyo5kqTPFHiUmGWe7Dceuh50MRM8kUxXMfwrY4PbQNY95eYL6J
tKcJVs8BDOSKBeBYSIT8uyGjaHasJh+H5iZmyWiVoLLBnC5zd9S9wgJ3XWrdKWTlOkrVtiXwc4TY
jsu5hO4XfUVkJFdCJY1CDtSLyQrAGBCoB2dRCLkmACMg2VGdR/VIxaxZZmZ4iRj8Ejt+KXG7RnIJ
a0LWO7gKRRNW1xFA3k3lsWxmKBBrDnLkrJGtIvwDlWqI1AY8UllBRPK9KQ3qHKXE7hG6rzNs6wqr
pWl639q19UpwlTvza8oN163x4SyqIYifWpqrvULVOW5BpFDWcEiWqETEgIoCxim2sGBtIqRpSe3O
FiMupnIcQtyQKEgvNyCZ0CJxg0zjVCRKeRfwMD5kjkkazQ34Nhu274KRtSCg2iQnIkmyMBwUOkSk
3fmEDgoIJFQEYkSBJCkZy8ULQnRtNQEhnNSd18cPHKVESkamDFxzqqqKW3bBkQKMBdiAtBLQWuOc
1NsgTahEAeRtNwxY6TSsjctUBe1iNaFxGgJ2N5tSKl0JGVWD6UJf+patZsMYLyDM4kFMuGE57zOh
59RypwOXBflRHxp1WMTrg8Psfm0Ia5e5uOaNg0g9OteNTe7EIHgB4AdK82O0pKg6767gcMSwgBXg
FImGbcaeCo4xoTQiZ0fCRtb6PXRXGLH6Y1eVYgEhSLQhONHAy5lyXYJCPaJUEQQhzlQLhQRsuMqA
PEQCZDSXaG7h0EiYWgb9kTllBIQ3DeMYvMuXyZKIkygwC8onckTPO5SVig4UUSkWQgMIjWQDcZtA
i4Ld1sR2J234hoXhseovC9tuEt8THIRqsQYWEjPyo7rDWaSiRF65igcaAJcxnkwwWNSHJwJJiNHN
t6GGOQsalrFEUWNBNDk1Mj7yhgoBwffRjVRMIC3FCUMkjbp6VgIIlJFXTBjqfTQY6Ma7aG7G4pb8
JEmOaxUrQgacU7DZSBtGqj58gqRB9B5QSJSQU2ZT3F4JENMvKIk22u6QcmDjtHYWaekQrjnwINhV
XGZwaqyaxfBmZq5ccJaUYzVZSq8y1KtChCV0PDreglVRFESgJVEpZb5MhNswtBAHQPdG8qtVAz6S
ICFOg1CsXQRBheci0wGTIKlDhQ2fs7JAszQpr15ZNCYgd1jRe6hCLj1GpDVhimdPKXrvhYiOlEqJ
ATBpLAhDJFu2zGDXG4LzS/By2svBOsiKMcx6eT8lShZipTYLfLwbHjPaiP2sOejQNG8ldm9uEU1y
UrhmhDCLDcvFIpElmqWa5RIlU6Wq0huevMoZ5Eax96RrNs1NMZI8RGch4HfYw/tkZ8KLteI3NeTY
uS5gKclzgAyVgSwbUOku68V7WsToYIKQqaIlymI12Hqli9LTMlz32IkHkBSiciWAlm4QSxAZEtlu
OM5bgFNw1MHmIEGx4HOTzxfN4oPF7ReZz54fGugFD399aR0RZMTIhs3xkVa0Exc5EBMHvnKsTPoJ
hNFp6sZoXlJNxSYiAV42PD1C6ECayWd1huW7mUAkz4WiA1zYmcqRvdquiVcIKaapOopEkpsAeQIy
QEQDiNN0RhslEIy0bbiC8b1TCPsxhpPuQZBEOOcVoc2OMPGqwjVTrXuETGirVqUoROyzS+xx26cY
Q8KlDbmN3EFbTRsuwcwdRy/jE11KCzL6VAKmZfgzE4EloMyKpFwhKaISLgEcjuWMp1MHgPPFTehs
UUibHPVjkwYKeKJosHQgEcnPj4HLpxoW0TRyXKUwTLCeYCDKh7EER5y/oSuERnFzeoc5dKHqecET
K0hsZafQlLU4ebTL2CCE8uch3T4d/JAWM6thPjpWrmKC5jzlIRQ5axXcOo+PvGA0jnoX9mhvWopG
Wu1CaEjpuwiTjGnPslVylUmkGFcmehNzv49jbVzV2vS0nwCuJcMlKJKe/XhVxvcBJl2s1gG36BgN
62lBZ5stiwWPSVtixOc5im+inDrZ4PWs5Zs62BnSxeYLUqoGQJHIrHWazE1Mai++eeiYjMFQfjMk
EQicDZpQ0hDucGriwyO3FvHVjV5GDol/nRFZztyb2am0yVJnIUK1OtDHBAY0TEVcMnMbGVcXT272
9CfyiQFcpkG3yIOfFLwEgBtRuN7oV2uDEcxbSaFpp3phCVK72TxNn5IgtHk6qU7SJSoyBNAsz1ki
DURKxAF7EB7rdE+DLX1V9xM1aonF8cVuuKoSHcC4cNgKQlywVhKVODmqsMAlowMIbQmOpDvEcalh
iUCPG29uVkmQgjmFcEhTHZEXp0rRcjFTPTBuWLbUquxLoXJlRX9yJaq1yVgr1UzAbc5jlYEa1Nt+
uw8TPXrGGTRyTOSA+yHkiHMlAQfBExjtC51GdNFgwbBxycBweomRJSuSJ2x1GMCm5yKPFYnjTGug
uuloJiiQ2diAbQDuRNoBldgxdoB7OdGC88KqgjSk2iXDmxAs8P0Q67luSAbrzal4Q6iwgdiLx7Tu
UwNiyJ5LnIx11XYi9SO5A2kbncCMaybRveuxOWKKxxRoHcnPahgaQr8zo+wyNNdomit5ESzTVT5c
YQRC6ImN3PKm+99yRjjbK7ExSULTDUobpzHUbwoeHrOC2WNGucvYm8Gs6UIiCZkQUMxLsSOKQK1p
kG2oydHkcTcdCZGBg1RiMeEEQa1zRYsVsWt01IysjQ5QiC1sFYg22xEgO+7oFhraW6ekhmg6SlQV
CJvpEKBVJxwjhxEziqjpkq+ImZUEYWBlYlwRZCVLVRHEJUeys6xrAlldi7Q4OgkZljoohIsZKqgW
UQmiy791VzE/RErNV6nbpnIjEfBjDlvDPg04QQFMKQFrO2nMEdxY+NS00TqPtzxQiTIjFk7UltNZ
7nZC777GBEtzwqtrkngjI0VIGiRN4UWBKs4sTmdihB1qt6F0pPhEIeKIXIGMjFC5WixOlxnMm/Xu
VUjTbRyXnJ4FPAxVNtevJCUtZxEbCvMRLPCd+xE5Aj66rKX54XwkeKquXKUctIdptvhKUTkXznLi
7sGJAQddMTpyaK4CDebiBpJ2mytlhhEAjM7ECxDThjqTHRexo0QqCbmnRJ5AGybRNtohcc4fdLbG
i080NF8er1ZLFieeDRpToiXNtaYxaENzHAw4UUQ6ccSgSH5tOJgaFiJye2AdCG+4bK9yJIgVhwO6
eAxzFpQJlScfAY0plzfMpFRjY2YsuRQRZKrVGz4cyPNEHVELoBA2MKTNy54EiJct14mSJFTwFHOp
0cY46sbUzrQXKWoUJTRPj4REQ+H6v1uzWL7/Dj4rdzpzzKIkquV/uGs8ZYcdqIMCBF2IJmnPy49M
TrUntTMRcVKSkmSmKmkcbYKYZGWlTC0AS6llBillO4AViAmgESZ0qIMiFE5+rk1Gq8E6ioGgudLJ
6Vyg18FXGD+9onhh9PbTQa1YnpJSvgKMKDE3c0XGRGBzHLM+bDrDPcWcmBur6g0dtZT9cOf6/z/R
aegoIQA6kWEUhq1nZ1HyuCee9rBA/zZCFAEH6I0MQikDU8fdIdgkrBFYxGRGCIMDr0ZOkkRFEQVU
VBwriWwQQYxSIkEZIiIivHXaO0Cdc3afmPxJq5gPoU80Vpop0odsPnhxDoU+FS1pT8prnsF9faiC
aF9xIh2+74fDyvwAfpTV3Lr/UJi+8H7xPyln9IFCchcL5X/hY+j/zQP6wCLkTge1FP3/DyTuQO9J
FGMgMFRJIsUh4wG+593mf9ncAXU5NYB8QcgFxgH8HAodJwvzSuamAUMAH4mXQVA+zQqhgMuXpS98
AdCQgak1GxgCdCcFNEip+GbqjuH8woUUmiIaZnBZhmL8Rvp2XcH1FwujmTMC2AI//PC8VC8BwiEJ
CcP9jAyi/XwJNRnSAZsjy8RpgW1BuYmPs3a/BlxUEd3G9eQNoigNOovpoQI4wk38Uz0AwaHU7bg1
ymuRkQGpgvqIZkxeVhTfH6TajJkAdBNgnIEOCI68W6AXiHUHvsuKPxbU6JFh5dncAMqIXIWrSCgQ
TqASibC0V6TlnUVkOWFpoyIRQxALBpE0XHeKJMh2MQ8UuItSMcC14dpp1Ej5/LCNjV7RZyxjAa3J
vOFSB3ACyZymhjuKAzaCOCgnicTpAOQWEMzCv6HO68y8Be7xOZcGAD9bG032a+pQcQqRIEZi4Qdx
QhmiUCmMisAX8eqEr0du2ayyFdpQGjCkC9UZuLdxlxkqGFiul5112KeY55hkcB0P5AVIzCQaQmcS
PROSzplEDYmMGJW2uyvG3muBEBv0E2VHApCwD+emSIBtHztQaEyQhyIAYkF60tuvIFkaOKy4RqOk
zJwXoLek4BUHSogTYjJREARh8F2kKiBxgHHWAbgCLqFn7oZQfKnYUZIHqJEGflnAYchQhaMuLH22
B7fT6fX+D7vw8fD06NNh5thzF95KPqilB4dqUouuRJFPptABjPyDYmF53H4AWBanUZzPYpl0yCqZ
OCgpGSUghCbasDggYnwBvIB7Ia340bB1mGtC1n6YkDtBsGKP0/PWJhJgon4pIWsupSNBBIwgEIjE
hkPUWBH7wuP3hHJJjRWnTQYxS6yLIyGdFEU0EBWl+ULB+KF48CcaShWGsIIYoBlPGi2kna+ezAkU
geaZ6CO8+o/P4NZ9Jf+X9Rasi3EoPQRFt9eRmfWOSPyKE0VZxFJGPqYjc/bH+1fBIWxQYiRJG9Zz
Kij0HieFgsObtNTg2IGzFz9yJEwwsyKiZoRp6cNCRsUHYtZP1sGDY0Y4GIG37vxAq9JHoxrL1vmP
oBZLXJcO4KIchETaMHZOgwips2Yl1zxxQTykoGw0Nos2q29JL+SCmcScu0OBoCpKgHKCPouqcSIJ
96co9cD1i/eJX3pYMIYGFQTigHg5sSqpqGloLYfN0juOyHoCBoh31983cAQqBUXLw3iYHYTqnEU+
dkh0oEL0il9zThIZqBjBrhsSEUrVIWwLGsustTDpa8uguAqg5JCRjLUXGWbNRSqQpaD3IzcGbjXZ
litBU4C1gp4wup6q8qemdHFhrbJOIjDmKyRsE4FhrrIaEWY0EEpc9zfdOvSiKZoZbB2PCENxxLsB
e0ZNW7YAfjuTisxsHMdMcDmQh0F6kpk6R52bQTuHUEyRJCBOe8r5YJ5q5YgTJ+6BfUrQPO44xepX
GGiOMRMGEqUg9oDGhyFKLHBAmZppy4xApS5k1lUY6lG7eIcxC4gJ5wlkKy0iXWD1HsoRLZxC41Fh
ISGvr23h7ypJbSWPmGY4i6IhUZjCXK/Wh7YXFx1gcqIJjRoXvA8geL14ul41OBO/BfI6h/UQkV0o
Q8pTzWsfyUpeGJH1xQIYcJ28lD7KqhQeVbcEgZlXsUB6neuPiVuAMiJMmPE4m0pQRBm59BxSIiHM
qZYaAx4HHRPiIe89w5OEymCrmLmGPfIiMOOOL8dU0KVgpImRkZm6ZwKpQjUlQgTiTaBUGIFC4aLW
wtNXQHe8nguLTWTZJv3ipIqToqbVQ90YRCNs2hiUGR48CpTaaEqzl6KMXhzErIDn7SSzaaF9Q7cb
M9QcHRbbJ966Q50edeygop6njFMCEIoqxBAYm4zMTQRY5a6G6xv70g5rhAu9IjabPOiIirZ1RQ+X
Kdp68eeE6TugHTcUYs4SDMArgDTgcJIknkEiWhSxLBLEsiWhSwQpEo0Eo2CWhSjQhSQK/4APcQ2Y
xdoFB1ogkxUvU+0dOmXlS428cX9hwfw3Pd38DANvCHQQR0PeAiUR4kgRkLQaNJxnYbkNvwhEx6X2
vCZ2ZfWUEvkmLKGt6EyYtg4arUdFLnkS50tQrhhfEbsDslGTbqRkwzWx2gFDTV70vA0PQeo8x5jQ
IPE9cetIvwPUZwXGox9RBUpMjktzH4IG1Tf4/dI9hctLuiFUyofObxL3uk7beKAi4NehwSBYy36z
DFXpGzAtMuZY3nEZQbNyEA9VjymcErDnhUudSJggeaJ7YllJ1OOSp1RIMXiyBllAyPJ7qJUbB5qs
FwH7SSB0ROgsrIKcZlwyrKCrTGSwDYHjU9jj/buCG9Jd+TxNSTmJtFtLijb16Th8Iu8D4QE9GvgP
E4V1oilI8Z3hcX90fBDVx0HRCu+UKeaZpvEi+JTxdnfgoHCZAFT3eP1kXNOcHDviSl6lB3BWRY+z
UHfZSnKd9ap5kHTNrXoF5WBVPohWWLOED7CqlfuXgkIoMLEFqkRAJROZCusTlhii+4kTfMoaD0nc
VWB+SXSDkcR3tRI5fJCk7mkc3I1ShghY6/NBKTQaz+TVMuo5ZTKv2TgVXDFDqIldiEE9KCIFQVeU
pplp0dsOTCYekKwRZAUVBEwQ9/y7nfn3FSHgfr9qV8X+rgvlM8/mG+o5HsDXjiJeMNXSgPJa5kjW
sC9qS222ieRsPmLJIMutcHGNb3LK4udL7Ddi5FjLDXG4O/Tvg+eTvDr2Opa0yGkSW5k8RZQLYI6K
08bznAudJ1d02CtIvPxIaoSQiBjCMiwaWDwS5FDtBps77QhKgIUF6SfMvO0OOveVOAnRFQy6Mh0E
7bEzIpkVC1ZmO03s8vNykh8Flo49a1RFULwSFxq86SiuGRObQzTf6V2btNOFBVRRikksxGCxKRnO
BeOeA8juN5z+bWIgHpq7OZwJRxx9qzeUM02x9z87ZdichEAz6Ihrdvx7WW3rL17cKEQxRDxd6EgG
msyZHIFkm7b0Ah73N7g3r0Hhn8ColiAqIQSviBwBUQyz0vXTbNtk7NaIR9bew0/LftjIiFFM0rn8
Pdvjf0qQU6AyHvJ2c3CL1/B5Q/tfAWq1nM9Qov59dFWlnt4wYmE72vnCedzodoTyxPMhyM9Tijcv
7WRpNR00CaYi2JdAKKUGDi4LaBqRHIS6Gg+TMwJzCBmj3w4RhT1VSM7ULlacvaTLzQkPz4gboG8O
weqdgZ0FQRYp2T376hPcKWaNKh6R+k7GhhkzDRmHFfzDcFO1CUt5xYPd1HWNgxsYmdiFAI38PnOv
5Jw7dDvctpL+duWMUpTDfmiZQQDqQIGoIGWJDTSaykNZPopKiCMEyJ2ommhjTIkAuROz53Ia710D
waaNClokgyR7+Z1aQ5sQAL+6mlOgMGBuRArwlWNppAMYiCMOeQ6sOR17CQ7IDRJtQrFFch0vYBMP
sHyfA9h7lQtNntZ3lj5S8F9nUg0u7Sdxkam/gYMFz4XKkjJYcoIQMVkVLmDQ+CpOM9j8OMV9xIkI
gDYKB8Yib3No8FiIwUL2oaL4KKOJljIbvQKhkKd4zJMgYWSlrsEpNeYidErIknQucSMh7PafpEEV
J4n2kTMdTzAnE+AmDoeiqlzpsAjiZnEmJAVW2qEvFiWwuIOh4aAI7UgQg8Jp5kN2ApxI8dvoqAsO
YyA9ZFwRb+S5adZ75O6SN2jhJYDUhy4BnDAILE0aiwPqqXGkumx6Dv4qc5ia2D80PwzTpUzBgr0m
3UEAzIJrINlulWJYXyClOB6chyDA8YuQZaHnQ10mJAbrARoysLrI7W8OoW4ZWHwDgAfQiCeLyzHV
tUwRNdAp2G4ltmS+Vn6oXU1NdTVm5cpqy6hXU0V3ld5hBBC2xjE5NV35MfMy4rPY9n/0mPS5iqH2
VXQhJg0ny2Vq5YaoTE+IhYj57pa09FyCjLX/TahQO5ByUBgL49/mXf4MSOaD8AjwXgp3YBqcoHke
WeappQxGDcRq4EmJELAsgfP7CHsofOgYhljABIRd50LAjCfUt1HNLh28PjQuh9JCEJEJAwMMjIJG
S/tJ+WFGJ1Wss6eBpLOcPcR0o6DydlO7dKKJGpKmZoH3+Lx46OTcoAfGcmkHuA9Knyr2Au4oJ1Q4
bbW4YSDRAMETkliJH3rp9yTBo4xyzGlONECKZXyxMiEU9wdxxeGi0e2K9sYiYMYDGBmS3QTIZooH
yYH5AtHARNCBpTWxBOEen8sCQz9q69n2JwonjRBJE8SXw1JEQbpDxd0sYsDVsVLlI1PkRPzeaR5W
jy1K/AJF1LJQe/x6aDB6AhUyXHsBw3fVlEjuDemtKOb9Qo5/R8TRYnJn+uadyKJyyV+/l0HkNqDg
/KPytHQwhG4BhDYnrI+ZI9amKm9EU5QxBnzBQVIDBIiMF7/xd3MDfJCETlOtPGKvMc4PTT4YpwU6
O0IkEgj0gHWjDuFSASsKRuwCBpHbv+vv3aIxFSL4E1LxenvicCKc6Hyr6wBuXSHpE+QGeDudp0gS
HvesHXBgnEG0qNKeZCynXqRS7Zxsvf4O6K4BmmofYPGd8EcD1RPm4Cwbhh1iT7nhAOM5TzH5ZbVQ
biFSJYYOnEyS1JQVcNFgoS1EDDoteXMUQSt3Y3sOAKco+LmHZkKuKmIKaa0DnZPVUf2ZJ8IBtRBN
AmJ4DYAUJrirDtKKYTvUiHJa62Rep3BpswuUVuQtY5vXTEeoPrAM0QI++JdOwRfiEg1CzRrabfaU
tr/VYp5s7a3SLddqKhwpgvIcdO4s2gWG8lD51JZXbKUkInJ5h3uvk94MxeAMRwLQtCG8+LkX2NZ6
/oINRFDfAWoBUAV7yKagCnhvAM0iCLwLIkFTwBfh6DeX1iFgbiRKTV14+ziSImBRSIhPWWgDkANv
2BoEeW6IJMH1yDoRI5nNtuPjlBmJNpF/YApA8dVUFER3kKi1BW1+ekuPrtZbTT8FsFMRTsF9wfc+
s0Ow1qeNedVLA3M9m0Kw3KUAnu5bJfQhTZhpmHRgLYKXnms6AxkdF19tm2JnOhYSqG95d+8uFyyU
mCyP8feLm0hCOowX2wCzoikYhaSSKd09ew938w+9pC+SLNWngC6OiRKZ2coaAgMRdHAvcBriUgG4
AoCwREaEJwCcMBMGZZMSGFYDz6DvoaynSEDBTg7za5NAebnyRsoSAmoBjipnkofborATwrA2IyO/
NXO337BNCYGQw3yNYzQTDRwd+EjyG/MSAzRi0MjjsKpNsRKqBFcYDGESJvSgShJj4KVbCZGJYQJa
kRsbBT7lXS4Gw4CiPyMEIXSUEBs+EvbKUj0R8gbFBQUikBYAlIJOG7WkH1/5YJ1UKl5PpILp4E6q
vaQhXFCJQwhfJ1Igmm/yLlpPwLBQPxxcwxT2tBB1Bvso2DeUqJsW20857oZ45/N3Yvv2D7tOtdes
PxLBDN8IPIPT8AHGJ3MhzHjIBrefVtkDjRBL1tHEuL0BQcle/DriJsL0iZQUctLxsTTEHyqXR13S
kOjJGgK5CaMiB4uc5bcwDfZTnBE0KAiFhhIUEJKPqsVBskR4gR1W3dYDOtLIN8TmRSw5IB6Ldipo
F8I8VGuW6hTOl05Gd47lcZ08QaZ+2oN4erNfcE9D+059ykwGadMmRda+7N+B3Qnbc4RucmhThE5D
7QwBwXE9KkRWkCZzuARuSJGGh+NBcHxlAlu3Xn2znTv7TMCY8BvsFHvwKXiRJh4j2UY4Zh6rRu+s
K16oUyWFqTrGKUGCMEQhQokSMI9x7hjpMKFOoCDpSJ6KmwOnM5PAQUE8RMDQak1Hj3fEawwQJSL0
L0igfgOy6n0QPB45u28TeTnEEUJ2aspCoaHlERgiUhkgigixM0KjCgthQwCJlXMyZIxRF+rALohO
9nGpkwYIMMBQoEeBy8il1GJsB1q6D2UDEHRhR58Kv2BDkfl6BSSnd1HSmnuM0SlW/DlLHeH2i5WN
yDUBBZAmOpx8nGA9aoN8q2Is3YyeyUs/JdMuCRC1HgkWSJAI2ALMNVABojJPbmTCQqUGMDpE8aKY
F0+bFDVZB40GxItbxSzqC4c9ChtAgoGuPueTZtug5gpNnc8Ws2RR2CREColDNlgogdLAKWQyKCoW
SiEGhIRSqFeMja6DtQ+0PLU7JosWFYGkSiRISLpeTzY6yZ9zX32aiI8A0LC0IAHCA+K7HFRkdWia
MnAPm6SNeMvBsSOFH5dZTzPBUwpmSogqbOZUtE6oeM9CmCQpOmIWRlcSVQHEI4FqaW2g4jg4ULh3
zWQeqBYw07mlwG04Y6A4FDU8myghBIkQ2lCiMGQ139ZK3ENzogjEEDMYQqB0M2RhUwjzpbDhIka9
+mspMM4EjgMV4hNIM2l1yTggrixAsTaQDamKB0Q8IdhEwRImVSISNvuZsJIhZo5ChWt2QHA7ifVM
qvBoI1OpmobGLxjuFkMohVQHs+HPedwZCWpG9FFhFgIgqMR3Qk3ycpxOMN51t3CHClG8VYYYhv1K
t0NIx6FNcZACQWKKKCixRdkOpJpNDF84VhuzDeRUQjL08zehdCEhVYbcGxYrad1AjpW4lhfkE49l
QsU6MmpdqotDkp6pr/m/vo2St9MPN1Ww3kIVh0QhAhAnGNnmTgNnCnZwgFJ1Aj6PXrw1DPfkGchh
ByKBMM81HOpAxnRzgG0MrYwwYZWUE9+G7dTuHrU4tBd6QgZNkNJYnaVOShUKDHdi7pJUvhXtNInM
xIiKLKsIZeXlEVFCE4yISUYjYoTaEaOUccP0ao5cmjiKFwgSLkI0IsJGZIheQ40ITSg5O4UVFosn
C4m4OOmKobdMa4KFRUTdBKmDXGxmZtKiWQrKEgoesKkjJTlfORZ1oTb9vYlUAu48N+0OBwrmQcsM
QtN8JEDENoNIJajmi4ERauYry6Lcl1yQJtpEcyJ/J38l47JDklVIxFgGSNwcpDAbDTjgdwmGHGYF
1LmAFk3GtRdyk2ulIawMYLcANev2FqwXHBS1DEKE4RXUaftOo0G8U5G88Y2m8nXHpSiJKlbo2Q78
DngGwZEjIIIijJIgxBIsA3b2whJ3cGpv3H0j0YSHb5wDoNvI6tIjBSKCrSh7CutImKbICOtAMdx0
UuCc6B5MgOOQTENY6kTPBWRDX4Yf953nPiWNwUoPOciuJdB5DAwuixNPcs6NZ24BRvno9kAeOCnL
rFJr4ywgann+uh0cKG8DQiKRMjvnaiF+FAwI+jYUOsS4oV6yYtdJc+4ZLZoFwBmB8iPkO7h6hDhN
aO8JrXgNiLBNRApNiXmjUNfUH4QELaJPR5+1f1shGKKmRrgGOEFomoER10mxArWaj5Ae4vgQMD9E
NJ35su+w108vDESAvWjBgMfi8QhrFAF4ebzQcvot/l1YSWFkDykZKhNZ6hv1ir57rgPtIGzst9mQ
cUIvl9KGsHwhvPdIaSFSrB8a0cTwjwWDUsNMG07xiFBEntHUO7RuTtxRyQmLObqsHiJAUpkMp07p
EDGOya7MPWJAdFv3wDkIPUdgGTCUmxwCiB4VvyAzKKwbQukMiVJdA8Fx8Im7zoHmuih5TAHMwLp1
EU7nWPI7CY0lRkEVQqa12U2MNITSDIaWBwdPyC2yRBIC9OHOAZNTvH6MuL2we8hn4gHd4iaRryvb
XkSoluNlACYLWtvcifhxAMELx41pQanYGzMAyXgU1e+DYTug+hT5wP3nsTxD+0+n/1+XcYaHSaLN
kosGm5Sf4ftP/xdyRThQkO5dcaY=

Re: [PATCH] GnuTLS support on Woe32

[Ted Zlatanov]

[-- Attachment #1: Type: text/plain, Size: 1874 bytes --]

On Sun, 20 Mar 2011 22:41:23 +0100 claudio.bley@gmail.com (Claudio Bley) wrote: 
CB> I made some minor changes and integrated your patch into my branch.

CB> Basically, the changes are in correspondence to what Eli requested.

Looks OK.  I adjusted the patch against the recent configure changes and
today's Emacs trunk, added ChangeLog entries for my changes, and fixed
the `gnutls-hostname' verification.  I added verify-hostname-error and
verify-error parameters to `gnutls-negotiate' in addition to
verify-flags and I added a usage example to `open-gnutls-stream'.

I tested it all.  Seems to work OK on Linux, can you take a look?
Especially on W32, which I couldn't test?

Also I'd like the patch to be reviewed by Stefan or Chong.  It's not
huge but it's not tiny anymore either.

CB> Additionally, I reverted the change to gnutls-negotiate where I signal
CB> an error now instead of returning an error value since I had realized
CB> that some more code depended upon returning the given process. As the
CB> GnuTLS functionality should be almost transparent to other libraries
CB> making network connections I think this is the better solution. What
CB> do you think about that?

Looks OK, except there's 5000+ messages about retrying now.  Is that
necessary?

CB> Otherwise, your patch looks good so far. Except that I always got
CB> hostname mismatches for www.google.no and www.google.com.

I think that's fixed.  The explicit call to Fsymbol_value is kind of
weird, I'm sure there's a better way.

CB> Btw, I could not reproduce the problem reported by Lars Magne
CB> Ingebrigsten, ie. this

CB> (progn
CB>   (require 'gnutls)
CB>   (url-retrieve "https://www.google.no" #'ignore)
CB>   (url-retrieve "https://www.google.no" #'ignore))

CB> works flawlessly and does not hang (tested on Windows and Linux).

Let's cross our fingers :)  Lars, can you check?

Ted


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: callbacks.patch --]
[-- Type: text/x-diff, Size: 35094 bytes --]

=== modified file 'configure.in'
--- configure.in	2011-03-20 23:58:23 +0000
+++ configure.in	2011-03-21 03:32:08 +0000
@@ -1973,12 +1973,22 @@
 AC_SUBST(LIBSELINUX_LIBS)
 
 HAVE_GNUTLS=no
+HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY=no
 if test "${with_gnutls}" = "yes" ; then
   PKG_CHECK_MODULES([LIBGNUTLS], [gnutls >= 2.2.4], HAVE_GNUTLS=yes, HAVE_GNUTLS=no)
   if test "${HAVE_GNUTLS}" = "yes"; then
     AC_DEFINE(HAVE_GNUTLS, 1, [Define if using GnuTLS.])
   fi
+
+  CFLAGS="$CFLAGS $LIBGNUTLS_CFLAGS"
+  LIBS="$LIBGNUTLS_LIBS $LIBS"
+  AC_CHECK_FUNCS(gnutls_certificate_set_verify_function, HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY=yes)
+
+  if test "${HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY}" = "yes"; then
+    AC_DEFINE(HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY, 1, [Define if using GnuTLS certificate verification callbacks.])
+  fi
 fi
+
 AC_SUBST(LIBGNUTLS_LIBS)
 AC_SUBST(LIBGNUTLS_CFLAGS)
 
@@ -3667,6 +3677,7 @@
 echo "  Does Emacs use -lgconf?                                 ${HAVE_GCONF}"
 echo "  Does Emacs use -lselinux?                               ${HAVE_LIBSELINUX}"
 echo "  Does Emacs use -lgnutls?                                ${HAVE_GNUTLS}"
+echo "  Does Emacs use -lgnutls certificate verify callbacks?   ${HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY}"
 echo "  Does Emacs use -lxml2?                                  ${HAVE_LIBXML2}"
 
 echo "  Does Emacs use -lfreetype?                              ${HAVE_FREETYPE}"

=== modified file 'lib-src/ChangeLog'
--- lib-src/ChangeLog	2011-03-12 19:19:47 +0000
+++ lib-src/ChangeLog	2011-03-21 03:32:08 +0000
@@ -1,3 +1,7 @@
+2011-03-06  Claudio Bley  <claudio.bley@gmail.com>
+
+	* makefile.w32-in (obj): Added gnutls.o.
+
 2011-03-03  Drake Wilson  <drake@begriffli.ch>  (tiny change)
 
 	* emacsclient.c (longopts): Add quiet.

=== modified file 'lib-src/makefile.w32-in'
--- lib-src/makefile.w32-in	2011-03-12 19:19:47 +0000
+++ lib-src/makefile.w32-in	2011-03-21 03:32:08 +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-22 00:30:23 +0000
+++ lisp/ChangeLog	2011-03-22 03:15:19 +0000
@@ -1,3 +1,17 @@
+2011-03-22  Teodor Zlatanov  <tzz@lifelogs.com>
+
+	* net/gnutls.el (gnutls-hostname): New buffer-local variable for
+	hostname verification.
+	(gnutls-negotiate): Add verify-flags, verify-error, and
+	verify-hostname-error.
+	(open-gnutls-stream): Add usage example.
+
+2011-03-22  Claudio Bley  <claudio.bley@gmail.com>
+
+	* 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-22  Chong Yidong  <cyd@stupidchicken.com>
 
 	* custom.el (custom--inhibit-theme-enable): Make it affect only

=== modified file 'lisp/net/gnutls.el'
--- lisp/net/gnutls.el	2011-01-25 04:08:28 +0000
+++ lisp/net/gnutls.el	2011-03-22 03:10:24 +0000
@@ -44,6 +44,10 @@
   :type 'integer
   :group 'gnutls)
 
+(defvar gnutls-hostname nil
+  "Remote hostname.  Always buffer-local.")
+(make-variable-buffer-local 'gnutls-hostname)
+
 (defun open-gnutls-stream (name buffer host service)
   "Open a SSL/TLS connection for a service to a host.
 Returns a subprocess-object to represent the connection.
@@ -59,26 +63,77 @@
 Fourth arg SERVICE is name of the service desired, or an integer
 specifying a port number to connect to.
 
+Usage example:
+
+  \(with-temp-buffer
+    \(open-gnutls-stream \"tls\"
+                        \(current-buffer)
+                        \"your server goes here\"
+                        \"imaps\"))
+
 This is a very simple wrapper around `gnutls-negotiate'.  See its
 documentation for the specific parameters you can use to open a
 GnuTLS connection, including specifying the credential type,
 trust and key files, and priority string."
-  (let ((proc (open-network-stream name buffer host service)))
-    (gnutls-negotiate proc 'gnutls-x509pki)))
+  ;; remember the hostname associated with this buffer
+  (with-current-buffer buffer
+    (setq gnutls-hostname host))
+  (gnutls-negotiate (open-network-stream name buffer host service)
+                    'gnutls-x509pki))
+
+(put 'gnutls-error
+     'error-conditions
+     '(error gnutls-error))
+(put 'gnutls-error
+     'error-message "GnuTLS error")
 
 (declare-function gnutls-boot "gnutls.c" (proc type proplist))
 
 (defun gnutls-negotiate (proc type &optional priority-string
-                              trustfiles keyfiles)
-  "Negotiate a SSL/TLS connection.
+                              trustfiles keyfiles verify-flags
+                              verify-error verify-hostname-error)
+  "Negotiate a SSL/TLS connection.  Returns proc. Signals gnutls-error.
 TYPE is `gnutls-x509pki' (default) or `gnutls-anon'.  Use nil for the default.
 PROC is a process returned by `open-network-stream'.
 PRIORITY-STRING is as per the GnuTLS docs, default is \"NORMAL\".
 TRUSTFILES is a list of CA bundles.
-KEYFILES is a list of client keys."
+KEYFILES is a list of client keys.
+
+When VERIFY-HOSTNAME-ERROR is not nil, an error will be raised
+when the hostname does not match the presented certificate's host
+name.  The exact verification algorithm is a basic implementation
+of the matching described in RFC2818 (HTTPS), which takes into
+account wildcards, and the DNSName/IPAddress subject alternative
+name PKIX extension.  See gnutls_x509_crt_check_hostname() for
+details.  When VERIFY-HOSTNAME-ERROR is nil, only a warning will
+be issued.
+
+When VERIFY-ERROR is not nil, an error will be raised when the
+peer certificate verification fails as per
+gnutls_certificate_verify_peers2().  Otherwise, only warnings
+will be shown about the verification failure.
+
+VERIFY-FLAGS is a numeric OR of verification flags only for
+`gnutls-x509pki' connections.  See GnuTLS' x509.h for details;
+here's a recent version of the list.
+
+    GNUTLS_VERIFY_DISABLE_CA_SIGN = 1,
+    GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT = 2,
+    GNUTLS_VERIFY_DO_NOT_ALLOW_SAME = 4,
+    GNUTLS_VERIFY_ALLOW_ANY_X509_V1_CA_CRT = 8,
+    GNUTLS_VERIFY_ALLOW_SIGN_RSA_MD2 = 16,
+    GNUTLS_VERIFY_ALLOW_SIGN_RSA_MD5 = 32,
+    GNUTLS_VERIFY_DISABLE_TIME_CHECKS = 64,
+    GNUTLS_VERIFY_DISABLE_TRUSTED_TIME_CHECKS = 128,
+    GNUTLS_VERIFY_DO_NOT_ALLOW_X509_V1_CA_CRT = 256
+
+It must be omitted, a number, or nil; if omitted or nil it
+defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT."
   (let* ((type (or type 'gnutls-x509pki))
+         (default-trustfile "/etc/ssl/certs/ca-certificates.crt")
          (trustfiles (or trustfiles
-                        '("/etc/ssl/certs/ca-certificates.crt")))
+                         (when (file-exists-p default-trustfile)
+                           (list default-trustfile))))
          (priority-string (or priority-string
                               (cond
                                ((eq type 'gnutls-anon)
@@ -89,12 +144,18 @@
                              :loglevel ,gnutls-log-level
                              :trustfiles ,trustfiles
                              :keyfiles ,keyfiles
+                             :verify-flags ,verify-flags
+                             :verify-error ,verify-error
+                             :verify-hostname-error ,verify-hostname-error
                              :callbacks nil))
          ret)
 
     (gnutls-message-maybe
      (setq ret (gnutls-boot proc type params))
-     "boot: %s")
+     "boot: %s" params)
+
+    (when (gnutls-errorp ret)
+      (signal 'gnutls-error (list proc ret)))
 
     proc))
 

=== modified file 'nt/ChangeLog'
--- nt/ChangeLog	2011-03-12 19:19:47 +0000
+++ nt/ChangeLog	2011-03-21 03:32:08 +0000
@@ -1,3 +1,10 @@
+2011-03-06  Claudio Bley  <claudio.bley@gmail.com>
+
+	* 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  <eliz@gnu.org>
 
 	* inc/unistd.h (readlink, symlink): Declare prototypes.

=== modified file 'nt/INSTALL'
--- nt/INSTALL	2011-01-26 08:36:39 +0000
+++ nt/INSTALL	2011-03-21 03:32:08 +0000
@@ -306,6 +306,16 @@
   `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.
+
+  Pre-built binaries and an installer can be found at
+  http://josefsson.org/gnutls4win/.
+
 * 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-21 03:32:08 +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
@@ -204,6 +211,14 @@
 shift
 goto again
 
+:userlibs
+shift
+echo. userlibs: %userlibs%
+set userlibs=%userlibs%%sep4%%1
+set sep4= %nothing%
+shift
+goto again
+
 rem ----------------------------------------------------------------------
 
 :userldflags
@@ -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-21 03:32:08 +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-20 23:58:23 +0000
+++ src/ChangeLog	2011-03-22 03:16:05 +0000
@@ -1,3 +1,37 @@
+2011-03-22  Teodor Zlatanov  <tzz@lifelogs.com>
+
+	* gnutls.c: Renamed global_initialized to
+	gnutls_global_initialized.  Added internals for the
+	:verify-hostname-error, :verify-error, and :verify-flags
+	parameters of `gnutls-boot' and documented those parameters in the
+	docstring.  Start callback support.
+
+2011-03-20  Claudio Bley  <claudio.bley@gmail.com>
+
+	* w32.h: (emacs_gnutls_pull): Add prototype.
+	(emacs_gnutls_push): Likewise.
+
+	* w32.c: (emacs_gnutls_pull): New function for GnuTLS on Woe32.
+	(emacs_gnutls_push): Likewise.
+
+	* 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_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-20  Glenn Morris  <rgm@gnu.org>
 
 	* config.in: Remove file.

=== modified file 'src/gnutls.c'
--- src/gnutls.c	2011-01-25 04:08:28 +0000
+++ src/gnutls.c	2011-03-22 03:12:24 +0000
@@ -26,11 +26,21 @@
 #ifdef HAVE_GNUTLS
 #include <gnutls/gnutls.h>
 
+#ifdef WINDOWSNT
+#include <windows.h>
+#include "w32.h"
+#endif
+
+static int
+emacs_gnutls_handle_error (gnutls_session_t, int err);
+
 Lisp_Object Qgnutls_code;
 Lisp_Object Qgnutls_anon, Qgnutls_x509pki;
 Lisp_Object Qgnutls_e_interrupted, Qgnutls_e_again,
   Qgnutls_e_invalid_session, Qgnutls_e_not_ready_for_handshake;
-int global_initialized;
+int gnutls_global_initialized;
+
+Lisp_Object Qgnutls_hostname;
 
 /* The following are for the property list of `gnutls-boot'.  */
 Lisp_Object Qgnutls_bootprop_priority;
@@ -38,8 +48,14 @@
 Lisp_Object Qgnutls_bootprop_keyfiles;
 Lisp_Object Qgnutls_bootprop_callbacks;
 Lisp_Object Qgnutls_bootprop_loglevel;
-
-static void
+Lisp_Object Qgnutls_bootprop_verify_flags;
+Lisp_Object Qgnutls_bootprop_verify_error;
+Lisp_Object Qgnutls_bootprop_verify_hostname_error;
+
+/* Callback keys for `gnutls-boot'.  Unused currently.  */
+Lisp_Object Qgnutls_bootprop_callbacks_verify;
+
+static int
 emacs_gnutls_handshake (struct Lisp_Process *proc)
 {
   gnutls_session_t state = proc->gnutls_state;
@@ -50,17 +66,44 @@
 
   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 +111,11 @@
       /* here we're finally done.  */
       proc->gnutls_initstage = GNUTLS_STAGE_READY;
     }
+  else
+    {
+        gnutls_alert_send_appropriate (state, ret);
+    }
+  return ret;
 }
 
 int
@@ -98,7 +146,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 +173,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;
   }
 }
 
+/* report a GnuTLS error to the user.
+   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
@@ -265,10 +355,10 @@
 {
   int ret = GNUTLS_E_SUCCESS;
 
-  if (!global_initialized)
+  if (!gnutls_global_initialized)
     ret = gnutls_global_init ();
 
-  global_initialized = 1;
+  gnutls_global_initialized = 1;
 
   return gnutls_make_error (ret);
 }
@@ -278,10 +368,10 @@
 static Lisp_Object
 gnutls_emacs_global_deinit (void)
 {
-  if (global_initialized)
+  if (gnutls_global_initialized)
     gnutls_global_deinit ();
 
-  global_initialized = 0;
+  gnutls_global_initialized = 0;
 
   return gnutls_make_error (GNUTLS_E_SUCCESS);
 }
@@ -307,11 +397,20 @@
 PROPLIST is a property list with the following keys:
 
 :priority is a GnuTLS priority string, defaults to "NORMAL".
+
 :trustfiles is a list of PEM-encoded trust files for `gnutls-x509pki'.
+
 :keyfiles is a list of PEM-encoded key files for `gnutls-x509pki'.
-:callbacks is an alist of callback functions (TODO).
+
+:callbacks is an alist of callback functions, see below.
+
 :loglevel is the debug level requested from GnuTLS, try 4.
 
+:verify-flags is a bitset as per gnutls_certificate_set_verify_flags().
+
+:verify-hostname-error determines if a hostname mismatch is a warning
+or an error.
+
 The debug level will be set for this process AND globally for GnuTLS.
 So if you set it higher or lower at any point, it affects global
 debugging.
@@ -324,6 +423,9 @@
 functions are used.  This function allocates resources which can only
 be deallocated by calling `gnutls-deinit' or by calling it again.
 
+The callbacks alist can have a `verify' key, associated with a
+verification function (UNUSED).
+
 Each authentication type may need additional information in order to
 work.  For X.509 PKI (`gnutls-x509pki'), you probably need at least
 one trustfile (usually a CA bundle).  */)
@@ -336,12 +438,19 @@
   /* TODO: GNUTLS_X509_FMT_DER is also an option.  */
   int file_format = GNUTLS_X509_FMT_PEM;
 
+  unsigned int gnutls_verify_flags = GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT;
+  gnutls_x509_crt_t gnutls_verify_cert;
+  unsigned int gnutls_verify_cert_list_size;
+  const gnutls_datum_t *gnutls_verify_cert_list;
+
   gnutls_session_t state;
   gnutls_certificate_credentials_t x509_cred;
   gnutls_anon_client_credentials_t anon_cred;
   Lisp_Object global_init;
   char* priority_string_ptr = "NORMAL"; /* default priority string.  */
   Lisp_Object tail;
+  char* hostname;
+  int peer_verification;
 
   /* Placeholders for the property list elements.  */
   Lisp_Object priority_string;
@@ -349,16 +458,24 @@
   Lisp_Object keyfiles;
   Lisp_Object callbacks;
   Lisp_Object loglevel;
+  Lisp_Object verify_flags;
+  Lisp_Object verify_error;
+  Lisp_Object verify_hostname_error;
 
   CHECK_PROCESS (proc);
   CHECK_SYMBOL (type);
   CHECK_LIST (proplist);
 
-  priority_string = Fplist_get (proplist, Qgnutls_bootprop_priority);
-  trustfiles      = Fplist_get (proplist, Qgnutls_bootprop_trustfiles);
-  keyfiles        = Fplist_get (proplist, Qgnutls_bootprop_keyfiles);
-  callbacks       = Fplist_get (proplist, Qgnutls_bootprop_callbacks);
-  loglevel        = Fplist_get (proplist, Qgnutls_bootprop_loglevel);
+  priority_string       = Fplist_get (proplist, Qgnutls_bootprop_priority);
+  trustfiles            = Fplist_get (proplist, Qgnutls_bootprop_trustfiles);
+  keyfiles              = Fplist_get (proplist, Qgnutls_bootprop_keyfiles);
+  callbacks             = Fplist_get (proplist, Qgnutls_bootprop_callbacks);
+  loglevel              = Fplist_get (proplist, Qgnutls_bootprop_loglevel);
+  verify_flags          = Fplist_get (proplist, Qgnutls_bootprop_verify_flags);
+  verify_error          = Fplist_get (proplist, Qgnutls_bootprop_verify_error);
+  verify_hostname_error = Fplist_get (proplist, Qgnutls_bootprop_verify_hostname_error);
+
+  hostname = SSDATA (Fsymbol_value (intern_c_string ("gnutls-hostname")));
 
   state = XPROCESS (proc)->gnutls_state;
   XPROCESS (proc)->gnutls_p = 1;
@@ -416,6 +533,23 @@
       x509_cred = XPROCESS (proc)->gnutls_x509_cred;
       if (gnutls_certificate_allocate_credentials (&x509_cred) < 0)
         memory_full ();
+
+      if (NUMBERP (verify_flags))
+        {
+          gnutls_verify_flags = XINT (verify_flags);
+          GNUTLS_LOG (2, max_log_level, "setting verification flags");
+        }
+      else if (NILP (verify_flags))
+        {
+          /* The default is already GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT.  */
+          GNUTLS_LOG (2, max_log_level, "using default verification flags");
+        }
+      else
+        {
+          /* The default is already GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT.  */
+          GNUTLS_LOG (2, max_log_level, "ignoring invalid verify-flags");
+        }
+      gnutls_certificate_set_verify_flags (x509_cred, gnutls_verify_flags);
     }
   else if (EQ (type, Qgnutls_anon))
     {
@@ -484,6 +618,14 @@
 
   GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_FILES;
 
+  GNUTLS_LOG (1, max_log_level, "gnutls callbacks");
+
+  GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CALLBACKS;
+
+#ifdef HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY
+#else
+#endif
+
   GNUTLS_LOG (1, max_log_level, "gnutls_init");
 
   ret = gnutls_init (&state, GNUTLS_CLIENT);
@@ -541,9 +683,120 @@
 
   GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CRED_SET;
 
-  emacs_gnutls_handshake (XPROCESS (proc));
-
-  return gnutls_make_error (GNUTLS_E_SUCCESS);
+  ret = emacs_gnutls_handshake (XPROCESS (proc));
+
+  if (ret < GNUTLS_E_SUCCESS)
+    return gnutls_make_error (ret);
+
+  /* Now verify the peer, following
+     http://www.gnu.org/software/gnutls/manual/html_node/Verifying-peer_0027s-certificate.html.
+     The peer should present at least one certificate in the chain; do a
+     check of the certificate's hostname with
+     gnutls_x509_crt_check_hostname() against gnutls-hostname (which is
+     buffer-local and set by `open-gnutls-stream'.  */
+
+  ret = gnutls_certificate_verify_peers2 (state, &peer_verification);
+
+  if (ret < GNUTLS_E_SUCCESS)
+    return gnutls_make_error (ret);
+  
+  if (peer_verification & GNUTLS_CERT_INVALID)
+  {
+    message ("%s certificate could not be verified.", 
+             hostname);
+  }
+ 
+ if (peer_verification & GNUTLS_CERT_REVOKED)
+  {
+    message ("%s certificate was revoked (CRL).",
+              hostname);
+  }
+ 
+ if (peer_verification & GNUTLS_CERT_SIGNER_NOT_FOUND)
+   {
+     message ("%s certificate's signer was not found.",
+              hostname);
+   }
+
+ if (peer_verification & GNUTLS_CERT_SIGNER_NOT_CA)
+   {
+     message ("%s certificate's signer is not a CA.",
+              hostname);
+   }
+
+ if (peer_verification & GNUTLS_CERT_INSECURE_ALGORITHM)
+   {
+     message ("%s certificate was signed with an insecure algorithm.",
+              hostname);
+   }
+
+ if (peer_verification & GNUTLS_CERT_NOT_ACTIVATED)
+   {
+     message ("%s certificate is not yet activated.");
+   }
+
+ if (peer_verification & GNUTLS_CERT_EXPIRED)
+   {
+     message ("%s certificate has expired.");
+   }
+
+ if (peer_verification != 0)
+   {
+     if (NILP (verify_hostname_error))
+       {
+         message ("Certificate validation failed for %s, verification code %d",
+                  hostname, peer_verification);
+       }
+     else
+       {
+         error ("Certificate validation failed for %s, verification code %d",
+                hostname, peer_verification);
+       }
+   }
+
+  /* Up to here the process is the same for X.509 certificates and
+     OpenPGP keys. From now on X.509 certificates are assumed. This can
+     be easily extended to work with openpgp keys as well.
+  */
+  if (gnutls_certificate_type_get (state) == GNUTLS_CRT_X509)
+    {
+      ret = gnutls_x509_crt_init (&gnutls_verify_cert);
+
+      if (ret < GNUTLS_E_SUCCESS)
+        return gnutls_make_error (ret);
+
+      gnutls_verify_cert_list = gnutls_certificate_get_peers (state, &gnutls_verify_cert_list_size);
+      if (NULL == gnutls_verify_cert_list)
+        {
+          error ("No certificate was found!\n");
+        }
+
+      /* We only check the first certificate in the given chain.  */
+      ret = gnutls_x509_crt_import (gnutls_verify_cert, &gnutls_verify_cert_list[0], GNUTLS_X509_FMT_DER);
+
+      if (ret < GNUTLS_E_SUCCESS)
+        {
+          gnutls_x509_crt_deinit (gnutls_verify_cert);
+          return gnutls_make_error (ret);
+        }
+
+      if (!gnutls_x509_crt_check_hostname (gnutls_verify_cert, hostname))
+        {
+          if (NILP (verify_hostname_error))
+            {
+              message ("GnuTLS warning: the certificate's hostname does not match gnutls-hostname \"%s\"", hostname);
+            }
+          else
+            {
+              gnutls_x509_crt_deinit (gnutls_verify_cert);
+              error ("The certificate's hostname does not match gnutls-hostname \"%s\"", hostname);
+            }
+        }
+
+      gnutls_x509_crt_deinit (gnutls_verify_cert);
+    }
+
+  return gnutls_make_error (ret);
 }
 
 DEFUN ("gnutls-bye", Fgnutls_bye,
@@ -578,7 +831,7 @@
 void
 syms_of_gnutls (void)
 {
-  global_initialized = 0;
+  gnutls_global_initialized = 0;
 
   Qgnutls_code = intern_c_string ("gnutls-code");
   staticpro (&Qgnutls_code);
@@ -589,6 +842,9 @@
   Qgnutls_x509pki = intern_c_string ("gnutls-x509pki");
   staticpro (&Qgnutls_x509pki);
 
+  Qgnutls_hostname = intern_c_string ("gnutls-hostname");
+  staticpro (&Qgnutls_hostname);
+
   Qgnutls_bootprop_priority = intern_c_string (":priority");
   staticpro (&Qgnutls_bootprop_priority);
 
@@ -601,9 +857,21 @@
   Qgnutls_bootprop_callbacks = intern_c_string (":callbacks");
   staticpro (&Qgnutls_bootprop_callbacks);
 
+  Qgnutls_bootprop_callbacks_verify = intern_c_string ("verify");
+  staticpro (&Qgnutls_bootprop_callbacks_verify);
+
   Qgnutls_bootprop_loglevel = intern_c_string (":loglevel");
   staticpro (&Qgnutls_bootprop_loglevel);
 
+  Qgnutls_bootprop_verify_flags = intern_c_string (":verify-flags");
+  staticpro (&Qgnutls_bootprop_verify_flags);
+
+  Qgnutls_bootprop_verify_hostname_error = intern_c_string (":verify-error");
+  staticpro (&Qgnutls_bootprop_verify_error);
+
+  Qgnutls_bootprop_verify_hostname_error = intern_c_string (":verify-hostname-error");
+  staticpro (&Qgnutls_bootprop_verify_hostname_error);
+
   Qgnutls_e_interrupted = intern_c_string ("gnutls-e-interrupted");
   staticpro (&Qgnutls_e_interrupted);
   Fput (Qgnutls_e_interrupted, Qgnutls_code,

=== modified file 'src/gnutls.h'
--- src/gnutls.h	2011-01-25 04:08:28 +0000
+++ src/gnutls.h	2011-03-21 03:32:08 +0000
@@ -21,6 +21,7 @@
 
 #ifdef HAVE_GNUTLS
 #include <gnutls/gnutls.h>
+#include <gnutls/x509.h>
 
 typedef enum
 {
@@ -28,6 +29,7 @@
   GNUTLS_STAGE_EMPTY = 0,
   GNUTLS_STAGE_CRED_ALLOC,
   GNUTLS_STAGE_FILES,
+  GNUTLS_STAGE_CALLBACKS,
   GNUTLS_STAGE_INIT,
   GNUTLS_STAGE_PRIORITY,
   GNUTLS_STAGE_CRED_SET,

=== modified file 'src/makefile.w32-in'
--- src/makefile.w32-in	2011-03-19 03:22:14 +0000
+++ src/makefile.w32-in	2011-03-21 03:32:08 +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)
 
 #
@@ -948,6 +950,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-03-17 05:18:33 +0000
+++ src/process.c	2011-03-21 03:32:08 +0000
@@ -4780,6 +4780,19 @@
              &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;

=== modified file 'src/w32.c'
--- src/w32.c	2011-03-14 17:07:53 +0000
+++ src/w32.c	2011-03-21 03:32:08 +0000
@@ -6084,5 +6084,74 @@
   p->childp = childp2;
 }
 
+#ifdef HAVE_GNUTLS
+
+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 = sys_read(fd, (char*)buf, sz);
+
+      if (n >= 0)
+        return n;
+      else
+        {
+          int err = errno;
+
+          if (err == EWOULDBLOCK)
+            {
+              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 || errno == EWOULDBLOCK)
+                /* we have to translate WSAEWOULDBLOCK alias
+		   EWOULDBLOCK to EAGAIN for GnuTLS */
+                err = EAGAIN;
+              else
+                err = errno;
+            }
+          gnutls_transport_set_errno (proc->gnutls_state, err);
+
+          return -1;
+        }
+    }
+}
+
+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 = sys_write((int)fd, buf, sz);
+
+  if (n >= 0)
+    return n;
+  else
+    {
+      gnutls_transport_set_errno (proc->gnutls_state,
+                                  /* translate WSAEWOULDBLOCK alias
+                                     EWOULDBLOCK to EAGAIN for
+                                     GnuTLS */
+                                  errno == EWOULDBLOCK
+                                  ? EAGAIN
+                                  : errno);
+
+      return -1;
+    }
+}
+#endif /* HAVE_GNUTLS */
+
 /* end of w32.c */
 

=== modified file 'src/w32.h'
--- src/w32.h	2011-01-25 04:08:28 +0000
+++ src/w32.h	2011-03-21 03:32:08 +0000
@@ -143,5 +143,14 @@
 extern int _sys_read_ahead (int fd);
 extern int _sys_wait_accept (int fd);
 
+#ifdef HAVE_GNUTLS
+#include <gnutls/gnutls.h>
+
+extern ssize_t emacs_gnutls_pull(gnutls_transport_ptr_t p,
+				 void* buf, size_t sz);
+extern ssize_t emacs_gnutls_push(gnutls_transport_ptr_t p,
+				 const void* buf, size_t sz);
+#endif /* HAVE_GNUTLS */
+
 #endif /* EMACS_W32_H */
 

Re: [PATCH] GnuTLS support on Woe32

[Stefan Monnier]

> +  hostname = SSDATA (Fsymbol_value (intern_c_string ("gnutls-hostname")));

C is not Lisp, it does not perform dynamic type checks for you, you have
to do them by hand: the above code will lead to crashes if someone sets
gnutls-hostname to something else than a string, so you need to
CHECK_STRING or something like that.

Also further down you define Qgnutls_hostname but never use it, but here
would be a good place to use it (otherwise, don't define it).
Finally, if you want to avoid Fsymbol_value, you can use DEFVAR_LISP to
define Vgnutls_hostname so you can then just do SSDATA (Vgnutls_hostname).

> +  if (peer_verification & GNUTLS_CERT_INVALID)
> +  {
> +    message ("%s certificate could not be verified.", 
> +             hostname);
> +  }

You do not need the braces if there's only one instruction in the block.

> +#ifdef HAVE_GNUTLS
> +          /* GnuTLS buffers data internally. In lowat mode it leaves some data

Shouldn't that be "Iowait"?  Also please put 2 spaces after a ".".

> +              && gnutls_record_check_pending(wait_proc->gnutls_state) > 0)
                                              ^^
                                          needs a space

> +              sc = select (fd + 1, &fdset, (SELECT_TYPE *)0, (SELECT_TYPE *)0, &timeout);

That seems to go way past column 80.  Please fold it.

> +                                  /* translate WSAEWOULDBLOCK alias
> +                                     EWOULDBLOCK to EAGAIN for
> +                                     GnuTLS */

The comment above needs to start with a capital letter and end with a ".".

> +extern ssize_t emacs_gnutls_pull(gnutls_transport_ptr_t p,
> +				 void* buf, size_t sz);
> +extern ssize_t emacs_gnutls_push(gnutls_transport_ptr_t p,
> +				 const void* buf, size_t sz);

Again, the above needs spaces before the open paren.

As far as functionality goes, I don't know what this is trying to do nor
why it needs to do it this way, so I can't really judge.  The key
validation code seems to be "very" complex, in the sense that we would
probably want to move some of that complexity to Elisp at some point.


        Stefan

Re: [PATCH] GnuTLS support on Woe32

[Ted Zlatanov]

[-- Attachment #1: Type: text/plain, Size: 4062 bytes --]

On Tue, 22 Mar 2011 01:40:06 -0400 Stefan Monnier <monnier@iro.umontreal.ca> wrote: 

>> +  hostname = SSDATA (Fsymbol_value (intern_c_string ("gnutls-hostname")));
SM> C is not Lisp, it does not perform dynamic type checks for you, you have
SM> to do them by hand: the above code will lead to crashes if someone sets
SM> gnutls-hostname to something else than a string, so you need to
SM> CHECK_STRING or something like that.

Added CHECK_STRING.

SM> Also further down you define Qgnutls_hostname but never use it, but here
SM> would be a good place to use it (otherwise, don't define it).
SM> Finally, if you want to avoid Fsymbol_value, you can use DEFVAR_LISP to
SM> define Vgnutls_hostname so you can then just do SSDATA (Vgnutls_hostname).

Fixed.  I wanted to define that variable in gnutls.el so I can make it
buffer-local there too (right before it's used).  If you think that's
better in gnutls.c, I'll change it.

SM> You do not need the braces if there's only one instruction in the block.

Fixed, except in these two places:

 if (peer_verification != 0)
   {
     if (NILP (verify_hostname_error))
       {
         message ("Certificate validation failed for %s, verification code %d",
                  hostname, peer_verification);
       }
     else
       {
         error ("Certificate validation failed for %s, verification code %d",
                hostname, peer_verification);
       }
   }

...
      if (!gnutls_x509_crt_check_hostname (gnutls_verify_cert, hostname))
        {
          if (NILP (verify_hostname_error))
            {
              message ("GnuTLS warning: the certificate's hostname does not match gnutls-hostname \"%s\"", hostname);
            }
          else
            {
              gnutls_x509_crt_deinit (gnutls_verify_cert);
              error ("The certificate's hostname does not match gnutls-hostname \"%s\"", hostname);
            }
        }

where I thought removing the braces looked confusing and ugly because of
the nesting.

>> +#ifdef HAVE_GNUTLS
>> +          /* GnuTLS buffers data internally. In lowat mode it leaves some data

SM> Shouldn't that be "Iowait"?

No, see gnutls_transport_set_lowat() for instance.

SM>  Also please put 2 spaces after a ".".

I fixed the comments, I think.

>> +              && gnutls_record_check_pending(wait_proc->gnutls_state) > 0)
Fixed.
>> +              sc = select (fd + 1, &fdset, (SELECT_TYPE *)0, (SELECT_TYPE *)0, &timeout);
Fixed.
>> +                                  /* translate WSAEWOULDBLOCK alias
>> +                                     EWOULDBLOCK to EAGAIN for
>> +                                     GnuTLS */
Fixed (and the other such comment in w32.c).

>> +extern ssize_t emacs_gnutls_pull(gnutls_transport_ptr_t p,
>> +				 void* buf, size_t sz);
>> +extern ssize_t emacs_gnutls_push(gnutls_transport_ptr_t p,
>> +				 const void* buf, size_t sz);
Fixed, and the call in w32.c too.

I've attached an updated patch.  Sorry if I have missed anything.  It
would be nice to have an automatic way to catch these formatting issues.

SM> As far as functionality goes, I don't know what this is trying to do nor
SM> why it needs to do it this way, so I can't really judge.  The key
SM> validation code seems to be "very" complex, in the sense that we would
SM> probably want to move some of that complexity to Elisp at some point.

Unfortunately the validation is tightly coupled to the C-level GnuTLS
functions so it would require writing a lot of glue code.  All the
session data initialization and certificate validation are done with
GnuTLS C functions and the data passed around has to be at the C level.
Breaking up the validation into chunks could help but then more
intermediate results have to be stored in each buffer and the
error-handling logic would get even more complicated.

I am excited that this patch finally achieves the base functionality
Emacs needs to do SSL and TLS connections without helper applications on
most platforms we support.  So I hope I can make it acceptable soon :)
Thanks for looking at it.

Ted


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: revised 2011-03-22 --]
[-- Type: text/x-diff, Size: 35164 bytes --]

=== modified file 'configure.in'
--- configure.in	2011-03-20 23:58:23 +0000
+++ configure.in	2011-03-21 03:32:08 +0000
@@ -1973,12 +1973,22 @@
 AC_SUBST(LIBSELINUX_LIBS)
 
 HAVE_GNUTLS=no
+HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY=no
 if test "${with_gnutls}" = "yes" ; then
   PKG_CHECK_MODULES([LIBGNUTLS], [gnutls >= 2.2.4], HAVE_GNUTLS=yes, HAVE_GNUTLS=no)
   if test "${HAVE_GNUTLS}" = "yes"; then
     AC_DEFINE(HAVE_GNUTLS, 1, [Define if using GnuTLS.])
   fi
+
+  CFLAGS="$CFLAGS $LIBGNUTLS_CFLAGS"
+  LIBS="$LIBGNUTLS_LIBS $LIBS"
+  AC_CHECK_FUNCS(gnutls_certificate_set_verify_function, HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY=yes)
+
+  if test "${HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY}" = "yes"; then
+    AC_DEFINE(HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY, 1, [Define if using GnuTLS certificate verification callbacks.])
+  fi
 fi
+
 AC_SUBST(LIBGNUTLS_LIBS)
 AC_SUBST(LIBGNUTLS_CFLAGS)
 
@@ -3667,6 +3677,7 @@
 echo "  Does Emacs use -lgconf?                                 ${HAVE_GCONF}"
 echo "  Does Emacs use -lselinux?                               ${HAVE_LIBSELINUX}"
 echo "  Does Emacs use -lgnutls?                                ${HAVE_GNUTLS}"
+echo "  Does Emacs use -lgnutls certificate verify callbacks?   ${HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY}"
 echo "  Does Emacs use -lxml2?                                  ${HAVE_LIBXML2}"
 
 echo "  Does Emacs use -lfreetype?                              ${HAVE_FREETYPE}"

=== modified file 'lib-src/ChangeLog'
--- lib-src/ChangeLog	2011-03-12 19:19:47 +0000
+++ lib-src/ChangeLog	2011-03-21 03:32:08 +0000
@@ -1,3 +1,7 @@
+2011-03-06  Claudio Bley  <claudio.bley@gmail.com>
+
+	* makefile.w32-in (obj): Added gnutls.o.
+
 2011-03-03  Drake Wilson  <drake@begriffli.ch>  (tiny change)
 
 	* emacsclient.c (longopts): Add quiet.

=== modified file 'lib-src/makefile.w32-in'
--- lib-src/makefile.w32-in	2011-03-12 19:19:47 +0000
+++ lib-src/makefile.w32-in	2011-03-21 03:32:08 +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-22 00:30:23 +0000
+++ lisp/ChangeLog	2011-03-22 03:15:19 +0000
@@ -1,3 +1,17 @@
+2011-03-22  Teodor Zlatanov  <tzz@lifelogs.com>
+
+	* net/gnutls.el (gnutls-hostname): New buffer-local variable for
+	hostname verification.
+	(gnutls-negotiate): Add verify-flags, verify-error, and
+	verify-hostname-error.
+	(open-gnutls-stream): Add usage example.
+
+2011-03-22  Claudio Bley  <claudio.bley@gmail.com>
+
+	* 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-22  Chong Yidong  <cyd@stupidchicken.com>
 
 	* custom.el (custom--inhibit-theme-enable): Make it affect only

=== modified file 'lisp/net/gnutls.el'
--- lisp/net/gnutls.el	2011-01-25 04:08:28 +0000
+++ lisp/net/gnutls.el	2011-03-22 03:10:24 +0000
@@ -44,6 +44,10 @@
   :type 'integer
   :group 'gnutls)
 
+(defvar gnutls-hostname nil
+  "Remote hostname.  Always buffer-local.")
+(make-variable-buffer-local 'gnutls-hostname)
+
 (defun open-gnutls-stream (name buffer host service)
   "Open a SSL/TLS connection for a service to a host.
 Returns a subprocess-object to represent the connection.
@@ -59,26 +63,77 @@
 Fourth arg SERVICE is name of the service desired, or an integer
 specifying a port number to connect to.
 
+Usage example:
+
+  \(with-temp-buffer
+    \(open-gnutls-stream \"tls\"
+                        \(current-buffer)
+                        \"your server goes here\"
+                        \"imaps\"))
+
 This is a very simple wrapper around `gnutls-negotiate'.  See its
 documentation for the specific parameters you can use to open a
 GnuTLS connection, including specifying the credential type,
 trust and key files, and priority string."
-  (let ((proc (open-network-stream name buffer host service)))
-    (gnutls-negotiate proc 'gnutls-x509pki)))
+  ;; remember the hostname associated with this buffer
+  (with-current-buffer buffer
+    (setq gnutls-hostname host))
+  (gnutls-negotiate (open-network-stream name buffer host service)
+                    'gnutls-x509pki))
+
+(put 'gnutls-error
+     'error-conditions
+     '(error gnutls-error))
+(put 'gnutls-error
+     'error-message "GnuTLS error")
 
 (declare-function gnutls-boot "gnutls.c" (proc type proplist))
 
 (defun gnutls-negotiate (proc type &optional priority-string
-                              trustfiles keyfiles)
-  "Negotiate a SSL/TLS connection.
+                              trustfiles keyfiles verify-flags
+                              verify-error verify-hostname-error)
+  "Negotiate a SSL/TLS connection.  Returns proc. Signals gnutls-error.
 TYPE is `gnutls-x509pki' (default) or `gnutls-anon'.  Use nil for the default.
 PROC is a process returned by `open-network-stream'.
 PRIORITY-STRING is as per the GnuTLS docs, default is \"NORMAL\".
 TRUSTFILES is a list of CA bundles.
-KEYFILES is a list of client keys."
+KEYFILES is a list of client keys.
+
+When VERIFY-HOSTNAME-ERROR is not nil, an error will be raised
+when the hostname does not match the presented certificate's host
+name.  The exact verification algorithm is a basic implementation
+of the matching described in RFC2818 (HTTPS), which takes into
+account wildcards, and the DNSName/IPAddress subject alternative
+name PKIX extension.  See gnutls_x509_crt_check_hostname() for
+details.  When VERIFY-HOSTNAME-ERROR is nil, only a warning will
+be issued.
+
+When VERIFY-ERROR is not nil, an error will be raised when the
+peer certificate verification fails as per
+gnutls_certificate_verify_peers2().  Otherwise, only warnings
+will be shown about the verification failure.
+
+VERIFY-FLAGS is a numeric OR of verification flags only for
+`gnutls-x509pki' connections.  See GnuTLS' x509.h for details;
+here's a recent version of the list.
+
+    GNUTLS_VERIFY_DISABLE_CA_SIGN = 1,
+    GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT = 2,
+    GNUTLS_VERIFY_DO_NOT_ALLOW_SAME = 4,
+    GNUTLS_VERIFY_ALLOW_ANY_X509_V1_CA_CRT = 8,
+    GNUTLS_VERIFY_ALLOW_SIGN_RSA_MD2 = 16,
+    GNUTLS_VERIFY_ALLOW_SIGN_RSA_MD5 = 32,
+    GNUTLS_VERIFY_DISABLE_TIME_CHECKS = 64,
+    GNUTLS_VERIFY_DISABLE_TRUSTED_TIME_CHECKS = 128,
+    GNUTLS_VERIFY_DO_NOT_ALLOW_X509_V1_CA_CRT = 256
+
+It must be omitted, a number, or nil; if omitted or nil it
+defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT."
   (let* ((type (or type 'gnutls-x509pki))
+         (default-trustfile "/etc/ssl/certs/ca-certificates.crt")
          (trustfiles (or trustfiles
-                        '("/etc/ssl/certs/ca-certificates.crt")))
+                         (when (file-exists-p default-trustfile)
+                           (list default-trustfile))))
          (priority-string (or priority-string
                               (cond
                                ((eq type 'gnutls-anon)
@@ -89,12 +144,18 @@
                              :loglevel ,gnutls-log-level
                              :trustfiles ,trustfiles
                              :keyfiles ,keyfiles
+                             :verify-flags ,verify-flags
+                             :verify-error ,verify-error
+                             :verify-hostname-error ,verify-hostname-error
                              :callbacks nil))
          ret)
 
     (gnutls-message-maybe
      (setq ret (gnutls-boot proc type params))
-     "boot: %s")
+     "boot: %s" params)
+
+    (when (gnutls-errorp ret)
+      (signal 'gnutls-error (list proc ret)))
 
     proc))
 

=== modified file 'nt/ChangeLog'
--- nt/ChangeLog	2011-03-12 19:19:47 +0000
+++ nt/ChangeLog	2011-03-21 03:32:08 +0000
@@ -1,3 +1,10 @@
+2011-03-06  Claudio Bley  <claudio.bley@gmail.com>
+
+	* 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  <eliz@gnu.org>
 
 	* inc/unistd.h (readlink, symlink): Declare prototypes.

=== modified file 'nt/INSTALL'
--- nt/INSTALL	2011-01-26 08:36:39 +0000
+++ nt/INSTALL	2011-03-21 03:32:08 +0000
@@ -306,6 +306,16 @@
   `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.
+
+  Pre-built binaries and an installer can be found at
+  http://josefsson.org/gnutls4win/.
+
 * 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-21 03:32:08 +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
@@ -204,6 +211,14 @@
 shift
 goto again
 
+:userlibs
+shift
+echo. userlibs: %userlibs%
+set userlibs=%userlibs%%sep4%%1
+set sep4= %nothing%
+shift
+goto again
+
 rem ----------------------------------------------------------------------
 
 :userldflags
@@ -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-21 03:32:08 +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-20 23:58:23 +0000
+++ src/ChangeLog	2011-03-22 03:16:05 +0000
@@ -1,3 +1,37 @@
+2011-03-22  Teodor Zlatanov  <tzz@lifelogs.com>
+
+	* gnutls.c: Renamed global_initialized to
+	gnutls_global_initialized.  Added internals for the
+	:verify-hostname-error, :verify-error, and :verify-flags
+	parameters of `gnutls-boot' and documented those parameters in the
+	docstring.  Start callback support.
+
+2011-03-20  Claudio Bley  <claudio.bley@gmail.com>
+
+	* w32.h: (emacs_gnutls_pull): Add prototype.
+	(emacs_gnutls_push): Likewise.
+
+	* w32.c: (emacs_gnutls_pull): New function for GnuTLS on Woe32.
+	(emacs_gnutls_push): Likewise.
+
+	* 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_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-20  Glenn Morris  <rgm@gnu.org>
 
 	* config.in: Remove file.

=== modified file 'src/gnutls.c'
--- src/gnutls.c	2011-01-25 04:08:28 +0000
+++ src/gnutls.c	2011-03-22 13:01:22 +0000
@@ -26,11 +26,21 @@
 #ifdef HAVE_GNUTLS
 #include <gnutls/gnutls.h>
 
+#ifdef WINDOWSNT
+#include <windows.h>
+#include "w32.h"
+#endif
+
+static int
+emacs_gnutls_handle_error (gnutls_session_t, int err);
+
 Lisp_Object Qgnutls_code;
 Lisp_Object Qgnutls_anon, Qgnutls_x509pki;
 Lisp_Object Qgnutls_e_interrupted, Qgnutls_e_again,
   Qgnutls_e_invalid_session, Qgnutls_e_not_ready_for_handshake;
-int global_initialized;
+int gnutls_global_initialized;
+
+Lisp_Object Qgnutls_hostname;
 
 /* The following are for the property list of `gnutls-boot'.  */
 Lisp_Object Qgnutls_bootprop_priority;
@@ -38,8 +48,14 @@
 Lisp_Object Qgnutls_bootprop_keyfiles;
 Lisp_Object Qgnutls_bootprop_callbacks;
 Lisp_Object Qgnutls_bootprop_loglevel;
-
-static void
+Lisp_Object Qgnutls_bootprop_verify_flags;
+Lisp_Object Qgnutls_bootprop_verify_error;
+Lisp_Object Qgnutls_bootprop_verify_hostname_error;
+
+/* Callback keys for `gnutls-boot'.  Unused currently.  */
+Lisp_Object Qgnutls_bootprop_callbacks_verify;
+
+static int
 emacs_gnutls_handshake (struct Lisp_Process *proc)
 {
   gnutls_session_t state = proc->gnutls_state;
@@ -50,24 +66,56 @@
 
   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 and 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)
     {
-      /* here we're finally done.  */
+      /* Here we're finally done.  */
       proc->gnutls_initstage = GNUTLS_STAGE_READY;
     }
+  else
+    {
+        gnutls_alert_send_appropriate (state, ret);
+    }
+  return ret;
 }
 
 int
@@ -98,7 +146,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 +173,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;
   }
 }
 
+/* report a GnuTLS error to the user.
+   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
@@ -265,10 +355,10 @@
 {
   int ret = GNUTLS_E_SUCCESS;
 
-  if (!global_initialized)
+  if (!gnutls_global_initialized)
     ret = gnutls_global_init ();
 
-  global_initialized = 1;
+  gnutls_global_initialized = 1;
 
   return gnutls_make_error (ret);
 }
@@ -278,10 +368,10 @@
 static Lisp_Object
 gnutls_emacs_global_deinit (void)
 {
-  if (global_initialized)
+  if (gnutls_global_initialized)
     gnutls_global_deinit ();
 
-  global_initialized = 0;
+  gnutls_global_initialized = 0;
 
   return gnutls_make_error (GNUTLS_E_SUCCESS);
 }
@@ -307,11 +397,20 @@
 PROPLIST is a property list with the following keys:
 
 :priority is a GnuTLS priority string, defaults to "NORMAL".
+
 :trustfiles is a list of PEM-encoded trust files for `gnutls-x509pki'.
+
 :keyfiles is a list of PEM-encoded key files for `gnutls-x509pki'.
-:callbacks is an alist of callback functions (TODO).
+
+:callbacks is an alist of callback functions, see below.
+
 :loglevel is the debug level requested from GnuTLS, try 4.
 
+:verify-flags is a bitset as per gnutls_certificate_set_verify_flags().
+
+:verify-hostname-error determines if a hostname mismatch is a warning
+or an error.
+
 The debug level will be set for this process AND globally for GnuTLS.
 So if you set it higher or lower at any point, it affects global
 debugging.
@@ -324,6 +423,9 @@
 functions are used.  This function allocates resources which can only
 be deallocated by calling `gnutls-deinit' or by calling it again.
 
+The callbacks alist can have a `verify' key, associated with a
+verification function (UNUSED).
+
 Each authentication type may need additional information in order to
 work.  For X.509 PKI (`gnutls-x509pki'), you probably need at least
 one trustfile (usually a CA bundle).  */)
@@ -336,12 +438,19 @@
   /* TODO: GNUTLS_X509_FMT_DER is also an option.  */
   int file_format = GNUTLS_X509_FMT_PEM;
 
+  unsigned int gnutls_verify_flags = GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT;
+  gnutls_x509_crt_t gnutls_verify_cert;
+  unsigned int gnutls_verify_cert_list_size;
+  const gnutls_datum_t *gnutls_verify_cert_list;
+
   gnutls_session_t state;
   gnutls_certificate_credentials_t x509_cred;
   gnutls_anon_client_credentials_t anon_cred;
   Lisp_Object global_init;
   char* priority_string_ptr = "NORMAL"; /* default priority string.  */
   Lisp_Object tail;
+  char* hostname;
+  int peer_verification;
 
   /* Placeholders for the property list elements.  */
   Lisp_Object priority_string;
@@ -349,16 +458,26 @@
   Lisp_Object keyfiles;
   Lisp_Object callbacks;
   Lisp_Object loglevel;
+  Lisp_Object verify_flags;
+  Lisp_Object verify_error;
+  Lisp_Object verify_hostname_error;
 
   CHECK_PROCESS (proc);
   CHECK_SYMBOL (type);
   CHECK_LIST (proplist);
 
-  priority_string = Fplist_get (proplist, Qgnutls_bootprop_priority);
-  trustfiles      = Fplist_get (proplist, Qgnutls_bootprop_trustfiles);
-  keyfiles        = Fplist_get (proplist, Qgnutls_bootprop_keyfiles);
-  callbacks       = Fplist_get (proplist, Qgnutls_bootprop_callbacks);
-  loglevel        = Fplist_get (proplist, Qgnutls_bootprop_loglevel);
+  priority_string       = Fplist_get (proplist, Qgnutls_bootprop_priority);
+  trustfiles            = Fplist_get (proplist, Qgnutls_bootprop_trustfiles);
+  keyfiles              = Fplist_get (proplist, Qgnutls_bootprop_keyfiles);
+  callbacks             = Fplist_get (proplist, Qgnutls_bootprop_callbacks);
+  loglevel              = Fplist_get (proplist, Qgnutls_bootprop_loglevel);
+  verify_flags          = Fplist_get (proplist, Qgnutls_bootprop_verify_flags);
+  verify_error          = Fplist_get (proplist, Qgnutls_bootprop_verify_error);
+  verify_hostname_error = Fplist_get (proplist, Qgnutls_bootprop_verify_hostname_error);
+
+  CHECK_STRING (Qgnutls_hostname);
+
+  hostname = SSDATA (Fsymbol_value (Qgnutls_hostname));
 
   state = XPROCESS (proc)->gnutls_state;
   XPROCESS (proc)->gnutls_p = 1;
@@ -416,6 +535,23 @@
       x509_cred = XPROCESS (proc)->gnutls_x509_cred;
       if (gnutls_certificate_allocate_credentials (&x509_cred) < 0)
         memory_full ();
+
+      if (NUMBERP (verify_flags))
+        {
+          gnutls_verify_flags = XINT (verify_flags);
+          GNUTLS_LOG (2, max_log_level, "setting verification flags");
+        }
+      else if (NILP (verify_flags))
+        {
+          /* The default is already GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT.  */
+          GNUTLS_LOG (2, max_log_level, "using default verification flags");
+        }
+      else
+        {
+          /* The default is already GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT.  */
+          GNUTLS_LOG (2, max_log_level, "ignoring invalid verify-flags");
+        }
+      gnutls_certificate_set_verify_flags (x509_cred, gnutls_verify_flags);
     }
   else if (EQ (type, Qgnutls_anon))
     {
@@ -484,6 +620,14 @@
 
   GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_FILES;
 
+  GNUTLS_LOG (1, max_log_level, "gnutls callbacks");
+
+  GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CALLBACKS;
+
+#ifdef HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY
+#else
+#endif
+
   GNUTLS_LOG (1, max_log_level, "gnutls_init");
 
   ret = gnutls_init (&state, GNUTLS_CLIENT);
@@ -541,9 +685,105 @@
 
   GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CRED_SET;
 
-  emacs_gnutls_handshake (XPROCESS (proc));
-
-  return gnutls_make_error (GNUTLS_E_SUCCESS);
+  ret = emacs_gnutls_handshake (XPROCESS (proc));
+
+  if (ret < GNUTLS_E_SUCCESS)
+    return gnutls_make_error (ret);
+
+  /* Now verify the peer, following
+     http://www.gnu.org/software/gnutls/manual/html_node/Verifying-peer_0027s-certificate.html.
+     The peer should present at least one certificate in the chain; do a
+     check of the certificate's hostname with
+     gnutls_x509_crt_check_hostname() against gnutls-hostname (which is
+     buffer-local and set by `open-gnutls-stream'.  */
+
+  ret = gnutls_certificate_verify_peers2 (state, &peer_verification);
+
+  if (ret < GNUTLS_E_SUCCESS)
+    return gnutls_make_error (ret);
+  
+  if (peer_verification & GNUTLS_CERT_INVALID)
+    message ("%s certificate could not be verified.", 
+             hostname);
+ 
+ if (peer_verification & GNUTLS_CERT_REVOKED)
+   message ("%s certificate was revoked (CRL).",
+            hostname);
+ 
+ if (peer_verification & GNUTLS_CERT_SIGNER_NOT_FOUND)
+   message ("%s certificate's signer was not found.",
+            hostname);
+
+ if (peer_verification & GNUTLS_CERT_SIGNER_NOT_CA)
+   message ("%s certificate's signer is not a CA.",
+            hostname);
+
+ if (peer_verification & GNUTLS_CERT_INSECURE_ALGORITHM)
+   message ("%s certificate was signed with an insecure algorithm.",
+            hostname);
+
+ if (peer_verification & GNUTLS_CERT_NOT_ACTIVATED)
+   message ("%s certificate is not yet activated.", hostname);
+
+ if (peer_verification & GNUTLS_CERT_EXPIRED)
+   message ("%s certificate has expired.", hostname);
+
+ if (peer_verification != 0)
+   {
+     if (NILP (verify_hostname_error))
+       {
+         message ("Certificate validation failed for %s, verification code %d",
+                  hostname, peer_verification);
+       }
+     else
+       {
+         error ("Certificate validation failed for %s, verification code %d",
+                hostname, peer_verification);
+       }
+   }
+
+  /* Up to here the process is the same for X.509 certificates and
+     OpenPGP keys.  From now on X.509 certificates are assumed.  This
+     can be easily extended to work with openpgp keys as well.  */
+  if (gnutls_certificate_type_get (state) == GNUTLS_CRT_X509)
+    {
+      ret = gnutls_x509_crt_init (&gnutls_verify_cert);
+
+      if (ret < GNUTLS_E_SUCCESS)
+        return gnutls_make_error (ret);
+
+      gnutls_verify_cert_list = gnutls_certificate_get_peers (state, &gnutls_verify_cert_list_size);
+      if (NULL == gnutls_verify_cert_list)
+        {
+          error ("No certificate was found!\n");
+        }
+
+      /* We only check the first certificate in the given chain.  */
+      ret = gnutls_x509_crt_import (gnutls_verify_cert, &gnutls_verify_cert_list[0], GNUTLS_X509_FMT_DER);
+
+      if (ret < GNUTLS_E_SUCCESS)
+        {
+          gnutls_x509_crt_deinit (gnutls_verify_cert);
+          return gnutls_make_error (ret);
+        }
+
+      if (!gnutls_x509_crt_check_hostname (gnutls_verify_cert, hostname))
+        {
+          if (NILP (verify_hostname_error))
+            {
+              message ("GnuTLS warning: the certificate's hostname does not match gnutls-hostname \"%s\"", hostname);
+            }
+          else
+            {
+              gnutls_x509_crt_deinit (gnutls_verify_cert);
+              error ("The certificate's hostname does not match gnutls-hostname \"%s\"", hostname);
+            }
+        }
+
+      gnutls_x509_crt_deinit (gnutls_verify_cert);
+    }
+
+  return gnutls_make_error (ret);
 }
 
 DEFUN ("gnutls-bye", Fgnutls_bye,
@@ -578,7 +818,7 @@
 void
 syms_of_gnutls (void)
 {
-  global_initialized = 0;
+  gnutls_global_initialized = 0;
 
   Qgnutls_code = intern_c_string ("gnutls-code");
   staticpro (&Qgnutls_code);
@@ -589,6 +829,9 @@
   Qgnutls_x509pki = intern_c_string ("gnutls-x509pki");
   staticpro (&Qgnutls_x509pki);
 
+  Qgnutls_hostname = intern_c_string ("gnutls-hostname");
+  staticpro (&Qgnutls_hostname);
+
   Qgnutls_bootprop_priority = intern_c_string (":priority");
   staticpro (&Qgnutls_bootprop_priority);
 
@@ -601,9 +844,21 @@
   Qgnutls_bootprop_callbacks = intern_c_string (":callbacks");
   staticpro (&Qgnutls_bootprop_callbacks);
 
+  Qgnutls_bootprop_callbacks_verify = intern_c_string ("verify");
+  staticpro (&Qgnutls_bootprop_callbacks_verify);
+
   Qgnutls_bootprop_loglevel = intern_c_string (":loglevel");
   staticpro (&Qgnutls_bootprop_loglevel);
 
+  Qgnutls_bootprop_verify_flags = intern_c_string (":verify-flags");
+  staticpro (&Qgnutls_bootprop_verify_flags);
+
+  Qgnutls_bootprop_verify_hostname_error = intern_c_string (":verify-error");
+  staticpro (&Qgnutls_bootprop_verify_error);
+
+  Qgnutls_bootprop_verify_hostname_error = intern_c_string (":verify-hostname-error");
+  staticpro (&Qgnutls_bootprop_verify_hostname_error);
+
   Qgnutls_e_interrupted = intern_c_string ("gnutls-e-interrupted");
   staticpro (&Qgnutls_e_interrupted);
   Fput (Qgnutls_e_interrupted, Qgnutls_code,

=== modified file 'src/gnutls.h'
--- src/gnutls.h	2011-01-25 04:08:28 +0000
+++ src/gnutls.h	2011-03-21 03:32:08 +0000
@@ -21,6 +21,7 @@
 
 #ifdef HAVE_GNUTLS
 #include <gnutls/gnutls.h>
+#include <gnutls/x509.h>
 
 typedef enum
 {
@@ -28,6 +29,7 @@
   GNUTLS_STAGE_EMPTY = 0,
   GNUTLS_STAGE_CRED_ALLOC,
   GNUTLS_STAGE_FILES,
+  GNUTLS_STAGE_CALLBACKS,
   GNUTLS_STAGE_INIT,
   GNUTLS_STAGE_PRIORITY,
   GNUTLS_STAGE_CRED_SET,

=== modified file 'src/makefile.w32-in'
--- src/makefile.w32-in	2011-03-19 03:22:14 +0000
+++ src/makefile.w32-in	2011-03-21 03:32:08 +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)
 
 #
@@ -948,6 +950,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-03-17 05:18:33 +0000
+++ src/process.c	2011-03-22 12:46:47 +0000
@@ -4780,6 +4780,19 @@
              &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;

=== modified file 'src/w32.c'
--- src/w32.c	2011-03-14 17:07:53 +0000
+++ src/w32.c	2011-03-22 12:51:35 +0000
@@ -6084,5 +6084,75 @@
   p->childp = childp2;
 }
 
+#ifdef HAVE_GNUTLS
+
+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 = sys_read(fd, (char*)buf, sz);
+
+      if (n >= 0)
+        return n;
+      else
+        {
+          int err = errno;
+
+          if (err == EWOULDBLOCK)
+            {
+              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 || errno == EWOULDBLOCK)
+                /* We have to translate WSAEWOULDBLOCK alias
+		   EWOULDBLOCK to EAGAIN for GnuTLS.  */
+                err = EAGAIN;
+              else
+                err = errno;
+            }
+          gnutls_transport_set_errno (proc->gnutls_state, err);
+
+          return -1;
+        }
+    }
+}
+
+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 = sys_write((int)fd, buf, sz);
+
+  if (n >= 0)
+    return n;
+  else
+    {
+      gnutls_transport_set_errno (proc->gnutls_state,
+                                  /* Translate WSAEWOULDBLOCK alias
+                                     EWOULDBLOCK to EAGAIN for
+                                     GnuTLS.  */
+                                  errno == EWOULDBLOCK
+                                  ? EAGAIN
+                                  : errno);
+
+      return -1;
+    }
+}
+#endif /* HAVE_GNUTLS */
+
 /* end of w32.c */
 

=== modified file 'src/w32.h'
--- src/w32.h	2011-01-25 04:08:28 +0000
+++ src/w32.h	2011-03-22 12:52:10 +0000
@@ -143,5 +143,14 @@
 extern int _sys_read_ahead (int fd);
 extern int _sys_wait_accept (int fd);
 
+#ifdef HAVE_GNUTLS
+#include <gnutls/gnutls.h>
+
+extern ssize_t emacs_gnutls_pull (gnutls_transport_ptr_t p,
+                                  void* buf, size_t sz);
+extern ssize_t emacs_gnutls_push (gnutls_transport_ptr_t p,
+                                  const void* buf, size_t sz);
+#endif /* HAVE_GNUTLS */
+
 #endif /* EMACS_W32_H */
 

Re: [PATCH] GnuTLS support on Woe32

[Robert Pluim]

Ted Zlatanov <tzz@lifelogs.com> writes:

> I've attached an updated patch.  Sorry if I have missed anything.  It
> would be nice to have an automatic way to catch these formatting issues.

I've just tried this patch on my Emacs under Cygwin, and got some errors
from gnus when using the builtin TLS support, and all my gnus servers
including the non-tls-requiring ones failed to work:

    Buffer has a running process; kill it? (y or n)  n
    Saving file /cygdrive/c/Documents and Settings/RPluim/.newsrc-dribble...
    Wrote /cygdrive/c/Documents and Settings/RPluim/.newsrc-dribble [2 times]
    Gnus auto-save file exists.  Do you want to read it? (y or n)  y
    Reading /cygdrive/c/Documents and Settings/RPluim/.newsrc.eld...
    Generating the cache active file...done
    Opening nnimap server on mymail...
    Unable to open server nnimap+mymail due to: Wrong type argument: stringp, gnutls-hostname

Does gnus require a change as well?

Thanks

Robert

Re: [PATCH] GnuTLS support on Woe32

[Ted Zlatanov]

On Tue, 22 Mar 2011 17:19:22 +0100 Robert Pluim <rpluim@gmail.com> wrote: 

RP> Ted Zlatanov <tzz@lifelogs.com> writes:
>> I've attached an updated patch.  Sorry if I have missed anything.  It
>> would be nice to have an automatic way to catch these formatting issues.

RP> I've just tried this patch on my Emacs under Cygwin, and got some errors
RP> from gnus when using the builtin TLS support, and all my gnus servers
RP> including the non-tls-requiring ones failed to work:

RP>     Buffer has a running process; kill it? (y or n)  n
RP>     Saving file /cygdrive/c/Documents and Settings/RPluim/.newsrc-dribble...
RP>     Wrote /cygdrive/c/Documents and Settings/RPluim/.newsrc-dribble [2 times]
RP>     Gnus auto-save file exists.  Do you want to read it? (y or n)  y
RP>     Reading /cygdrive/c/Documents and Settings/RPluim/.newsrc.eld...
RP>     Generating the cache active file...done
RP>     Opening nnimap server on mymail...
RP>     Unable to open server nnimap+mymail due to: Wrong type argument: stringp, gnutls-hostname

RP> Does gnus require a change as well?

Yes, it will have to set the `gnutls-hostname'.  This should be
transparent to the user, probably in proto-stream.el.  I can look at it
once the patch is approved.

Ted

Re: [PATCH] GnuTLS support on Woe32

[Robert Pluim]

Ted Zlatanov <tzz@lifelogs.com> writes:

> On Tue, 22 Mar 2011 17:19:22 +0100 Robert Pluim <rpluim@gmail.com> wrote: 
>
> RP> Ted Zlatanov <tzz@lifelogs.com> writes:
>>> I've attached an updated patch.  Sorry if I have missed anything.  It
>>> would be nice to have an automatic way to catch these formatting issues.
>
> RP> Does gnus require a change as well?
>
> Yes, it will have to set the `gnutls-hostname'.  This should be
> transparent to the user, probably in proto-stream.el.  I can look at it
> once the patch is approved.

Well, gnus is my testcase for TLS, so I can't weigh in on that at all :)

Robert

Re: [PATCH] GnuTLS support on Woe32

[Ted Zlatanov]

[-- Attachment #1: Type: text/plain, Size: 826 bytes --]

On Tue, 22 Mar 2011 18:12:11 +0100 Robert Pluim <rpluim@gmail.com> wrote: 

RP> Ted Zlatanov <tzz@lifelogs.com> writes:
>> On Tue, 22 Mar 2011 17:19:22 +0100 Robert Pluim <rpluim@gmail.com> wrote: 
>> 
RP> Ted Zlatanov <tzz@lifelogs.com> writes:
>>>> I've attached an updated patch.  Sorry if I have missed anything.  It
>>>> would be nice to have an automatic way to catch these formatting issues.
>> 
RP> Does gnus require a change as well?
>> 
>> Yes, it will have to set the `gnutls-hostname'.  This should be
>> transparent to the user, probably in proto-stream.el.  I can look at it
>> once the patch is approved.

RP> Well, gnus is my testcase for TLS, so I can't weigh in on that at all :)

Try the attached patch against proto-stream.el in the Emacs trunk.  I'll
refresh my patch to add this change too.

Thanks
Ted


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: callbacks-proto.patch --]
[-- Type: text/x-diff, Size: 1141 bytes --]

=== modified file 'lisp/gnus/proto-stream.el'
--- lisp/gnus/proto-stream.el	2011-02-06 22:27:28 +0000
+++ lisp/gnus/proto-stream.el	2011-03-22 17:55:28 +0000
@@ -61,7 +61,8 @@
   :group 'comm)
 
 (declare-function gnutls-negotiate "gnutls"
-		  (proc type &optional priority-string trustfiles keyfiles))
+		  (proc type &optional priority-string trustfiles keyfiles
+                        verify-flags verify-error verify-hostname-error))
 
 ;;;###autoload
 (defun open-protocol-stream (name buffer host service &rest parameters)
@@ -190,7 +191,12 @@
 		  (list stream greeting capabilities 'network)))
 	    ;; The server said it was OK to start doing STARTTLS negotiations.
 	    (if (fboundp 'open-gnutls-stream)
-		(gnutls-negotiate stream nil)
+                (progn
+                  ;; Set the required buffer-local gnutls-hostname
+                  ;; (defined in gnutls.el).
+                  (with-current-buffer buffer
+                    (set (intern "gnutls-hostname") host))
+                  (gnutls-negotiate stream nil))
 	      (unless (starttls-negotiate stream)
 		(delete-process stream)
 		(setq stream nil)))

Re: [PATCH] GnuTLS support on Woe32

[Stefan Monnier]

SM> Also further down you define Qgnutls_hostname but never use it, but here
SM> would be a good place to use it (otherwise, don't define it).
SM> Finally, if you want to avoid Fsymbol_value, you can use DEFVAR_LISP to
SM> define Vgnutls_hostname so you can then just do SSDATA (Vgnutls_hostname).
> Fixed.  I wanted to define that variable in gnutls.el so I can make it
> buffer-local there too (right before it's used).  If you think that's
> better in gnutls.c, I'll change it.

You can call Fmake_variable_buffer_local from C code just as well.
Grep for `fontification_functions' for an example.

BTW, I had not noticed this part in gnutls.el, which seems like an
error: why would you want it to be buffer-local?  Gnutls is about
processes, so binding this var to buffers makes no sense to me.

Whether to define it in C or in Elisp is mainly a question of what's
more convenient and whether you'd rather think that the functionality
associated with this variable is implemented in C or in Elisp.

Now that I look at it, I don't understand what this gnutls-hostname
variable is about.  Why isn't it an additional keyword argument instead?
It needs better documentation than the current "Remote hostname.".

> where I thought removing the braces looked confusing and ugly because of
> the nesting.

Fine (I personally prefer this code without the internal braces, but
it's no big deal).  I'm not opposed to braces, but in the previous code
there was a lot of them around repetitive and "simple" code which lead
to the code being much too diluted.

SM> Shouldn't that be "Iowait"?
> No, see gnutls_transport_set_lowat() for instance.

OK, thanks.

> I've attached an updated patch.  Sorry if I have missed anything.  It
> would be nice to have an automatic way to catch these formatting issues.

We could come up with some font-lock rules to highlight "offending"
code, but I'm not sure it's worth the trouble.

> Unfortunately the validation is tightly coupled to the C-level GnuTLS
> functions so it would require writing a lot of glue code.  All the
> session data initialization and certificate validation are done with
> GnuTLS C functions and the data passed around has to be at the C level.
> Breaking up the validation into chunks could help but then more
> intermediate results have to be stored in each buffer and the
> error-handling logic would get even more complicated.

I saw that, and I'm OK with the patch as it is in this regard.

> I am excited that this patch finally achieves the base functionality
> Emacs needs to do SSL and TLS connections without helper applications on
> most platforms we support.  So I hope I can make it acceptable soon :)

Looks pretty good, yes.  A few more nitpicks below.

> +:verify-flags is a bitset as per gnutls_certificate_set_verify_flags().

In the GNU system we use the convention that "funname()" is a function
call and denotes the result of calling that function, rather than the
function itself.  To refer to the function, just say "funname".

> +:verify-hostname-error determines if a hostname mismatch is a warning
> +or an error.

Try to use the form "if non-nil blabla", so it's clear which value gives
you which behavior.


        Stefan

Re: [PATCH] GnuTLS support on Woe32

[Stefan Monnier]

> +                    (set (intern "gnutls-hostname") host))

Yuck!!
This should say "(setq gnutls-hostname host)": more efficient, more
concise, more understandable (also for the compiler), ...


        Stefan

Re: [PATCH] GnuTLS support on Woe32

[Robert Pluim]

Ted Zlatanov <tzz@lifelogs.com> writes:

>
> Try the attached patch against proto-stream.el in the Emacs trunk.  I'll
> refresh my patch to add this change too.
>

That doesn't work for me.  Just to be clear, I connect to my imap server
on port 993 with TLS, it's not a connection that gets upgraded after the
fact, so I suspect proto-stream-open-tls needs to change.

Thanks

Robert

Re: [PATCH] GnuTLS support on Woe32

[Ted Zlatanov]

[-- Attachment #1: Type: text/plain, Size: 2933 bytes --]

On Tue, 22 Mar 2011 14:50:06 -0400 Stefan Monnier <monnier@IRO.UMontreal.CA> wrote: 

SM> BTW, I had not noticed this part in gnutls.el, which seems like an
SM> error: why would you want it to be buffer-local?  Gnutls is about
SM> processes, so binding this var to buffers makes no sense to me.
...
SM> Now that I look at it, I don't understand what this gnutls-hostname
SM> variable is about.  Why isn't it an additional keyword argument instead?
SM> It needs better documentation than the current "Remote hostname.".

Because of the way SSL and TLS work, the connection may start out
unencrypted and the upgrade is sort of opportunistic.  So we don't know
in advance if we'll need the `gnutls-hostname'.  Also the
`gnutls-hostname' is not necessarily the actual host we connect to, so
we can't keep it as a per-process property.  And finally, making it a
keyword parameter means the piece that *upgrades* the connection to TLS
has to know the original hostname of the connection.  I thought it was
cleaner to separate them, so upgrading a connection is easier to do
opportunistically.

Emacs doesn't have per-process variables at the ELisp level so I had to
associate it with the buffer and making it buffer-local seemed
sensible.  How would you do it?

>> where I thought removing the braces looked confusing and ugly because of
>> the nesting.

SM> Fine (I personally prefer this code without the internal braces, but
SM> it's no big deal).  I'm not opposed to braces, but in the previous code
SM> there was a lot of them around repetitive and "simple" code which lead
SM> to the code being much too diluted.

Yes, you were absolutely right to note those.  Thanks.

SM> We could come up with some font-lock rules to highlight "offending"
SM> code, but I'm not sure it's worth the trouble.

It would make my life easier.  And maybe help other contributors.

>> +:verify-flags is a bitset as per gnutls_certificate_set_verify_flags().

SM> In the GNU system we use the convention that "funname()" is a function
SM> call and denotes the result of calling that function, rather than the
SM> function itself.  To refer to the function, just say "funname".

Fixed.  It's a habit for me :)

>> +:verify-hostname-error determines if a hostname mismatch is a warning
>> +or an error.

SM> Try to use the form "if non-nil blabla", so it's clear which value gives
SM> you which behavior.

Fixed.

>> +                    (set (intern "gnutls-hostname") host))

SM> Yuck!!
SM> This should say "(setq gnutls-hostname host)": more efficient, more
SM> concise, more understandable (also for the compiler), ...

I was trying to shut up the byte-compilation warnings.  proto-stream.el
does some funky loading and I didn't know a better way (there's no
`declare-variable').  If you have a better approach, please tell...

Sorry this patch is getting so large.  I'll try to fix all the issues
ASAP.  We need Claudio Bley's papers too, right?

Ted


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: revised 2011-03-22 with proto-stream.el changes --]
[-- Type: text/x-diff, Size: 36479 bytes --]

=== modified file 'configure.in'
--- configure.in	2011-03-20 23:58:23 +0000
+++ configure.in	2011-03-22 17:49:45 +0000
@@ -1973,12 +1973,22 @@
 AC_SUBST(LIBSELINUX_LIBS)
 
 HAVE_GNUTLS=no
+HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY=no
 if test "${with_gnutls}" = "yes" ; then
   PKG_CHECK_MODULES([LIBGNUTLS], [gnutls >= 2.2.4], HAVE_GNUTLS=yes, HAVE_GNUTLS=no)
   if test "${HAVE_GNUTLS}" = "yes"; then
     AC_DEFINE(HAVE_GNUTLS, 1, [Define if using GnuTLS.])
   fi
+
+  CFLAGS="$CFLAGS $LIBGNUTLS_CFLAGS"
+  LIBS="$LIBGNUTLS_LIBS $LIBS"
+  AC_CHECK_FUNCS(gnutls_certificate_set_verify_function, HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY=yes)
+
+  if test "${HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY}" = "yes"; then
+    AC_DEFINE(HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY, 1, [Define if using GnuTLS certificate verification callbacks.])
+  fi
 fi
+
 AC_SUBST(LIBGNUTLS_LIBS)
 AC_SUBST(LIBGNUTLS_CFLAGS)
 
@@ -3667,6 +3677,7 @@
 echo "  Does Emacs use -lgconf?                                 ${HAVE_GCONF}"
 echo "  Does Emacs use -lselinux?                               ${HAVE_LIBSELINUX}"
 echo "  Does Emacs use -lgnutls?                                ${HAVE_GNUTLS}"
+echo "  Does Emacs use -lgnutls certificate verify callbacks?   ${HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY}"
 echo "  Does Emacs use -lxml2?                                  ${HAVE_LIBXML2}"
 
 echo "  Does Emacs use -lfreetype?                              ${HAVE_FREETYPE}"

=== modified file 'lib-src/ChangeLog'
--- lib-src/ChangeLog	2011-03-12 19:19:47 +0000
+++ lib-src/ChangeLog	2011-03-22 17:49:45 +0000
@@ -1,3 +1,7 @@
+2011-03-06  Claudio Bley  <claudio.bley@gmail.com>
+
+	* makefile.w32-in (obj): Added gnutls.o.
+
 2011-03-03  Drake Wilson  <drake@begriffli.ch>  (tiny change)
 
 	* emacsclient.c (longopts): Add quiet.

=== modified file 'lib-src/makefile.w32-in'
--- lib-src/makefile.w32-in	2011-03-12 19:19:47 +0000
+++ lib-src/makefile.w32-in	2011-03-22 17:49:45 +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-22 15:38:40 +0000
+++ lisp/ChangeLog	2011-03-22 17:50:32 +0000
@@ -1,3 +1,18 @@
+2011-03-22  Teodor Zlatanov  <tzz@lifelogs.com>
+
+	* net/gnutls.el (gnutls-hostname): New buffer-local variable for
+	hostname verification.
+	(gnutls-negotiate): Add verify-flags, verify-error, and
+	verify-hostname-error.
+	(open-gnutls-stream): Add usage example.
+
+2011-03-22  Claudio Bley  <claudio.bley@gmail.com>
+
+	* 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-22  Leo Liu  <sdl.web@gmail.com>
 
 	* abbrev.el (write-abbrev-file): Use utf-8 for writing if it can

=== modified file 'lisp/gnus/proto-stream.el'
--- lisp/gnus/proto-stream.el	2011-02-06 22:27:28 +0000
+++ lisp/gnus/proto-stream.el	2011-03-22 17:55:28 +0000
@@ -61,7 +61,8 @@
   :group 'comm)
 
 (declare-function gnutls-negotiate "gnutls"
-		  (proc type &optional priority-string trustfiles keyfiles))
+		  (proc type &optional priority-string trustfiles keyfiles
+                        verify-flags verify-error verify-hostname-error))
 
 ;;;###autoload
 (defun open-protocol-stream (name buffer host service &rest parameters)
@@ -190,7 +191,12 @@
 		  (list stream greeting capabilities 'network)))
 	    ;; The server said it was OK to start doing STARTTLS negotiations.
 	    (if (fboundp 'open-gnutls-stream)
-		(gnutls-negotiate stream nil)
+                (progn
+                  ;; Set the required buffer-local gnutls-hostname
+                  ;; (defined in gnutls.el).
+                  (with-current-buffer buffer
+                    (set (intern "gnutls-hostname") host))
+                  (gnutls-negotiate stream nil))
 	      (unless (starttls-negotiate stream)
 		(delete-process stream)
 		(setq stream nil)))

=== modified file 'lisp/net/gnutls.el'
--- lisp/net/gnutls.el	2011-01-25 04:08:28 +0000
+++ lisp/net/gnutls.el	2011-03-22 18:55:41 +0000
@@ -44,6 +44,10 @@
   :type 'integer
   :group 'gnutls)
 
+(defvar gnutls-hostname nil
+  "Remote hostname.  Always buffer-local.")
+(make-variable-buffer-local 'gnutls-hostname)
+
 (defun open-gnutls-stream (name buffer host service)
   "Open a SSL/TLS connection for a service to a host.
 Returns a subprocess-object to represent the connection.
@@ -59,26 +63,77 @@
 Fourth arg SERVICE is name of the service desired, or an integer
 specifying a port number to connect to.
 
+Usage example:
+
+  \(with-temp-buffer
+    \(open-gnutls-stream \"tls\"
+                        \(current-buffer)
+                        \"your server goes here\"
+                        \"imaps\"))
+
 This is a very simple wrapper around `gnutls-negotiate'.  See its
 documentation for the specific parameters you can use to open a
 GnuTLS connection, including specifying the credential type,
 trust and key files, and priority string."
-  (let ((proc (open-network-stream name buffer host service)))
-    (gnutls-negotiate proc 'gnutls-x509pki)))
+  ;; remember the hostname associated with this buffer
+  (with-current-buffer buffer
+    (setq gnutls-hostname host))
+  (gnutls-negotiate (open-network-stream name buffer host service)
+                    'gnutls-x509pki))
+
+(put 'gnutls-error
+     'error-conditions
+     '(error gnutls-error))
+(put 'gnutls-error
+     'error-message "GnuTLS error")
 
 (declare-function gnutls-boot "gnutls.c" (proc type proplist))
 
 (defun gnutls-negotiate (proc type &optional priority-string
-                              trustfiles keyfiles)
-  "Negotiate a SSL/TLS connection.
+                              trustfiles keyfiles verify-flags
+                              verify-error verify-hostname-error)
+  "Negotiate a SSL/TLS connection.  Returns proc. Signals gnutls-error.
 TYPE is `gnutls-x509pki' (default) or `gnutls-anon'.  Use nil for the default.
 PROC is a process returned by `open-network-stream'.
 PRIORITY-STRING is as per the GnuTLS docs, default is \"NORMAL\".
 TRUSTFILES is a list of CA bundles.
-KEYFILES is a list of client keys."
+KEYFILES is a list of client keys.
+
+When VERIFY-HOSTNAME-ERROR is not nil, an error will be raised
+when the hostname does not match the presented certificate's host
+name.  The exact verification algorithm is a basic implementation
+of the matching described in RFC2818 (HTTPS), which takes into
+account wildcards, and the DNSName/IPAddress subject alternative
+name PKIX extension.  See GnuTLS' gnutls_x509_crt_check_hostname
+for details.  When VERIFY-HOSTNAME-ERROR is nil, only a warning
+will be issued.
+
+When VERIFY-ERROR is not nil, an error will be raised when the
+peer certificate verification fails as per GnuTLS'
+gnutls_certificate_verify_peers2.  Otherwise, only warnings will
+be shown about the verification failure.
+
+VERIFY-FLAGS is a numeric OR of verification flags only for
+`gnutls-x509pki' connections.  See GnuTLS' x509.h for details;
+here's a recent version of the list.
+
+    GNUTLS_VERIFY_DISABLE_CA_SIGN = 1,
+    GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT = 2,
+    GNUTLS_VERIFY_DO_NOT_ALLOW_SAME = 4,
+    GNUTLS_VERIFY_ALLOW_ANY_X509_V1_CA_CRT = 8,
+    GNUTLS_VERIFY_ALLOW_SIGN_RSA_MD2 = 16,
+    GNUTLS_VERIFY_ALLOW_SIGN_RSA_MD5 = 32,
+    GNUTLS_VERIFY_DISABLE_TIME_CHECKS = 64,
+    GNUTLS_VERIFY_DISABLE_TRUSTED_TIME_CHECKS = 128,
+    GNUTLS_VERIFY_DO_NOT_ALLOW_X509_V1_CA_CRT = 256
+
+It must be omitted, a number, or nil; if omitted or nil it
+defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT."
   (let* ((type (or type 'gnutls-x509pki))
+         (default-trustfile "/etc/ssl/certs/ca-certificates.crt")
          (trustfiles (or trustfiles
-                        '("/etc/ssl/certs/ca-certificates.crt")))
+                         (when (file-exists-p default-trustfile)
+                           (list default-trustfile))))
          (priority-string (or priority-string
                               (cond
                                ((eq type 'gnutls-anon)
@@ -89,12 +144,18 @@
                              :loglevel ,gnutls-log-level
                              :trustfiles ,trustfiles
                              :keyfiles ,keyfiles
+                             :verify-flags ,verify-flags
+                             :verify-error ,verify-error
+                             :verify-hostname-error ,verify-hostname-error
                              :callbacks nil))
          ret)
 
     (gnutls-message-maybe
      (setq ret (gnutls-boot proc type params))
-     "boot: %s")
+     "boot: %s" params)
+
+    (when (gnutls-errorp ret)
+      (signal 'gnutls-error (list proc ret)))
 
     proc))
 

=== modified file 'nt/ChangeLog'
--- nt/ChangeLog	2011-03-12 19:19:47 +0000
+++ nt/ChangeLog	2011-03-22 17:49:45 +0000
@@ -1,3 +1,10 @@
+2011-03-06  Claudio Bley  <claudio.bley@gmail.com>
+
+	* 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  <eliz@gnu.org>
 
 	* inc/unistd.h (readlink, symlink): Declare prototypes.

=== modified file 'nt/INSTALL'
--- nt/INSTALL	2011-01-26 08:36:39 +0000
+++ nt/INSTALL	2011-03-22 17:49:45 +0000
@@ -306,6 +306,16 @@
   `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.
+
+  Pre-built binaries and an installer can be found at
+  http://josefsson.org/gnutls4win/.
+
 * 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-22 17:49:45 +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
@@ -204,6 +211,14 @@
 shift
 goto again
 
+:userlibs
+shift
+echo. userlibs: %userlibs%
+set userlibs=%userlibs%%sep4%%1
+set sep4= %nothing%
+shift
+goto again
+
 rem ----------------------------------------------------------------------
 
 :userldflags
@@ -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-22 17:49:45 +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-20 23:58:23 +0000
+++ src/ChangeLog	2011-03-22 17:49:45 +0000
@@ -1,3 +1,37 @@
+2011-03-22  Teodor Zlatanov  <tzz@lifelogs.com>
+
+	* gnutls.c: Renamed global_initialized to
+	gnutls_global_initialized.  Added internals for the
+	:verify-hostname-error, :verify-error, and :verify-flags
+	parameters of `gnutls-boot' and documented those parameters in the
+	docstring.  Start callback support.
+
+2011-03-20  Claudio Bley  <claudio.bley@gmail.com>
+
+	* w32.h: (emacs_gnutls_pull): Add prototype.
+	(emacs_gnutls_push): Likewise.
+
+	* w32.c: (emacs_gnutls_pull): New function for GnuTLS on Woe32.
+	(emacs_gnutls_push): Likewise.
+
+	* 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_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-20  Glenn Morris  <rgm@gnu.org>
 
 	* config.in: Remove file.

=== modified file 'src/gnutls.c'
--- src/gnutls.c	2011-01-25 04:08:28 +0000
+++ src/gnutls.c	2011-03-22 18:58:00 +0000
@@ -26,11 +26,21 @@
 #ifdef HAVE_GNUTLS
 #include <gnutls/gnutls.h>
 
+#ifdef WINDOWSNT
+#include <windows.h>
+#include "w32.h"
+#endif
+
+static int
+emacs_gnutls_handle_error (gnutls_session_t, int err);
+
 Lisp_Object Qgnutls_code;
 Lisp_Object Qgnutls_anon, Qgnutls_x509pki;
 Lisp_Object Qgnutls_e_interrupted, Qgnutls_e_again,
   Qgnutls_e_invalid_session, Qgnutls_e_not_ready_for_handshake;
-int global_initialized;
+int gnutls_global_initialized;
+
+Lisp_Object Qgnutls_hostname;
 
 /* The following are for the property list of `gnutls-boot'.  */
 Lisp_Object Qgnutls_bootprop_priority;
@@ -38,8 +48,14 @@
 Lisp_Object Qgnutls_bootprop_keyfiles;
 Lisp_Object Qgnutls_bootprop_callbacks;
 Lisp_Object Qgnutls_bootprop_loglevel;
-
-static void
+Lisp_Object Qgnutls_bootprop_verify_flags;
+Lisp_Object Qgnutls_bootprop_verify_error;
+Lisp_Object Qgnutls_bootprop_verify_hostname_error;
+
+/* Callback keys for `gnutls-boot'.  Unused currently.  */
+Lisp_Object Qgnutls_bootprop_callbacks_verify;
+
+static int
 emacs_gnutls_handshake (struct Lisp_Process *proc)
 {
   gnutls_session_t state = proc->gnutls_state;
@@ -50,24 +66,56 @@
 
   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 and 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)
     {
-      /* here we're finally done.  */
+      /* Here we're finally done.  */
       proc->gnutls_initstage = GNUTLS_STAGE_READY;
     }
+  else
+    {
+        gnutls_alert_send_appropriate (state, ret);
+    }
+  return ret;
 }
 
 int
@@ -98,7 +146,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 +173,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;
   }
 }
 
+/* report a GnuTLS error to the user.
+   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
@@ -265,10 +355,10 @@
 {
   int ret = GNUTLS_E_SUCCESS;
 
-  if (!global_initialized)
+  if (!gnutls_global_initialized)
     ret = gnutls_global_init ();
 
-  global_initialized = 1;
+  gnutls_global_initialized = 1;
 
   return gnutls_make_error (ret);
 }
@@ -278,10 +368,10 @@
 static Lisp_Object
 gnutls_emacs_global_deinit (void)
 {
-  if (global_initialized)
+  if (gnutls_global_initialized)
     gnutls_global_deinit ();
 
-  global_initialized = 0;
+  gnutls_global_initialized = 0;
 
   return gnutls_make_error (GNUTLS_E_SUCCESS);
 }
@@ -307,11 +397,24 @@
 PROPLIST is a property list with the following keys:
 
 :priority is a GnuTLS priority string, defaults to "NORMAL".
+
 :trustfiles is a list of PEM-encoded trust files for `gnutls-x509pki'.
+
 :keyfiles is a list of PEM-encoded key files for `gnutls-x509pki'.
-:callbacks is an alist of callback functions (TODO).
+
+:callbacks is an alist of callback functions, see below.
+
 :loglevel is the debug level requested from GnuTLS, try 4.
 
+:verify-flags is a bitset as per GnuTLS'
+gnutls_certificate_set_verify_flags.
+
+:verify-error, if non-nil, makes failure of the certificate validation
+an error.  Otherwise it will be just a series of warnings.
+
+:verify-hostname-error, if non-nil, makes a hostname mismatch an
+error.  Otherwise it will be just a warning.
+
 The debug level will be set for this process AND globally for GnuTLS.
 So if you set it higher or lower at any point, it affects global
 debugging.
@@ -324,6 +427,9 @@
 functions are used.  This function allocates resources which can only
 be deallocated by calling `gnutls-deinit' or by calling it again.
 
+The callbacks alist can have a `verify' key, associated with a
+verification function (UNUSED).
+
 Each authentication type may need additional information in order to
 work.  For X.509 PKI (`gnutls-x509pki'), you probably need at least
 one trustfile (usually a CA bundle).  */)
@@ -336,12 +442,19 @@
   /* TODO: GNUTLS_X509_FMT_DER is also an option.  */
   int file_format = GNUTLS_X509_FMT_PEM;
 
+  unsigned int gnutls_verify_flags = GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT;
+  gnutls_x509_crt_t gnutls_verify_cert;
+  unsigned int gnutls_verify_cert_list_size;
+  const gnutls_datum_t *gnutls_verify_cert_list;
+
   gnutls_session_t state;
   gnutls_certificate_credentials_t x509_cred;
   gnutls_anon_client_credentials_t anon_cred;
   Lisp_Object global_init;
   char* priority_string_ptr = "NORMAL"; /* default priority string.  */
   Lisp_Object tail;
+  char* hostname;
+  int peer_verification;
 
   /* Placeholders for the property list elements.  */
   Lisp_Object priority_string;
@@ -349,16 +462,26 @@
   Lisp_Object keyfiles;
   Lisp_Object callbacks;
   Lisp_Object loglevel;
+  Lisp_Object verify_flags;
+  Lisp_Object verify_error;
+  Lisp_Object verify_hostname_error;
 
   CHECK_PROCESS (proc);
   CHECK_SYMBOL (type);
   CHECK_LIST (proplist);
 
-  priority_string = Fplist_get (proplist, Qgnutls_bootprop_priority);
-  trustfiles      = Fplist_get (proplist, Qgnutls_bootprop_trustfiles);
-  keyfiles        = Fplist_get (proplist, Qgnutls_bootprop_keyfiles);
-  callbacks       = Fplist_get (proplist, Qgnutls_bootprop_callbacks);
-  loglevel        = Fplist_get (proplist, Qgnutls_bootprop_loglevel);
+  priority_string       = Fplist_get (proplist, Qgnutls_bootprop_priority);
+  trustfiles            = Fplist_get (proplist, Qgnutls_bootprop_trustfiles);
+  keyfiles              = Fplist_get (proplist, Qgnutls_bootprop_keyfiles);
+  callbacks             = Fplist_get (proplist, Qgnutls_bootprop_callbacks);
+  loglevel              = Fplist_get (proplist, Qgnutls_bootprop_loglevel);
+  verify_flags          = Fplist_get (proplist, Qgnutls_bootprop_verify_flags);
+  verify_error          = Fplist_get (proplist, Qgnutls_bootprop_verify_error);
+  verify_hostname_error = Fplist_get (proplist, Qgnutls_bootprop_verify_hostname_error);
+
+  CHECK_STRING (Qgnutls_hostname);
+
+  hostname = SSDATA (Fsymbol_value (Qgnutls_hostname));
 
   state = XPROCESS (proc)->gnutls_state;
   XPROCESS (proc)->gnutls_p = 1;
@@ -416,6 +539,23 @@
       x509_cred = XPROCESS (proc)->gnutls_x509_cred;
       if (gnutls_certificate_allocate_credentials (&x509_cred) < 0)
         memory_full ();
+
+      if (NUMBERP (verify_flags))
+        {
+          gnutls_verify_flags = XINT (verify_flags);
+          GNUTLS_LOG (2, max_log_level, "setting verification flags");
+        }
+      else if (NILP (verify_flags))
+        {
+          /* The default is already GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT.  */
+          GNUTLS_LOG (2, max_log_level, "using default verification flags");
+        }
+      else
+        {
+          /* The default is already GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT.  */
+          GNUTLS_LOG (2, max_log_level, "ignoring invalid verify-flags");
+        }
+      gnutls_certificate_set_verify_flags (x509_cred, gnutls_verify_flags);
     }
   else if (EQ (type, Qgnutls_anon))
     {
@@ -484,6 +624,14 @@
 
   GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_FILES;
 
+  GNUTLS_LOG (1, max_log_level, "gnutls callbacks");
+
+  GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CALLBACKS;
+
+#ifdef HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY
+#else
+#endif
+
   GNUTLS_LOG (1, max_log_level, "gnutls_init");
 
   ret = gnutls_init (&state, GNUTLS_CLIENT);
@@ -541,9 +689,105 @@
 
   GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CRED_SET;
 
-  emacs_gnutls_handshake (XPROCESS (proc));
-
-  return gnutls_make_error (GNUTLS_E_SUCCESS);
+  ret = emacs_gnutls_handshake (XPROCESS (proc));
+
+  if (ret < GNUTLS_E_SUCCESS)
+    return gnutls_make_error (ret);
+
+  /* Now verify the peer, following
+     http://www.gnu.org/software/gnutls/manual/html_node/Verifying-peer_0027s-certificate.html.
+     The peer should present at least one certificate in the chain; do a
+     check of the certificate's hostname with
+     gnutls_x509_crt_check_hostname() against gnutls-hostname (which is
+     buffer-local and set by `open-gnutls-stream'.  */
+
+  ret = gnutls_certificate_verify_peers2 (state, &peer_verification);
+
+  if (ret < GNUTLS_E_SUCCESS)
+    return gnutls_make_error (ret);
+  
+  if (peer_verification & GNUTLS_CERT_INVALID)
+    message ("%s certificate could not be verified.", 
+             hostname);
+ 
+ if (peer_verification & GNUTLS_CERT_REVOKED)
+   message ("%s certificate was revoked (CRL).",
+            hostname);
+ 
+ if (peer_verification & GNUTLS_CERT_SIGNER_NOT_FOUND)
+   message ("%s certificate's signer was not found.",
+            hostname);
+
+ if (peer_verification & GNUTLS_CERT_SIGNER_NOT_CA)
+   message ("%s certificate's signer is not a CA.",
+            hostname);
+
+ if (peer_verification & GNUTLS_CERT_INSECURE_ALGORITHM)
+   message ("%s certificate was signed with an insecure algorithm.",
+            hostname);
+
+ if (peer_verification & GNUTLS_CERT_NOT_ACTIVATED)
+   message ("%s certificate is not yet activated.", hostname);
+
+ if (peer_verification & GNUTLS_CERT_EXPIRED)
+   message ("%s certificate has expired.", hostname);
+
+ if (peer_verification != 0)
+   {
+     if (NILP (verify_hostname_error))
+       {
+         message ("Certificate validation failed for %s, verification code %d",
+                  hostname, peer_verification);
+       }
+     else
+       {
+         error ("Certificate validation failed for %s, verification code %d",
+                hostname, peer_verification);
+       }
+   }
+
+  /* Up to here the process is the same for X.509 certificates and
+     OpenPGP keys.  From now on X.509 certificates are assumed.  This
+     can be easily extended to work with openpgp keys as well.  */
+  if (gnutls_certificate_type_get (state) == GNUTLS_CRT_X509)
+    {
+      ret = gnutls_x509_crt_init (&gnutls_verify_cert);
+
+      if (ret < GNUTLS_E_SUCCESS)
+        return gnutls_make_error (ret);
+
+      gnutls_verify_cert_list = gnutls_certificate_get_peers (state, &gnutls_verify_cert_list_size);
+      if (NULL == gnutls_verify_cert_list)
+        {
+          error ("No certificate was found!\n");
+        }
+
+      /* We only check the first certificate in the given chain.  */
+      ret = gnutls_x509_crt_import (gnutls_verify_cert, &gnutls_verify_cert_list[0], GNUTLS_X509_FMT_DER);
+
+      if (ret < GNUTLS_E_SUCCESS)
+        {
+          gnutls_x509_crt_deinit (gnutls_verify_cert);
+          return gnutls_make_error (ret);
+        }
+
+      if (!gnutls_x509_crt_check_hostname (gnutls_verify_cert, hostname))
+        {
+          if (NILP (verify_hostname_error))
+            {
+              message ("GnuTLS warning: the certificate's hostname does not match gnutls-hostname \"%s\"", hostname);
+            }
+          else
+            {
+              gnutls_x509_crt_deinit (gnutls_verify_cert);
+              error ("The certificate's hostname does not match gnutls-hostname \"%s\"", hostname);
+            }
+        }
+
+      gnutls_x509_crt_deinit (gnutls_verify_cert);
+    }
+
+  return gnutls_make_error (ret);
 }
 
 DEFUN ("gnutls-bye", Fgnutls_bye,
@@ -578,7 +822,7 @@
 void
 syms_of_gnutls (void)
 {
-  global_initialized = 0;
+  gnutls_global_initialized = 0;
 
   Qgnutls_code = intern_c_string ("gnutls-code");
   staticpro (&Qgnutls_code);
@@ -589,6 +833,9 @@
   Qgnutls_x509pki = intern_c_string ("gnutls-x509pki");
   staticpro (&Qgnutls_x509pki);
 
+  Qgnutls_hostname = intern_c_string ("gnutls-hostname");
+  staticpro (&Qgnutls_hostname);
+
   Qgnutls_bootprop_priority = intern_c_string (":priority");
   staticpro (&Qgnutls_bootprop_priority);
 
@@ -601,9 +848,21 @@
   Qgnutls_bootprop_callbacks = intern_c_string (":callbacks");
   staticpro (&Qgnutls_bootprop_callbacks);
 
+  Qgnutls_bootprop_callbacks_verify = intern_c_string ("verify");
+  staticpro (&Qgnutls_bootprop_callbacks_verify);
+
   Qgnutls_bootprop_loglevel = intern_c_string (":loglevel");
   staticpro (&Qgnutls_bootprop_loglevel);
 
+  Qgnutls_bootprop_verify_flags = intern_c_string (":verify-flags");
+  staticpro (&Qgnutls_bootprop_verify_flags);
+
+  Qgnutls_bootprop_verify_hostname_error = intern_c_string (":verify-error");
+  staticpro (&Qgnutls_bootprop_verify_error);
+
+  Qgnutls_bootprop_verify_hostname_error = intern_c_string (":verify-hostname-error");
+  staticpro (&Qgnutls_bootprop_verify_hostname_error);
+
   Qgnutls_e_interrupted = intern_c_string ("gnutls-e-interrupted");
   staticpro (&Qgnutls_e_interrupted);
   Fput (Qgnutls_e_interrupted, Qgnutls_code,

=== modified file 'src/gnutls.h'
--- src/gnutls.h	2011-01-25 04:08:28 +0000
+++ src/gnutls.h	2011-03-22 17:49:45 +0000
@@ -21,6 +21,7 @@
 
 #ifdef HAVE_GNUTLS
 #include <gnutls/gnutls.h>
+#include <gnutls/x509.h>
 
 typedef enum
 {
@@ -28,6 +29,7 @@
   GNUTLS_STAGE_EMPTY = 0,
   GNUTLS_STAGE_CRED_ALLOC,
   GNUTLS_STAGE_FILES,
+  GNUTLS_STAGE_CALLBACKS,
   GNUTLS_STAGE_INIT,
   GNUTLS_STAGE_PRIORITY,
   GNUTLS_STAGE_CRED_SET,

=== modified file 'src/makefile.w32-in'
--- src/makefile.w32-in	2011-03-19 03:22:14 +0000
+++ src/makefile.w32-in	2011-03-22 17:49:45 +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)
 
 #
@@ -948,6 +950,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-03-17 05:18:33 +0000
+++ src/process.c	2011-03-22 17:49:45 +0000
@@ -4780,6 +4780,19 @@
              &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;

=== modified file 'src/w32.c'
--- src/w32.c	2011-03-14 17:07:53 +0000
+++ src/w32.c	2011-03-22 17:49:45 +0000
@@ -6084,5 +6084,75 @@
   p->childp = childp2;
 }
 
+#ifdef HAVE_GNUTLS
+
+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 = sys_read(fd, (char*)buf, sz);
+
+      if (n >= 0)
+        return n;
+      else
+        {
+          int err = errno;
+
+          if (err == EWOULDBLOCK)
+            {
+              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 || errno == EWOULDBLOCK)
+                /* We have to translate WSAEWOULDBLOCK alias
+		   EWOULDBLOCK to EAGAIN for GnuTLS.  */
+                err = EAGAIN;
+              else
+                err = errno;
+            }
+          gnutls_transport_set_errno (proc->gnutls_state, err);
+
+          return -1;
+        }
+    }
+}
+
+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 = sys_write((int)fd, buf, sz);
+
+  if (n >= 0)
+    return n;
+  else
+    {
+      gnutls_transport_set_errno (proc->gnutls_state,
+                                  /* Translate WSAEWOULDBLOCK alias
+                                     EWOULDBLOCK to EAGAIN for
+                                     GnuTLS.  */
+                                  errno == EWOULDBLOCK
+                                  ? EAGAIN
+                                  : errno);
+
+      return -1;
+    }
+}
+#endif /* HAVE_GNUTLS */
+
 /* end of w32.c */
 

=== modified file 'src/w32.h'
--- src/w32.h	2011-01-25 04:08:28 +0000
+++ src/w32.h	2011-03-22 17:49:45 +0000
@@ -143,5 +143,14 @@
 extern int _sys_read_ahead (int fd);
 extern int _sys_wait_accept (int fd);
 
+#ifdef HAVE_GNUTLS
+#include <gnutls/gnutls.h>
+
+extern ssize_t emacs_gnutls_pull (gnutls_transport_ptr_t p,
+                                  void* buf, size_t sz);
+extern ssize_t emacs_gnutls_push (gnutls_transport_ptr_t p,
+                                  const void* buf, size_t sz);
+#endif /* HAVE_GNUTLS */
+
 #endif /* EMACS_W32_H */
 

Re: [PATCH] GnuTLS support on Woe32

[Ted Zlatanov]

On Tue, 22 Mar 2011 19:56:16 +0100 Robert Pluim <rpluim@gmail.com> wrote: 

RP> Ted Zlatanov <tzz@lifelogs.com> writes:
>> 
>> Try the attached patch against proto-stream.el in the Emacs trunk.  I'll
>> refresh my patch to add this change too.

RP> That doesn't work for me.  Just to be clear, I connect to my imap server
RP> on port 993 with TLS, it's not a connection that gets upgraded after the
RP> fact, so I suspect proto-stream-open-tls needs to change.

Drat, the simple fix didn't work.  Can you please set `gnutls-log-level'
to 4 and show the whole sequence in *Messages*?

I don't think `proto-stream-open-tls' needs to change because it calls
`open-gnutls-stream' which in turn sets `gnutls-hostname'.  But I don't
know that code well at all and may be missing something.  Unfortunately
it is very DWIM code so it's hard to test it for the "just open a
SSL/TLS connection" case.  I'll try to look at it again.

Ted

Re: [PATCH] GnuTLS support on Woe32

[Stefan Monnier]

> Because of the way SSL and TLS work, the connection may start out
> unencrypted and the upgrade is sort of opportunistic.  So we don't know
> in advance if we'll need the `gnutls-hostname'.

I must be missing something: the code seems to read `gnutls-hostname'
right after reading the keyword arguments, so it behaves just like
a keyword argument AFAICT.  And the caller of gnutls-boot seems to set
it just before calling gnutls-negotiate/gnutls-boot so it seems that
from the caller's POV it could also be replaced by an additional
argument to gnutls-boot/negotiate.

> Also the `gnutls-hostname' is not necessarily the actual host we
> connect to, so we can't keep it as a per-process property.

I don't see how the "so" above connects the two parts of the sentence.
Then again, I still don't know what `gnutls-hostname' stands for so I'm
largely talking about something I don't understand.

> And finally, making it a keyword parameter means the piece that
> *upgrades* the connection to TLS has to know the original hostname of
> the connection.  I thought it was cleaner to separate them, so
> upgrading a connection is easier to do opportunistically.

Sounds reasonable.

> Emacs doesn't have per-process variables at the ELisp level so I had to
> associate it with the buffer and making it buffer-local seemed
> sensible.  How would you do it?

Not sure what you mean.  Don't process-put/get provide per-process
"variables"?  Also, rather than a buffer-local variable, why not use
a let-bound variable instead?

> (there's no `declare-variable').

Of course there is: it's called (defvar <VAR>).

> Sorry this patch is getting so large.  I'll try to fix all the issues
> ASAP.  We need Claudio Bley's papers too, right?

I don't know, I haven't tracked what comes from where.


        Stefan

Re: [PATCH] GnuTLS support on Woe32

[Robert Pluim]

Ted Zlatanov <tzz@lifelogs.com> writes:

> On Tue, 22 Mar 2011 19:56:16 +0100 Robert Pluim <rpluim@gmail.com> wrote: 
>
> RP> Ted Zlatanov <tzz@lifelogs.com> writes:
>>> 
>>> Try the attached patch against proto-stream.el in the Emacs trunk.  I'll
>>> refresh my patch to add this change too.
>
> RP> That doesn't work for me.  Just to be clear, I connect to my imap server
> RP> on port 993 with TLS, it's not a connection that gets upgraded after the
> RP> fact, so I suspect proto-stream-open-tls needs to change.
>
> Drat, the simple fix didn't work.  Can you please set `gnutls-log-level'
> to 4 and show the whole sequence in *Messages*?
>

That makes no difference at all in the messages. I think it's not
getting to the starting TLS phase at all because of the hostname issue.

Regards

Robert

Re: [PATCH] GnuTLS support on Woe32

[Ted Zlatanov]

[-- Attachment #1: Type: text/plain, Size: 2211 bytes --]

On Tue, 22 Mar 2011 16:14:08 -0500 Ted Zlatanov <tzz@lifelogs.com> wrote: 

TZ> On Tue, 22 Mar 2011 14:50:06 -0400 Stefan Monnier <monnier@IRO.UMontreal.CA> wrote: 
SM> BTW, I had not noticed this part in gnutls.el, which seems like an
SM> error: why would you want it to be buffer-local?  Gnutls is about
SM> processes, so binding this var to buffers makes no sense to me.
TZ> ...
SM> Now that I look at it, I don't understand what this gnutls-hostname
SM> variable is about.  Why isn't it an additional keyword argument instead?
SM> It needs better documentation than the current "Remote hostname.".

After thinking about it some more, I realized that this need for
separating the hostname out was mostly my fantasy :) I modified
`gnutls-negotiate' to take a hostname and removed `gnutls-hostname'
everywhere.  The hostname is now passed via :hostname to `gnutls-boot'.
So the caller is responsible for preserving the hostname if he wants to
call `gnutls-negotiate' but with `open-gnutls-stream' everything Just
Works.

>>> +                    (set (intern "gnutls-hostname") host))
SM> Yuck!!
SM> This should say "(setq gnutls-hostname host)": more efficient, more
SM> concise, more understandable (also for the compiler), ...

This is gone now.  I've added some new code to the patch and reformatted
a few long lines, too.

On Wed, 23 Mar 2011 09:42:11 +0100 Robert Pluim <rpluim@gmail.com> wrote: 

RP> That doesn't work for me.  Just to be clear, I connect to my imap server
RP> on port 993 with TLS, it's not a connection that gets upgraded after the
RP> fact, so I suspect proto-stream-open-tls needs to change.

I see.  It was a bug in the original code, but in addition I reworked
things as mentioned above so Gnus will work properly now (tested).  

The *Messages* warnings about failed certificates are a little annoying
so I set them to be issued only when `gnutls-log-level' is above 0 (off
by default).  The HTTP users of the GnuTLS functionality will probably
want to set :verify-error and :verify-hostname-error instead of raising
`gnutls-log-level', but many IMAP users have self-signed certificates.
So I'm totally throwing that problem at the API users like
proto-stream.el :)

Thanks
Ted


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: revised 2011-03-23 --]
[-- Type: text/x-diff, Size: 36634 bytes --]

=== modified file 'configure.in'
--- configure.in	2011-03-21 05:34:48 +0000
+++ configure.in	2011-03-23 01:44:59 +0000
@@ -1972,12 +1972,22 @@
 AC_SUBST(LIBSELINUX_LIBS)
 
 HAVE_GNUTLS=no
+HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY=no
 if test "${with_gnutls}" = "yes" ; then
   PKG_CHECK_MODULES([LIBGNUTLS], [gnutls >= 2.2.4], HAVE_GNUTLS=yes, HAVE_GNUTLS=no)
   if test "${HAVE_GNUTLS}" = "yes"; then
     AC_DEFINE(HAVE_GNUTLS, 1, [Define if using GnuTLS.])
   fi
+
+  CFLAGS="$CFLAGS $LIBGNUTLS_CFLAGS"
+  LIBS="$LIBGNUTLS_LIBS $LIBS"
+  AC_CHECK_FUNCS(gnutls_certificate_set_verify_function, HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY=yes)
+
+  if test "${HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY}" = "yes"; then
+    AC_DEFINE(HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY, 1, [Define if using GnuTLS certificate verification callbacks.])
+  fi
 fi
+
 AC_SUBST(LIBGNUTLS_LIBS)
 AC_SUBST(LIBGNUTLS_CFLAGS)
 
@@ -3666,6 +3676,7 @@
 echo "  Does Emacs use -lgconf?                                 ${HAVE_GCONF}"
 echo "  Does Emacs use -lselinux?                               ${HAVE_LIBSELINUX}"
 echo "  Does Emacs use -lgnutls?                                ${HAVE_GNUTLS}"
+echo "  Does Emacs use -lgnutls certificate verify callbacks?   ${HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY}"
 echo "  Does Emacs use -lxml2?                                  ${HAVE_LIBXML2}"
 
 echo "  Does Emacs use -lfreetype?                              ${HAVE_FREETYPE}"

=== modified file 'lib-src/ChangeLog'
--- lib-src/ChangeLog	2011-03-23 01:01:59 +0000
+++ lib-src/ChangeLog	2011-03-23 01:45:34 +0000
@@ -1,3 +1,7 @@
+2011-03-23  Claudio Bley  <claudio.bley@gmail.com>
+
+	* makefile.w32-in (obj): Added gnutls.o.
+
 2011-03-23  Paul Eggert  <eggert@cs.ucla.edu>
 
 	* ebrowse.c: Use size_t, not int, for sizes.

=== modified file 'lib-src/makefile.w32-in'
--- lib-src/makefile.w32-in	2011-03-12 19:19:47 +0000
+++ lib-src/makefile.w32-in	2011-03-23 01:44:59 +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-22 20:58:27 +0000
+++ lisp/ChangeLog	2011-03-23 12:03:28 +0000
@@ -1,3 +1,15 @@
+2011-03-23  Teodor Zlatanov  <tzz@lifelogs.com>
+
+	* net/gnutls.el (gnutls-negotiate): Add hostname, verify-flags,
+	verify-error, and verify-hostname-error parameters.
+	(open-gnutls-stream): Add usage example.
+
+2011-03-23  Claudio Bley  <claudio.bley@gmail.com>
+
+	* 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-22  Juanma Barranquero  <lekktu@gmail.com>
 
 	* emacs-lisp/derived.el (define-derived-mode): Wrap declaration of

=== modified file 'lisp/gnus/proto-stream.el'
--- lisp/gnus/proto-stream.el	2011-02-06 22:27:28 +0000
+++ lisp/gnus/proto-stream.el	2011-03-23 11:46:18 +0000
@@ -61,7 +61,8 @@
   :group 'comm)
 
 (declare-function gnutls-negotiate "gnutls"
-		  (proc type &optional priority-string trustfiles keyfiles))
+		  (proc type &optional priority-string trustfiles keyfiles
+                        verify-flags verify-error verify-hostname-error))
 
 ;;;###autoload
 (defun open-protocol-stream (name buffer host service &rest parameters)
@@ -190,7 +191,7 @@
 		  (list stream greeting capabilities 'network)))
 	    ;; The server said it was OK to start doing STARTTLS negotiations.
 	    (if (fboundp 'open-gnutls-stream)
-		(gnutls-negotiate stream nil)
+                (gnutls-negotiate stream nil host)
 	      (unless (starttls-negotiate stream)
 		(delete-process stream)
 		(setq stream nil)))

=== modified file 'lisp/net/gnutls.el'
--- lisp/net/gnutls.el	2011-01-25 04:08:28 +0000
+++ lisp/net/gnutls.el	2011-03-23 11:47:34 +0000
@@ -59,26 +59,76 @@
 Fourth arg SERVICE is name of the service desired, or an integer
 specifying a port number to connect to.
 
+Usage example:
+
+  \(with-temp-buffer
+    \(open-gnutls-stream \"tls\"
+                        \(current-buffer)
+                        \"your server goes here\"
+                        \"imaps\"))
+
 This is a very simple wrapper around `gnutls-negotiate'.  See its
 documentation for the specific parameters you can use to open a
 GnuTLS connection, including specifying the credential type,
 trust and key files, and priority string."
-  (let ((proc (open-network-stream name buffer host service)))
-    (gnutls-negotiate proc 'gnutls-x509pki)))
+  (gnutls-negotiate (open-network-stream name buffer host service)
+                    'gnutls-x509pki
+                    host))
+
+(put 'gnutls-error
+     'error-conditions
+     '(error gnutls-error))
+(put 'gnutls-error
+     'error-message "GnuTLS error")
 
 (declare-function gnutls-boot "gnutls.c" (proc type proplist))
 
-(defun gnutls-negotiate (proc type &optional priority-string
-                              trustfiles keyfiles)
-  "Negotiate a SSL/TLS connection.
+(defun gnutls-negotiate (proc type hostname &optional priority-string
+                              trustfiles keyfiles verify-flags
+                              verify-error verify-hostname-error)
+  "Negotiate a SSL/TLS connection.  Returns proc. Signals gnutls-error.
 TYPE is `gnutls-x509pki' (default) or `gnutls-anon'.  Use nil for the default.
 PROC is a process returned by `open-network-stream'.
+HOSTNAME is the remote hostname.  It must be a valid string.
 PRIORITY-STRING is as per the GnuTLS docs, default is \"NORMAL\".
 TRUSTFILES is a list of CA bundles.
-KEYFILES is a list of client keys."
+KEYFILES is a list of client keys.
+
+When VERIFY-HOSTNAME-ERROR is not nil, an error will be raised
+when the hostname does not match the presented certificate's host
+name.  The exact verification algorithm is a basic implementation
+of the matching described in RFC2818 (HTTPS), which takes into
+account wildcards, and the DNSName/IPAddress subject alternative
+name PKIX extension.  See GnuTLS' gnutls_x509_crt_check_hostname
+for details.  When VERIFY-HOSTNAME-ERROR is nil, only a warning
+will be issued.
+
+When VERIFY-ERROR is not nil, an error will be raised when the
+peer certificate verification fails as per GnuTLS'
+gnutls_certificate_verify_peers2.  Otherwise, only warnings will
+be shown about the verification failure.
+
+VERIFY-FLAGS is a numeric OR of verification flags only for
+`gnutls-x509pki' connections.  See GnuTLS' x509.h for details;
+here's a recent version of the list.
+
+    GNUTLS_VERIFY_DISABLE_CA_SIGN = 1,
+    GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT = 2,
+    GNUTLS_VERIFY_DO_NOT_ALLOW_SAME = 4,
+    GNUTLS_VERIFY_ALLOW_ANY_X509_V1_CA_CRT = 8,
+    GNUTLS_VERIFY_ALLOW_SIGN_RSA_MD2 = 16,
+    GNUTLS_VERIFY_ALLOW_SIGN_RSA_MD5 = 32,
+    GNUTLS_VERIFY_DISABLE_TIME_CHECKS = 64,
+    GNUTLS_VERIFY_DISABLE_TRUSTED_TIME_CHECKS = 128,
+    GNUTLS_VERIFY_DO_NOT_ALLOW_X509_V1_CA_CRT = 256
+
+It must be omitted, a number, or nil; if omitted or nil it
+defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT."
   (let* ((type (or type 'gnutls-x509pki))
+         (default-trustfile "/etc/ssl/certs/ca-certificates.crt")
          (trustfiles (or trustfiles
-                        '("/etc/ssl/certs/ca-certificates.crt")))
+                         (when (file-exists-p default-trustfile)
+                           (list default-trustfile))))
          (priority-string (or priority-string
                               (cond
                                ((eq type 'gnutls-anon)
@@ -86,15 +136,22 @@
                                ((eq type 'gnutls-x509pki)
                                 "NORMAL"))))
          (params `(:priority ,priority-string
+                             :hostname ,hostname
                              :loglevel ,gnutls-log-level
                              :trustfiles ,trustfiles
                              :keyfiles ,keyfiles
+                             :verify-flags ,verify-flags
+                             :verify-error ,verify-error
+                             :verify-hostname-error ,verify-hostname-error
                              :callbacks nil))
          ret)
 
     (gnutls-message-maybe
      (setq ret (gnutls-boot proc type params))
-     "boot: %s")
+     "boot: %s" params)
+
+    (when (gnutls-errorp ret)
+      (signal 'gnutls-error (list proc ret)))
 
     proc))
 

=== modified file 'nt/ChangeLog'
--- nt/ChangeLog	2011-03-12 19:19:47 +0000
+++ nt/ChangeLog	2011-03-23 01:44:59 +0000
@@ -1,3 +1,10 @@
+2011-03-06  Claudio Bley  <claudio.bley@gmail.com>
+
+	* 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  <eliz@gnu.org>
 
 	* inc/unistd.h (readlink, symlink): Declare prototypes.

=== modified file 'nt/INSTALL'
--- nt/INSTALL	2011-01-26 08:36:39 +0000
+++ nt/INSTALL	2011-03-23 01:44:59 +0000
@@ -306,6 +306,16 @@
   `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.
+
+  Pre-built binaries and an installer can be found at
+  http://josefsson.org/gnutls4win/.
+
 * 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-23 01:44:59 +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
@@ -204,6 +211,14 @@
 shift
 goto again
 
+:userlibs
+shift
+echo. userlibs: %userlibs%
+set userlibs=%userlibs%%sep4%%1
+set sep4= %nothing%
+shift
+goto again
+
 rem ----------------------------------------------------------------------
 
 :userldflags
@@ -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-23 01:44:59 +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-23 01:01:59 +0000
+++ src/ChangeLog	2011-03-23 01:46:57 +0000
@@ -1,3 +1,36 @@
+2011-03-22  Teodor Zlatanov  <tzz@lifelogs.com>
+
+	* gnutls.c: Renamed global_initialized to
+	gnutls_global_initialized.  Added internals for the
+	:verify-hostname-error, :verify-error, and :verify-flags
+	parameters of `gnutls-boot' and documented those parameters in the
+	docstring.  Start callback support.
+
+2011-03-20  Claudio Bley  <claudio.bley@gmail.com>
+
+	* w32.h: (emacs_gnutls_pull): Add prototype.
+	(emacs_gnutls_push): Likewise.
+
+	* w32.c: (emacs_gnutls_pull): New function for GnuTLS on Woe32.
+	(emacs_gnutls_push): Likewise.
+
+	* 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_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-23  Paul Eggert  <eggert@cs.ucla.edu>
 
 	Fix more problems found by GCC 4.5.2's static checks.

=== modified file 'src/gnutls.c'
--- src/gnutls.c	2011-01-25 04:08:28 +0000
+++ src/gnutls.c	2011-03-23 12:13:10 +0000
@@ -26,11 +26,19 @@
 #ifdef HAVE_GNUTLS
 #include <gnutls/gnutls.h>
 
+#ifdef WINDOWSNT
+#include <windows.h>
+#include "w32.h"
+#endif
+
+static int
+emacs_gnutls_handle_error (gnutls_session_t, int err);
+
 Lisp_Object Qgnutls_code;
 Lisp_Object Qgnutls_anon, Qgnutls_x509pki;
 Lisp_Object Qgnutls_e_interrupted, Qgnutls_e_again,
   Qgnutls_e_invalid_session, Qgnutls_e_not_ready_for_handshake;
-int global_initialized;
+int gnutls_global_initialized;
 
 /* The following are for the property list of `gnutls-boot'.  */
 Lisp_Object Qgnutls_bootprop_priority;
@@ -38,8 +46,15 @@
 Lisp_Object Qgnutls_bootprop_keyfiles;
 Lisp_Object Qgnutls_bootprop_callbacks;
 Lisp_Object Qgnutls_bootprop_loglevel;
-
-static void
+Lisp_Object Qgnutls_bootprop_hostname;
+Lisp_Object Qgnutls_bootprop_verify_flags;
+Lisp_Object Qgnutls_bootprop_verify_error;
+Lisp_Object Qgnutls_bootprop_verify_hostname_error;
+
+/* Callback keys for `gnutls-boot'.  Unused currently.  */
+Lisp_Object Qgnutls_bootprop_callbacks_verify;
+
+static int
 emacs_gnutls_handshake (struct Lisp_Process *proc)
 {
   gnutls_session_t state = proc->gnutls_state;
@@ -50,24 +65,56 @@
 
   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 and 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)
     {
-      /* here we're finally done.  */
+      /* Here we're finally done.  */
       proc->gnutls_initstage = GNUTLS_STAGE_READY;
     }
+  else
+    {
+        gnutls_alert_send_appropriate (state, ret);
+    }
+  return ret;
 }
 
 int
@@ -98,7 +145,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 +172,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;
   }
 }
 
+/* report a GnuTLS error to the user.
+   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
@@ -265,10 +354,10 @@
 {
   int ret = GNUTLS_E_SUCCESS;
 
-  if (!global_initialized)
+  if (!gnutls_global_initialized)
     ret = gnutls_global_init ();
 
-  global_initialized = 1;
+  gnutls_global_initialized = 1;
 
   return gnutls_make_error (ret);
 }
@@ -278,10 +367,10 @@
 static Lisp_Object
 gnutls_emacs_global_deinit (void)
 {
-  if (global_initialized)
+  if (gnutls_global_initialized)
     gnutls_global_deinit ();
 
-  global_initialized = 0;
+  gnutls_global_initialized = 0;
 
   return gnutls_make_error (GNUTLS_E_SUCCESS);
 }
@@ -306,12 +395,27 @@
 TYPE is a symbol, either `gnutls-anon' or `gnutls-x509pki'.
 PROPLIST is a property list with the following keys:
 
+:hostname is a string naming the remote host.
+
 :priority is a GnuTLS priority string, defaults to "NORMAL".
+
 :trustfiles is a list of PEM-encoded trust files for `gnutls-x509pki'.
+
 :keyfiles is a list of PEM-encoded key files for `gnutls-x509pki'.
-:callbacks is an alist of callback functions (TODO).
+
+:callbacks is an alist of callback functions, see below.
+
 :loglevel is the debug level requested from GnuTLS, try 4.
 
+:verify-flags is a bitset as per GnuTLS'
+gnutls_certificate_set_verify_flags.
+
+:verify-error, if non-nil, makes failure of the certificate validation
+an error.  Otherwise it will be just a series of warnings.
+
+:verify-hostname-error, if non-nil, makes a hostname mismatch an
+error.  Otherwise it will be just a warning.
+
 The debug level will be set for this process AND globally for GnuTLS.
 So if you set it higher or lower at any point, it affects global
 debugging.
@@ -324,6 +428,9 @@
 functions are used.  This function allocates resources which can only
 be deallocated by calling `gnutls-deinit' or by calling it again.
 
+The callbacks alist can have a `verify' key, associated with a
+verification function (UNUSED).
+
 Each authentication type may need additional information in order to
 work.  For X.509 PKI (`gnutls-x509pki'), you probably need at least
 one trustfile (usually a CA bundle).  */)
@@ -336,12 +443,19 @@
   /* TODO: GNUTLS_X509_FMT_DER is also an option.  */
   int file_format = GNUTLS_X509_FMT_PEM;
 
+  unsigned int gnutls_verify_flags = GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT;
+  gnutls_x509_crt_t gnutls_verify_cert;
+  unsigned int gnutls_verify_cert_list_size;
+  const gnutls_datum_t *gnutls_verify_cert_list;
+
   gnutls_session_t state;
   gnutls_certificate_credentials_t x509_cred;
   gnutls_anon_client_credentials_t anon_cred;
   Lisp_Object global_init;
   char* priority_string_ptr = "NORMAL"; /* default priority string.  */
   Lisp_Object tail;
+  int peer_verification;
+  char* c_hostname;
 
   /* Placeholders for the property list elements.  */
   Lisp_Object priority_string;
@@ -349,16 +463,29 @@
   Lisp_Object keyfiles;
   Lisp_Object callbacks;
   Lisp_Object loglevel;
+  Lisp_Object hostname;
+  Lisp_Object verify_flags;
+  Lisp_Object verify_error;
+  Lisp_Object verify_hostname_error;
 
   CHECK_PROCESS (proc);
   CHECK_SYMBOL (type);
   CHECK_LIST (proplist);
 
-  priority_string = Fplist_get (proplist, Qgnutls_bootprop_priority);
-  trustfiles      = Fplist_get (proplist, Qgnutls_bootprop_trustfiles);
-  keyfiles        = Fplist_get (proplist, Qgnutls_bootprop_keyfiles);
-  callbacks       = Fplist_get (proplist, Qgnutls_bootprop_callbacks);
-  loglevel        = Fplist_get (proplist, Qgnutls_bootprop_loglevel);
+  hostname              = Fplist_get (proplist, Qgnutls_bootprop_hostname);
+  priority_string       = Fplist_get (proplist, Qgnutls_bootprop_priority);
+  trustfiles            = Fplist_get (proplist, Qgnutls_bootprop_trustfiles);
+  keyfiles              = Fplist_get (proplist, Qgnutls_bootprop_keyfiles);
+  callbacks             = Fplist_get (proplist, Qgnutls_bootprop_callbacks);
+  loglevel              = Fplist_get (proplist, Qgnutls_bootprop_loglevel);
+  verify_flags          = Fplist_get (proplist, Qgnutls_bootprop_verify_flags);
+  verify_error          = Fplist_get (proplist, Qgnutls_bootprop_verify_error);
+  verify_hostname_error = Fplist_get (proplist, Qgnutls_bootprop_verify_hostname_error);
+
+  if (!STRINGP (hostname))
+    error ("gnutls-boot: invalid :hostname parameter");
+
+  c_hostname = SSDATA (hostname);
 
   state = XPROCESS (proc)->gnutls_state;
   XPROCESS (proc)->gnutls_p = 1;
@@ -416,6 +543,23 @@
       x509_cred = XPROCESS (proc)->gnutls_x509_cred;
       if (gnutls_certificate_allocate_credentials (&x509_cred) < 0)
         memory_full ();
+
+      if (NUMBERP (verify_flags))
+        {
+          gnutls_verify_flags = XINT (verify_flags);
+          GNUTLS_LOG (2, max_log_level, "setting verification flags");
+        }
+      else if (NILP (verify_flags))
+        {
+          /* The default is already GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT.  */
+          GNUTLS_LOG (2, max_log_level, "using default verification flags");
+        }
+      else
+        {
+          /* The default is already GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT.  */
+          GNUTLS_LOG (2, max_log_level, "ignoring invalid verify-flags");
+        }
+      gnutls_certificate_set_verify_flags (x509_cred, gnutls_verify_flags);
     }
   else if (EQ (type, Qgnutls_anon))
     {
@@ -484,6 +628,14 @@
 
   GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_FILES;
 
+  GNUTLS_LOG (1, max_log_level, "gnutls callbacks");
+
+  GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CALLBACKS;
+
+#ifdef HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY
+#else
+#endif
+
   GNUTLS_LOG (1, max_log_level, "gnutls_init");
 
   ret = gnutls_init (&state, GNUTLS_CLIENT);
@@ -541,9 +693,112 @@
 
   GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CRED_SET;
 
-  emacs_gnutls_handshake (XPROCESS (proc));
-
-  return gnutls_make_error (GNUTLS_E_SUCCESS);
+  ret = emacs_gnutls_handshake (XPROCESS (proc));
+
+  if (ret < GNUTLS_E_SUCCESS)
+    return gnutls_make_error (ret);
+
+  /* Now verify the peer, following
+     http://www.gnu.org/software/gnutls/manual/html_node/Verifying-peer_0027s-certificate.html.
+     The peer should present at least one certificate in the chain; do a
+     check of the certificate's hostname with
+     gnutls_x509_crt_check_hostname() against :hostname.  */
+
+  ret = gnutls_certificate_verify_peers2 (state, &peer_verification);
+
+  if (ret < GNUTLS_E_SUCCESS)
+    return gnutls_make_error (ret);
+  
+  if (XINT (loglevel) > 0 && peer_verification & GNUTLS_CERT_INVALID)
+    message ("%s certificate could not be verified.", 
+             c_hostname);
+ 
+ if (XINT (loglevel) > 0 && peer_verification & GNUTLS_CERT_REVOKED)
+   message ("%s certificate was revoked (CRL).",
+            c_hostname);
+ 
+ if (XINT (loglevel) > 0 && peer_verification & GNUTLS_CERT_SIGNER_NOT_FOUND)
+   message ("%s certificate's signer was not found.",
+            c_hostname);
+
+ if (XINT (loglevel) > 0 && peer_verification & GNUTLS_CERT_SIGNER_NOT_CA)
+   message ("%s certificate's signer is not a CA.",
+            c_hostname);
+
+ if (XINT (loglevel) > 0 && peer_verification & GNUTLS_CERT_INSECURE_ALGORITHM)
+   message ("%s certificate was signed with an insecure algorithm.",
+            c_hostname);
+
+ if (XINT (loglevel) > 0 && peer_verification & GNUTLS_CERT_NOT_ACTIVATED)
+   message ("%s certificate is not yet activated.", c_hostname);
+
+ if (XINT (loglevel) > 0 && peer_verification & GNUTLS_CERT_EXPIRED)
+   message ("%s certificate has expired.", c_hostname);
+
+ if (peer_verification != 0)
+   {
+     if (NILP (verify_hostname_error))
+       {
+         if (XINT (loglevel) > 0)
+           message ("Certificate validation failed %s, verification code %d",
+                    c_hostname, peer_verification);
+       }
+     else
+       {
+         error ("Certificate validation failed %s, verification code %d",
+                c_hostname, peer_verification);
+       }
+   }
+
+  /* Up to here the process is the same for X.509 certificates and
+     OpenPGP keys.  From now on X.509 certificates are assumed.  This
+     can be easily extended to work with openpgp keys as well.  */
+  if (gnutls_certificate_type_get (state) == GNUTLS_CRT_X509)
+    {
+      ret = gnutls_x509_crt_init (&gnutls_verify_cert);
+
+      if (ret < GNUTLS_E_SUCCESS)
+        return gnutls_make_error (ret);
+
+      gnutls_verify_cert_list = 
+        gnutls_certificate_get_peers (state, &gnutls_verify_cert_list_size);
+
+      if (NULL == gnutls_verify_cert_list)
+        {
+          error ("No x509 certificate was found!\n");
+        }
+
+      /* We only check the first certificate in the given chain.  */
+      ret = gnutls_x509_crt_import (gnutls_verify_cert,
+                                    &gnutls_verify_cert_list[0],
+                                    GNUTLS_X509_FMT_DER);
+
+      if (ret < GNUTLS_E_SUCCESS)
+        {
+          gnutls_x509_crt_deinit (gnutls_verify_cert);
+          return gnutls_make_error (ret);
+        }
+
+      if (!gnutls_x509_crt_check_hostname (gnutls_verify_cert, c_hostname))
+        {
+          if (NILP (verify_hostname_error))
+            {
+              if (XINT (loglevel) > 0)
+                message ("The x509 certificate does not match \"%s\"",
+                         c_hostname);
+            }
+          else
+            {
+              gnutls_x509_crt_deinit (gnutls_verify_cert);
+              error ("The x509 certificate does not match \"%s\"",
+                     c_hostname);
+            }
+        }
+
+      gnutls_x509_crt_deinit (gnutls_verify_cert);
+    }
+
+  return gnutls_make_error (ret);
 }
 
 DEFUN ("gnutls-bye", Fgnutls_bye,
@@ -578,7 +833,7 @@
 void
 syms_of_gnutls (void)
 {
-  global_initialized = 0;
+  gnutls_global_initialized = 0;
 
   Qgnutls_code = intern_c_string ("gnutls-code");
   staticpro (&Qgnutls_code);
@@ -589,6 +844,9 @@
   Qgnutls_x509pki = intern_c_string ("gnutls-x509pki");
   staticpro (&Qgnutls_x509pki);
 
+  Qgnutls_bootprop_hostname = intern_c_string (":hostname");
+  staticpro (&Qgnutls_bootprop_hostname);
+
   Qgnutls_bootprop_priority = intern_c_string (":priority");
   staticpro (&Qgnutls_bootprop_priority);
 
@@ -601,9 +859,21 @@
   Qgnutls_bootprop_callbacks = intern_c_string (":callbacks");
   staticpro (&Qgnutls_bootprop_callbacks);
 
+  Qgnutls_bootprop_callbacks_verify = intern_c_string ("verify");
+  staticpro (&Qgnutls_bootprop_callbacks_verify);
+
   Qgnutls_bootprop_loglevel = intern_c_string (":loglevel");
   staticpro (&Qgnutls_bootprop_loglevel);
 
+  Qgnutls_bootprop_verify_flags = intern_c_string (":verify-flags");
+  staticpro (&Qgnutls_bootprop_verify_flags);
+
+  Qgnutls_bootprop_verify_hostname_error = intern_c_string (":verify-error");
+  staticpro (&Qgnutls_bootprop_verify_error);
+
+  Qgnutls_bootprop_verify_hostname_error = intern_c_string (":verify-hostname-error");
+  staticpro (&Qgnutls_bootprop_verify_hostname_error);
+
   Qgnutls_e_interrupted = intern_c_string ("gnutls-e-interrupted");
   staticpro (&Qgnutls_e_interrupted);
   Fput (Qgnutls_e_interrupted, Qgnutls_code,

=== modified file 'src/gnutls.h'
--- src/gnutls.h	2011-01-25 04:08:28 +0000
+++ src/gnutls.h	2011-03-23 01:44:59 +0000
@@ -21,6 +21,7 @@
 
 #ifdef HAVE_GNUTLS
 #include <gnutls/gnutls.h>
+#include <gnutls/x509.h>
 
 typedef enum
 {
@@ -28,6 +29,7 @@
   GNUTLS_STAGE_EMPTY = 0,
   GNUTLS_STAGE_CRED_ALLOC,
   GNUTLS_STAGE_FILES,
+  GNUTLS_STAGE_CALLBACKS,
   GNUTLS_STAGE_INIT,
   GNUTLS_STAGE_PRIORITY,
   GNUTLS_STAGE_CRED_SET,

=== modified file 'src/makefile.w32-in'
--- src/makefile.w32-in	2011-03-19 03:22:14 +0000
+++ src/makefile.w32-in	2011-03-23 01:44:59 +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)
 
 #
@@ -948,6 +950,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-03-20 16:55:33 +0000
+++ src/process.c	2011-03-23 01:44:59 +0000
@@ -4775,6 +4775,19 @@
              &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;

=== modified file 'src/w32.c'
--- src/w32.c	2011-03-14 17:07:53 +0000
+++ src/w32.c	2011-03-23 01:44:59 +0000
@@ -6084,5 +6084,75 @@
   p->childp = childp2;
 }
 
+#ifdef HAVE_GNUTLS
+
+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 = sys_read(fd, (char*)buf, sz);
+
+      if (n >= 0)
+        return n;
+      else
+        {
+          int err = errno;
+
+          if (err == EWOULDBLOCK)
+            {
+              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 || errno == EWOULDBLOCK)
+                /* We have to translate WSAEWOULDBLOCK alias
+		   EWOULDBLOCK to EAGAIN for GnuTLS.  */
+                err = EAGAIN;
+              else
+                err = errno;
+            }
+          gnutls_transport_set_errno (proc->gnutls_state, err);
+
+          return -1;
+        }
+    }
+}
+
+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 = sys_write((int)fd, buf, sz);
+
+  if (n >= 0)
+    return n;
+  else
+    {
+      gnutls_transport_set_errno (proc->gnutls_state,
+                                  /* Translate WSAEWOULDBLOCK alias
+                                     EWOULDBLOCK to EAGAIN for
+                                     GnuTLS.  */
+                                  errno == EWOULDBLOCK
+                                  ? EAGAIN
+                                  : errno);
+
+      return -1;
+    }
+}
+#endif /* HAVE_GNUTLS */
+
 /* end of w32.c */
 

=== modified file 'src/w32.h'
--- src/w32.h	2011-01-25 04:08:28 +0000
+++ src/w32.h	2011-03-23 01:44:59 +0000
@@ -143,5 +143,14 @@
 extern int _sys_read_ahead (int fd);
 extern int _sys_wait_accept (int fd);
 
+#ifdef HAVE_GNUTLS
+#include <gnutls/gnutls.h>
+
+extern ssize_t emacs_gnutls_pull (gnutls_transport_ptr_t p,
+                                  void* buf, size_t sz);
+extern ssize_t emacs_gnutls_push (gnutls_transport_ptr_t p,
+                                  const void* buf, size_t sz);
+#endif /* HAVE_GNUTLS */
+
 #endif /* EMACS_W32_H */
 

Re: [PATCH] GnuTLS support on Woe32

[Robert Pluim]

Ted Zlatanov <tzz@lifelogs.com> writes:

> On Wed, 23 Mar 2011 09:42:11 +0100 Robert Pluim <rpluim@gmail.com> wrote: 
>
> RP> That doesn't work for me.  Just to be clear, I connect to my imap server
> RP> on port 993 with TLS, it's not a connection that gets upgraded after the
> RP> fact, so I suspect proto-stream-open-tls needs to change.
>
> I see.  It was a bug in the original code, but in addition I reworked
> things as mentioned above so Gnus will work properly now (tested).  
>

Works for me so far (I'm using it to write this message).

> The *Messages* warnings about failed certificates are a little annoying
> so I set them to be issued only when `gnutls-log-level' is above 0 (off
> by default).  The HTTP users of the GnuTLS functionality will probably
> want to set :verify-error and :verify-hostname-error instead of raising
> `gnutls-log-level', but many IMAP users have self-signed certificates.
> So I'm totally throwing that problem at the API users like
> proto-stream.el :)

Ya. I'll be putting gnutls-log-level back to 0 in my config :)

Robert

Re: [PATCH] GnuTLS support on Woe32

[Ted Zlatanov]

On Wed, 23 Mar 2011 14:14:26 +0100 Robert Pluim <rpluim@gmail.com> wrote: 

RP> Works for me so far (I'm using it to write this message).

My Emacs freaked out on me while testing this, switching buffers
randomly, but I think it was unrelated: I have a new Logitech G19
keyboard and some very beta-ish support for it.  So please let me know
if you observe strange behavior.

RP> Ya. I'll be putting gnutls-log-level back to 0 in my config :)

No need, 0 will always be the default.

Ted

Re: [PATCH] GnuTLS support on Woe32

[Robert Pluim]

Ted Zlatanov <tzz@lifelogs.com> writes:

> On Wed, 23 Mar 2011 14:14:26 +0100 Robert Pluim <rpluim@gmail.com> wrote: 
>
> RP> Works for me so far (I'm using it to write this message).
>
> My Emacs freaked out on me while testing this, switching buffers
> randomly, but I think it was unrelated: I have a new Logitech G19
> keyboard and some very beta-ish support for it.  So please let me know
> if you observe strange behavior.
>

I am getting quite a few of these: 
  gnutls.c *** Non fatal error: Resource temporarily unavailable, try again.

which I'm assuming aren't a problem, the message is just annoying.

Regards

Robert

Re: [PATCH] GnuTLS support on Woe32

[Ted Zlatanov]

On Tue, 22 Mar 2011 21:20:21 -0400 Stefan Monnier <monnier@IRO.UMontreal.CA> wrote: 

>> Because of the way SSL and TLS work, the connection may start out
>> unencrypted and the upgrade is sort of opportunistic.  So we don't know
>> in advance if we'll need the `gnutls-hostname'.

SM> I must be missing something: the code seems to read `gnutls-hostname'
SM> right after reading the keyword arguments, so it behaves just like
SM> a keyword argument AFAICT.  And the caller of gnutls-boot seems to set
SM> it just before calling gnutls-negotiate/gnutls-boot so it seems that
SM> from the caller's POV it could also be replaced by an additional
SM> argument to gnutls-boot/negotiate.

Oh, and it was buggy too :)  Sorry for putting up crappy code but I
honestly thought it was a good approach at the time.  The latest patch
("revised 2011-03-23" posted this morning) does it better, simply using
an extra :hostname parameter to `gnutls-negotiate'.

Thanks for explaining about `process-put' and `process-get' (which I had
completely forgotten).  I appreciate your patience.

>> Sorry this patch is getting so large.  I'll try to fix all the issues
>> ASAP.  We need Claudio Bley's papers too, right?

SM> I don't know, I haven't tracked what comes from where.

The ChangeLog diffs (appended) explain:

- Claudio and I worked on src/gnutls.c and lisp/net/gnutls.el; my work
  was to add callback support (though it is unused yet at the C level)
  and certificate and hostname verification.

- Claudio did everything else (W32 support plus some bug fixes)

The only remaining annoyance for me is that Claudio's code does logging
in a non-standard way, ignoring `gnutls-log-level', so thousands of
warnings get logged while the connections is being retried.  I mentioned
that to him and I'll see that it's fixed before this patch goes in.

Ted

=== modified file 'lib-src/ChangeLog'
--- lib-src/ChangeLog	2011-03-12 19:19:47 +0000
+++ lib-src/ChangeLog	2011-03-22 17:49:45 +0000
@@ -1,3 +1,7 @@
+2011-03-06  Claudio Bley  <claudio.bley@gmail.com>
+
+	* makefile.w32-in (obj): Added gnutls.o.
+
 2011-03-03  Drake Wilson  <drake@begriffli.ch>  (tiny change)
 
 	* emacsclient.c (longopts): Add quiet.

=== modified file 'lisp/ChangeLog'
--- lisp/ChangeLog	2011-03-22 15:38:40 +0000
+++ lisp/ChangeLog	2011-03-22 17:50:32 +0000
@@ -1,3 +1,18 @@
+2011-03-22  Teodor Zlatanov  <tzz@lifelogs.com>
+
+	* net/gnutls.el (gnutls-hostname): New buffer-local variable for
+	hostname verification.
+	(gnutls-negotiate): Add verify-flags, verify-error, and
+	verify-hostname-error.
+	(open-gnutls-stream): Add usage example.
+
+2011-03-22  Claudio Bley  <claudio.bley@gmail.com>
+
+	* 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-22  Leo Liu  <sdl.web@gmail.com>
 
 	* abbrev.el (write-abbrev-file): Use utf-8 for writing if it can

=== modified file 'nt/ChangeLog'
--- nt/ChangeLog	2011-03-12 19:19:47 +0000
+++ nt/ChangeLog	2011-03-22 17:49:45 +0000
@@ -1,3 +1,10 @@
+2011-03-06  Claudio Bley  <claudio.bley@gmail.com>
+
+	* 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  <eliz@gnu.org>
 
 	* inc/unistd.h (readlink, symlink): Declare prototypes.

=== modified file 'src/ChangeLog'
--- src/ChangeLog	2011-03-20 23:58:23 +0000
+++ src/ChangeLog	2011-03-22 17:49:45 +0000
@@ -1,3 +1,37 @@
+2011-03-22  Teodor Zlatanov  <tzz@lifelogs.com>
+
+	* gnutls.c: Renamed global_initialized to
+	gnutls_global_initialized.  Added internals for the
+	:verify-hostname-error, :verify-error, and :verify-flags
+	parameters of `gnutls-boot' and documented those parameters in the
+	docstring.  Start callback support.
+
+2011-03-20  Claudio Bley  <claudio.bley@gmail.com>
+
+	* w32.h: (emacs_gnutls_pull): Add prototype.
+	(emacs_gnutls_push): Likewise.
+
+	* w32.c: (emacs_gnutls_pull): New function for GnuTLS on Woe32.
+	(emacs_gnutls_push): Likewise.
+
+	* 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_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-20  Glenn Morris  <rgm@gnu.org>
 
 	* config.in: Remove file.

Re: [PATCH] GnuTLS support on Woe32

[Ted Zlatanov]

On Wed, 23 Mar 2011 16:10:37 +0100 Robert Pluim <rpluim@gmail.com> wrote: 

RP> Ted Zlatanov <tzz@lifelogs.com> writes:
>> On Wed, 23 Mar 2011 14:14:26 +0100 Robert Pluim <rpluim@gmail.com> wrote: 
>> 
RP> Works for me so far (I'm using it to write this message).
>> 
>> My Emacs freaked out on me while testing this, switching buffers
>> randomly, but I think it was unrelated: I have a new Logitech G19
>> keyboard and some very beta-ish support for it.  So please let me know
>> if you observe strange behavior.
>> 

RP> I am getting quite a few of these: 
RP>   gnutls.c *** Non fatal error: Resource temporarily unavailable, try again.

RP> which I'm assuming aren't a problem, the message is just annoying.

Yeah, Claudio added that.  I'd like him to fix it because I don't know
the severity of the error but it seems trivial (so should probably be at
gnutls-log-level 4 or higher).  It should probably also use the
`GNUTLS_LOG' and `GNUTLS_LOG2' macros instead of `message' directly so
the log level is automatically respected.

I just realized my own code in `gnutls-boot' uses `message' directly,
oops.  I've adjusted it but the change is too minor to merit reposting
the patch.

Ted

Re: [PATCH] GnuTLS support on Woe32

[Stefan Monnier]

> ("revised 2011-03-23" posted this morning) does it better, simply using
> an extra :hostname parameter to `gnutls-negotiate'.

Great.

> The ChangeLog diffs (appended) explain:

> - Claudio and I worked on src/gnutls.c and lisp/net/gnutls.el; my work
>   was to add callback support (though it is unused yet at the C level)
>   and certificate and hostname verification.

> - Claudio did everything else (W32 support plus some bug fixes)

So I think we need Claudio's papers before we can install the
change, indeed.  Is it in progress already?


        Stefan

Re: [PATCH] GnuTLS support on Woe32

[Ted Zlatanov]

On Tue, 15 Mar 2011 08:57:05 +0100 claudio.bley@gmail.com (Claudio Bley) wrote: 

CB> I've send a mail to assign@gnu.org and are awaiting the papers now.

On Wed, 23 Mar 2011 13:50:36 -0400 Stefan Monnier <monnier@iro.umontreal.ca> wrote: 

>> The ChangeLog diffs (appended) explain:

>> - Claudio and I worked on src/gnutls.c and lisp/net/gnutls.el; my work
>> was to add callback support (though it is unused yet at the C level)
>> and certificate and hostname verification.

>> - Claudio did everything else (W32 support plus some bug fixes)

SM> So I think we need Claudio's papers before we can install the
SM> change, indeed.  Is it in progress already?

Yes, see above.  I assume he'll post here when he has signed them.

Ted

Re: [PATCH] GnuTLS support on Woe32

[Claudio Bley]

At Tue, 22 Mar 2011 01:40:06 -0400,
Stefan Monnier wrote:
> > +#ifdef HAVE_GNUTLS
> > +          /* GnuTLS buffers data internally. In lowat mode it leaves some data
> 
> Shouldn't that be "Iowait"?

No, it's a "low water" value / mode. Whatever that's supposed to
mean...

> Also please put 2 spaces after a ".".
> 
> > +              && gnutls_record_check_pending(wait_proc->gnutls_state) > 0)
>                                               ^^
>                                           needs a space
> 
> > +              sc = select (fd + 1, &fdset, (SELECT_TYPE *)0, (SELECT_TYPE *)0, &timeout);
> 
> That seems to go way past column 80.  Please fold it.
> 
> > +                                  /* translate WSAEWOULDBLOCK alias
> > +                                     EWOULDBLOCK to EAGAIN for
> > +                                     GnuTLS */
> 
> The comment above needs to start with a capital letter and end with a ".".
> 
> > +extern ssize_t emacs_gnutls_pull(gnutls_transport_ptr_t p,
> > +				 void* buf, size_t sz);
> > +extern ssize_t emacs_gnutls_push(gnutls_transport_ptr_t p,
> > +				 const void* buf, size_t sz);
> 
> Again, the above needs spaces before the open paren.

OK, is there a style guide somewhere or better yet a style checker for
these kind of faux pas?

- Claudio

Re: [PATCH] GnuTLS support on Woe32

[Claudio Bley]

At Wed, 23 Mar 2011 13:50:36 -0400,
Stefan Monnier wrote:
> > The ChangeLog diffs (appended) explain:
> 
> > - Claudio and I worked on src/gnutls.c and lisp/net/gnutls.el; my work
> >   was to add callback support (though it is unused yet at the C level)
> >   and certificate and hostname verification.
> 
> > - Claudio did everything else (W32 support plus some bug fixes)
> 
> So I think we need Claudio's papers before we can install the
> change, indeed.  Is it in progress already?

I requested the papers, but I'm still waiting for receipt. So, this
will probably take some time...

- Claudio

Re: [PATCH] GnuTLS support on Woe32

[Stefan Monnier]

>> Again, the above needs spaces before the open paren.
> OK, is there a style guide somewhere or better yet a style checker for
> these kind of faux pas?

No.  But we do have abut 8MB of examples ;-)
Wait, yes there is: the GNU coding standard (www.gnu.org/prep/standards/)


        Stefan

GNU coding standard highlighting rules (was: [PATCH] GnuTLS support on Woe32)

[Ted Zlatanov]

On Wed, 23 Mar 2011 17:55:04 -0400 Stefan Monnier <monnier@iro.umontreal.ca> wrote: 

>>> Again, the above needs spaces before the open paren.
>> OK, is there a style guide somewhere or better yet a style checker for
>> these kind of faux pas?

SM> No.  But we do have abut 8MB of examples ;-)
SM> Wait, yes there is: the GNU coding standard (www.gnu.org/prep/standards/)

I would love to see highlighting rules for C and ELisp that at least
catch the comment problems: starting with lowercase and a period without
two spaces, etc.  I don't know the Emacs highlighting at all so I can't
write these myself, plus I would probably miss many of the rules through
inexperience.

If those rules could be enabled with a file-local variable that would be
even better.  It would really help people like me and Claudio who don't
work with the Emacs source code often.  It would probably benefit most
GNU projects, not just Emacs, to provide this.

Ted

Re: [PATCH] GnuTLS support on Woe32

[Ted Zlatanov]

[-- Attachment #1: Type: text/plain, Size: 1456 bytes --]

On Wed, 23 Mar 2011 21:57:56 +0100 claudio.bley@gmail.com (Claudio Bley) wrote: 

CB> I requested the papers, but I'm still waiting for receipt. So, this
CB> will probably take some time...

Thanks.  Meanwhile could you please look at this revision of the patch?

Here are the new changes I made to your code and some proposals.  I can
do the TODO items I list below but wanted your opinion first.

- use GNUTLS_LOG2 macro to report warnings so users get less noise
  (done, please review)

- use `gnutls-log-level' in emacs_gnutls_handle_error (done)

- emacs_gnutls_handle_error should IMO use gnutls_make_error(err) and
  not err directly.  That way the return value can be directly compared
  to a symbol for GNUTLS_E_AGAIN for instance (where it will be
  Qgnutls_e_again) and you can print it nicely in messages.  This is how
  I did the error handling originally but if you have reasons why it's
  better to do it the other way, please tell me.  I think the
  performance, at least, won't suffer much my way.  (TODO)

- if you go along with the above, we should use Fgnutls_error_fatalp and
  Fgnutls_error_string instead of gnutls_error_is_fatal and
  gnutls_strerror directly.  I think it will make the code cleaner. (TODO)

- "Resource unavailable, try again" should be a level 2 error, right now
  it's level 1 as non-fatal.  If you go along with the above we just
  need to compare the Lisp_Object error to Qgnutls_e_again (TODO)

Thanks!
Ted


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: revised 2011-03-24 --]
[-- Type: text/x-diff, Size: 38725 bytes --]

=== modified file 'configure.in'
--- configure.in	2011-03-20 23:58:23 +0000
+++ configure.in	2011-03-23 15:37:05 +0000
@@ -1973,12 +1973,22 @@
 AC_SUBST(LIBSELINUX_LIBS)
 
 HAVE_GNUTLS=no
+HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY=no
 if test "${with_gnutls}" = "yes" ; then
   PKG_CHECK_MODULES([LIBGNUTLS], [gnutls >= 2.2.4], HAVE_GNUTLS=yes, HAVE_GNUTLS=no)
   if test "${HAVE_GNUTLS}" = "yes"; then
     AC_DEFINE(HAVE_GNUTLS, 1, [Define if using GnuTLS.])
   fi
+
+  CFLAGS="$CFLAGS $LIBGNUTLS_CFLAGS"
+  LIBS="$LIBGNUTLS_LIBS $LIBS"
+  AC_CHECK_FUNCS(gnutls_certificate_set_verify_function, HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY=yes)
+
+  if test "${HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY}" = "yes"; then
+    AC_DEFINE(HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY, 1, [Define if using GnuTLS certificate verification callbacks.])
+  fi
 fi
+
 AC_SUBST(LIBGNUTLS_LIBS)
 AC_SUBST(LIBGNUTLS_CFLAGS)
 
@@ -3667,6 +3677,7 @@
 echo "  Does Emacs use -lgconf?                                 ${HAVE_GCONF}"
 echo "  Does Emacs use -lselinux?                               ${HAVE_LIBSELINUX}"
 echo "  Does Emacs use -lgnutls?                                ${HAVE_GNUTLS}"
+echo "  Does Emacs use -lgnutls certificate verify callbacks?   ${HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY}"
 echo "  Does Emacs use -lxml2?                                  ${HAVE_LIBXML2}"
 
 echo "  Does Emacs use -lfreetype?                              ${HAVE_FREETYPE}"

=== modified file 'lib-src/ChangeLog'
--- lib-src/ChangeLog	2011-03-12 19:19:47 +0000
+++ lib-src/ChangeLog	2011-03-23 15:39:25 +0000
@@ -1,3 +1,7 @@
+2011-03-23  Claudio Bley  <claudio.bley@gmail.com>
+
+	* makefile.w32-in (obj): Added gnutls.o.
+
 2011-03-03  Drake Wilson  <drake@begriffli.ch>  (tiny change)
 
 	* emacsclient.c (longopts): Add quiet.

=== modified file 'lib-src/makefile.w32-in'
--- lib-src/makefile.w32-in	2011-03-12 19:19:47 +0000
+++ lib-src/makefile.w32-in	2011-03-23 15:37:05 +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-22 15:38:40 +0000
+++ lisp/ChangeLog	2011-03-23 15:38:41 +0000
@@ -1,3 +1,15 @@
+2011-03-23  Teodor Zlatanov  <tzz@lifelogs.com>
+
+	* net/gnutls.el (gnutls-negotiate): Add hostname, verify-flags,
+	verify-error, and verify-hostname-error parameters.
+	(open-gnutls-stream): Add usage example.
+
+2011-03-23  Claudio Bley  <claudio.bley@gmail.com>
+
+	* 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-22  Leo Liu  <sdl.web@gmail.com>
 
 	* abbrev.el (write-abbrev-file): Use utf-8 for writing if it can

=== modified file 'lisp/gnus/proto-stream.el'
--- lisp/gnus/proto-stream.el	2011-02-06 22:27:28 +0000
+++ lisp/gnus/proto-stream.el	2011-03-23 17:56:45 +0000
@@ -61,7 +61,8 @@
   :group 'comm)
 
 (declare-function gnutls-negotiate "gnutls"
-		  (proc type &optional priority-string trustfiles keyfiles))
+		  (proc type &optional priority-string trustfiles keyfiles
+                        verify-flags verify-error verify-hostname-error))
 
 ;;;###autoload
 (defun open-protocol-stream (name buffer host service &rest parameters)
@@ -190,7 +191,7 @@
 		  (list stream greeting capabilities 'network)))
 	    ;; The server said it was OK to start doing STARTTLS negotiations.
 	    (if (fboundp 'open-gnutls-stream)
-		(gnutls-negotiate stream nil)
+                (gnutls-negotiate stream nil host)
 	      (unless (starttls-negotiate stream)
 		(delete-process stream)
 		(setq stream nil)))

=== modified file 'lisp/net/gnutls.el'
--- lisp/net/gnutls.el	2011-01-25 04:08:28 +0000
+++ lisp/net/gnutls.el	2011-03-23 18:44:51 +0000
@@ -25,7 +25,8 @@
 ;;; Commentary:
 
 ;; This package provides language bindings for the GnuTLS library
-;; using the corresponding core functions in gnutls.c.
+;; using the corresponding core functions in gnutls.c.  It should NOT
+;; be used directly, only through open-protocol-stream.
 
 ;; Simple test:
 ;;
@@ -59,26 +60,76 @@
 Fourth arg SERVICE is name of the service desired, or an integer
 specifying a port number to connect to.
 
+Usage example:
+
+  \(with-temp-buffer
+    \(open-gnutls-stream \"tls\"
+                        \(current-buffer)
+                        \"your server goes here\"
+                        \"imaps\"))
+
 This is a very simple wrapper around `gnutls-negotiate'.  See its
 documentation for the specific parameters you can use to open a
 GnuTLS connection, including specifying the credential type,
 trust and key files, and priority string."
-  (let ((proc (open-network-stream name buffer host service)))
-    (gnutls-negotiate proc 'gnutls-x509pki)))
+  (gnutls-negotiate (open-network-stream name buffer host service)
+                    'gnutls-x509pki
+                    host))
+
+(put 'gnutls-error
+     'error-conditions
+     '(error gnutls-error))
+(put 'gnutls-error
+     'error-message "GnuTLS error")
 
 (declare-function gnutls-boot "gnutls.c" (proc type proplist))
 
-(defun gnutls-negotiate (proc type &optional priority-string
-                              trustfiles keyfiles)
-  "Negotiate a SSL/TLS connection.
+(defun gnutls-negotiate (proc type hostname &optional priority-string
+                              trustfiles keyfiles verify-flags
+                              verify-error verify-hostname-error)
+  "Negotiate a SSL/TLS connection.  Returns proc. Signals gnutls-error.
 TYPE is `gnutls-x509pki' (default) or `gnutls-anon'.  Use nil for the default.
 PROC is a process returned by `open-network-stream'.
+HOSTNAME is the remote hostname.  It must be a valid string.
 PRIORITY-STRING is as per the GnuTLS docs, default is \"NORMAL\".
 TRUSTFILES is a list of CA bundles.
-KEYFILES is a list of client keys."
+KEYFILES is a list of client keys.
+
+When VERIFY-HOSTNAME-ERROR is not nil, an error will be raised
+when the hostname does not match the presented certificate's host
+name.  The exact verification algorithm is a basic implementation
+of the matching described in RFC2818 (HTTPS), which takes into
+account wildcards, and the DNSName/IPAddress subject alternative
+name PKIX extension.  See GnuTLS' gnutls_x509_crt_check_hostname
+for details.  When VERIFY-HOSTNAME-ERROR is nil, only a warning
+will be issued.
+
+When VERIFY-ERROR is not nil, an error will be raised when the
+peer certificate verification fails as per GnuTLS'
+gnutls_certificate_verify_peers2.  Otherwise, only warnings will
+be shown about the verification failure.
+
+VERIFY-FLAGS is a numeric OR of verification flags only for
+`gnutls-x509pki' connections.  See GnuTLS' x509.h for details;
+here's a recent version of the list.
+
+    GNUTLS_VERIFY_DISABLE_CA_SIGN = 1,
+    GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT = 2,
+    GNUTLS_VERIFY_DO_NOT_ALLOW_SAME = 4,
+    GNUTLS_VERIFY_ALLOW_ANY_X509_V1_CA_CRT = 8,
+    GNUTLS_VERIFY_ALLOW_SIGN_RSA_MD2 = 16,
+    GNUTLS_VERIFY_ALLOW_SIGN_RSA_MD5 = 32,
+    GNUTLS_VERIFY_DISABLE_TIME_CHECKS = 64,
+    GNUTLS_VERIFY_DISABLE_TRUSTED_TIME_CHECKS = 128,
+    GNUTLS_VERIFY_DO_NOT_ALLOW_X509_V1_CA_CRT = 256
+
+It must be omitted, a number, or nil; if omitted or nil it
+defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT."
   (let* ((type (or type 'gnutls-x509pki))
+         (default-trustfile "/etc/ssl/certs/ca-certificates.crt")
          (trustfiles (or trustfiles
-                        '("/etc/ssl/certs/ca-certificates.crt")))
+                         (when (file-exists-p default-trustfile)
+                           (list default-trustfile))))
          (priority-string (or priority-string
                               (cond
                                ((eq type 'gnutls-anon)
@@ -86,15 +137,22 @@
                                ((eq type 'gnutls-x509pki)
                                 "NORMAL"))))
          (params `(:priority ,priority-string
+                             :hostname ,hostname
                              :loglevel ,gnutls-log-level
                              :trustfiles ,trustfiles
                              :keyfiles ,keyfiles
+                             :verify-flags ,verify-flags
+                             :verify-error ,verify-error
+                             :verify-hostname-error ,verify-hostname-error
                              :callbacks nil))
          ret)
 
     (gnutls-message-maybe
      (setq ret (gnutls-boot proc type params))
-     "boot: %s")
+     "boot: %s" params)
+
+    (when (gnutls-errorp ret)
+      (signal 'gnutls-error (list proc ret)))
 
     proc))
 

=== modified file 'nt/ChangeLog'
--- nt/ChangeLog	2011-03-12 19:19:47 +0000
+++ nt/ChangeLog	2011-03-23 15:37:05 +0000
@@ -1,3 +1,10 @@
+2011-03-06  Claudio Bley  <claudio.bley@gmail.com>
+
+	* 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  <eliz@gnu.org>
 
 	* inc/unistd.h (readlink, symlink): Declare prototypes.

=== modified file 'nt/INSTALL'
--- nt/INSTALL	2011-01-26 08:36:39 +0000
+++ nt/INSTALL	2011-03-23 15:37:05 +0000
@@ -306,6 +306,16 @@
   `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.
+
+  Pre-built binaries and an installer can be found at
+  http://josefsson.org/gnutls4win/.
+
 * 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-23 15:37:05 +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
@@ -204,6 +211,14 @@
 shift
 goto again
 
+:userlibs
+shift
+echo. userlibs: %userlibs%
+set userlibs=%userlibs%%sep4%%1
+set sep4= %nothing%
+shift
+goto again
+
 rem ----------------------------------------------------------------------
 
 :userldflags
@@ -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-23 15:37:05 +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-20 23:58:23 +0000
+++ src/ChangeLog	2011-03-24 18:52:49 +0000
@@ -1,3 +1,36 @@
+2011-03-23  Teodor Zlatanov  <tzz@lifelogs.com>
+
+	* gnutls.c: Renamed global_initialized to
+	gnutls_global_initialized.  Added internals for the
+	:verify-hostname-error, :verify-error, and :verify-flags
+	parameters of `gnutls-boot' and documented those parameters in the
+	docstring.  Start callback support.
+
+2011-03-23  Claudio Bley  <claudio.bley@gmail.com>
+
+	* w32.h: (emacs_gnutls_pull): Add prototype.
+	(emacs_gnutls_push): Likewise.
+
+	* w32.c: (emacs_gnutls_pull): New function for GnuTLS on Woe32.
+	(emacs_gnutls_push): Likewise.
+
+	* 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_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-20  Glenn Morris  <rgm@gnu.org>
 
 	* config.in: Remove file.

=== modified file 'src/gnutls.c'
--- src/gnutls.c	2011-01-25 04:08:28 +0000
+++ src/gnutls.c	2011-03-24 19:24:46 +0000
@@ -26,11 +26,20 @@
 #ifdef HAVE_GNUTLS
 #include <gnutls/gnutls.h>
 
+#ifdef WINDOWSNT
+#include <windows.h>
+#include "w32.h"
+#endif
+
+static int
+emacs_gnutls_handle_error (gnutls_session_t, int err);
+
+Lisp_Object Qgnutls_log_level;
 Lisp_Object Qgnutls_code;
 Lisp_Object Qgnutls_anon, Qgnutls_x509pki;
 Lisp_Object Qgnutls_e_interrupted, Qgnutls_e_again,
   Qgnutls_e_invalid_session, Qgnutls_e_not_ready_for_handshake;
-int global_initialized;
+int gnutls_global_initialized;
 
 /* The following are for the property list of `gnutls-boot'.  */
 Lisp_Object Qgnutls_bootprop_priority;
@@ -38,8 +47,27 @@
 Lisp_Object Qgnutls_bootprop_keyfiles;
 Lisp_Object Qgnutls_bootprop_callbacks;
 Lisp_Object Qgnutls_bootprop_loglevel;
-
-static void
+Lisp_Object Qgnutls_bootprop_hostname;
+Lisp_Object Qgnutls_bootprop_verify_flags;
+Lisp_Object Qgnutls_bootprop_verify_error;
+Lisp_Object Qgnutls_bootprop_verify_hostname_error;
+
+/* Callback keys for `gnutls-boot'.  Unused currently.  */
+Lisp_Object Qgnutls_bootprop_callbacks_verify;
+
+static void
+gnutls_log_function (int level, const char* string)
+{
+  message ("gnutls.c: [%d] %s", level, string);
+}
+
+static void
+gnutls_log_function2 (int level, const char* string, const char* extra)
+{
+  message ("gnutls.c: [%d] %s %s", level, string, extra);
+}
+
+static int
 emacs_gnutls_handshake (struct Lisp_Process *proc)
 {
   gnutls_session_t state = proc->gnutls_state;
@@ -50,24 +78,56 @@
 
   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 and 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)
     {
-      /* here we're finally done.  */
+      /* Here we're finally done.  */
       proc->gnutls_initstage = GNUTLS_STAGE_READY;
     }
+  else
+    {
+        gnutls_alert_send_appropriate (state, ret);
+    }
+  return ret;
 }
 
 int
@@ -98,7 +158,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 +185,68 @@
       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;
   }
 }
 
+/* report a GnuTLS error to the user.
+   Returns zero if the error code was successfully handled. */
+static int
+emacs_gnutls_handle_error (gnutls_session_t session, int err)
+{
+  Lisp_Object gnutls_log_level = Fsymbol_value (Qgnutls_log_level);
+  int max_log_level = 0;
+
+  int alert, ret;
+  const char *str;
+
+  /* TODO: use a Lisp_Object generated by gnutls_make_error?  */
+  if (err >= 0)
+    return 0;
+
+  if (NUMBERP (gnutls_log_level))
+    max_log_level = XINT (gnutls_log_level);
+
+  /* TODO: use gnutls-error-fatalp and gnutls-error-string.  */
+
+  str = gnutls_strerror (err);
+  if (str == NULL)
+    str = "unknown";
+
+  if (gnutls_error_is_fatal (err) == 0)
+    {
+      ret = 0;
+      GNUTLS_LOG2 (1, max_log_level, "non-fatal error:", str);
+      /* TODO: EAGAIN AKA Qgnutls_e_again should be level 2.  */
+    }
+  else
+    {
+      ret = err;
+      GNUTLS_LOG2 (0, max_log_level, "fatal error:", str);
+    }
+
+  if (err == GNUTLS_E_WARNING_ALERT_RECEIVED
+      || err == GNUTLS_E_FATAL_ALERT_RECEIVED)
+    {
+      int alert = gnutls_alert_get (session);
+      int level = err == GNUTLS_E_FATAL_ALERT_RECEIVED ? 0 : 1;
+      str = gnutls_alert_get_name (alert);
+      if (str == NULL)
+	str = "unknown";
+
+      GNUTLS_LOG2 (level, max_log_level, "Received 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
@@ -261,14 +374,14 @@
 Call `gnutls-global-deinit' when GnuTLS usage is no longer needed.
 Returns zero on success.  */
 static Lisp_Object
-gnutls_emacs_global_init (void)
+emacs_gnutls_global_init (void)
 {
   int ret = GNUTLS_E_SUCCESS;
 
-  if (!global_initialized)
+  if (!gnutls_global_initialized)
     ret = gnutls_global_init ();
 
-  global_initialized = 1;
+  gnutls_global_initialized = 1;
 
   return gnutls_make_error (ret);
 }
@@ -276,28 +389,16 @@
 /* Deinitializes global GnuTLS state.
 See also `gnutls-global-init'.  */
 static Lisp_Object
-gnutls_emacs_global_deinit (void)
+emacs_gnutls_global_deinit (void)
 {
-  if (global_initialized)
+  if (gnutls_global_initialized)
     gnutls_global_deinit ();
 
-  global_initialized = 0;
+  gnutls_global_initialized = 0;
 
   return gnutls_make_error (GNUTLS_E_SUCCESS);
 }
 
-static void
-gnutls_log_function (int level, const char* string)
-{
-  message ("gnutls.c: [%d] %s", level, string);
-}
-
-static void
-gnutls_log_function2 (int level, const char* string, const char* extra)
-{
-  message ("gnutls.c: [%d] %s %s", level, string, extra);
-}
-
 DEFUN ("gnutls-boot", Fgnutls_boot, Sgnutls_boot, 3, 3, 0,
        doc: /* Initialize GnuTLS client for process PROC with TYPE+PROPLIST.
 Currently only client mode is supported.  Returns a success/failure
@@ -306,12 +407,27 @@
 TYPE is a symbol, either `gnutls-anon' or `gnutls-x509pki'.
 PROPLIST is a property list with the following keys:
 
+:hostname is a string naming the remote host.
+
 :priority is a GnuTLS priority string, defaults to "NORMAL".
+
 :trustfiles is a list of PEM-encoded trust files for `gnutls-x509pki'.
+
 :keyfiles is a list of PEM-encoded key files for `gnutls-x509pki'.
-:callbacks is an alist of callback functions (TODO).
+
+:callbacks is an alist of callback functions, see below.
+
 :loglevel is the debug level requested from GnuTLS, try 4.
 
+:verify-flags is a bitset as per GnuTLS'
+gnutls_certificate_set_verify_flags.
+
+:verify-error, if non-nil, makes failure of the certificate validation
+an error.  Otherwise it will be just a series of warnings.
+
+:verify-hostname-error, if non-nil, makes a hostname mismatch an
+error.  Otherwise it will be just a warning.
+
 The debug level will be set for this process AND globally for GnuTLS.
 So if you set it higher or lower at any point, it affects global
 debugging.
@@ -324,6 +440,9 @@
 functions are used.  This function allocates resources which can only
 be deallocated by calling `gnutls-deinit' or by calling it again.
 
+The callbacks alist can have a `verify' key, associated with a
+verification function (UNUSED).
+
 Each authentication type may need additional information in order to
 work.  For X.509 PKI (`gnutls-x509pki'), you probably need at least
 one trustfile (usually a CA bundle).  */)
@@ -336,12 +455,19 @@
   /* TODO: GNUTLS_X509_FMT_DER is also an option.  */
   int file_format = GNUTLS_X509_FMT_PEM;
 
+  unsigned int gnutls_verify_flags = GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT;
+  gnutls_x509_crt_t gnutls_verify_cert;
+  unsigned int gnutls_verify_cert_list_size;
+  const gnutls_datum_t *gnutls_verify_cert_list;
+
   gnutls_session_t state;
   gnutls_certificate_credentials_t x509_cred;
   gnutls_anon_client_credentials_t anon_cred;
   Lisp_Object global_init;
   char* priority_string_ptr = "NORMAL"; /* default priority string.  */
   Lisp_Object tail;
+  int peer_verification;
+  char* c_hostname;
 
   /* Placeholders for the property list elements.  */
   Lisp_Object priority_string;
@@ -349,16 +475,29 @@
   Lisp_Object keyfiles;
   Lisp_Object callbacks;
   Lisp_Object loglevel;
+  Lisp_Object hostname;
+  Lisp_Object verify_flags;
+  Lisp_Object verify_error;
+  Lisp_Object verify_hostname_error;
 
   CHECK_PROCESS (proc);
   CHECK_SYMBOL (type);
   CHECK_LIST (proplist);
 
-  priority_string = Fplist_get (proplist, Qgnutls_bootprop_priority);
-  trustfiles      = Fplist_get (proplist, Qgnutls_bootprop_trustfiles);
-  keyfiles        = Fplist_get (proplist, Qgnutls_bootprop_keyfiles);
-  callbacks       = Fplist_get (proplist, Qgnutls_bootprop_callbacks);
-  loglevel        = Fplist_get (proplist, Qgnutls_bootprop_loglevel);
+  hostname              = Fplist_get (proplist, Qgnutls_bootprop_hostname);
+  priority_string       = Fplist_get (proplist, Qgnutls_bootprop_priority);
+  trustfiles            = Fplist_get (proplist, Qgnutls_bootprop_trustfiles);
+  keyfiles              = Fplist_get (proplist, Qgnutls_bootprop_keyfiles);
+  callbacks             = Fplist_get (proplist, Qgnutls_bootprop_callbacks);
+  loglevel              = Fplist_get (proplist, Qgnutls_bootprop_loglevel);
+  verify_flags          = Fplist_get (proplist, Qgnutls_bootprop_verify_flags);
+  verify_error          = Fplist_get (proplist, Qgnutls_bootprop_verify_error);
+  verify_hostname_error = Fplist_get (proplist, Qgnutls_bootprop_verify_hostname_error);
+
+  if (!STRINGP (hostname))
+    error ("gnutls-boot: invalid :hostname parameter");
+
+  c_hostname = SSDATA (hostname);
 
   state = XPROCESS (proc)->gnutls_state;
   XPROCESS (proc)->gnutls_p = 1;
@@ -372,7 +511,7 @@
     }
 
   /* always initialize globals.  */
-  global_init = gnutls_emacs_global_init ();
+  global_init = emacs_gnutls_global_init ();
   if (! NILP (Fgnutls_errorp (global_init)))
     return global_init;
 
@@ -416,6 +555,23 @@
       x509_cred = XPROCESS (proc)->gnutls_x509_cred;
       if (gnutls_certificate_allocate_credentials (&x509_cred) < 0)
         memory_full ();
+
+      if (NUMBERP (verify_flags))
+        {
+          gnutls_verify_flags = XINT (verify_flags);
+          GNUTLS_LOG (2, max_log_level, "setting verification flags");
+        }
+      else if (NILP (verify_flags))
+        {
+          /* The default is already GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT.  */
+          GNUTLS_LOG (2, max_log_level, "using default verification flags");
+        }
+      else
+        {
+          /* The default is already GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT.  */
+          GNUTLS_LOG (2, max_log_level, "ignoring invalid verify-flags");
+        }
+      gnutls_certificate_set_verify_flags (x509_cred, gnutls_verify_flags);
     }
   else if (EQ (type, Qgnutls_anon))
     {
@@ -484,6 +640,14 @@
 
   GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_FILES;
 
+  GNUTLS_LOG (1, max_log_level, "gnutls callbacks");
+
+  GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CALLBACKS;
+
+#ifdef HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY
+#else
+#endif
+
   GNUTLS_LOG (1, max_log_level, "gnutls_init");
 
   ret = gnutls_init (&state, GNUTLS_CLIENT);
@@ -541,9 +705,113 @@
 
   GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CRED_SET;
 
-  emacs_gnutls_handshake (XPROCESS (proc));
-
-  return gnutls_make_error (GNUTLS_E_SUCCESS);
+  ret = emacs_gnutls_handshake (XPROCESS (proc));
+
+  if (ret < GNUTLS_E_SUCCESS)
+    return gnutls_make_error (ret);
+
+  /* Now verify the peer, following
+     http://www.gnu.org/software/gnutls/manual/html_node/Verifying-peer_0027s-certificate.html.
+     The peer should present at least one certificate in the chain; do a
+     check of the certificate's hostname with
+     gnutls_x509_crt_check_hostname() against :hostname.  */
+
+  ret = gnutls_certificate_verify_peers2 (state, &peer_verification);
+
+  if (ret < GNUTLS_E_SUCCESS)
+    return gnutls_make_error (ret);
+  
+  if (XINT (loglevel) > 0 && peer_verification & GNUTLS_CERT_INVALID)
+    message ("%s certificate could not be verified.", 
+             c_hostname);
+ 
+ if (peer_verification & GNUTLS_CERT_REVOKED)
+   GNUTLS_LOG2 (1, max_log_level, "certificate was revoked (CRL):",
+                c_hostname);
+ 
+ if (peer_verification & GNUTLS_CERT_SIGNER_NOT_FOUND)
+   GNUTLS_LOG2 (1, max_log_level, "certificate signer was not found:",
+                c_hostname);
+ 
+ if (peer_verification & GNUTLS_CERT_SIGNER_NOT_CA)
+   GNUTLS_LOG2 (1, max_log_level, "certificate signer is not a CA:",
+                c_hostname);
+
+ if (peer_verification & GNUTLS_CERT_INSECURE_ALGORITHM)
+   GNUTLS_LOG2 (1, max_log_level,
+                "certificate was signed with an insecure algorithm:",
+                c_hostname);
+
+ if (peer_verification & GNUTLS_CERT_NOT_ACTIVATED)
+   GNUTLS_LOG2 (1, max_log_level, "certificate is not yet activated:",
+                c_hostname);
+
+ if (peer_verification & GNUTLS_CERT_EXPIRED)
+   GNUTLS_LOG2 (1, max_log_level, "certificate has expired:",
+                c_hostname);
+
+ if (peer_verification != 0)
+   {
+     if (NILP (verify_hostname_error))
+       {
+         GNUTLS_LOG2 (1, max_log_level, "certificate validation failed:",
+                      c_hostname);
+       }
+     else
+       {
+         error ("Certificate validation failed %s, verification code %d",
+                c_hostname, peer_verification);
+       }
+   }
+
+  /* Up to here the process is the same for X.509 certificates and
+     OpenPGP keys.  From now on X.509 certificates are assumed.  This
+     can be easily extended to work with openpgp keys as well.  */
+  if (gnutls_certificate_type_get (state) == GNUTLS_CRT_X509)
+    {
+      ret = gnutls_x509_crt_init (&gnutls_verify_cert);
+
+      if (ret < GNUTLS_E_SUCCESS)
+        return gnutls_make_error (ret);
+
+      gnutls_verify_cert_list = 
+        gnutls_certificate_get_peers (state, &gnutls_verify_cert_list_size);
+
+      if (NULL == gnutls_verify_cert_list)
+        {
+          error ("No x509 certificate was found!\n");
+        }
+
+      /* We only check the first certificate in the given chain.  */
+      ret = gnutls_x509_crt_import (gnutls_verify_cert,
+                                    &gnutls_verify_cert_list[0],
+                                    GNUTLS_X509_FMT_DER);
+
+      if (ret < GNUTLS_E_SUCCESS)
+        {
+          gnutls_x509_crt_deinit (gnutls_verify_cert);
+          return gnutls_make_error (ret);
+        }
+
+      if (!gnutls_x509_crt_check_hostname (gnutls_verify_cert, c_hostname))
+        {
+          if (NILP (verify_hostname_error))
+            {
+              GNUTLS_LOG2 (1, max_log_level, "x509 certificate does not match:",
+                           c_hostname);
+            }
+          else
+            {
+              gnutls_x509_crt_deinit (gnutls_verify_cert);
+              error ("The x509 certificate does not match \"%s\"",
+                     c_hostname);
+            }
+        }
+
+      gnutls_x509_crt_deinit (gnutls_verify_cert);
+    }
+
+  return gnutls_make_error (ret);
 }
 
 DEFUN ("gnutls-bye", Fgnutls_bye,
@@ -578,7 +846,10 @@
 void
 syms_of_gnutls (void)
 {
-  global_initialized = 0;
+  gnutls_global_initialized = 0;
+
+  Qgnutls_log_level = intern_c_string ("gnutls-log-level");
+  staticpro (&Qgnutls_log_level);
 
   Qgnutls_code = intern_c_string ("gnutls-code");
   staticpro (&Qgnutls_code);
@@ -589,6 +860,9 @@
   Qgnutls_x509pki = intern_c_string ("gnutls-x509pki");
   staticpro (&Qgnutls_x509pki);
 
+  Qgnutls_bootprop_hostname = intern_c_string (":hostname");
+  staticpro (&Qgnutls_bootprop_hostname);
+
   Qgnutls_bootprop_priority = intern_c_string (":priority");
   staticpro (&Qgnutls_bootprop_priority);
 
@@ -601,9 +875,21 @@
   Qgnutls_bootprop_callbacks = intern_c_string (":callbacks");
   staticpro (&Qgnutls_bootprop_callbacks);
 
+  Qgnutls_bootprop_callbacks_verify = intern_c_string ("verify");
+  staticpro (&Qgnutls_bootprop_callbacks_verify);
+
   Qgnutls_bootprop_loglevel = intern_c_string (":loglevel");
   staticpro (&Qgnutls_bootprop_loglevel);
 
+  Qgnutls_bootprop_verify_flags = intern_c_string (":verify-flags");
+  staticpro (&Qgnutls_bootprop_verify_flags);
+
+  Qgnutls_bootprop_verify_hostname_error = intern_c_string (":verify-error");
+  staticpro (&Qgnutls_bootprop_verify_error);
+
+  Qgnutls_bootprop_verify_hostname_error = intern_c_string (":verify-hostname-error");
+  staticpro (&Qgnutls_bootprop_verify_hostname_error);
+
   Qgnutls_e_interrupted = intern_c_string ("gnutls-e-interrupted");
   staticpro (&Qgnutls_e_interrupted);
   Fput (Qgnutls_e_interrupted, Qgnutls_code,

=== modified file 'src/gnutls.h'
--- src/gnutls.h	2011-01-25 04:08:28 +0000
+++ src/gnutls.h	2011-03-24 19:22:03 +0000
@@ -21,6 +21,7 @@
 
 #ifdef HAVE_GNUTLS
 #include <gnutls/gnutls.h>
+#include <gnutls/x509.h>
 
 typedef enum
 {
@@ -28,6 +29,7 @@
   GNUTLS_STAGE_EMPTY = 0,
   GNUTLS_STAGE_CRED_ALLOC,
   GNUTLS_STAGE_FILES,
+  GNUTLS_STAGE_CALLBACKS,
   GNUTLS_STAGE_INIT,
   GNUTLS_STAGE_PRIORITY,
   GNUTLS_STAGE_CRED_SET,

=== modified file 'src/makefile.w32-in'
--- src/makefile.w32-in	2011-03-19 03:22:14 +0000
+++ src/makefile.w32-in	2011-03-23 15:37:05 +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)
 
 #
@@ -948,6 +950,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-03-17 05:18:33 +0000
+++ src/process.c	2011-03-24 18:53:32 +0000
@@ -4780,6 +4780,19 @@
              &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;

=== modified file 'src/w32.c'
--- src/w32.c	2011-03-14 17:07:53 +0000
+++ src/w32.c	2011-03-24 18:53:21 +0000
@@ -6084,5 +6084,75 @@
   p->childp = childp2;
 }
 
+#ifdef HAVE_GNUTLS
+
+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 = sys_read(fd, (char*)buf, sz);
+
+      if (n >= 0)
+        return n;
+      else
+        {
+          int err = errno;
+
+          if (err == EWOULDBLOCK)
+            {
+              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 || errno == EWOULDBLOCK)
+                /* We have to translate WSAEWOULDBLOCK alias
+		   EWOULDBLOCK to EAGAIN for GnuTLS.  */
+                err = EAGAIN;
+              else
+                err = errno;
+            }
+          gnutls_transport_set_errno (proc->gnutls_state, err);
+
+          return -1;
+        }
+    }
+}
+
+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 = sys_write((int)fd, buf, sz);
+
+  if (n >= 0)
+    return n;
+  else
+    {
+      gnutls_transport_set_errno (proc->gnutls_state,
+                                  /* Translate WSAEWOULDBLOCK alias
+                                     EWOULDBLOCK to EAGAIN for
+                                     GnuTLS.  */
+                                  errno == EWOULDBLOCK
+                                  ? EAGAIN
+                                  : errno);
+
+      return -1;
+    }
+}
+#endif /* HAVE_GNUTLS */
+
 /* end of w32.c */
 

=== modified file 'src/w32.h'
--- src/w32.h	2011-01-25 04:08:28 +0000
+++ src/w32.h	2011-03-24 18:53:11 +0000
@@ -143,5 +143,14 @@
 extern int _sys_read_ahead (int fd);
 extern int _sys_wait_accept (int fd);
 
+#ifdef HAVE_GNUTLS
+#include <gnutls/gnutls.h>
+
+extern ssize_t emacs_gnutls_pull (gnutls_transport_ptr_t p,
+                                  void* buf, size_t sz);
+extern ssize_t emacs_gnutls_push (gnutls_transport_ptr_t p,
+                                  const void* buf, size_t sz);
+#endif /* HAVE_GNUTLS */
+
 #endif /* EMACS_W32_H */
 

Re: [PATCH] GnuTLS support on Woe32

[Robert Pluim]

Ted Zlatanov <tzz@lifelogs.com> writes:

> On Wed, 23 Mar 2011 21:57:56 +0100 claudio.bley@gmail.com (Claudio Bley) wrote: 
>
> CB> I requested the papers, but I'm still waiting for receipt. So, this
> CB> will probably take some time...
>
> Thanks.  Meanwhile could you please look at this revision of the patch?
>

I've been getting uninterruptible hangs from Gnus with the previous
version of this patch, which I don't remember getting when using
external gnutls-cli processes.  Is there something I can look at to
figure out why this is happening (I can run emacs under gdb if needed)?

I can also update to this latest version of the patch if you think that
will make a difference.

Thanks

Robert

Re: [PATCH] GnuTLS support on Woe32

[Ted Zlatanov]

On Thu, 24 Mar 2011 21:07:04 +0100 Robert Pluim <rpluim@gmail.com> wrote: 

RP> I've been getting uninterruptible hangs from Gnus with the previous
RP> version of this patch, which I don't remember getting when using
RP> external gnutls-cli processes.  Is there something I can look at to
RP> figure out why this is happening (I can run emacs under gdb if needed)?

I'm surprised about the uninterruptible part.  I use it daily.  Can you
try following the steps in (info "(emacs) Checklist") to generate a
backtrace of the hang?

You can use an Emacs bug report against the patch, just change the To
address so it goes to me directly.

RP> I can also update to this latest version of the patch if you think that
RP> will make a difference.

It may, for the better logging.  The older (2011-03-23 and prior)
versions printed a lot of EAGAIN messages.

Ted

Re: [PATCH] GnuTLS support on Woe32

[Robert Pluim]

Ted Zlatanov <tzz@lifelogs.com> writes:

> On Thu, 24 Mar 2011 21:07:04 +0100 Robert Pluim <rpluim@gmail.com> wrote: 
>
> RP> I've been getting uninterruptible hangs from Gnus with the previous
> RP> version of this patch, which I don't remember getting when using
> RP> external gnutls-cli processes.  Is there something I can look at to
> RP> figure out why this is happening (I can run emacs under gdb if needed)?
>
> I'm surprised about the uninterruptible part.  I use it daily.  Can you
> try following the steps in (info "(emacs) Checklist") to generate a
> backtrace of the hang?

Well, I've been running it for a day, and of course it hasn't hung
once.  I may have to start messing with my network connection :)

Robert

Re: [PATCH] GnuTLS support on Woe32

[Ted Zlatanov]

On Fri, 25 Mar 2011 14:46:35 +0100 Robert Pluim <rpluim@gmail.com> wrote: 

RP> Ted Zlatanov <tzz@lifelogs.com> writes:
>> On Thu, 24 Mar 2011 21:07:04 +0100 Robert Pluim <rpluim@gmail.com> wrote: 
>> 
RP> I've been getting uninterruptible hangs from Gnus with the previous
RP> version of this patch, which I don't remember getting when using
RP> external gnutls-cli processes.  Is there something I can look at to
RP> figure out why this is happening (I can run emacs under gdb if needed)?
>> 
>> I'm surprised about the uninterruptible part.  I use it daily.  Can you
>> try following the steps in (info "(emacs) Checklist") to generate a
>> backtrace of the hang?

RP> Well, I've been running it for a day, and of course it hasn't hung
RP> once.  I may have to start messing with my network connection :)

There's a possibly related issue (noted by Joakim in
http://permalink.gmane.org/gmane.emacs.devel/137268) about Emacs hangs
when network interfaces change.  It may be that GnuTLS is a red herring
and in fact you're seeing that underlying problem.

Ted

Re: GNU coding standard highlighting rules

[Stefan Monnier]

> I would love to see highlighting rules for C and ELisp that at least
> catch the comment problems: starting with lowercase and a period without
> two spaces, etc.  I don't know the Emacs highlighting at all so I can't
> write these myself, plus I would probably miss many of the rules through
> inexperience.

That would be good, indeed.


        Stefan

Re: GNU coding standard highlighting rules

[Ted Zlatanov]

On Sun, 27 Mar 2011 17:47:40 -0400 Stefan Monnier <monnier@iro.umontreal.ca> wrote: 

>> I would love to see highlighting rules for C and ELisp that at least
>> catch the comment problems: starting with lowercase and a period without
>> two spaces, etc.  I don't know the Emacs highlighting at all so I can't
>> write these myself, plus I would probably miss many of the rules through
>> inexperience.

SM> That would be good, indeed.

I looked through www.gnu.org/prep/standards/ and here are my suggestions
for such a helper mode, by section.  Some will require actual C parsing,
of course.

2.1: highlight "Unix" in any case

2.3: highlight "trade\s*mark" and "(tm)".  Also perhaps the common funny
misspellings of "Windows" like "Winblows" and "Windoze"

3.2 and 3.3: highlight non-POSIX language use and compiler extension use?

3.4: highlight incorrect C function definitions (with special code for
ELisp functions maybe?)

3.5: highlight #ifdef constructs

4.2: `system', `malloc', `realloc' return code should be captured.  USC
`signal' calls should be caught.  Check the exit code is not typecast
from a larger value.  Highlight "/tmp" anywhere in code.

4.7: highlight usage of argv and argc (`getopt' is suggested)

5.1, 5.2, 5.3: almost everything applies I think, plus for 5.2 we can
add the rules about ending sentences with a period and two spaces and
starting with an uppercase character.

5.4: highlight CamelCase functions and variables

5.9, 5.10: highlight non-ASCII text

Re: [PATCH] GnuTLS support on Woe32

[Ted Zlatanov]

[-- Attachment #1: Type: text/plain, Size: 1841 bytes --]

On Thu, 24 Mar 2011 14:27:55 -0500 Ted Zlatanov <tzz@lifelogs.com> wrote: 

TZ> On Wed, 23 Mar 2011 21:57:56 +0100 claudio.bley@gmail.com (Claudio Bley) wrote: 
CB> I requested the papers, but I'm still waiting for receipt. So, this
CB> will probably take some time...

Any news?  If you still don't have the papers I will separate our work
so I don't have to keep rebasing the patch.

TZ> Here are the new changes I made to your code and some proposals.  I can
TZ> do the TODO items I list below but wanted your opinion first.

TZ> - use GNUTLS_LOG2 macro to report warnings so users get less noise
TZ>   (done, please review)

TZ> - use `gnutls-log-level' in emacs_gnutls_handle_error (done)

TZ> - emacs_gnutls_handle_error should IMO use gnutls_make_error(err) and
TZ>   not err directly.  That way the return value can be directly compared
TZ>   to a symbol for GNUTLS_E_AGAIN for instance (where it will be
TZ>   Qgnutls_e_again) and you can print it nicely in messages.  This is how
TZ>   I did the error handling originally but if you have reasons why it's
TZ>   better to do it the other way, please tell me.  I think the
TZ>   performance, at least, won't suffer much my way.  (TODO)

TZ> - if you go along with the above, we should use Fgnutls_error_fatalp and
TZ>   Fgnutls_error_string instead of gnutls_error_is_fatal and
TZ>   gnutls_strerror directly.  I think it will make the code cleaner. (TODO)

TZ> - "Resource unavailable, try again" should be a level 2 error, right now
TZ>   it's level 1 as non-fatal.  If you go along with the above we just
TZ>   need to compare the Lisp_Object error to Qgnutls_e_again (TODO)

In addition this latest GnuTLS patch revision (2011-04-04) changes
lisp/net/network-stream.el to use the correct `gnutls-negotiate'
prototype.  It appears to work correctly after the lexbind merge.

Ted


[-- Attachment #2: updated 2011-04-04 --]
[-- Type: text/x-diff, Size: 40477 bytes --]

=== modified file 'configure.in'
--- configure.in	2011-03-31 04:24:03 +0000
+++ configure.in	2011-04-04 01:11:54 +0000
@@ -1969,12 +1969,22 @@
 AC_SUBST(LIBSELINUX_LIBS)
 
 HAVE_GNUTLS=no
+HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY=no
 if test "${with_gnutls}" = "yes" ; then
   PKG_CHECK_MODULES([LIBGNUTLS], [gnutls >= 2.2.4], HAVE_GNUTLS=yes, HAVE_GNUTLS=no)
   if test "${HAVE_GNUTLS}" = "yes"; then
     AC_DEFINE(HAVE_GNUTLS, 1, [Define if using GnuTLS.])
   fi
+
+  CFLAGS="$CFLAGS $LIBGNUTLS_CFLAGS"
+  LIBS="$LIBGNUTLS_LIBS $LIBS"
+  AC_CHECK_FUNCS(gnutls_certificate_set_verify_function, HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY=yes)
+
+  if test "${HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY}" = "yes"; then
+    AC_DEFINE(HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY, 1, [Define if using GnuTLS certificate verification callbacks.])
+  fi
 fi
+
 AC_SUBST(LIBGNUTLS_LIBS)
 AC_SUBST(LIBGNUTLS_CFLAGS)
 
@@ -3658,6 +3668,7 @@
 echo "  Does Emacs use -lgconf?                                 ${HAVE_GCONF}"
 echo "  Does Emacs use -lselinux?                               ${HAVE_LIBSELINUX}"
 echo "  Does Emacs use -lgnutls?                                ${HAVE_GNUTLS}"
+echo "  Does Emacs use -lgnutls certificate verify callbacks?   ${HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY}"
 echo "  Does Emacs use -lxml2?                                  ${HAVE_LIBXML2}"
 
 echo "  Does Emacs use -lfreetype?                              ${HAVE_FREETYPE}"

=== modified file 'lib-src/ChangeLog'
--- lib-src/ChangeLog	2011-03-30 00:39:12 +0000
+++ lib-src/ChangeLog	2011-04-04 09:33:03 +0000
@@ -1,3 +1,7 @@
+2011-04-04  Claudio Bley  <claudio.bley@gmail.com>
+
+	* makefile.w32-in (obj): Added gnutls.o.
+
 2011-03-30  Paul Eggert  <eggert@cs.ucla.edu>
 
 	Fix a problem found by GCC 4.6.0's static checks.

=== modified file 'lib-src/makefile.w32-in'
--- lib-src/makefile.w32-in	2011-03-12 19:19:47 +0000
+++ lib-src/makefile.w32-in	2011-04-04 01:11:54 +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-04-03 21:23:23 +0000
+++ lisp/ChangeLog	2011-04-04 09:32:20 +0000
@@ -1,3 +1,19 @@
+2011-04-04  Teodor Zlatanov  <tzz@lifelogs.com>
+
+	* net/gnutls.el (gnutls-negotiate): Add hostname, verify-flags,
+	verify-error, and verify-hostname-error parameters.
+	(open-gnutls-stream): Add usage example.
+
+	* net/network-stream.el (network-stream-open-starttls): Give host
+	parameter to `gnutls-negotiate'.
+	(gnutls-negotiate): Adjust `gnutls-negotiate' declaration.
+
+2011-04-04  Claudio Bley  <claudio.bley@gmail.com>
+
+	* 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-04-03  Chong Yidong  <cyd@stupidchicken.com>
 
 	* dired-aux.el (dired-create-files): Add docstring (Bug#7970).

=== modified file 'lisp/dired.el'
--- lisp/dired.el	2011-03-21 16:42:16 +0000
+++ lisp/dired.el	2011-04-04 01:17:29 +0000
@@ -3629,7 +3629,7 @@
 ;;;;;;  dired-run-shell-command dired-do-shell-command dired-do-async-shell-command
 ;;;;;;  dired-clean-directory dired-do-print dired-do-touch dired-do-chown
 ;;;;;;  dired-do-chgrp dired-do-chmod dired-compare-directories dired-backup-diff
-;;;;;;  dired-diff) "dired-aux" "dired-aux.el" "2d805d6766bd7970cd446413b4ed4ce0")
+;;;;;;  dired-diff) "dired-aux" "dired-aux.el" "0488aa71a7abdb8dcc9ce90201114ebc")
 ;;; Generated autoloads from dired-aux.el
 
 (autoload 'dired-diff "dired-aux" "\
@@ -3766,7 +3766,7 @@
 \(fn COMMAND &optional ARG FILE-LIST)" t nil)
 
 (autoload 'dired-run-shell-command "dired-aux" "\
-Not documented
+
 
 \(fn COMMAND)" nil nil)
 
@@ -3785,7 +3785,7 @@
 \(fn &optional ARG FMT)" t nil)
 
 (autoload 'dired-compress-file "dired-aux" "\
-Not documented
+
 
 \(fn FILE)" nil nil)
 
@@ -3834,12 +3834,12 @@
 \(fn &optional ARG TEST-FOR-SUBDIR)" t nil)
 
 (autoload 'dired-add-file "dired-aux" "\
-Not documented
+
 
 \(fn FILENAME &optional MARKER-CHAR)" nil nil)
 
 (autoload 'dired-remove-file "dired-aux" "\
-Not documented
+
 
 \(fn FILE)" nil nil)
 
@@ -3849,12 +3849,12 @@
 \(fn FILE)" nil nil)
 
 (autoload 'dired-copy-file "dired-aux" "\
-Not documented
+
 
 \(fn FROM TO OK-FLAG)" nil nil)
 
 (autoload 'dired-rename-file "dired-aux" "\
-Not documented
+
 
 \(fn FILE NEWNAME OK-IF-ALREADY-EXISTS)" nil nil)
 

=== modified file 'lisp/net/gnutls.el'
--- lisp/net/gnutls.el	2011-01-25 04:08:28 +0000
+++ lisp/net/gnutls.el	2011-04-04 01:11:54 +0000
@@ -25,7 +25,8 @@
 ;;; Commentary:
 
 ;; This package provides language bindings for the GnuTLS library
-;; using the corresponding core functions in gnutls.c.
+;; using the corresponding core functions in gnutls.c.  It should NOT
+;; be used directly, only through open-protocol-stream.
 
 ;; Simple test:
 ;;
@@ -59,26 +60,76 @@
 Fourth arg SERVICE is name of the service desired, or an integer
 specifying a port number to connect to.
 
+Usage example:
+
+  \(with-temp-buffer
+    \(open-gnutls-stream \"tls\"
+                        \(current-buffer)
+                        \"your server goes here\"
+                        \"imaps\"))
+
 This is a very simple wrapper around `gnutls-negotiate'.  See its
 documentation for the specific parameters you can use to open a
 GnuTLS connection, including specifying the credential type,
 trust and key files, and priority string."
-  (let ((proc (open-network-stream name buffer host service)))
-    (gnutls-negotiate proc 'gnutls-x509pki)))
+  (gnutls-negotiate (open-network-stream name buffer host service)
+                    'gnutls-x509pki
+                    host))
+
+(put 'gnutls-error
+     'error-conditions
+     '(error gnutls-error))
+(put 'gnutls-error
+     'error-message "GnuTLS error")
 
 (declare-function gnutls-boot "gnutls.c" (proc type proplist))
 
-(defun gnutls-negotiate (proc type &optional priority-string
-                              trustfiles keyfiles)
-  "Negotiate a SSL/TLS connection.
+(defun gnutls-negotiate (proc type hostname &optional priority-string
+                              trustfiles keyfiles verify-flags
+                              verify-error verify-hostname-error)
+  "Negotiate a SSL/TLS connection.  Returns proc. Signals gnutls-error.
 TYPE is `gnutls-x509pki' (default) or `gnutls-anon'.  Use nil for the default.
 PROC is a process returned by `open-network-stream'.
+HOSTNAME is the remote hostname.  It must be a valid string.
 PRIORITY-STRING is as per the GnuTLS docs, default is \"NORMAL\".
 TRUSTFILES is a list of CA bundles.
-KEYFILES is a list of client keys."
+KEYFILES is a list of client keys.
+
+When VERIFY-HOSTNAME-ERROR is not nil, an error will be raised
+when the hostname does not match the presented certificate's host
+name.  The exact verification algorithm is a basic implementation
+of the matching described in RFC2818 (HTTPS), which takes into
+account wildcards, and the DNSName/IPAddress subject alternative
+name PKIX extension.  See GnuTLS' gnutls_x509_crt_check_hostname
+for details.  When VERIFY-HOSTNAME-ERROR is nil, only a warning
+will be issued.
+
+When VERIFY-ERROR is not nil, an error will be raised when the
+peer certificate verification fails as per GnuTLS'
+gnutls_certificate_verify_peers2.  Otherwise, only warnings will
+be shown about the verification failure.
+
+VERIFY-FLAGS is a numeric OR of verification flags only for
+`gnutls-x509pki' connections.  See GnuTLS' x509.h for details;
+here's a recent version of the list.
+
+    GNUTLS_VERIFY_DISABLE_CA_SIGN = 1,
+    GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT = 2,
+    GNUTLS_VERIFY_DO_NOT_ALLOW_SAME = 4,
+    GNUTLS_VERIFY_ALLOW_ANY_X509_V1_CA_CRT = 8,
+    GNUTLS_VERIFY_ALLOW_SIGN_RSA_MD2 = 16,
+    GNUTLS_VERIFY_ALLOW_SIGN_RSA_MD5 = 32,
+    GNUTLS_VERIFY_DISABLE_TIME_CHECKS = 64,
+    GNUTLS_VERIFY_DISABLE_TRUSTED_TIME_CHECKS = 128,
+    GNUTLS_VERIFY_DO_NOT_ALLOW_X509_V1_CA_CRT = 256
+
+It must be omitted, a number, or nil; if omitted or nil it
+defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT."
   (let* ((type (or type 'gnutls-x509pki))
+         (default-trustfile "/etc/ssl/certs/ca-certificates.crt")
          (trustfiles (or trustfiles
-                        '("/etc/ssl/certs/ca-certificates.crt")))
+                         (when (file-exists-p default-trustfile)
+                           (list default-trustfile))))
          (priority-string (or priority-string
                               (cond
                                ((eq type 'gnutls-anon)
@@ -86,15 +137,22 @@
                                ((eq type 'gnutls-x509pki)
                                 "NORMAL"))))
          (params `(:priority ,priority-string
+                             :hostname ,hostname
                              :loglevel ,gnutls-log-level
                              :trustfiles ,trustfiles
                              :keyfiles ,keyfiles
+                             :verify-flags ,verify-flags
+                             :verify-error ,verify-error
+                             :verify-hostname-error ,verify-hostname-error
                              :callbacks nil))
          ret)
 
     (gnutls-message-maybe
      (setq ret (gnutls-boot proc type params))
-     "boot: %s")
+     "boot: %s" params)
+
+    (when (gnutls-errorp ret)
+      (signal 'gnutls-error (list proc ret)))
 
     proc))
 

=== modified file 'lisp/net/network-stream.el'
--- lisp/net/network-stream.el	2011-04-02 23:41:03 +0000
+++ lisp/net/network-stream.el	2011-04-04 09:28:04 +0000
@@ -46,7 +46,8 @@
 (require 'starttls)
 
 (declare-function gnutls-negotiate "gnutls"
-		  (proc type &optional priority-string trustfiles keyfiles))
+                  (proc type host &optional priority-string trustfiles keyfiles
+                        verify-flags verify-error verify-hostname-error))
 
 ;;;###autoload
 (defun open-network-stream (name buffer host service &rest parameters)
@@ -195,7 +196,7 @@
 			  (network-stream-command stream starttls-command eoc))
 	;; The server said it was OK to begin STARTTLS negotiations.
 	(if (fboundp 'open-gnutls-stream)
-	    (gnutls-negotiate stream nil)
+	    (gnutls-negotiate stream nil host)
 	  (unless (starttls-negotiate stream)
 	    (delete-process stream)))
 	(if (memq (process-status stream) '(open run))

=== modified file 'nt/ChangeLog'
--- nt/ChangeLog	2011-03-27 02:27:11 +0000
+++ nt/ChangeLog	2011-04-04 01:11:54 +0000
@@ -1,3 +1,10 @@
+2011-03-28  Claudio Bley  <claudio.bley@gmail.com>
+
+	* 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-03-27  Glenn Morris  <rgm@gnu.org>
 
 	* config.nt: Remove RETSIGTYPE, SIGTYPE (identical to void).

=== modified file 'nt/INSTALL'
--- nt/INSTALL	2011-01-26 08:36:39 +0000
+++ nt/INSTALL	2011-04-04 01:11:54 +0000
@@ -306,6 +306,16 @@
   `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.
+
+  Pre-built binaries and an installer can be found at
+  http://josefsson.org/gnutls4win/.
+
 * 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-04-04 01:11:54 +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
@@ -204,6 +211,14 @@
 shift
 goto again
 
+:userlibs
+shift
+echo. userlibs: %userlibs%
+set userlibs=%userlibs%%sep4%%1
+set sep4= %nothing%
+shift
+goto again
+
 rem ----------------------------------------------------------------------
 
 :userldflags
@@ -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-04-04 01:11:54 +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-04-03 08:30:57 +0000
+++ src/ChangeLog	2011-04-04 09:32:33 +0000
@@ -1,3 +1,36 @@
+2011-04-04  Teodor Zlatanov  <tzz@lifelogs.com>
+
+	* gnutls.c: Renamed global_initialized to
+	gnutls_global_initialized.  Added internals for the
+	:verify-hostname-error, :verify-error, and :verify-flags
+	parameters of `gnutls-boot' and documented those parameters in the
+	docstring.  Start callback support.
+
+2011-04-04  Claudio Bley  <claudio.bley@gmail.com>
+
+	* w32.h: (emacs_gnutls_pull): Add prototype.
+	(emacs_gnutls_push): Likewise.
+
+	* w32.c: (emacs_gnutls_pull): New function for GnuTLS on Woe32.
+	(emacs_gnutls_push): Likewise.
+
+	* 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_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-04-03  Jan Djärv  <jan.h.d@swipnet.se>
 
 	* nsterm.m (ns_update_auto_hide_menu_bar): Define MAC_OS_X_VERSION_10_6

=== modified file 'src/gnutls.c'
--- src/gnutls.c	2011-01-25 04:08:28 +0000
+++ src/gnutls.c	2011-04-04 01:11:54 +0000
@@ -26,11 +26,20 @@
 #ifdef HAVE_GNUTLS
 #include <gnutls/gnutls.h>
 
+#ifdef WINDOWSNT
+#include <windows.h>
+#include "w32.h"
+#endif
+
+static int
+emacs_gnutls_handle_error (gnutls_session_t, int err);
+
+Lisp_Object Qgnutls_log_level;
 Lisp_Object Qgnutls_code;
 Lisp_Object Qgnutls_anon, Qgnutls_x509pki;
 Lisp_Object Qgnutls_e_interrupted, Qgnutls_e_again,
   Qgnutls_e_invalid_session, Qgnutls_e_not_ready_for_handshake;
-int global_initialized;
+int gnutls_global_initialized;
 
 /* The following are for the property list of `gnutls-boot'.  */
 Lisp_Object Qgnutls_bootprop_priority;
@@ -38,8 +47,27 @@
 Lisp_Object Qgnutls_bootprop_keyfiles;
 Lisp_Object Qgnutls_bootprop_callbacks;
 Lisp_Object Qgnutls_bootprop_loglevel;
-
-static void
+Lisp_Object Qgnutls_bootprop_hostname;
+Lisp_Object Qgnutls_bootprop_verify_flags;
+Lisp_Object Qgnutls_bootprop_verify_error;
+Lisp_Object Qgnutls_bootprop_verify_hostname_error;
+
+/* Callback keys for `gnutls-boot'.  Unused currently.  */
+Lisp_Object Qgnutls_bootprop_callbacks_verify;
+
+static void
+gnutls_log_function (int level, const char* string)
+{
+  message ("gnutls.c: [%d] %s", level, string);
+}
+
+static void
+gnutls_log_function2 (int level, const char* string, const char* extra)
+{
+  message ("gnutls.c: [%d] %s %s", level, string, extra);
+}
+
+static int
 emacs_gnutls_handshake (struct Lisp_Process *proc)
 {
   gnutls_session_t state = proc->gnutls_state;
@@ -50,24 +78,56 @@
 
   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 and 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)
     {
-      /* here we're finally done.  */
+      /* Here we're finally done.  */
       proc->gnutls_initstage = GNUTLS_STAGE_READY;
     }
+  else
+    {
+        gnutls_alert_send_appropriate (state, ret);
+    }
+  return ret;
 }
 
 int
@@ -98,7 +158,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 +185,68 @@
       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;
   }
 }
 
+/* report a GnuTLS error to the user.
+   Returns zero if the error code was successfully handled. */
+static int
+emacs_gnutls_handle_error (gnutls_session_t session, int err)
+{
+  Lisp_Object gnutls_log_level = Fsymbol_value (Qgnutls_log_level);
+  int max_log_level = 0;
+
+  int alert, ret;
+  const char *str;
+
+  /* TODO: use a Lisp_Object generated by gnutls_make_error?  */
+  if (err >= 0)
+    return 0;
+
+  if (NUMBERP (gnutls_log_level))
+    max_log_level = XINT (gnutls_log_level);
+
+  /* TODO: use gnutls-error-fatalp and gnutls-error-string.  */
+
+  str = gnutls_strerror (err);
+  if (str == NULL)
+    str = "unknown";
+
+  if (gnutls_error_is_fatal (err) == 0)
+    {
+      ret = 0;
+      GNUTLS_LOG2 (1, max_log_level, "non-fatal error:", str);
+      /* TODO: EAGAIN AKA Qgnutls_e_again should be level 2.  */
+    }
+  else
+    {
+      ret = err;
+      GNUTLS_LOG2 (0, max_log_level, "fatal error:", str);
+    }
+
+  if (err == GNUTLS_E_WARNING_ALERT_RECEIVED
+      || err == GNUTLS_E_FATAL_ALERT_RECEIVED)
+    {
+      int alert = gnutls_alert_get (session);
+      int level = err == GNUTLS_E_FATAL_ALERT_RECEIVED ? 0 : 1;
+      str = gnutls_alert_get_name (alert);
+      if (str == NULL)
+	str = "unknown";
+
+      GNUTLS_LOG2 (level, max_log_level, "Received 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
@@ -261,14 +374,14 @@
 Call `gnutls-global-deinit' when GnuTLS usage is no longer needed.
 Returns zero on success.  */
 static Lisp_Object
-gnutls_emacs_global_init (void)
+emacs_gnutls_global_init (void)
 {
   int ret = GNUTLS_E_SUCCESS;
 
-  if (!global_initialized)
+  if (!gnutls_global_initialized)
     ret = gnutls_global_init ();
 
-  global_initialized = 1;
+  gnutls_global_initialized = 1;
 
   return gnutls_make_error (ret);
 }
@@ -276,28 +389,16 @@
 /* Deinitializes global GnuTLS state.
 See also `gnutls-global-init'.  */
 static Lisp_Object
-gnutls_emacs_global_deinit (void)
+emacs_gnutls_global_deinit (void)
 {
-  if (global_initialized)
+  if (gnutls_global_initialized)
     gnutls_global_deinit ();
 
-  global_initialized = 0;
+  gnutls_global_initialized = 0;
 
   return gnutls_make_error (GNUTLS_E_SUCCESS);
 }
 
-static void
-gnutls_log_function (int level, const char* string)
-{
-  message ("gnutls.c: [%d] %s", level, string);
-}
-
-static void
-gnutls_log_function2 (int level, const char* string, const char* extra)
-{
-  message ("gnutls.c: [%d] %s %s", level, string, extra);
-}
-
 DEFUN ("gnutls-boot", Fgnutls_boot, Sgnutls_boot, 3, 3, 0,
        doc: /* Initialize GnuTLS client for process PROC with TYPE+PROPLIST.
 Currently only client mode is supported.  Returns a success/failure
@@ -306,12 +407,27 @@
 TYPE is a symbol, either `gnutls-anon' or `gnutls-x509pki'.
 PROPLIST is a property list with the following keys:
 
+:hostname is a string naming the remote host.
+
 :priority is a GnuTLS priority string, defaults to "NORMAL".
+
 :trustfiles is a list of PEM-encoded trust files for `gnutls-x509pki'.
+
 :keyfiles is a list of PEM-encoded key files for `gnutls-x509pki'.
-:callbacks is an alist of callback functions (TODO).
+
+:callbacks is an alist of callback functions, see below.
+
 :loglevel is the debug level requested from GnuTLS, try 4.
 
+:verify-flags is a bitset as per GnuTLS'
+gnutls_certificate_set_verify_flags.
+
+:verify-error, if non-nil, makes failure of the certificate validation
+an error.  Otherwise it will be just a series of warnings.
+
+:verify-hostname-error, if non-nil, makes a hostname mismatch an
+error.  Otherwise it will be just a warning.
+
 The debug level will be set for this process AND globally for GnuTLS.
 So if you set it higher or lower at any point, it affects global
 debugging.
@@ -324,6 +440,9 @@
 functions are used.  This function allocates resources which can only
 be deallocated by calling `gnutls-deinit' or by calling it again.
 
+The callbacks alist can have a `verify' key, associated with a
+verification function (UNUSED).
+
 Each authentication type may need additional information in order to
 work.  For X.509 PKI (`gnutls-x509pki'), you probably need at least
 one trustfile (usually a CA bundle).  */)
@@ -336,12 +455,19 @@
   /* TODO: GNUTLS_X509_FMT_DER is also an option.  */
   int file_format = GNUTLS_X509_FMT_PEM;
 
+  unsigned int gnutls_verify_flags = GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT;
+  gnutls_x509_crt_t gnutls_verify_cert;
+  unsigned int gnutls_verify_cert_list_size;
+  const gnutls_datum_t *gnutls_verify_cert_list;
+
   gnutls_session_t state;
   gnutls_certificate_credentials_t x509_cred;
   gnutls_anon_client_credentials_t anon_cred;
   Lisp_Object global_init;
   char* priority_string_ptr = "NORMAL"; /* default priority string.  */
   Lisp_Object tail;
+  int peer_verification;
+  char* c_hostname;
 
   /* Placeholders for the property list elements.  */
   Lisp_Object priority_string;
@@ -349,16 +475,29 @@
   Lisp_Object keyfiles;
   Lisp_Object callbacks;
   Lisp_Object loglevel;
+  Lisp_Object hostname;
+  Lisp_Object verify_flags;
+  Lisp_Object verify_error;
+  Lisp_Object verify_hostname_error;
 
   CHECK_PROCESS (proc);
   CHECK_SYMBOL (type);
   CHECK_LIST (proplist);
 
-  priority_string = Fplist_get (proplist, Qgnutls_bootprop_priority);
-  trustfiles      = Fplist_get (proplist, Qgnutls_bootprop_trustfiles);
-  keyfiles        = Fplist_get (proplist, Qgnutls_bootprop_keyfiles);
-  callbacks       = Fplist_get (proplist, Qgnutls_bootprop_callbacks);
-  loglevel        = Fplist_get (proplist, Qgnutls_bootprop_loglevel);
+  hostname              = Fplist_get (proplist, Qgnutls_bootprop_hostname);
+  priority_string       = Fplist_get (proplist, Qgnutls_bootprop_priority);
+  trustfiles            = Fplist_get (proplist, Qgnutls_bootprop_trustfiles);
+  keyfiles              = Fplist_get (proplist, Qgnutls_bootprop_keyfiles);
+  callbacks             = Fplist_get (proplist, Qgnutls_bootprop_callbacks);
+  loglevel              = Fplist_get (proplist, Qgnutls_bootprop_loglevel);
+  verify_flags          = Fplist_get (proplist, Qgnutls_bootprop_verify_flags);
+  verify_error          = Fplist_get (proplist, Qgnutls_bootprop_verify_error);
+  verify_hostname_error = Fplist_get (proplist, Qgnutls_bootprop_verify_hostname_error);
+
+  if (!STRINGP (hostname))
+    error ("gnutls-boot: invalid :hostname parameter");
+
+  c_hostname = SSDATA (hostname);
 
   state = XPROCESS (proc)->gnutls_state;
   XPROCESS (proc)->gnutls_p = 1;
@@ -372,7 +511,7 @@
     }
 
   /* always initialize globals.  */
-  global_init = gnutls_emacs_global_init ();
+  global_init = emacs_gnutls_global_init ();
   if (! NILP (Fgnutls_errorp (global_init)))
     return global_init;
 
@@ -416,6 +555,23 @@
       x509_cred = XPROCESS (proc)->gnutls_x509_cred;
       if (gnutls_certificate_allocate_credentials (&x509_cred) < 0)
         memory_full ();
+
+      if (NUMBERP (verify_flags))
+        {
+          gnutls_verify_flags = XINT (verify_flags);
+          GNUTLS_LOG (2, max_log_level, "setting verification flags");
+        }
+      else if (NILP (verify_flags))
+        {
+          /* The default is already GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT.  */
+          GNUTLS_LOG (2, max_log_level, "using default verification flags");
+        }
+      else
+        {
+          /* The default is already GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT.  */
+          GNUTLS_LOG (2, max_log_level, "ignoring invalid verify-flags");
+        }
+      gnutls_certificate_set_verify_flags (x509_cred, gnutls_verify_flags);
     }
   else if (EQ (type, Qgnutls_anon))
     {
@@ -484,6 +640,14 @@
 
   GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_FILES;
 
+  GNUTLS_LOG (1, max_log_level, "gnutls callbacks");
+
+  GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CALLBACKS;
+
+#ifdef HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY
+#else
+#endif
+
   GNUTLS_LOG (1, max_log_level, "gnutls_init");
 
   ret = gnutls_init (&state, GNUTLS_CLIENT);
@@ -541,9 +705,113 @@
 
   GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CRED_SET;
 
-  emacs_gnutls_handshake (XPROCESS (proc));
-
-  return gnutls_make_error (GNUTLS_E_SUCCESS);
+  ret = emacs_gnutls_handshake (XPROCESS (proc));
+
+  if (ret < GNUTLS_E_SUCCESS)
+    return gnutls_make_error (ret);
+
+  /* Now verify the peer, following
+     http://www.gnu.org/software/gnutls/manual/html_node/Verifying-peer_0027s-certificate.html.
+     The peer should present at least one certificate in the chain; do a
+     check of the certificate's hostname with
+     gnutls_x509_crt_check_hostname() against :hostname.  */
+
+  ret = gnutls_certificate_verify_peers2 (state, &peer_verification);
+
+  if (ret < GNUTLS_E_SUCCESS)
+    return gnutls_make_error (ret);
+  
+  if (XINT (loglevel) > 0 && peer_verification & GNUTLS_CERT_INVALID)
+    message ("%s certificate could not be verified.", 
+             c_hostname);
+ 
+ if (peer_verification & GNUTLS_CERT_REVOKED)
+   GNUTLS_LOG2 (1, max_log_level, "certificate was revoked (CRL):",
+                c_hostname);
+ 
+ if (peer_verification & GNUTLS_CERT_SIGNER_NOT_FOUND)
+   GNUTLS_LOG2 (1, max_log_level, "certificate signer was not found:",
+                c_hostname);
+ 
+ if (peer_verification & GNUTLS_CERT_SIGNER_NOT_CA)
+   GNUTLS_LOG2 (1, max_log_level, "certificate signer is not a CA:",
+                c_hostname);
+
+ if (peer_verification & GNUTLS_CERT_INSECURE_ALGORITHM)
+   GNUTLS_LOG2 (1, max_log_level,
+                "certificate was signed with an insecure algorithm:",
+                c_hostname);
+
+ if (peer_verification & GNUTLS_CERT_NOT_ACTIVATED)
+   GNUTLS_LOG2 (1, max_log_level, "certificate is not yet activated:",
+                c_hostname);
+
+ if (peer_verification & GNUTLS_CERT_EXPIRED)
+   GNUTLS_LOG2 (1, max_log_level, "certificate has expired:",
+                c_hostname);
+
+ if (peer_verification != 0)
+   {
+     if (NILP (verify_hostname_error))
+       {
+         GNUTLS_LOG2 (1, max_log_level, "certificate validation failed:",
+                      c_hostname);
+       }
+     else
+       {
+         error ("Certificate validation failed %s, verification code %d",
+                c_hostname, peer_verification);
+       }
+   }
+
+  /* Up to here the process is the same for X.509 certificates and
+     OpenPGP keys.  From now on X.509 certificates are assumed.  This
+     can be easily extended to work with openpgp keys as well.  */
+  if (gnutls_certificate_type_get (state) == GNUTLS_CRT_X509)
+    {
+      ret = gnutls_x509_crt_init (&gnutls_verify_cert);
+
+      if (ret < GNUTLS_E_SUCCESS)
+        return gnutls_make_error (ret);
+
+      gnutls_verify_cert_list = 
+        gnutls_certificate_get_peers (state, &gnutls_verify_cert_list_size);
+
+      if (NULL == gnutls_verify_cert_list)
+        {
+          error ("No x509 certificate was found!\n");
+        }
+
+      /* We only check the first certificate in the given chain.  */
+      ret = gnutls_x509_crt_import (gnutls_verify_cert,
+                                    &gnutls_verify_cert_list[0],
+                                    GNUTLS_X509_FMT_DER);
+
+      if (ret < GNUTLS_E_SUCCESS)
+        {
+          gnutls_x509_crt_deinit (gnutls_verify_cert);
+          return gnutls_make_error (ret);
+        }
+
+      if (!gnutls_x509_crt_check_hostname (gnutls_verify_cert, c_hostname))
+        {
+          if (NILP (verify_hostname_error))
+            {
+              GNUTLS_LOG2 (1, max_log_level, "x509 certificate does not match:",
+                           c_hostname);
+            }
+          else
+            {
+              gnutls_x509_crt_deinit (gnutls_verify_cert);
+              error ("The x509 certificate does not match \"%s\"",
+                     c_hostname);
+            }
+        }
+
+      gnutls_x509_crt_deinit (gnutls_verify_cert);
+    }
+
+  return gnutls_make_error (ret);
 }
 
 DEFUN ("gnutls-bye", Fgnutls_bye,
@@ -578,7 +846,10 @@
 void
 syms_of_gnutls (void)
 {
-  global_initialized = 0;
+  gnutls_global_initialized = 0;
+
+  Qgnutls_log_level = intern_c_string ("gnutls-log-level");
+  staticpro (&Qgnutls_log_level);
 
   Qgnutls_code = intern_c_string ("gnutls-code");
   staticpro (&Qgnutls_code);
@@ -589,6 +860,9 @@
   Qgnutls_x509pki = intern_c_string ("gnutls-x509pki");
   staticpro (&Qgnutls_x509pki);
 
+  Qgnutls_bootprop_hostname = intern_c_string (":hostname");
+  staticpro (&Qgnutls_bootprop_hostname);
+
   Qgnutls_bootprop_priority = intern_c_string (":priority");
   staticpro (&Qgnutls_bootprop_priority);
 
@@ -601,9 +875,21 @@
   Qgnutls_bootprop_callbacks = intern_c_string (":callbacks");
   staticpro (&Qgnutls_bootprop_callbacks);
 
+  Qgnutls_bootprop_callbacks_verify = intern_c_string ("verify");
+  staticpro (&Qgnutls_bootprop_callbacks_verify);
+
   Qgnutls_bootprop_loglevel = intern_c_string (":loglevel");
   staticpro (&Qgnutls_bootprop_loglevel);
 
+  Qgnutls_bootprop_verify_flags = intern_c_string (":verify-flags");
+  staticpro (&Qgnutls_bootprop_verify_flags);
+
+  Qgnutls_bootprop_verify_hostname_error = intern_c_string (":verify-error");
+  staticpro (&Qgnutls_bootprop_verify_error);
+
+  Qgnutls_bootprop_verify_hostname_error = intern_c_string (":verify-hostname-error");
+  staticpro (&Qgnutls_bootprop_verify_hostname_error);
+
   Qgnutls_e_interrupted = intern_c_string ("gnutls-e-interrupted");
   staticpro (&Qgnutls_e_interrupted);
   Fput (Qgnutls_e_interrupted, Qgnutls_code,

=== modified file 'src/gnutls.h'
--- src/gnutls.h	2011-01-25 04:08:28 +0000
+++ src/gnutls.h	2011-04-04 01:11:54 +0000
@@ -21,6 +21,7 @@
 
 #ifdef HAVE_GNUTLS
 #include <gnutls/gnutls.h>
+#include <gnutls/x509.h>
 
 typedef enum
 {
@@ -28,6 +29,7 @@
   GNUTLS_STAGE_EMPTY = 0,
   GNUTLS_STAGE_CRED_ALLOC,
   GNUTLS_STAGE_FILES,
+  GNUTLS_STAGE_CALLBACKS,
   GNUTLS_STAGE_INIT,
   GNUTLS_STAGE_PRIORITY,
   GNUTLS_STAGE_CRED_SET,

=== modified file 'src/makefile.w32-in'
--- src/makefile.w32-in	2011-03-19 03:22:14 +0000
+++ src/makefile.w32-in	2011-04-04 01:11:54 +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)
 
 #
@@ -948,6 +950,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-03-27 02:32:40 +0000
+++ src/process.c	2011-04-04 01:11:54 +0000
@@ -4776,6 +4776,19 @@
              &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;

=== modified file 'src/w32.c'
--- src/w32.c	2011-03-29 14:00:16 +0000
+++ src/w32.c	2011-04-04 01:11:54 +0000
@@ -6081,5 +6081,75 @@
   p->childp = childp2;
 }
 
+#ifdef HAVE_GNUTLS
+
+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 = sys_read(fd, (char*)buf, sz);
+
+      if (n >= 0)
+        return n;
+      else
+        {
+          int err = errno;
+
+          if (err == EWOULDBLOCK)
+            {
+              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 || errno == EWOULDBLOCK)
+                /* We have to translate WSAEWOULDBLOCK alias
+		   EWOULDBLOCK to EAGAIN for GnuTLS.  */
+                err = EAGAIN;
+              else
+                err = errno;
+            }
+          gnutls_transport_set_errno (proc->gnutls_state, err);
+
+          return -1;
+        }
+    }
+}
+
+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 = sys_write((int)fd, buf, sz);
+
+  if (n >= 0)
+    return n;
+  else
+    {
+      gnutls_transport_set_errno (proc->gnutls_state,
+                                  /* Translate WSAEWOULDBLOCK alias
+                                     EWOULDBLOCK to EAGAIN for
+                                     GnuTLS.  */
+                                  errno == EWOULDBLOCK
+                                  ? EAGAIN
+                                  : errno);
+
+      return -1;
+    }
+}
+#endif /* HAVE_GNUTLS */
+
 /* end of w32.c */
 

=== modified file 'src/w32.h'
--- src/w32.h	2011-01-25 04:08:28 +0000
+++ src/w32.h	2011-04-04 01:11:54 +0000
@@ -143,5 +143,14 @@
 extern int _sys_read_ahead (int fd);
 extern int _sys_wait_accept (int fd);
 
+#ifdef HAVE_GNUTLS
+#include <gnutls/gnutls.h>
+
+extern ssize_t emacs_gnutls_pull (gnutls_transport_ptr_t p,
+                                  void* buf, size_t sz);
+extern ssize_t emacs_gnutls_push (gnutls_transport_ptr_t p,
+                                  const void* buf, size_t sz);
+#endif /* HAVE_GNUTLS */
+
 #endif /* EMACS_W32_H */
 

Re: [PATCH] GnuTLS support on Woe32

[Deniz Dogan]

What's the status on this? Are we still waiting for Claudio's papers?

I applied the patch and built Emacs on Windows but as I'm not that
knowledgeable when it comes to TLS and/or Gnus (which is why I need
TLS) I'm not sure whether it is broken or whether I'm just doing
something wrong.

-- 
Deniz Dogan

Re: [PATCH] GnuTLS support on Woe32

[Ted Zlatanov]

On Thu, 14 Apr 2011 09:34:06 +0200 Deniz Dogan <deniz.a.m.dogan@gmail.com> wrote: 

DD> What's the status on this? Are we still waiting for Claudio's papers?
DD> I applied the patch and built Emacs on Windows but as I'm not that
DD> knowledgeable when it comes to TLS and/or Gnus (which is why I need
DD> TLS) I'm not sure whether it is broken or whether I'm just doing
DD> something wrong.

Still waiting.  I asked 10 days ago in
http://permalink.gmane.org/gmane.emacs.devel/138102, haven't heard back.

It will be used automatically if you (require 'gnutls)

Ted

Re: [PATCH] GnuTLS support on Woe32

[Ted Zlatanov]

[-- Attachment #1: Type: text/plain, Size: 505 bytes --]

On Mon, 04 Apr 2011 04:58:17 -0500 Ted Zlatanov <tzz@lifelogs.com> wrote: 

TZ> On Thu, 24 Mar 2011 14:27:55 -0500 Ted Zlatanov <tzz@lifelogs.com> wrote: 
TZ> On Wed, 23 Mar 2011 21:57:56 +0100 claudio.bley@gmail.com (Claudio Bley) wrote: 
CB> I requested the papers, but I'm still waiting for receipt. So, this
CB> will probably take some time...

TZ> Any news?  If you still don't have the papers I will separate our work
TZ> so I don't have to keep rebasing the patch.

*sigh* one more rebase...

Ted


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 2011-04-15 --]
[-- Type: text/x-diff, Size: 38739 bytes --]

=== modified file 'configure.in'
--- configure.in	2011-04-12 03:55:07 +0000
+++ configure.in	2011-04-15 17:15:39 +0000
@@ -1972,12 +1972,22 @@
 AC_SUBST(LIBSELINUX_LIBS)
 
 HAVE_GNUTLS=no
+HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY=no
 if test "${with_gnutls}" = "yes" ; then
   PKG_CHECK_MODULES([LIBGNUTLS], [gnutls >= 2.2.4], HAVE_GNUTLS=yes, HAVE_GNUTLS=no)
   if test "${HAVE_GNUTLS}" = "yes"; then
     AC_DEFINE(HAVE_GNUTLS, 1, [Define if using GnuTLS.])
   fi
+
+  CFLAGS="$CFLAGS $LIBGNUTLS_CFLAGS"
+  LIBS="$LIBGNUTLS_LIBS $LIBS"
+  AC_CHECK_FUNCS(gnutls_certificate_set_verify_function, HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY=yes)
+
+  if test "${HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY}" = "yes"; then
+    AC_DEFINE(HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY, 1, [Define if using GnuTLS certificate verification callbacks.])
+  fi
 fi
+
 AC_SUBST(LIBGNUTLS_LIBS)
 AC_SUBST(LIBGNUTLS_CFLAGS)
 
@@ -3675,6 +3685,7 @@
 echo "  Does Emacs use -lgconf?                                 ${HAVE_GCONF}"
 echo "  Does Emacs use -lselinux?                               ${HAVE_LIBSELINUX}"
 echo "  Does Emacs use -lgnutls?                                ${HAVE_GNUTLS}"
+echo "  Does Emacs use -lgnutls certificate verify callbacks?   ${HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY}"
 echo "  Does Emacs use -lxml2?                                  ${HAVE_LIBXML2}"
 
 echo "  Does Emacs use -lfreetype?                              ${HAVE_FREETYPE}"

=== modified file 'lib-src/ChangeLog'
--- lib-src/ChangeLog	2011-04-06 12:18:10 +0000
+++ lib-src/ChangeLog	2011-04-15 17:28:09 +0000
@@ -1,3 +1,7 @@
+2011-04-15  Claudio Bley  <claudio.bley@gmail.com>
+
+	* makefile.w32-in (obj): Added gnutls.o.
+
 2011-04-06  Paul Eggert  <eggert@cs.ucla.edu>
 
 	Fix more problems found by GCC 4.6.0's static checks.

=== modified file 'lib-src/makefile.w32-in'
--- lib-src/makefile.w32-in	2011-03-12 19:19:47 +0000
+++ lib-src/makefile.w32-in	2011-04-15 17:15:39 +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-04-15 13:50:04 +0000
+++ lisp/ChangeLog	2011-04-15 17:28:55 +0000
@@ -1,3 +1,19 @@
+2011-04-15  Teodor Zlatanov  <tzz@lifelogs.com>
+
+	* net/gnutls.el (gnutls-negotiate): Add hostname, verify-flags,
+	verify-error, and verify-hostname-error parameters.
+	(open-gnutls-stream): Add usage example.
+
+	* net/network-stream.el (network-stream-open-starttls): Give host
+	parameter to `gnutls-negotiate'.
+	(gnutls-negotiate): Adjust `gnutls-negotiate' declaration.
+
+2011-04-15  Claudio Bley  <claudio.bley@gmail.com>
+
+	* 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-04-15  Stefan Monnier  <monnier@iro.umontreal.ca>
 
 	* mail/sendmail.el (mail-mode-map): Use completion-at-point.

=== modified file 'lisp/net/gnutls.el'
--- lisp/net/gnutls.el	2011-01-25 04:08:28 +0000
+++ lisp/net/gnutls.el	2011-04-15 17:15:39 +0000
@@ -25,7 +25,8 @@
 ;;; Commentary:
 
 ;; This package provides language bindings for the GnuTLS library
-;; using the corresponding core functions in gnutls.c.
+;; using the corresponding core functions in gnutls.c.  It should NOT
+;; be used directly, only through open-protocol-stream.
 
 ;; Simple test:
 ;;
@@ -59,26 +60,76 @@
 Fourth arg SERVICE is name of the service desired, or an integer
 specifying a port number to connect to.
 
+Usage example:
+
+  \(with-temp-buffer
+    \(open-gnutls-stream \"tls\"
+                        \(current-buffer)
+                        \"your server goes here\"
+                        \"imaps\"))
+
 This is a very simple wrapper around `gnutls-negotiate'.  See its
 documentation for the specific parameters you can use to open a
 GnuTLS connection, including specifying the credential type,
 trust and key files, and priority string."
-  (let ((proc (open-network-stream name buffer host service)))
-    (gnutls-negotiate proc 'gnutls-x509pki)))
+  (gnutls-negotiate (open-network-stream name buffer host service)
+                    'gnutls-x509pki
+                    host))
+
+(put 'gnutls-error
+     'error-conditions
+     '(error gnutls-error))
+(put 'gnutls-error
+     'error-message "GnuTLS error")
 
 (declare-function gnutls-boot "gnutls.c" (proc type proplist))
 
-(defun gnutls-negotiate (proc type &optional priority-string
-                              trustfiles keyfiles)
-  "Negotiate a SSL/TLS connection.
+(defun gnutls-negotiate (proc type hostname &optional priority-string
+                              trustfiles keyfiles verify-flags
+                              verify-error verify-hostname-error)
+  "Negotiate a SSL/TLS connection.  Returns proc. Signals gnutls-error.
 TYPE is `gnutls-x509pki' (default) or `gnutls-anon'.  Use nil for the default.
 PROC is a process returned by `open-network-stream'.
+HOSTNAME is the remote hostname.  It must be a valid string.
 PRIORITY-STRING is as per the GnuTLS docs, default is \"NORMAL\".
 TRUSTFILES is a list of CA bundles.
-KEYFILES is a list of client keys."
+KEYFILES is a list of client keys.
+
+When VERIFY-HOSTNAME-ERROR is not nil, an error will be raised
+when the hostname does not match the presented certificate's host
+name.  The exact verification algorithm is a basic implementation
+of the matching described in RFC2818 (HTTPS), which takes into
+account wildcards, and the DNSName/IPAddress subject alternative
+name PKIX extension.  See GnuTLS' gnutls_x509_crt_check_hostname
+for details.  When VERIFY-HOSTNAME-ERROR is nil, only a warning
+will be issued.
+
+When VERIFY-ERROR is not nil, an error will be raised when the
+peer certificate verification fails as per GnuTLS'
+gnutls_certificate_verify_peers2.  Otherwise, only warnings will
+be shown about the verification failure.
+
+VERIFY-FLAGS is a numeric OR of verification flags only for
+`gnutls-x509pki' connections.  See GnuTLS' x509.h for details;
+here's a recent version of the list.
+
+    GNUTLS_VERIFY_DISABLE_CA_SIGN = 1,
+    GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT = 2,
+    GNUTLS_VERIFY_DO_NOT_ALLOW_SAME = 4,
+    GNUTLS_VERIFY_ALLOW_ANY_X509_V1_CA_CRT = 8,
+    GNUTLS_VERIFY_ALLOW_SIGN_RSA_MD2 = 16,
+    GNUTLS_VERIFY_ALLOW_SIGN_RSA_MD5 = 32,
+    GNUTLS_VERIFY_DISABLE_TIME_CHECKS = 64,
+    GNUTLS_VERIFY_DISABLE_TRUSTED_TIME_CHECKS = 128,
+    GNUTLS_VERIFY_DO_NOT_ALLOW_X509_V1_CA_CRT = 256
+
+It must be omitted, a number, or nil; if omitted or nil it
+defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT."
   (let* ((type (or type 'gnutls-x509pki))
+         (default-trustfile "/etc/ssl/certs/ca-certificates.crt")
          (trustfiles (or trustfiles
-                        '("/etc/ssl/certs/ca-certificates.crt")))
+                         (when (file-exists-p default-trustfile)
+                           (list default-trustfile))))
          (priority-string (or priority-string
                               (cond
                                ((eq type 'gnutls-anon)
@@ -86,15 +137,22 @@
                                ((eq type 'gnutls-x509pki)
                                 "NORMAL"))))
          (params `(:priority ,priority-string
+                             :hostname ,hostname
                              :loglevel ,gnutls-log-level
                              :trustfiles ,trustfiles
                              :keyfiles ,keyfiles
+                             :verify-flags ,verify-flags
+                             :verify-error ,verify-error
+                             :verify-hostname-error ,verify-hostname-error
                              :callbacks nil))
          ret)
 
     (gnutls-message-maybe
      (setq ret (gnutls-boot proc type params))
-     "boot: %s")
+     "boot: %s" params)
+
+    (when (gnutls-errorp ret)
+      (signal 'gnutls-error (list proc ret)))
 
     proc))
 

=== modified file 'lisp/net/network-stream.el'
--- lisp/net/network-stream.el	2011-04-12 22:18:02 +0000
+++ lisp/net/network-stream.el	2011-04-15 17:15:39 +0000
@@ -46,7 +46,8 @@
 (require 'starttls)
 
 (declare-function gnutls-negotiate "gnutls"
-		  (proc type &optional priority-string trustfiles keyfiles))
+                  (proc type host &optional priority-string trustfiles keyfiles
+                        verify-flags verify-error verify-hostname-error))
 
 ;;;###autoload
 (defun open-network-stream (name buffer host service &rest parameters)
@@ -197,7 +198,7 @@
 			  (network-stream-command stream starttls-command eoc))
 	;; The server said it was OK to begin STARTTLS negotiations.
 	(if (fboundp 'open-gnutls-stream)
-	    (gnutls-negotiate stream nil)
+	    (gnutls-negotiate stream nil host)
 	  (unless (starttls-negotiate stream)
 	    (delete-process stream)))
 	(if (memq (process-status stream) '(open run))

=== modified file 'nt/ChangeLog'
--- nt/ChangeLog	2011-04-06 15:44:32 +0000
+++ nt/ChangeLog	2011-04-15 17:29:37 +0000
@@ -1,3 +1,10 @@
+2011-04-15  Claudio Bley  <claudio.bley@gmail.com>
+
+	* 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-04-06  Eli Zaretskii  <eliz@gnu.org>
 
 	* config.nt (NO_INLINE, ATTRIBUTE_FORMAT)

=== modified file 'nt/INSTALL'
--- nt/INSTALL	2011-01-26 08:36:39 +0000
+++ nt/INSTALL	2011-04-15 17:15:39 +0000
@@ -306,6 +306,16 @@
   `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.
+
+  Pre-built binaries and an installer can be found at
+  http://josefsson.org/gnutls4win/.
+
 * 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-04-15 17:15:39 +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
@@ -204,6 +211,14 @@
 shift
 goto again
 
+:userlibs
+shift
+echo. userlibs: %userlibs%
+set userlibs=%userlibs%%sep4%%1
+set sep4= %nothing%
+shift
+goto again
+
 rem ----------------------------------------------------------------------
 
 :userldflags
@@ -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-04-15 17:15:39 +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-04-15 10:23:56 +0000
+++ src/ChangeLog	2011-04-15 17:30:05 +0000
@@ -1,3 +1,36 @@
+2011-04-15  Teodor Zlatanov  <tzz@lifelogs.com>
+
+	* gnutls.c: Renamed global_initialized to
+	gnutls_global_initialized.  Added internals for the
+	:verify-hostname-error, :verify-error, and :verify-flags
+	parameters of `gnutls-boot' and documented those parameters in the
+	docstring.  Start callback support.
+
+2011-04-15  Claudio Bley  <claudio.bley@gmail.com>
+
+	* w32.h: (emacs_gnutls_pull): Add prototype.
+	(emacs_gnutls_push): Likewise.
+
+	* w32.c: (emacs_gnutls_pull): New function for GnuTLS on Woe32.
+	(emacs_gnutls_push): Likewise.
+
+	* 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_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-04-15  Paul Eggert  <eggert@cs.ucla.edu>
 
 	* sysdep.c (emacs_read): Remove unnecessary check vs MAX_RW_COUNT.

=== modified file 'src/gnutls.c'
--- src/gnutls.c	2011-04-15 08:22:34 +0000
+++ src/gnutls.c	2011-04-15 17:18:52 +0000
@@ -26,11 +26,20 @@
 #ifdef HAVE_GNUTLS
 #include <gnutls/gnutls.h>
 
+#ifdef WINDOWSNT
+#include <windows.h>
+#include "w32.h"
+#endif
+
+static int
+emacs_gnutls_handle_error (gnutls_session_t, int err);
+
+Lisp_Object Qgnutls_log_level;
 Lisp_Object Qgnutls_code;
 Lisp_Object Qgnutls_anon, Qgnutls_x509pki;
 Lisp_Object Qgnutls_e_interrupted, Qgnutls_e_again,
   Qgnutls_e_invalid_session, Qgnutls_e_not_ready_for_handshake;
-int global_initialized;
+int gnutls_global_initialized;
 
 /* The following are for the property list of `gnutls-boot'.  */
 Lisp_Object Qgnutls_bootprop_priority;
@@ -38,8 +47,27 @@
 Lisp_Object Qgnutls_bootprop_keyfiles;
 Lisp_Object Qgnutls_bootprop_callbacks;
 Lisp_Object Qgnutls_bootprop_loglevel;
-
-static void
+Lisp_Object Qgnutls_bootprop_hostname;
+Lisp_Object Qgnutls_bootprop_verify_flags;
+Lisp_Object Qgnutls_bootprop_verify_error;
+Lisp_Object Qgnutls_bootprop_verify_hostname_error;
+
+/* Callback keys for `gnutls-boot'.  Unused currently.  */
+Lisp_Object Qgnutls_bootprop_callbacks_verify;
+
+static void
+gnutls_log_function (int level, const char* string)
+{
+  message ("gnutls.c: [%d] %s", level, string);
+}
+
+static void
+gnutls_log_function2 (int level, const char* string, const char* extra)
+{
+  message ("gnutls.c: [%d] %s %s", level, string, extra);
+}
+
+static int
 emacs_gnutls_handshake (struct Lisp_Process *proc)
 {
   gnutls_session_t state = proc->gnutls_state;
@@ -50,24 +78,56 @@
 
   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 and 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)
     {
-      /* here we're finally done.  */
+      /* Here we're finally done.  */
       proc->gnutls_initstage = GNUTLS_STAGE_READY;
     }
+  else
+    {
+        gnutls_alert_send_appropriate (state, ret);
+    }
+  return ret;
 }
 
 EMACS_INT
@@ -107,6 +167,7 @@
       bytes_written += rtnval;
     }
 
+  emacs_gnutls_handle_error (state, rtnval);
   return (bytes_written);
 }
 
@@ -122,19 +183,68 @@
       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;
   }
 }
 
+/* report a GnuTLS error to the user.
+   Returns zero if the error code was successfully handled. */
+static int
+emacs_gnutls_handle_error (gnutls_session_t session, int err)
+{
+  Lisp_Object gnutls_log_level = Fsymbol_value (Qgnutls_log_level);
+  int max_log_level = 0;
+
+  int alert, ret;
+  const char *str;
+
+  /* TODO: use a Lisp_Object generated by gnutls_make_error?  */
+  if (err >= 0)
+    return 0;
+
+  if (NUMBERP (gnutls_log_level))
+    max_log_level = XINT (gnutls_log_level);
+
+  /* TODO: use gnutls-error-fatalp and gnutls-error-string.  */
+
+  str = gnutls_strerror (err);
+  if (str == NULL)
+    str = "unknown";
+
+  if (gnutls_error_is_fatal (err) == 0)
+    {
+      ret = 0;
+      GNUTLS_LOG2 (1, max_log_level, "non-fatal error:", str);
+      /* TODO: EAGAIN AKA Qgnutls_e_again should be level 2.  */
+    }
+  else
+    {
+      ret = err;
+      GNUTLS_LOG2 (0, max_log_level, "fatal error:", str);
+    }
+
+  if (err == GNUTLS_E_WARNING_ALERT_RECEIVED
+      || err == GNUTLS_E_FATAL_ALERT_RECEIVED)
+    {
+      int alert = gnutls_alert_get (session);
+      int level = err == GNUTLS_E_FATAL_ALERT_RECEIVED ? 0 : 1;
+      str = gnutls_alert_get_name (alert);
+      if (str == NULL)
+	str = "unknown";
+
+      GNUTLS_LOG2 (level, max_log_level, "Received 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
@@ -262,14 +372,14 @@
 Call `gnutls-global-deinit' when GnuTLS usage is no longer needed.
 Returns zero on success.  */
 static Lisp_Object
-gnutls_emacs_global_init (void)
+emacs_gnutls_global_init (void)
 {
   int ret = GNUTLS_E_SUCCESS;
 
-  if (!global_initialized)
+  if (!gnutls_global_initialized)
     ret = gnutls_global_init ();
 
-  global_initialized = 1;
+  gnutls_global_initialized = 1;
 
   return gnutls_make_error (ret);
 }
@@ -277,28 +387,16 @@
 /* Deinitializes global GnuTLS state.
 See also `gnutls-global-init'.  */
 static Lisp_Object
-gnutls_emacs_global_deinit (void)
+emacs_gnutls_global_deinit (void)
 {
-  if (global_initialized)
+  if (gnutls_global_initialized)
     gnutls_global_deinit ();
 
-  global_initialized = 0;
+  gnutls_global_initialized = 0;
 
   return gnutls_make_error (GNUTLS_E_SUCCESS);
 }
 
-static void
-gnutls_log_function (int level, const char* string)
-{
-  message ("gnutls.c: [%d] %s", level, string);
-}
-
-static void
-gnutls_log_function2 (int level, const char* string, const char* extra)
-{
-  message ("gnutls.c: [%d] %s %s", level, string, extra);
-}
-
 DEFUN ("gnutls-boot", Fgnutls_boot, Sgnutls_boot, 3, 3, 0,
        doc: /* Initialize GnuTLS client for process PROC with TYPE+PROPLIST.
 Currently only client mode is supported.  Returns a success/failure
@@ -307,12 +405,27 @@
 TYPE is a symbol, either `gnutls-anon' or `gnutls-x509pki'.
 PROPLIST is a property list with the following keys:
 
+:hostname is a string naming the remote host.
+
 :priority is a GnuTLS priority string, defaults to "NORMAL".
+
 :trustfiles is a list of PEM-encoded trust files for `gnutls-x509pki'.
+
 :keyfiles is a list of PEM-encoded key files for `gnutls-x509pki'.
-:callbacks is an alist of callback functions (TODO).
+
+:callbacks is an alist of callback functions, see below.
+
 :loglevel is the debug level requested from GnuTLS, try 4.
 
+:verify-flags is a bitset as per GnuTLS'
+gnutls_certificate_set_verify_flags.
+
+:verify-error, if non-nil, makes failure of the certificate validation
+an error.  Otherwise it will be just a series of warnings.
+
+:verify-hostname-error, if non-nil, makes a hostname mismatch an
+error.  Otherwise it will be just a warning.
+
 The debug level will be set for this process AND globally for GnuTLS.
 So if you set it higher or lower at any point, it affects global
 debugging.
@@ -325,6 +438,9 @@
 functions are used.  This function allocates resources which can only
 be deallocated by calling `gnutls-deinit' or by calling it again.
 
+The callbacks alist can have a `verify' key, associated with a
+verification function (UNUSED).
+
 Each authentication type may need additional information in order to
 work.  For X.509 PKI (`gnutls-x509pki'), you probably need at least
 one trustfile (usually a CA bundle).  */)
@@ -337,12 +453,19 @@
   /* TODO: GNUTLS_X509_FMT_DER is also an option.  */
   int file_format = GNUTLS_X509_FMT_PEM;
 
+  unsigned int gnutls_verify_flags = GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT;
+  gnutls_x509_crt_t gnutls_verify_cert;
+  unsigned int gnutls_verify_cert_list_size;
+  const gnutls_datum_t *gnutls_verify_cert_list;
+
   gnutls_session_t state;
   gnutls_certificate_credentials_t x509_cred;
   gnutls_anon_client_credentials_t anon_cred;
   Lisp_Object global_init;
   char* priority_string_ptr = "NORMAL"; /* default priority string.  */
   Lisp_Object tail;
+  int peer_verification;
+  char* c_hostname;
 
   /* Placeholders for the property list elements.  */
   Lisp_Object priority_string;
@@ -350,16 +473,29 @@
   Lisp_Object keyfiles;
   Lisp_Object callbacks;
   Lisp_Object loglevel;
+  Lisp_Object hostname;
+  Lisp_Object verify_flags;
+  Lisp_Object verify_error;
+  Lisp_Object verify_hostname_error;
 
   CHECK_PROCESS (proc);
   CHECK_SYMBOL (type);
   CHECK_LIST (proplist);
 
-  priority_string = Fplist_get (proplist, Qgnutls_bootprop_priority);
-  trustfiles      = Fplist_get (proplist, Qgnutls_bootprop_trustfiles);
-  keyfiles        = Fplist_get (proplist, Qgnutls_bootprop_keyfiles);
-  callbacks       = Fplist_get (proplist, Qgnutls_bootprop_callbacks);
-  loglevel        = Fplist_get (proplist, Qgnutls_bootprop_loglevel);
+  hostname              = Fplist_get (proplist, Qgnutls_bootprop_hostname);
+  priority_string       = Fplist_get (proplist, Qgnutls_bootprop_priority);
+  trustfiles            = Fplist_get (proplist, Qgnutls_bootprop_trustfiles);
+  keyfiles              = Fplist_get (proplist, Qgnutls_bootprop_keyfiles);
+  callbacks             = Fplist_get (proplist, Qgnutls_bootprop_callbacks);
+  loglevel              = Fplist_get (proplist, Qgnutls_bootprop_loglevel);
+  verify_flags          = Fplist_get (proplist, Qgnutls_bootprop_verify_flags);
+  verify_error          = Fplist_get (proplist, Qgnutls_bootprop_verify_error);
+  verify_hostname_error = Fplist_get (proplist, Qgnutls_bootprop_verify_hostname_error);
+
+  if (!STRINGP (hostname))
+    error ("gnutls-boot: invalid :hostname parameter");
+
+  c_hostname = SSDATA (hostname);
 
   state = XPROCESS (proc)->gnutls_state;
   XPROCESS (proc)->gnutls_p = 1;
@@ -373,7 +509,7 @@
     }
 
   /* always initialize globals.  */
-  global_init = gnutls_emacs_global_init ();
+  global_init = emacs_gnutls_global_init ();
   if (! NILP (Fgnutls_errorp (global_init)))
     return global_init;
 
@@ -417,6 +553,23 @@
       x509_cred = XPROCESS (proc)->gnutls_x509_cred;
       if (gnutls_certificate_allocate_credentials (&x509_cred) < 0)
         memory_full ();
+
+      if (NUMBERP (verify_flags))
+        {
+          gnutls_verify_flags = XINT (verify_flags);
+          GNUTLS_LOG (2, max_log_level, "setting verification flags");
+        }
+      else if (NILP (verify_flags))
+        {
+          /* The default is already GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT.  */
+          GNUTLS_LOG (2, max_log_level, "using default verification flags");
+        }
+      else
+        {
+          /* The default is already GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT.  */
+          GNUTLS_LOG (2, max_log_level, "ignoring invalid verify-flags");
+        }
+      gnutls_certificate_set_verify_flags (x509_cred, gnutls_verify_flags);
     }
   else if (EQ (type, Qgnutls_anon))
     {
@@ -485,6 +638,14 @@
 
   GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_FILES;
 
+  GNUTLS_LOG (1, max_log_level, "gnutls callbacks");
+
+  GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CALLBACKS;
+
+#ifdef HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY
+#else
+#endif
+
   GNUTLS_LOG (1, max_log_level, "gnutls_init");
 
   ret = gnutls_init (&state, GNUTLS_CLIENT);
@@ -542,9 +703,113 @@
 
   GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CRED_SET;
 
-  emacs_gnutls_handshake (XPROCESS (proc));
-
-  return gnutls_make_error (GNUTLS_E_SUCCESS);
+  ret = emacs_gnutls_handshake (XPROCESS (proc));
+
+  if (ret < GNUTLS_E_SUCCESS)
+    return gnutls_make_error (ret);
+
+  /* Now verify the peer, following
+     http://www.gnu.org/software/gnutls/manual/html_node/Verifying-peer_0027s-certificate.html.
+     The peer should present at least one certificate in the chain; do a
+     check of the certificate's hostname with
+     gnutls_x509_crt_check_hostname() against :hostname.  */
+
+  ret = gnutls_certificate_verify_peers2 (state, &peer_verification);
+
+  if (ret < GNUTLS_E_SUCCESS)
+    return gnutls_make_error (ret);
+  
+  if (XINT (loglevel) > 0 && peer_verification & GNUTLS_CERT_INVALID)
+    message ("%s certificate could not be verified.", 
+             c_hostname);
+ 
+ if (peer_verification & GNUTLS_CERT_REVOKED)
+   GNUTLS_LOG2 (1, max_log_level, "certificate was revoked (CRL):",
+                c_hostname);
+ 
+ if (peer_verification & GNUTLS_CERT_SIGNER_NOT_FOUND)
+   GNUTLS_LOG2 (1, max_log_level, "certificate signer was not found:",
+                c_hostname);
+ 
+ if (peer_verification & GNUTLS_CERT_SIGNER_NOT_CA)
+   GNUTLS_LOG2 (1, max_log_level, "certificate signer is not a CA:",
+                c_hostname);
+
+ if (peer_verification & GNUTLS_CERT_INSECURE_ALGORITHM)
+   GNUTLS_LOG2 (1, max_log_level,
+                "certificate was signed with an insecure algorithm:",
+                c_hostname);
+
+ if (peer_verification & GNUTLS_CERT_NOT_ACTIVATED)
+   GNUTLS_LOG2 (1, max_log_level, "certificate is not yet activated:",
+                c_hostname);
+
+ if (peer_verification & GNUTLS_CERT_EXPIRED)
+   GNUTLS_LOG2 (1, max_log_level, "certificate has expired:",
+                c_hostname);
+
+ if (peer_verification != 0)
+   {
+     if (NILP (verify_hostname_error))
+       {
+         GNUTLS_LOG2 (1, max_log_level, "certificate validation failed:",
+                      c_hostname);
+       }
+     else
+       {
+         error ("Certificate validation failed %s, verification code %d",
+                c_hostname, peer_verification);
+       }
+   }
+
+  /* Up to here the process is the same for X.509 certificates and
+     OpenPGP keys.  From now on X.509 certificates are assumed.  This
+     can be easily extended to work with openpgp keys as well.  */
+  if (gnutls_certificate_type_get (state) == GNUTLS_CRT_X509)
+    {
+      ret = gnutls_x509_crt_init (&gnutls_verify_cert);
+
+      if (ret < GNUTLS_E_SUCCESS)
+        return gnutls_make_error (ret);
+
+      gnutls_verify_cert_list = 
+        gnutls_certificate_get_peers (state, &gnutls_verify_cert_list_size);
+
+      if (NULL == gnutls_verify_cert_list)
+        {
+          error ("No x509 certificate was found!\n");
+        }
+
+      /* We only check the first certificate in the given chain.  */
+      ret = gnutls_x509_crt_import (gnutls_verify_cert,
+                                    &gnutls_verify_cert_list[0],
+                                    GNUTLS_X509_FMT_DER);
+
+      if (ret < GNUTLS_E_SUCCESS)
+        {
+          gnutls_x509_crt_deinit (gnutls_verify_cert);
+          return gnutls_make_error (ret);
+        }
+
+      if (!gnutls_x509_crt_check_hostname (gnutls_verify_cert, c_hostname))
+        {
+          if (NILP (verify_hostname_error))
+            {
+              GNUTLS_LOG2 (1, max_log_level, "x509 certificate does not match:",
+                           c_hostname);
+            }
+          else
+            {
+              gnutls_x509_crt_deinit (gnutls_verify_cert);
+              error ("The x509 certificate does not match \"%s\"",
+                     c_hostname);
+            }
+        }
+
+      gnutls_x509_crt_deinit (gnutls_verify_cert);
+    }
+
+  return gnutls_make_error (ret);
 }
 
 DEFUN ("gnutls-bye", Fgnutls_bye,
@@ -579,7 +844,10 @@
 void
 syms_of_gnutls (void)
 {
-  global_initialized = 0;
+  gnutls_global_initialized = 0;
+
+  Qgnutls_log_level = intern_c_string ("gnutls-log-level");
+  staticpro (&Qgnutls_log_level);
 
   Qgnutls_code = intern_c_string ("gnutls-code");
   staticpro (&Qgnutls_code);
@@ -590,6 +858,9 @@
   Qgnutls_x509pki = intern_c_string ("gnutls-x509pki");
   staticpro (&Qgnutls_x509pki);
 
+  Qgnutls_bootprop_hostname = intern_c_string (":hostname");
+  staticpro (&Qgnutls_bootprop_hostname);
+
   Qgnutls_bootprop_priority = intern_c_string (":priority");
   staticpro (&Qgnutls_bootprop_priority);
 
@@ -602,9 +873,21 @@
   Qgnutls_bootprop_callbacks = intern_c_string (":callbacks");
   staticpro (&Qgnutls_bootprop_callbacks);
 
+  Qgnutls_bootprop_callbacks_verify = intern_c_string ("verify");
+  staticpro (&Qgnutls_bootprop_callbacks_verify);
+
   Qgnutls_bootprop_loglevel = intern_c_string (":loglevel");
   staticpro (&Qgnutls_bootprop_loglevel);
 
+  Qgnutls_bootprop_verify_flags = intern_c_string (":verify-flags");
+  staticpro (&Qgnutls_bootprop_verify_flags);
+
+  Qgnutls_bootprop_verify_hostname_error = intern_c_string (":verify-error");
+  staticpro (&Qgnutls_bootprop_verify_error);
+
+  Qgnutls_bootprop_verify_hostname_error = intern_c_string (":verify-hostname-error");
+  staticpro (&Qgnutls_bootprop_verify_hostname_error);
+
   Qgnutls_e_interrupted = intern_c_string ("gnutls-e-interrupted");
   staticpro (&Qgnutls_e_interrupted);
   Fput (Qgnutls_e_interrupted, Qgnutls_code,

=== modified file 'src/gnutls.h'
--- src/gnutls.h	2011-04-15 08:22:34 +0000
+++ src/gnutls.h	2011-04-15 17:15:40 +0000
@@ -21,6 +21,7 @@
 
 #ifdef HAVE_GNUTLS
 #include <gnutls/gnutls.h>
+#include <gnutls/x509.h>
 
 typedef enum
 {
@@ -28,6 +29,7 @@
   GNUTLS_STAGE_EMPTY = 0,
   GNUTLS_STAGE_CRED_ALLOC,
   GNUTLS_STAGE_FILES,
+  GNUTLS_STAGE_CALLBACKS,
   GNUTLS_STAGE_INIT,
   GNUTLS_STAGE_PRIORITY,
   GNUTLS_STAGE_CRED_SET,

=== modified file 'src/makefile.w32-in'
--- src/makefile.w32-in	2011-03-19 03:22:14 +0000
+++ src/makefile.w32-in	2011-04-15 17:15:40 +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)
 
 #
@@ -948,6 +950,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-04-15 08:35:53 +0000
+++ src/process.c	2011-04-15 17:15:40 +0000
@@ -4530,6 +4530,19 @@
              &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;

=== modified file 'src/w32.c'
--- src/w32.c	2011-04-06 16:05:49 +0000
+++ src/w32.c	2011-04-15 17:15:40 +0000
@@ -6102,5 +6102,75 @@
   p->childp = childp2;
 }
 
+#ifdef HAVE_GNUTLS
+
+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 = sys_read(fd, (char*)buf, sz);
+
+      if (n >= 0)
+        return n;
+      else
+        {
+          int err = errno;
+
+          if (err == EWOULDBLOCK)
+            {
+              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 || errno == EWOULDBLOCK)
+                /* We have to translate WSAEWOULDBLOCK alias
+		   EWOULDBLOCK to EAGAIN for GnuTLS.  */
+                err = EAGAIN;
+              else
+                err = errno;
+            }
+          gnutls_transport_set_errno (proc->gnutls_state, err);
+
+          return -1;
+        }
+    }
+}
+
+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 = sys_write((int)fd, buf, sz);
+
+  if (n >= 0)
+    return n;
+  else
+    {
+      gnutls_transport_set_errno (proc->gnutls_state,
+                                  /* Translate WSAEWOULDBLOCK alias
+                                     EWOULDBLOCK to EAGAIN for
+                                     GnuTLS.  */
+                                  errno == EWOULDBLOCK
+                                  ? EAGAIN
+                                  : errno);
+
+      return -1;
+    }
+}
+#endif /* HAVE_GNUTLS */
+
 /* end of w32.c */
 

=== modified file 'src/w32.h'
--- src/w32.h	2011-01-25 04:08:28 +0000
+++ src/w32.h	2011-04-15 17:15:40 +0000
@@ -143,5 +143,14 @@
 extern int _sys_read_ahead (int fd);
 extern int _sys_wait_accept (int fd);
 
+#ifdef HAVE_GNUTLS
+#include <gnutls/gnutls.h>
+
+extern ssize_t emacs_gnutls_pull (gnutls_transport_ptr_t p,
+                                  void* buf, size_t sz);
+extern ssize_t emacs_gnutls_push (gnutls_transport_ptr_t p,
+                                  const void* buf, size_t sz);
+#endif /* HAVE_GNUTLS */
+
 #endif /* EMACS_W32_H */
 

Re: [PATCH] GnuTLS support on Woe32

[Eli Zaretskii]

> From: Ted Zlatanov <tzz@lifelogs.com>
> Date: Fri, 15 Apr 2011 13:14:36 -0500
> 
> *sigh* one more rebase...

If you have a separate branch (i.e. one that is not bound to the
remote trunk), then you don't need to rebase at all.  Just wait until
the paperwork is done, and then simply merge from that branch onto
your trunk mirror; then commit.

Bazaar (and other dVCSs) does a much better job tracking changes in
each branch, so merge conflicts are very rare, unless someone actually
changes the same lines that you did.

Re: [PATCH] GnuTLS support on Woe32

[Ted Zlatanov]

On Fri, 15 Apr 2011 21:23:02 +0300 Eli Zaretskii <eliz@gnu.org> wrote: 

>> From: Ted Zlatanov <tzz@lifelogs.com>
>> Date: Fri, 15 Apr 2011 13:14:36 -0500
>> 
>> *sigh* one more rebase...

EZ> If you have a separate branch (i.e. one that is not bound to the
EZ> remote trunk), then you don't need to rebase at all.  Just wait until
EZ> the paperwork is done, and then simply merge from that branch onto
EZ> your trunk mirror; then commit.

I honestly thought Claudio's papers would be done by now, that's why I
didn't put effort into setting a branch up.

Ted

Re: [PATCH] GnuTLS support on Woe32

[Richard Stallman]

Have you asked Claudio to write to assign@gnu.org to try to speed this
up?  That is what you should do any time there is a delay caused by
papers.  Don't moan uselessly; take action that might help.

-- 
Dr Richard Stallman
President, Free Software Foundation
51 Franklin St
Boston MA 02110
USA
www.fsf.org, www.gnu.org
Skype: No way! That's nonfree (freedom-denying) software.

Re: [PATCH] GnuTLS support on Woe32

[Ted Zlatanov]

On Fri, 15 Apr 2011 19:58:05 -0400 Richard Stallman <rms@gnu.org> wrote: 

RS> Have you asked Claudio to write to assign@gnu.org to try to speed this
RS> up?  That is what you should do any time there is a delay caused by
RS> papers.  Don't moan uselessly; take action that might help.

I haven't heard back, though I've sent several e-mails to Claudio.  The
best I can do is split the patch between my work and his.  I'd really
hate to do that because he added W32 support that is badly needed (W32
is where most of the TLS issues with Gnus happen).  I'd rewrite his work
but it's rude.

Ted

Re: [PATCH] GnuTLS support on Woe32

[Lars Magne Ingebrigtsen]

Ted Zlatanov <tzz@lifelogs.com> writes:

> I'd rewrite his work but it's rude.

It's just code.  Code is for rewriting.  :-)

-- 
(domestic pets only, the antidote for overdose, milk.)
  bloggy blog http://lars.ingebrigtsen.no/

Re: [PATCH] GnuTLS support on Woe32

[Ted Zlatanov]

On Sat, 16 Apr 2011 03:45:02 +0200 Lars Magne Ingebrigtsen <larsi@gnus.org> wrote: 

LMI> Ted Zlatanov <tzz@lifelogs.com> writes:
>> I'd rewrite his work but it's rude.

LMI> It's just code.  Code is for rewriting.  :-)

Not too long ago someone complained when I rewrote a contribution (for
load-dir.el) so I'm trying to avoid that.  I'll wait a few more days and
then rewrite his contributions if Claudio is still not accessible.  I
certainly hope he's all right--he hasn't replied to personal e-mails either.

Ted

Re: [PATCH] GnuTLS support on Woe32

[Ted Zlatanov]

[-- Attachment #1: Type: text/plain, Size: 1176 bytes --]

On Mon, 18 Apr 2011 10:51:30 -0500 Ted Zlatanov <tzz@lifelogs.com> wrote: 

TZ> On Sat, 16 Apr 2011 03:45:02 +0200 Lars Magne Ingebrigtsen <larsi@gnus.org> wrote: 
LMI> Ted Zlatanov <tzz@lifelogs.com> writes:
>>> I'd rewrite his work but it's rude.

LMI> It's just code.  Code is for rewriting.  :-)

TZ> Not too long ago someone complained when I rewrote a contribution (for
TZ> load-dir.el) so I'm trying to avoid that.  I'll wait a few more days and
TZ> then rewrite his contributions if Claudio is still not accessible.  I
TZ> certainly hope he's all right--he hasn't replied to personal e-mails either.

Well, here's the patch with Claudio's code marked as (tiny change) or in
my name; I rewrote it a little but it really couldn't be written too
differently without writing it badly.

Please review and let me know if you need me to do more rewriting.  I'd
like to commit this after approval from one of the maintainers.  I'd
also like to mention Claudio's name as much as possible as a contributor
to this patch in NEWS.  Should I add the NEWS update to this patch?  It
needs a GnuTLS entry anyhow...  But I need W32 users to test it before
announcing it's ready!

Ted


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 2011-04-21 --]
[-- Type: text/x-diff, Size: 39414 bytes --]

=== modified file 'ChangeLog'
--- ChangeLog	2011-04-20 17:23:30 +0000
+++ ChangeLog	2011-04-21 22:17:47 +0000
@@ -1,3 +1,7 @@
+2011-04-21  Teodor Zlatanov  <tzz@lifelogs.com>
+
+	* configure.in: Check for GnuTLS certificate verify callbacks.
+
 2011-04-20  Stefan Monnier  <monnier@iro.umontreal.ca>
 
 	* Makefile.in (config.status): Don't erase in case of error.

=== modified file 'configure.in'
--- configure.in	2011-04-20 02:18:13 +0000
+++ configure.in	2011-04-21 22:13:49 +0000
@@ -1972,12 +1972,22 @@
 AC_SUBST(LIBSELINUX_LIBS)
 
 HAVE_GNUTLS=no
+HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY=no
 if test "${with_gnutls}" = "yes" ; then
   PKG_CHECK_MODULES([LIBGNUTLS], [gnutls >= 2.2.4], HAVE_GNUTLS=yes, HAVE_GNUTLS=no)
   if test "${HAVE_GNUTLS}" = "yes"; then
     AC_DEFINE(HAVE_GNUTLS, 1, [Define if using GnuTLS.])
   fi
+
+  CFLAGS="$CFLAGS $LIBGNUTLS_CFLAGS"
+  LIBS="$LIBGNUTLS_LIBS $LIBS"
+  AC_CHECK_FUNCS(gnutls_certificate_set_verify_function, HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY=yes)
+
+  if test "${HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY}" = "yes"; then
+    AC_DEFINE(HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY, 1, [Define if using GnuTLS certificate verification callbacks.])
+  fi
 fi
+
 AC_SUBST(LIBGNUTLS_LIBS)
 AC_SUBST(LIBGNUTLS_CFLAGS)
 
@@ -3675,6 +3685,7 @@
 echo "  Does Emacs use -lgconf?                                 ${HAVE_GCONF}"
 echo "  Does Emacs use -lselinux?                               ${HAVE_LIBSELINUX}"
 echo "  Does Emacs use -lgnutls?                                ${HAVE_GNUTLS}"
+echo "  Does Emacs use -lgnutls certificate verify callbacks?   ${HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY}"
 echo "  Does Emacs use -lxml2?                                  ${HAVE_LIBXML2}"
 
 echo "  Does Emacs use -lfreetype?                              ${HAVE_FREETYPE}"

=== modified file 'lib-src/ChangeLog'
--- lib-src/ChangeLog	2011-04-16 23:11:35 +0000
+++ lib-src/ChangeLog	2011-04-21 22:18:23 +0000
@@ -1,3 +1,7 @@
+2011-04-21  Claudio Bley  <claudio.bley@gmail.com>  (tiny change)
+
+	* makefile.w32-in (obj): Added gnutls.o.
+
 2011-04-16  Paul Eggert  <eggert@cs.ucla.edu>
 
 	Static checks with GCC 4.6.0 and non-default toolkits.

=== modified file 'lib-src/makefile.w32-in'
--- lib-src/makefile.w32-in	2011-03-12 19:19:47 +0000
+++ lib-src/makefile.w32-in	2011-04-21 22:13:49 +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-04-21 12:24:46 +0000
+++ lisp/ChangeLog	2011-04-21 22:19:02 +0000
@@ -1,3 +1,19 @@
+2011-04-21  Teodor Zlatanov  <tzz@lifelogs.com>
+
+	* net/gnutls.el (gnutls-negotiate): Add hostname, verify-flags,
+	verify-error, and verify-hostname-error parameters.
+	(open-gnutls-stream): Add usage example.
+
+	* net/network-stream.el (network-stream-open-starttls): Give host
+	parameter to `gnutls-negotiate'.
+	(gnutls-negotiate): Adjust `gnutls-negotiate' declaration.
+
+2011-04-21  Claudio Bley  <claudio.bley@gmail.com>  (tiny change)
+
+	* 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-04-21  Juanma Barranquero  <lekktu@gmail.com>
 
 	Lexical-binding cleanup.

=== modified file 'lisp/net/gnutls.el'
--- lisp/net/gnutls.el	2011-01-25 04:08:28 +0000
+++ lisp/net/gnutls.el	2011-04-21 22:13:49 +0000
@@ -25,7 +25,8 @@
 ;;; Commentary:
 
 ;; This package provides language bindings for the GnuTLS library
-;; using the corresponding core functions in gnutls.c.
+;; using the corresponding core functions in gnutls.c.  It should NOT
+;; be used directly, only through open-protocol-stream.
 
 ;; Simple test:
 ;;
@@ -59,26 +60,76 @@
 Fourth arg SERVICE is name of the service desired, or an integer
 specifying a port number to connect to.
 
+Usage example:
+
+  \(with-temp-buffer
+    \(open-gnutls-stream \"tls\"
+                        \(current-buffer)
+                        \"your server goes here\"
+                        \"imaps\"))
+
 This is a very simple wrapper around `gnutls-negotiate'.  See its
 documentation for the specific parameters you can use to open a
 GnuTLS connection, including specifying the credential type,
 trust and key files, and priority string."
-  (let ((proc (open-network-stream name buffer host service)))
-    (gnutls-negotiate proc 'gnutls-x509pki)))
+  (gnutls-negotiate (open-network-stream name buffer host service)
+                    'gnutls-x509pki
+                    host))
+
+(put 'gnutls-error
+     'error-conditions
+     '(error gnutls-error))
+(put 'gnutls-error
+     'error-message "GnuTLS error")
 
 (declare-function gnutls-boot "gnutls.c" (proc type proplist))
 
-(defun gnutls-negotiate (proc type &optional priority-string
-                              trustfiles keyfiles)
-  "Negotiate a SSL/TLS connection.
+(defun gnutls-negotiate (proc type hostname &optional priority-string
+                              trustfiles keyfiles verify-flags
+                              verify-error verify-hostname-error)
+  "Negotiate a SSL/TLS connection.  Returns proc. Signals gnutls-error.
 TYPE is `gnutls-x509pki' (default) or `gnutls-anon'.  Use nil for the default.
 PROC is a process returned by `open-network-stream'.
+HOSTNAME is the remote hostname.  It must be a valid string.
 PRIORITY-STRING is as per the GnuTLS docs, default is \"NORMAL\".
 TRUSTFILES is a list of CA bundles.
-KEYFILES is a list of client keys."
+KEYFILES is a list of client keys.
+
+When VERIFY-HOSTNAME-ERROR is not nil, an error will be raised
+when the hostname does not match the presented certificate's host
+name.  The exact verification algorithm is a basic implementation
+of the matching described in RFC2818 (HTTPS), which takes into
+account wildcards, and the DNSName/IPAddress subject alternative
+name PKIX extension.  See GnuTLS' gnutls_x509_crt_check_hostname
+for details.  When VERIFY-HOSTNAME-ERROR is nil, only a warning
+will be issued.
+
+When VERIFY-ERROR is not nil, an error will be raised when the
+peer certificate verification fails as per GnuTLS'
+gnutls_certificate_verify_peers2.  Otherwise, only warnings will
+be shown about the verification failure.
+
+VERIFY-FLAGS is a numeric OR of verification flags only for
+`gnutls-x509pki' connections.  See GnuTLS' x509.h for details;
+here's a recent version of the list.
+
+    GNUTLS_VERIFY_DISABLE_CA_SIGN = 1,
+    GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT = 2,
+    GNUTLS_VERIFY_DO_NOT_ALLOW_SAME = 4,
+    GNUTLS_VERIFY_ALLOW_ANY_X509_V1_CA_CRT = 8,
+    GNUTLS_VERIFY_ALLOW_SIGN_RSA_MD2 = 16,
+    GNUTLS_VERIFY_ALLOW_SIGN_RSA_MD5 = 32,
+    GNUTLS_VERIFY_DISABLE_TIME_CHECKS = 64,
+    GNUTLS_VERIFY_DISABLE_TRUSTED_TIME_CHECKS = 128,
+    GNUTLS_VERIFY_DO_NOT_ALLOW_X509_V1_CA_CRT = 256
+
+It must be omitted, a number, or nil; if omitted or nil it
+defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT."
   (let* ((type (or type 'gnutls-x509pki))
+         (default-trustfile "/etc/ssl/certs/ca-certificates.crt")
          (trustfiles (or trustfiles
-                        '("/etc/ssl/certs/ca-certificates.crt")))
+                         (when (file-exists-p default-trustfile)
+                           (list default-trustfile))))
          (priority-string (or priority-string
                               (cond
                                ((eq type 'gnutls-anon)
@@ -86,15 +137,22 @@
                                ((eq type 'gnutls-x509pki)
                                 "NORMAL"))))
          (params `(:priority ,priority-string
+                             :hostname ,hostname
                              :loglevel ,gnutls-log-level
                              :trustfiles ,trustfiles
                              :keyfiles ,keyfiles
+                             :verify-flags ,verify-flags
+                             :verify-error ,verify-error
+                             :verify-hostname-error ,verify-hostname-error
                              :callbacks nil))
          ret)
 
     (gnutls-message-maybe
      (setq ret (gnutls-boot proc type params))
-     "boot: %s")
+     "boot: %s" params)
+
+    (when (gnutls-errorp ret)
+      (signal 'gnutls-error (list proc ret)))
 
     proc))
 

=== modified file 'lisp/net/network-stream.el'
--- lisp/net/network-stream.el	2011-04-12 22:18:02 +0000
+++ lisp/net/network-stream.el	2011-04-21 22:13:49 +0000
@@ -46,7 +46,8 @@
 (require 'starttls)
 
 (declare-function gnutls-negotiate "gnutls"
-		  (proc type &optional priority-string trustfiles keyfiles))
+                  (proc type host &optional priority-string trustfiles keyfiles
+                        verify-flags verify-error verify-hostname-error))
 
 ;;;###autoload
 (defun open-network-stream (name buffer host service &rest parameters)
@@ -197,7 +198,7 @@
 			  (network-stream-command stream starttls-command eoc))
 	;; The server said it was OK to begin STARTTLS negotiations.
 	(if (fboundp 'open-gnutls-stream)
-	    (gnutls-negotiate stream nil)
+	    (gnutls-negotiate stream nil host)
 	  (unless (starttls-negotiate stream)
 	    (delete-process stream)))
 	(if (memq (process-status stream) '(open run))

=== modified file 'nt/ChangeLog'
--- nt/ChangeLog	2011-04-15 22:48:00 +0000
+++ nt/ChangeLog	2011-04-21 22:26:44 +0000
@@ -1,3 +1,11 @@
+2011-04-21  Claudio Bley  <claudio.bley@gmail.com>  (tiny change)
+
+	* configure.bat: New options --without-gnutls and --lib, new build
+	variable USER_LIBS, automatically detect GnuTLS.  Copies the PNG
+	library setup.
+	* INSTALL: Add instructions for GnuTLS support.
+	* gmake.defs: Prefix USER_LIB's with -l.
+
 2011-04-15  Ben Key  <bkey76@gmail.com>
 
 	* configure.bat: Modified the code that parses the --cflags and

=== modified file 'nt/INSTALL'
--- nt/INSTALL	2011-04-15 22:48:00 +0000
+++ nt/INSTALL	2011-04-21 22:13:49 +0000
@@ -316,6 +316,16 @@
   `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.
+
+  Pre-built binaries and an installer can be found at
+  http://josefsson.org/gnutls4win/.
+
 * Experimental SVG support
 
   SVG support is currently experimental, and not built by default.

=== modified file 'nt/configure.bat'
--- nt/configure.bat	2011-04-15 22:48:00 +0000
+++ nt/configure.bat	2011-04-21 22:13:49 +0000
@@ -99,10 +99,13 @@
 set usercflags=
 set docflags=
 set userldflags=
+set userlibs=
 set doldflags=
+set dolibs=
 set sep1=
 set sep2=
 set sep3=
+set sep4=
 set distfiles=
 
 rem ----------------------------------------------------------------------
@@ -120,10 +123,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
@@ -142,11 +147,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
 if "%use_extensions%" == "0" goto end
@@ -242,6 +249,14 @@
 shift
 goto again
 
+:userlibs
+shift
+echo. userlibs: %userlibs%
+set userlibs=%userlibs%%sep4%%1
+set sep4= %nothing%
+shift
+goto again
+
 rem ----------------------------------------------------------------------
 
 :userldflags
@@ -288,6 +303,14 @@
 
 rem ----------------------------------------------------------------------
 
+:withoutgnutls
+set tlssupport=N
+set HAVE_GNUTLS=
+shift
+goto again
+
+rem ----------------------------------------------------------------------
+
 :withouttiff
 set tiffsupport=N
 set HAVE_TIFF=
@@ -516,6 +539,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...
@@ -688,6 +734,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
 
@@ -700,6 +748,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
@@ -838,6 +887,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-04-21 22:13:49 +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-04-19 10:48:30 +0000
+++ src/ChangeLog	2011-04-21 22:45:20 +0000
@@ -1,3 +1,39 @@
+2011-04-21  Teodor Zlatanov  <tzz@lifelogs.com>
+
+	* gnutls.h: Add GNUTLS_STAGE_CALLBACKS enum to denote we're in the
+	callbacks stage.
+
+	* gnutls.c: Renamed global_initialized to
+	gnutls_global_initialized.  Added internals for the
+	:verify-hostname-error, :verify-error, and :verify-flags
+	parameters of `gnutls-boot' and documented those parameters in the
+	docstring.  Start callback support.
+	(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.
+
+	* w32.h: (emacs_gnutls_pull): Add prototype.
+	(emacs_gnutls_push): Likewise.
+
+	* w32.c: (emacs_gnutls_pull): New function for GnuTLS on Woe32.
+	(emacs_gnutls_push): Likewise.
+
+2011-04-21  Claudio Bley  <claudio.bley@gmail.com>  (tiny change)
+
+	* 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.
+
 2011-04-19  Eli Zaretskii  <eliz@gnu.org>
 
 	* syntax.h (SETUP_SYNTAX_TABLE_FOR_OBJECT): Fix setting of

=== modified file 'src/gnutls.c'
--- src/gnutls.c	2011-04-16 19:16:40 +0000
+++ src/gnutls.c	2011-04-21 22:46:56 +0000
@@ -26,11 +26,20 @@
 #ifdef HAVE_GNUTLS
 #include <gnutls/gnutls.h>
 
+#ifdef WINDOWSNT
+#include <windows.h>
+#include "w32.h"
+#endif
+
+static int
+emacs_gnutls_handle_error (gnutls_session_t, int err);
+
+Lisp_Object Qgnutls_log_level;
 Lisp_Object Qgnutls_code;
 Lisp_Object Qgnutls_anon, Qgnutls_x509pki;
 Lisp_Object Qgnutls_e_interrupted, Qgnutls_e_again,
   Qgnutls_e_invalid_session, Qgnutls_e_not_ready_for_handshake;
-int global_initialized;
+int gnutls_global_initialized;
 
 /* The following are for the property list of `gnutls-boot'.  */
 Lisp_Object Qgnutls_bootprop_priority;
@@ -38,8 +47,27 @@
 Lisp_Object Qgnutls_bootprop_keyfiles;
 Lisp_Object Qgnutls_bootprop_callbacks;
 Lisp_Object Qgnutls_bootprop_loglevel;
-
-static void
+Lisp_Object Qgnutls_bootprop_hostname;
+Lisp_Object Qgnutls_bootprop_verify_flags;
+Lisp_Object Qgnutls_bootprop_verify_error;
+Lisp_Object Qgnutls_bootprop_verify_hostname_error;
+
+/* Callback keys for `gnutls-boot'.  Unused currently.  */
+Lisp_Object Qgnutls_bootprop_callbacks_verify;
+
+static void
+gnutls_log_function (int level, const char* string)
+{
+  message ("gnutls.c: [%d] %s", level, string);
+}
+
+static void
+gnutls_log_function2 (int level, const char* string, const char* extra)
+{
+  message ("gnutls.c: [%d] %s %s", level, string, extra);
+}
+
+static int
 emacs_gnutls_handshake (struct Lisp_Process *proc)
 {
   gnutls_session_t state = proc->gnutls_state;
@@ -50,24 +78,55 @@
 
   if (proc->gnutls_initstage < GNUTLS_STAGE_TRANSPORT_POINTERS_SET)
     {
+#ifdef WINDOWSNT
+      /* On W32 we cannot transfer socket handles between different runtime
+         libraries, so we tell GnuTLS to use our special push/pull
+         functions.  */
+      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)
     {
-      /* here we're finally done.  */
+      /* Here we're finally done.  */
       proc->gnutls_initstage = GNUTLS_STAGE_READY;
     }
+  else
+    {
+        gnutls_alert_send_appropriate (state, ret);
+    }
+  return ret;
 }
 
 EMACS_INT
@@ -107,6 +166,7 @@
       bytes_written += rtnval;
     }
 
+  emacs_gnutls_handle_error (state, rtnval);
   return (bytes_written);
 }
 
@@ -122,19 +182,68 @@
       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;
   }
 }
 
+/* report a GnuTLS error to the user.
+   Returns zero if the error code was successfully handled. */
+static int
+emacs_gnutls_handle_error (gnutls_session_t session, int err)
+{
+  Lisp_Object gnutls_log_level = Fsymbol_value (Qgnutls_log_level);
+  int max_log_level = 0;
+
+  int alert, ret;
+  const char *str;
+
+  /* TODO: use a Lisp_Object generated by gnutls_make_error?  */
+  if (err >= 0)
+    return 0;
+
+  if (NUMBERP (gnutls_log_level))
+    max_log_level = XINT (gnutls_log_level);
+
+  /* TODO: use gnutls-error-fatalp and gnutls-error-string.  */
+
+  str = gnutls_strerror (err);
+  if (str == NULL)
+    str = "unknown";
+
+  if (gnutls_error_is_fatal (err) == 0)
+    {
+      ret = 0;
+      GNUTLS_LOG2 (1, max_log_level, "non-fatal error:", str);
+      /* TODO: EAGAIN AKA Qgnutls_e_again should be level 2.  */
+    }
+  else
+    {
+      ret = err;
+      GNUTLS_LOG2 (0, max_log_level, "fatal error:", str);
+    }
+
+  if (err == GNUTLS_E_WARNING_ALERT_RECEIVED
+      || err == GNUTLS_E_FATAL_ALERT_RECEIVED)
+    {
+      int alert = gnutls_alert_get (session);
+      int level = err == GNUTLS_E_FATAL_ALERT_RECEIVED ? 0 : 1;
+      str = gnutls_alert_get_name (alert);
+      if (str == NULL)
+	str = "unknown";
+
+      GNUTLS_LOG2 (level, max_log_level, "Received 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
@@ -262,14 +371,14 @@
 Call `gnutls-global-deinit' when GnuTLS usage is no longer needed.
 Returns zero on success.  */
 static Lisp_Object
-gnutls_emacs_global_init (void)
+emacs_gnutls_global_init (void)
 {
   int ret = GNUTLS_E_SUCCESS;
 
-  if (!global_initialized)
+  if (!gnutls_global_initialized)
     ret = gnutls_global_init ();
 
-  global_initialized = 1;
+  gnutls_global_initialized = 1;
 
   return gnutls_make_error (ret);
 }
@@ -277,28 +386,16 @@
 /* Deinitializes global GnuTLS state.
 See also `gnutls-global-init'.  */
 static Lisp_Object
-gnutls_emacs_global_deinit (void)
+emacs_gnutls_global_deinit (void)
 {
-  if (global_initialized)
+  if (gnutls_global_initialized)
     gnutls_global_deinit ();
 
-  global_initialized = 0;
+  gnutls_global_initialized = 0;
 
   return gnutls_make_error (GNUTLS_E_SUCCESS);
 }
 
-static void
-gnutls_log_function (int level, const char* string)
-{
-  message ("gnutls.c: [%d] %s", level, string);
-}
-
-static void
-gnutls_log_function2 (int level, const char* string, const char* extra)
-{
-  message ("gnutls.c: [%d] %s %s", level, string, extra);
-}
-
 DEFUN ("gnutls-boot", Fgnutls_boot, Sgnutls_boot, 3, 3, 0,
        doc: /* Initialize GnuTLS client for process PROC with TYPE+PROPLIST.
 Currently only client mode is supported.  Returns a success/failure
@@ -307,12 +404,27 @@
 TYPE is a symbol, either `gnutls-anon' or `gnutls-x509pki'.
 PROPLIST is a property list with the following keys:
 
+:hostname is a string naming the remote host.
+
 :priority is a GnuTLS priority string, defaults to "NORMAL".
+
 :trustfiles is a list of PEM-encoded trust files for `gnutls-x509pki'.
+
 :keyfiles is a list of PEM-encoded key files for `gnutls-x509pki'.
-:callbacks is an alist of callback functions (TODO).
+
+:callbacks is an alist of callback functions, see below.
+
 :loglevel is the debug level requested from GnuTLS, try 4.
 
+:verify-flags is a bitset as per GnuTLS'
+gnutls_certificate_set_verify_flags.
+
+:verify-error, if non-nil, makes failure of the certificate validation
+an error.  Otherwise it will be just a series of warnings.
+
+:verify-hostname-error, if non-nil, makes a hostname mismatch an
+error.  Otherwise it will be just a warning.
+
 The debug level will be set for this process AND globally for GnuTLS.
 So if you set it higher or lower at any point, it affects global
 debugging.
@@ -325,6 +437,9 @@
 functions are used.  This function allocates resources which can only
 be deallocated by calling `gnutls-deinit' or by calling it again.
 
+The callbacks alist can have a `verify' key, associated with a
+verification function (UNUSED).
+
 Each authentication type may need additional information in order to
 work.  For X.509 PKI (`gnutls-x509pki'), you probably need at least
 one trustfile (usually a CA bundle).  */)
@@ -337,12 +452,19 @@
   /* TODO: GNUTLS_X509_FMT_DER is also an option.  */
   int file_format = GNUTLS_X509_FMT_PEM;
 
+  unsigned int gnutls_verify_flags = GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT;
+  gnutls_x509_crt_t gnutls_verify_cert;
+  unsigned int gnutls_verify_cert_list_size;
+  const gnutls_datum_t *gnutls_verify_cert_list;
+
   gnutls_session_t state;
   gnutls_certificate_credentials_t x509_cred;
   gnutls_anon_client_credentials_t anon_cred;
   Lisp_Object global_init;
   char* priority_string_ptr = "NORMAL"; /* default priority string.  */
   Lisp_Object tail;
+  int peer_verification;
+  char* c_hostname;
 
   /* Placeholders for the property list elements.  */
   Lisp_Object priority_string;
@@ -350,16 +472,29 @@
   Lisp_Object keyfiles;
   Lisp_Object callbacks;
   Lisp_Object loglevel;
+  Lisp_Object hostname;
+  Lisp_Object verify_flags;
+  Lisp_Object verify_error;
+  Lisp_Object verify_hostname_error;
 
   CHECK_PROCESS (proc);
   CHECK_SYMBOL (type);
   CHECK_LIST (proplist);
 
-  priority_string = Fplist_get (proplist, Qgnutls_bootprop_priority);
-  trustfiles      = Fplist_get (proplist, Qgnutls_bootprop_trustfiles);
-  keyfiles        = Fplist_get (proplist, Qgnutls_bootprop_keyfiles);
-  callbacks       = Fplist_get (proplist, Qgnutls_bootprop_callbacks);
-  loglevel        = Fplist_get (proplist, Qgnutls_bootprop_loglevel);
+  hostname              = Fplist_get (proplist, Qgnutls_bootprop_hostname);
+  priority_string       = Fplist_get (proplist, Qgnutls_bootprop_priority);
+  trustfiles            = Fplist_get (proplist, Qgnutls_bootprop_trustfiles);
+  keyfiles              = Fplist_get (proplist, Qgnutls_bootprop_keyfiles);
+  callbacks             = Fplist_get (proplist, Qgnutls_bootprop_callbacks);
+  loglevel              = Fplist_get (proplist, Qgnutls_bootprop_loglevel);
+  verify_flags          = Fplist_get (proplist, Qgnutls_bootprop_verify_flags);
+  verify_error          = Fplist_get (proplist, Qgnutls_bootprop_verify_error);
+  verify_hostname_error = Fplist_get (proplist, Qgnutls_bootprop_verify_hostname_error);
+
+  if (!STRINGP (hostname))
+    error ("gnutls-boot: invalid :hostname parameter");
+
+  c_hostname = SSDATA (hostname);
 
   state = XPROCESS (proc)->gnutls_state;
   XPROCESS (proc)->gnutls_p = 1;
@@ -373,7 +508,7 @@
     }
 
   /* always initialize globals.  */
-  global_init = gnutls_emacs_global_init ();
+  global_init = emacs_gnutls_global_init ();
   if (! NILP (Fgnutls_errorp (global_init)))
     return global_init;
 
@@ -417,6 +552,23 @@
       x509_cred = XPROCESS (proc)->gnutls_x509_cred;
       if (gnutls_certificate_allocate_credentials (&x509_cred) < 0)
         memory_full ();
+
+      if (NUMBERP (verify_flags))
+        {
+          gnutls_verify_flags = XINT (verify_flags);
+          GNUTLS_LOG (2, max_log_level, "setting verification flags");
+        }
+      else if (NILP (verify_flags))
+        {
+          /* The default is already GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT.  */
+          GNUTLS_LOG (2, max_log_level, "using default verification flags");
+        }
+      else
+        {
+          /* The default is already GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT.  */
+          GNUTLS_LOG (2, max_log_level, "ignoring invalid verify-flags");
+        }
+      gnutls_certificate_set_verify_flags (x509_cred, gnutls_verify_flags);
     }
   else if (EQ (type, Qgnutls_anon))
     {
@@ -485,6 +637,14 @@
 
   GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_FILES;
 
+  GNUTLS_LOG (1, max_log_level, "gnutls callbacks");
+
+  GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CALLBACKS;
+
+#ifdef HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY
+#else
+#endif
+
   GNUTLS_LOG (1, max_log_level, "gnutls_init");
 
   ret = gnutls_init (&state, GNUTLS_CLIENT);
@@ -542,9 +702,113 @@
 
   GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CRED_SET;
 
-  emacs_gnutls_handshake (XPROCESS (proc));
-
-  return gnutls_make_error (GNUTLS_E_SUCCESS);
+  ret = emacs_gnutls_handshake (XPROCESS (proc));
+
+  if (ret < GNUTLS_E_SUCCESS)
+    return gnutls_make_error (ret);
+
+  /* Now verify the peer, following
+     http://www.gnu.org/software/gnutls/manual/html_node/Verifying-peer_0027s-certificate.html.
+     The peer should present at least one certificate in the chain; do a
+     check of the certificate's hostname with
+     gnutls_x509_crt_check_hostname() against :hostname.  */
+
+  ret = gnutls_certificate_verify_peers2 (state, &peer_verification);
+
+  if (ret < GNUTLS_E_SUCCESS)
+    return gnutls_make_error (ret);
+  
+  if (XINT (loglevel) > 0 && peer_verification & GNUTLS_CERT_INVALID)
+    message ("%s certificate could not be verified.", 
+             c_hostname);
+ 
+ if (peer_verification & GNUTLS_CERT_REVOKED)
+   GNUTLS_LOG2 (1, max_log_level, "certificate was revoked (CRL):",
+                c_hostname);
+ 
+ if (peer_verification & GNUTLS_CERT_SIGNER_NOT_FOUND)
+   GNUTLS_LOG2 (1, max_log_level, "certificate signer was not found:",
+                c_hostname);
+ 
+ if (peer_verification & GNUTLS_CERT_SIGNER_NOT_CA)
+   GNUTLS_LOG2 (1, max_log_level, "certificate signer is not a CA:",
+                c_hostname);
+
+ if (peer_verification & GNUTLS_CERT_INSECURE_ALGORITHM)
+   GNUTLS_LOG2 (1, max_log_level,
+                "certificate was signed with an insecure algorithm:",
+                c_hostname);
+
+ if (peer_verification & GNUTLS_CERT_NOT_ACTIVATED)
+   GNUTLS_LOG2 (1, max_log_level, "certificate is not yet activated:",
+                c_hostname);
+
+ if (peer_verification & GNUTLS_CERT_EXPIRED)
+   GNUTLS_LOG2 (1, max_log_level, "certificate has expired:",
+                c_hostname);
+
+ if (peer_verification != 0)
+   {
+     if (NILP (verify_hostname_error))
+       {
+         GNUTLS_LOG2 (1, max_log_level, "certificate validation failed:",
+                      c_hostname);
+       }
+     else
+       {
+         error ("Certificate validation failed %s, verification code %d",
+                c_hostname, peer_verification);
+       }
+   }
+
+  /* Up to here the process is the same for X.509 certificates and
+     OpenPGP keys.  From now on X.509 certificates are assumed.  This
+     can be easily extended to work with openpgp keys as well.  */
+  if (gnutls_certificate_type_get (state) == GNUTLS_CRT_X509)
+    {
+      ret = gnutls_x509_crt_init (&gnutls_verify_cert);
+
+      if (ret < GNUTLS_E_SUCCESS)
+        return gnutls_make_error (ret);
+
+      gnutls_verify_cert_list = 
+        gnutls_certificate_get_peers (state, &gnutls_verify_cert_list_size);
+
+      if (NULL == gnutls_verify_cert_list)
+        {
+          error ("No x509 certificate was found!\n");
+        }
+
+      /* We only check the first certificate in the given chain.  */
+      ret = gnutls_x509_crt_import (gnutls_verify_cert,
+                                    &gnutls_verify_cert_list[0],
+                                    GNUTLS_X509_FMT_DER);
+
+      if (ret < GNUTLS_E_SUCCESS)
+        {
+          gnutls_x509_crt_deinit (gnutls_verify_cert);
+          return gnutls_make_error (ret);
+        }
+
+      if (!gnutls_x509_crt_check_hostname (gnutls_verify_cert, c_hostname))
+        {
+          if (NILP (verify_hostname_error))
+            {
+              GNUTLS_LOG2 (1, max_log_level, "x509 certificate does not match:",
+                           c_hostname);
+            }
+          else
+            {
+              gnutls_x509_crt_deinit (gnutls_verify_cert);
+              error ("The x509 certificate does not match \"%s\"",
+                     c_hostname);
+            }
+        }
+
+      gnutls_x509_crt_deinit (gnutls_verify_cert);
+    }
+
+  return gnutls_make_error (ret);
 }
 
 DEFUN ("gnutls-bye", Fgnutls_bye,
@@ -579,7 +843,10 @@
 void
 syms_of_gnutls (void)
 {
-  global_initialized = 0;
+  gnutls_global_initialized = 0;
+
+  Qgnutls_log_level = intern_c_string ("gnutls-log-level");
+  staticpro (&Qgnutls_log_level);
 
   Qgnutls_code = intern_c_string ("gnutls-code");
   staticpro (&Qgnutls_code);
@@ -590,6 +857,9 @@
   Qgnutls_x509pki = intern_c_string ("gnutls-x509pki");
   staticpro (&Qgnutls_x509pki);
 
+  Qgnutls_bootprop_hostname = intern_c_string (":hostname");
+  staticpro (&Qgnutls_bootprop_hostname);
+
   Qgnutls_bootprop_priority = intern_c_string (":priority");
   staticpro (&Qgnutls_bootprop_priority);
 
@@ -602,9 +872,21 @@
   Qgnutls_bootprop_callbacks = intern_c_string (":callbacks");
   staticpro (&Qgnutls_bootprop_callbacks);
 
+  Qgnutls_bootprop_callbacks_verify = intern_c_string ("verify");
+  staticpro (&Qgnutls_bootprop_callbacks_verify);
+
   Qgnutls_bootprop_loglevel = intern_c_string (":loglevel");
   staticpro (&Qgnutls_bootprop_loglevel);
 
+  Qgnutls_bootprop_verify_flags = intern_c_string (":verify-flags");
+  staticpro (&Qgnutls_bootprop_verify_flags);
+
+  Qgnutls_bootprop_verify_hostname_error = intern_c_string (":verify-error");
+  staticpro (&Qgnutls_bootprop_verify_error);
+
+  Qgnutls_bootprop_verify_hostname_error = intern_c_string (":verify-hostname-error");
+  staticpro (&Qgnutls_bootprop_verify_hostname_error);
+
   Qgnutls_e_interrupted = intern_c_string ("gnutls-e-interrupted");
   staticpro (&Qgnutls_e_interrupted);
   Fput (Qgnutls_e_interrupted, Qgnutls_code,

=== modified file 'src/gnutls.h'
--- src/gnutls.h	2011-04-15 08:22:34 +0000
+++ src/gnutls.h	2011-04-21 22:13:49 +0000
@@ -21,6 +21,7 @@
 
 #ifdef HAVE_GNUTLS
 #include <gnutls/gnutls.h>
+#include <gnutls/x509.h>
 
 typedef enum
 {
@@ -28,6 +29,7 @@
   GNUTLS_STAGE_EMPTY = 0,
   GNUTLS_STAGE_CRED_ALLOC,
   GNUTLS_STAGE_FILES,
+  GNUTLS_STAGE_CALLBACKS,
   GNUTLS_STAGE_INIT,
   GNUTLS_STAGE_PRIORITY,
   GNUTLS_STAGE_CRED_SET,

=== modified file 'src/makefile.w32-in'
--- src/makefile.w32-in	2011-03-19 03:22:14 +0000
+++ src/makefile.w32-in	2011-04-21 22:13:49 +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)
 
 #
@@ -948,6 +950,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-04-16 22:04:41 +0000
+++ src/process.c	2011-04-21 22:13:49 +0000
@@ -4532,6 +4532,19 @@
              &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;

=== modified file 'src/w32.c'
--- src/w32.c	2011-04-06 16:05:49 +0000
+++ src/w32.c	2011-04-21 22:41:47 +0000
@@ -6102,5 +6102,72 @@
   p->childp = childp2;
 }
 
+#ifdef HAVE_GNUTLS
+
+ssize_t
+emacs_gnutls_pull (gnutls_transport_ptr_t p, void* buf, size_t sz)
+{
+  int n, sc, err;
+  SELECT_TYPE fdset;
+  EMACS_TIME timeout;
+  struct Lisp_Process *process = (struct Lisp_Process *)p;
+  int fd = process->infd;
+
+  for (;;)
+    {
+      n = sys_read(fd, (char*)buf, sz);
+
+      if (n >= 0)
+        return n;
+
+      err = errno;
+
+      if (err == EWOULDBLOCK)
+        {
+          /* Set a small timeout.  */
+          EMACS_SET_SECS_USECS(timeout, 1, 0);
+          FD_ZERO (&fdset);
+          FD_SET ((int)fd, &fdset);
+
+          /* Use select with the timeout to poll the selector.  */
+          sc = select (fd + 1, &fdset, (SELECT_TYPE *)0, (SELECT_TYPE *)0,
+                       &timeout);
+
+          if (sc > 0)
+            continue;  /* Try again.  */
+
+          /* Translate the WSAEWOULDBLOCK alias EWOULDBLOCK to EAGAIN.
+             Also accept select return 0 as an indicator to EAGAIN.  */
+          if (sc == 0 || errno == EWOULDBLOCK)
+            err = EAGAIN;
+          else
+            err = errno; /* Other errors are just passed on.  */
+        }
+
+      gnutls_transport_set_errno (process->gnutls_state, err);
+
+      return -1;
+    }
+}
+
+ssize_t
+emacs_gnutls_push (gnutls_transport_ptr_t p, const void* buf, size_t sz)
+{
+  struct Lisp_Process *process = (struct Lisp_Process *)p;
+  int fd = proc->outfd;
+  ssize_t n = sys_write(fd, buf, sz);
+
+  /* 0 or more bytes written means everything went fine.  */
+  if (n >= 0)
+    return n;
+
+  /* Negative bytes written means we got an error in errno.
+     Translate the WSAEWOULDBLOCK alias EWOULDBLOCK to EAGAIN.  */
+  gnutls_transport_set_errno (process->gnutls_state,
+                              errno == EWOULDBLOCK ? EAGAIN : errno);
+
+  return -1;
+}
+#endif /* HAVE_GNUTLS */
+
 /* end of w32.c */
-

=== modified file 'src/w32.h'
--- src/w32.h	2011-01-25 04:08:28 +0000
+++ src/w32.h	2011-04-21 22:28:28 +0000
@@ -143,5 +143,17 @@
 extern int _sys_read_ahead (int fd);
 extern int _sys_wait_accept (int fd);
 
+#ifdef HAVE_GNUTLS
+#include <gnutls/gnutls.h>
+
+/* GnuTLS pull (read from remote) interface.  */
+extern ssize_t emacs_gnutls_pull (gnutls_transport_ptr_t p,
+                                  void* buf, size_t sz);
+
+/* GnuTLS push (write to remote) interface.  */
+extern ssize_t emacs_gnutls_push (gnutls_transport_ptr_t p,
+                                  const void* buf, size_t sz);
+#endif /* HAVE_GNUTLS */
+
 #endif /* EMACS_W32_H */
 

Re: [PATCH] GnuTLS support on Woe32

[Glenn Morris]

Ted Zlatanov wrote:

> +echo "  Does Emacs use -lgnutls certificate verify callbacks?   ${HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY}"

Is this really necessary? Not every component of every feature needs to
be advertised at the end of configure.


Also, IMO there's no way that the changes ascribed to Claudio Bley in
this patch can be called a tiny change. The limit of needing copyright
paperwork is 10-15 lines, and that's cumulative over all changes. The
configure.bat part alone looks bigger than that.

Re: [PATCH] GnuTLS support on Woe32

[Ted Zlatanov]

[-- Attachment #1: Type: text/plain, Size: 980 bytes --]

On Fri, 22 Apr 2011 03:07:18 -0400 Glenn Morris <rgm@gnu.org> wrote: 

GM> Ted Zlatanov wrote:
>> +echo "  Does Emacs use -lgnutls certificate verify callbacks?   ${HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY}"

GM> Is this really necessary? Not every component of every feature needs to
GM> be advertised at the end of configure.

Removed.

GM> Also, IMO there's no way that the changes ascribed to Claudio Bley in
GM> this patch can be called a tiny change. The limit of needing copyright
GM> paperwork is 10-15 lines, and that's cumulative over all changes. The
GM> configure.bat part alone looks bigger than that.

I rewrote even more and attributed things appropriately.  For
configure.bat specifically, the changes looked large but they were just
a copy of the PNG detection code; I redid them and they look very much
the same.  

Now, minus comments, there are less than 15 lines by Claudio in the
patch and I'm listed as the author of the rest.  May I commit it?

Thanks
Ted


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 2011-04-22 --]
[-- Type: text/x-diff, Size: 39059 bytes --]

=== modified file 'ChangeLog'
--- ChangeLog	2011-04-20 17:23:30 +0000
+++ ChangeLog	2011-04-22 12:45:25 +0000
@@ -1,3 +1,7 @@
+2011-04-22  Teodor Zlatanov  <tzz@lifelogs.com>
+
+	* configure.in: Check for GnuTLS certificate verify callbacks.
+
 2011-04-20  Stefan Monnier  <monnier@iro.umontreal.ca>
 
 	* Makefile.in (config.status): Don't erase in case of error.

=== modified file 'configure.in'
--- configure.in	2011-04-20 02:18:13 +0000
+++ configure.in	2011-04-22 12:44:30 +0000
@@ -1972,12 +1972,22 @@
 AC_SUBST(LIBSELINUX_LIBS)
 
 HAVE_GNUTLS=no
+HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY=no
 if test "${with_gnutls}" = "yes" ; then
   PKG_CHECK_MODULES([LIBGNUTLS], [gnutls >= 2.2.4], HAVE_GNUTLS=yes, HAVE_GNUTLS=no)
   if test "${HAVE_GNUTLS}" = "yes"; then
     AC_DEFINE(HAVE_GNUTLS, 1, [Define if using GnuTLS.])
   fi
+
+  CFLAGS="$CFLAGS $LIBGNUTLS_CFLAGS"
+  LIBS="$LIBGNUTLS_LIBS $LIBS"
+  AC_CHECK_FUNCS(gnutls_certificate_set_verify_function, HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY=yes)
+
+  if test "${HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY}" = "yes"; then
+    AC_DEFINE(HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY, 1, [Define if using GnuTLS certificate verification callbacks.])
+  fi
 fi
+
 AC_SUBST(LIBGNUTLS_LIBS)
 AC_SUBST(LIBGNUTLS_CFLAGS)
 

=== modified file 'lib-src/ChangeLog'
--- lib-src/ChangeLog	2011-04-16 23:11:35 +0000
+++ lib-src/ChangeLog	2011-04-22 12:45:34 +0000
@@ -1,3 +1,7 @@
+2011-04-22  Teodor Zlatanov  <tzz@lifelogs.com>
+
+	* makefile.w32-in (obj): Added gnutls.o.
+
 2011-04-16  Paul Eggert  <eggert@cs.ucla.edu>
 
 	Static checks with GCC 4.6.0 and non-default toolkits.

=== modified file 'lib-src/makefile.w32-in'
--- lib-src/makefile.w32-in	2011-03-12 19:19:47 +0000
+++ lib-src/makefile.w32-in	2011-04-22 12:43:09 +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-04-22 02:35:48 +0000
+++ lisp/ChangeLog	2011-04-22 12:56:04 +0000
@@ -1,3 +1,16 @@
+2011-04-22  Teodor Zlatanov  <tzz@lifelogs.com>
+
+	* net/gnutls.el (gnutls-negotiate): Add hostname, verify-flags,
+	verify-error, and verify-hostname-error parameters.  Check whether
+	default trustfile exists before going to use it. Add missing
+	argument to gnutls-message-maybe call. Return return value.
+	Reported by Claudio Bley <claudio.bley@gmail.com>.
+	(open-gnutls-stream): Add usage example.
+
+	* net/network-stream.el (network-stream-open-starttls): Give host
+	parameter to `gnutls-negotiate'.
+	(gnutls-negotiate): Adjust `gnutls-negotiate' declaration.
+
 2011-04-22  Chong Yidong  <cyd@stupidchicken.com>
 
 	* emacs-lisp/package.el (package--builtins, package-alist)

=== modified file 'lisp/net/gnutls.el'
--- lisp/net/gnutls.el	2011-01-25 04:08:28 +0000
+++ lisp/net/gnutls.el	2011-04-22 12:58:38 +0000
@@ -25,7 +25,8 @@
 ;;; Commentary:
 
 ;; This package provides language bindings for the GnuTLS library
-;; using the corresponding core functions in gnutls.c.
+;; using the corresponding core functions in gnutls.c.  It should NOT
+;; be used directly, only through open-protocol-stream.
 
 ;; Simple test:
 ;;
@@ -59,26 +60,76 @@
 Fourth arg SERVICE is name of the service desired, or an integer
 specifying a port number to connect to.
 
+Usage example:
+
+  \(with-temp-buffer
+    \(open-gnutls-stream \"tls\"
+                        \(current-buffer)
+                        \"your server goes here\"
+                        \"imaps\"))
+
 This is a very simple wrapper around `gnutls-negotiate'.  See its
 documentation for the specific parameters you can use to open a
 GnuTLS connection, including specifying the credential type,
 trust and key files, and priority string."
-  (let ((proc (open-network-stream name buffer host service)))
-    (gnutls-negotiate proc 'gnutls-x509pki)))
+  (gnutls-negotiate (open-network-stream name buffer host service)
+                    'gnutls-x509pki
+                    host))
+
+(put 'gnutls-error
+     'error-conditions
+     '(error gnutls-error))
+(put 'gnutls-error
+     'error-message "GnuTLS error")
 
 (declare-function gnutls-boot "gnutls.c" (proc type proplist))
 
-(defun gnutls-negotiate (proc type &optional priority-string
-                              trustfiles keyfiles)
-  "Negotiate a SSL/TLS connection.
+(defun gnutls-negotiate (proc type hostname &optional priority-string
+                              trustfiles keyfiles verify-flags
+                              verify-error verify-hostname-error)
+  "Negotiate a SSL/TLS connection.  Returns proc. Signals gnutls-error.
 TYPE is `gnutls-x509pki' (default) or `gnutls-anon'.  Use nil for the default.
 PROC is a process returned by `open-network-stream'.
+HOSTNAME is the remote hostname.  It must be a valid string.
 PRIORITY-STRING is as per the GnuTLS docs, default is \"NORMAL\".
 TRUSTFILES is a list of CA bundles.
-KEYFILES is a list of client keys."
+KEYFILES is a list of client keys.
+
+When VERIFY-HOSTNAME-ERROR is not nil, an error will be raised
+when the hostname does not match the presented certificate's host
+name.  The exact verification algorithm is a basic implementation
+of the matching described in RFC2818 (HTTPS), which takes into
+account wildcards, and the DNSName/IPAddress subject alternative
+name PKIX extension.  See GnuTLS' gnutls_x509_crt_check_hostname
+for details.  When VERIFY-HOSTNAME-ERROR is nil, only a warning
+will be issued.
+
+When VERIFY-ERROR is not nil, an error will be raised when the
+peer certificate verification fails as per GnuTLS'
+gnutls_certificate_verify_peers2.  Otherwise, only warnings will
+be shown about the verification failure.
+
+VERIFY-FLAGS is a numeric OR of verification flags only for
+`gnutls-x509pki' connections.  See GnuTLS' x509.h for details;
+here's a recent version of the list.
+
+    GNUTLS_VERIFY_DISABLE_CA_SIGN = 1,
+    GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT = 2,
+    GNUTLS_VERIFY_DO_NOT_ALLOW_SAME = 4,
+    GNUTLS_VERIFY_ALLOW_ANY_X509_V1_CA_CRT = 8,
+    GNUTLS_VERIFY_ALLOW_SIGN_RSA_MD2 = 16,
+    GNUTLS_VERIFY_ALLOW_SIGN_RSA_MD5 = 32,
+    GNUTLS_VERIFY_DISABLE_TIME_CHECKS = 64,
+    GNUTLS_VERIFY_DISABLE_TRUSTED_TIME_CHECKS = 128,
+    GNUTLS_VERIFY_DO_NOT_ALLOW_X509_V1_CA_CRT = 256
+
+It must be omitted, a number, or nil; if omitted or nil it
+defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT."
   (let* ((type (or type 'gnutls-x509pki))
+         (default-trustfile "/etc/ssl/certs/ca-certificates.crt")
          (trustfiles (or trustfiles
-                        '("/etc/ssl/certs/ca-certificates.crt")))
+                         (when (file-exists-p default-trustfile)
+                           (list default-trustfile))))
          (priority-string (or priority-string
                               (cond
                                ((eq type 'gnutls-anon)
@@ -86,15 +137,23 @@
                                ((eq type 'gnutls-x509pki)
                                 "NORMAL"))))
          (params `(:priority ,priority-string
+                             :hostname ,hostname
                              :loglevel ,gnutls-log-level
                              :trustfiles ,trustfiles
                              :keyfiles ,keyfiles
+                             :verify-flags ,verify-flags
+                             :verify-error ,verify-error
+                             :verify-hostname-error ,verify-hostname-error
                              :callbacks nil))
          ret)
 
     (gnutls-message-maybe
      (setq ret (gnutls-boot proc type params))
-     "boot: %s")
+     "boot: %s" params)
+
+    (when (gnutls-errorp ret)
+      ;; This is a error from the underlying C code.
+      (signal 'gnutls-error (list proc ret)))
 
     proc))
 

=== modified file 'lisp/net/network-stream.el'
--- lisp/net/network-stream.el	2011-04-12 22:18:02 +0000
+++ lisp/net/network-stream.el	2011-04-22 12:43:09 +0000
@@ -46,7 +46,8 @@
 (require 'starttls)
 
 (declare-function gnutls-negotiate "gnutls"
-		  (proc type &optional priority-string trustfiles keyfiles))
+                  (proc type host &optional priority-string trustfiles keyfiles
+                        verify-flags verify-error verify-hostname-error))
 
 ;;;###autoload
 (defun open-network-stream (name buffer host service &rest parameters)
@@ -197,7 +198,7 @@
 			  (network-stream-command stream starttls-command eoc))
 	;; The server said it was OK to begin STARTTLS negotiations.
 	(if (fboundp 'open-gnutls-stream)
-	    (gnutls-negotiate stream nil)
+	    (gnutls-negotiate stream nil host)
 	  (unless (starttls-negotiate stream)
 	    (delete-process stream)))
 	(if (memq (process-status stream) '(open run))

=== modified file 'nt/ChangeLog'
--- nt/ChangeLog	2011-04-15 22:48:00 +0000
+++ nt/ChangeLog	2011-04-22 12:54:36 +0000
@@ -1,3 +1,11 @@
+2011-04-22  Teodor Zlatanov  <tzz@lifelogs.com>
+
+	* configure.bat: New options --without-gnutls and --lib, new build
+	variable USER_LIBS, automatically detect GnuTLS.  Copies the PNG
+	library setup with trivial modifications.
+	* INSTALL: Add instructions for GnuTLS support.
+	* gmake.defs: Prefix USER_LIBS with -l.
+
 2011-04-15  Ben Key  <bkey76@gmail.com>
 
 	* configure.bat: Modified the code that parses the --cflags and

=== modified file 'nt/INSTALL'
--- nt/INSTALL	2011-04-15 22:48:00 +0000
+++ nt/INSTALL	2011-04-22 12:47:25 +0000
@@ -316,6 +316,15 @@
   `dynamic-library-alist' and the value of `libpng-version', and
   download compatible DLLs if needed.
 
+* Optional GnuTLS support
+
+  You can build Emacs with GnuTLS support.  Put the gnutls/gnutls.h header in
+  the include path and link to the appropriate libraries (gnutls.dll and
+  gcrypt.dll) with the --lib option.
+
+  You can get pre-built binaries and an installer at
+  http://josefsson.org/gnutls4win/.
+
 * Experimental SVG support
 
   SVG support is currently experimental, and not built by default.

=== modified file 'nt/configure.bat'
--- nt/configure.bat	2011-04-15 22:48:00 +0000
+++ nt/configure.bat	2011-04-22 12:53:04 +0000
@@ -99,10 +99,13 @@
 set usercflags=
 set docflags=
 set userldflags=
+set extrauserlibs=
 set doldflags=
+set doextralibs=
 set sep1=
 set sep2=
 set sep3=
+set sep4=
 set distfiles=
 
 rem ----------------------------------------------------------------------
@@ -120,10 +123,12 @@
 if "%1" == "--no-cygwin" goto nocygwin
 if "%1" == "--cflags" goto usercflags
 if "%1" == "--ldflags" goto userldflags
+if "%1" == "--lib" goto extrauserlibs
 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
@@ -142,11 +147,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 extra 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
 if "%use_extensions%" == "0" goto end
@@ -242,6 +249,14 @@
 shift
 goto again
 
+:extrauserlibs
+shift
+echo. extrauserlibs: %extrauserlibs%
+set extrauserlibs=%extrauserlibs%%sep4%%1
+set sep4= %nothing%
+shift
+goto again
+
 rem ----------------------------------------------------------------------
 
 :userldflags
@@ -288,6 +303,14 @@
 
 rem ----------------------------------------------------------------------
 
+:withoutgnutls
+set tlssupport=N
+set HAVE_GNUTLS=
+shift
+goto again
+
+rem ----------------------------------------------------------------------
+
 :withouttiff
 set tiffsupport=N
 set HAVE_TIFF=
@@ -516,6 +539,30 @@
 :pngDone
 rm -f junk.c junk.obj
 
+if (%tlssupport%) == (N) goto tlsDone
+
+rem this is a copy of the PNG detection
+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...
@@ -688,6 +735,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 (%extrauserlibs%) do if not (%%v)==() set doextralibs=Y
+if (%doextralibs%)==(Y) echo USER_LIBS=%extrauserlibs%>>config.settings
 echo # End of settings from configure.bat>>config.settings
 echo. >>config.settings
 
@@ -700,6 +749,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
@@ -838,6 +888,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-04-22 12:53:58 +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-04-19 10:48:30 +0000
+++ src/ChangeLog	2011-04-22 13:08:48 +0000
@@ -1,3 +1,38 @@
+2011-04-22  Teodor Zlatanov  <tzz@lifelogs.com>
+
+	* gnutls.h: Add GNUTLS_STAGE_CALLBACKS enum to denote we're in the
+	callbacks stage.
+
+	* gnutls.c: Renamed global_initialized to
+	gnutls_global_initialized.  Added internals for the
+	:verify-hostname-error, :verify-error, and :verify-flags
+	parameters of `gnutls-boot' and documented those parameters in the
+	docstring.  Start callback support.
+	(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.
+	(emacs_gnutls_handle_error): New function.
+	(wsaerror_to_errno): Likewise.
+
+	* w32.h (emacs_gnutls_pull): Add prototype.
+	(emacs_gnutls_push): Likewise.
+
+	* w32.c (emacs_gnutls_pull): New function for GnuTLS on Woe32.
+	(emacs_gnutls_push): Likewise.
+
+2011-04-22  Claudio Bley  <claudio.bley@gmail.com>  (tiny change)
+
+	* 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.
+
 2011-04-19  Eli Zaretskii  <eliz@gnu.org>
 
 	* syntax.h (SETUP_SYNTAX_TABLE_FOR_OBJECT): Fix setting of

=== modified file 'src/gnutls.c'
--- src/gnutls.c	2011-04-16 19:16:40 +0000
+++ src/gnutls.c	2011-04-22 13:08:30 +0000
@@ -26,11 +26,20 @@
 #ifdef HAVE_GNUTLS
 #include <gnutls/gnutls.h>
 
+#ifdef WINDOWSNT
+#include <windows.h>
+#include "w32.h"
+#endif
+
+static int
+emacs_gnutls_handle_error (gnutls_session_t, int err);
+
+Lisp_Object Qgnutls_log_level;
 Lisp_Object Qgnutls_code;
 Lisp_Object Qgnutls_anon, Qgnutls_x509pki;
 Lisp_Object Qgnutls_e_interrupted, Qgnutls_e_again,
   Qgnutls_e_invalid_session, Qgnutls_e_not_ready_for_handshake;
-int global_initialized;
+int gnutls_global_initialized;
 
 /* The following are for the property list of `gnutls-boot'.  */
 Lisp_Object Qgnutls_bootprop_priority;
@@ -38,8 +47,27 @@
 Lisp_Object Qgnutls_bootprop_keyfiles;
 Lisp_Object Qgnutls_bootprop_callbacks;
 Lisp_Object Qgnutls_bootprop_loglevel;
-
-static void
+Lisp_Object Qgnutls_bootprop_hostname;
+Lisp_Object Qgnutls_bootprop_verify_flags;
+Lisp_Object Qgnutls_bootprop_verify_error;
+Lisp_Object Qgnutls_bootprop_verify_hostname_error;
+
+/* Callback keys for `gnutls-boot'.  Unused currently.  */
+Lisp_Object Qgnutls_bootprop_callbacks_verify;
+
+static void
+gnutls_log_function (int level, const char* string)
+{
+  message ("gnutls.c: [%d] %s", level, string);
+}
+
+static void
+gnutls_log_function2 (int level, const char* string, const char* extra)
+{
+  message ("gnutls.c: [%d] %s %s", level, string, extra);
+}
+
+static int
 emacs_gnutls_handshake (struct Lisp_Process *proc)
 {
   gnutls_session_t state = proc->gnutls_state;
@@ -50,24 +78,55 @@
 
   if (proc->gnutls_initstage < GNUTLS_STAGE_TRANSPORT_POINTERS_SET)
     {
+#ifdef WINDOWSNT
+      /* On W32 we cannot transfer socket handles between different runtime
+         libraries, so we tell GnuTLS to use our special push/pull
+         functions.  */
+      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)
     {
-      /* here we're finally done.  */
+      /* Here we're finally done.  */
       proc->gnutls_initstage = GNUTLS_STAGE_READY;
     }
+  else
+    {
+        gnutls_alert_send_appropriate (state, ret);
+    }
+  return ret;
 }
 
 EMACS_INT
@@ -107,6 +166,7 @@
       bytes_written += rtnval;
     }
 
+  emacs_gnutls_handle_error (state, rtnval);
   return (bytes_written);
 }
 
@@ -122,19 +182,68 @@
       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;
   }
 }
 
+/* report a GnuTLS error to the user.
+   Returns zero if the error code was successfully handled. */
+static int
+emacs_gnutls_handle_error (gnutls_session_t session, int err)
+{
+  Lisp_Object gnutls_log_level = Fsymbol_value (Qgnutls_log_level);
+  int max_log_level = 0;
+
+  int alert, ret;
+  const char *str;
+
+  /* TODO: use a Lisp_Object generated by gnutls_make_error?  */
+  if (err >= 0)
+    return 0;
+
+  if (NUMBERP (gnutls_log_level))
+    max_log_level = XINT (gnutls_log_level);
+
+  /* TODO: use gnutls-error-fatalp and gnutls-error-string.  */
+
+  str = gnutls_strerror (err);
+  if (!str)
+    str = "unknown";
+
+  if (gnutls_error_is_fatal (err))
+    {
+      ret = err;
+      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.  */
+    }
+
+  if (err == GNUTLS_E_WARNING_ALERT_RECEIVED
+      || err == GNUTLS_E_FATAL_ALERT_RECEIVED)
+    {
+      int alert = gnutls_alert_get (session);
+      int level = (err == GNUTLS_E_FATAL_ALERT_RECEIVED) ? 0 : 1;
+      str = gnutls_alert_get_name (alert);
+      if (!str)
+	str = "unknown";
+
+      GNUTLS_LOG2 (level, max_log_level, "Received 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
@@ -262,14 +371,14 @@
 Call `gnutls-global-deinit' when GnuTLS usage is no longer needed.
 Returns zero on success.  */
 static Lisp_Object
-gnutls_emacs_global_init (void)
+emacs_gnutls_global_init (void)
 {
   int ret = GNUTLS_E_SUCCESS;
 
-  if (!global_initialized)
+  if (!gnutls_global_initialized)
     ret = gnutls_global_init ();
 
-  global_initialized = 1;
+  gnutls_global_initialized = 1;
 
   return gnutls_make_error (ret);
 }
@@ -277,28 +386,16 @@
 /* Deinitializes global GnuTLS state.
 See also `gnutls-global-init'.  */
 static Lisp_Object
-gnutls_emacs_global_deinit (void)
+emacs_gnutls_global_deinit (void)
 {
-  if (global_initialized)
+  if (gnutls_global_initialized)
     gnutls_global_deinit ();
 
-  global_initialized = 0;
+  gnutls_global_initialized = 0;
 
   return gnutls_make_error (GNUTLS_E_SUCCESS);
 }
 
-static void
-gnutls_log_function (int level, const char* string)
-{
-  message ("gnutls.c: [%d] %s", level, string);
-}
-
-static void
-gnutls_log_function2 (int level, const char* string, const char* extra)
-{
-  message ("gnutls.c: [%d] %s %s", level, string, extra);
-}
-
 DEFUN ("gnutls-boot", Fgnutls_boot, Sgnutls_boot, 3, 3, 0,
        doc: /* Initialize GnuTLS client for process PROC with TYPE+PROPLIST.
 Currently only client mode is supported.  Returns a success/failure
@@ -307,12 +404,27 @@
 TYPE is a symbol, either `gnutls-anon' or `gnutls-x509pki'.
 PROPLIST is a property list with the following keys:
 
+:hostname is a string naming the remote host.
+
 :priority is a GnuTLS priority string, defaults to "NORMAL".
+
 :trustfiles is a list of PEM-encoded trust files for `gnutls-x509pki'.
+
 :keyfiles is a list of PEM-encoded key files for `gnutls-x509pki'.
-:callbacks is an alist of callback functions (TODO).
+
+:callbacks is an alist of callback functions, see below.
+
 :loglevel is the debug level requested from GnuTLS, try 4.
 
+:verify-flags is a bitset as per GnuTLS'
+gnutls_certificate_set_verify_flags.
+
+:verify-error, if non-nil, makes failure of the certificate validation
+an error.  Otherwise it will be just a series of warnings.
+
+:verify-hostname-error, if non-nil, makes a hostname mismatch an
+error.  Otherwise it will be just a warning.
+
 The debug level will be set for this process AND globally for GnuTLS.
 So if you set it higher or lower at any point, it affects global
 debugging.
@@ -325,6 +437,9 @@
 functions are used.  This function allocates resources which can only
 be deallocated by calling `gnutls-deinit' or by calling it again.
 
+The callbacks alist can have a `verify' key, associated with a
+verification function (UNUSED).
+
 Each authentication type may need additional information in order to
 work.  For X.509 PKI (`gnutls-x509pki'), you probably need at least
 one trustfile (usually a CA bundle).  */)
@@ -337,12 +452,19 @@
   /* TODO: GNUTLS_X509_FMT_DER is also an option.  */
   int file_format = GNUTLS_X509_FMT_PEM;
 
+  unsigned int gnutls_verify_flags = GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT;
+  gnutls_x509_crt_t gnutls_verify_cert;
+  unsigned int gnutls_verify_cert_list_size;
+  const gnutls_datum_t *gnutls_verify_cert_list;
+
   gnutls_session_t state;
   gnutls_certificate_credentials_t x509_cred;
   gnutls_anon_client_credentials_t anon_cred;
   Lisp_Object global_init;
   char* priority_string_ptr = "NORMAL"; /* default priority string.  */
   Lisp_Object tail;
+  int peer_verification;
+  char* c_hostname;
 
   /* Placeholders for the property list elements.  */
   Lisp_Object priority_string;
@@ -350,16 +472,29 @@
   Lisp_Object keyfiles;
   Lisp_Object callbacks;
   Lisp_Object loglevel;
+  Lisp_Object hostname;
+  Lisp_Object verify_flags;
+  Lisp_Object verify_error;
+  Lisp_Object verify_hostname_error;
 
   CHECK_PROCESS (proc);
   CHECK_SYMBOL (type);
   CHECK_LIST (proplist);
 
-  priority_string = Fplist_get (proplist, Qgnutls_bootprop_priority);
-  trustfiles      = Fplist_get (proplist, Qgnutls_bootprop_trustfiles);
-  keyfiles        = Fplist_get (proplist, Qgnutls_bootprop_keyfiles);
-  callbacks       = Fplist_get (proplist, Qgnutls_bootprop_callbacks);
-  loglevel        = Fplist_get (proplist, Qgnutls_bootprop_loglevel);
+  hostname              = Fplist_get (proplist, Qgnutls_bootprop_hostname);
+  priority_string       = Fplist_get (proplist, Qgnutls_bootprop_priority);
+  trustfiles            = Fplist_get (proplist, Qgnutls_bootprop_trustfiles);
+  keyfiles              = Fplist_get (proplist, Qgnutls_bootprop_keyfiles);
+  callbacks             = Fplist_get (proplist, Qgnutls_bootprop_callbacks);
+  loglevel              = Fplist_get (proplist, Qgnutls_bootprop_loglevel);
+  verify_flags          = Fplist_get (proplist, Qgnutls_bootprop_verify_flags);
+  verify_error          = Fplist_get (proplist, Qgnutls_bootprop_verify_error);
+  verify_hostname_error = Fplist_get (proplist, Qgnutls_bootprop_verify_hostname_error);
+
+  if (!STRINGP (hostname))
+    error ("gnutls-boot: invalid :hostname parameter");
+
+  c_hostname = SSDATA (hostname);
 
   state = XPROCESS (proc)->gnutls_state;
   XPROCESS (proc)->gnutls_p = 1;
@@ -373,7 +508,7 @@
     }
 
   /* always initialize globals.  */
-  global_init = gnutls_emacs_global_init ();
+  global_init = emacs_gnutls_global_init ();
   if (! NILP (Fgnutls_errorp (global_init)))
     return global_init;
 
@@ -417,6 +552,23 @@
       x509_cred = XPROCESS (proc)->gnutls_x509_cred;
       if (gnutls_certificate_allocate_credentials (&x509_cred) < 0)
         memory_full ();
+
+      if (NUMBERP (verify_flags))
+        {
+          gnutls_verify_flags = XINT (verify_flags);
+          GNUTLS_LOG (2, max_log_level, "setting verification flags");
+        }
+      else if (NILP (verify_flags))
+        {
+          /* The default is already GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT.  */
+          GNUTLS_LOG (2, max_log_level, "using default verification flags");
+        }
+      else
+        {
+          /* The default is already GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT.  */
+          GNUTLS_LOG (2, max_log_level, "ignoring invalid verify-flags");
+        }
+      gnutls_certificate_set_verify_flags (x509_cred, gnutls_verify_flags);
     }
   else if (EQ (type, Qgnutls_anon))
     {
@@ -485,6 +637,14 @@
 
   GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_FILES;
 
+  GNUTLS_LOG (1, max_log_level, "gnutls callbacks");
+
+  GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CALLBACKS;
+
+#ifdef HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY
+#else
+#endif
+
   GNUTLS_LOG (1, max_log_level, "gnutls_init");
 
   ret = gnutls_init (&state, GNUTLS_CLIENT);
@@ -542,9 +702,113 @@
 
   GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CRED_SET;
 
-  emacs_gnutls_handshake (XPROCESS (proc));
-
-  return gnutls_make_error (GNUTLS_E_SUCCESS);
+  ret = emacs_gnutls_handshake (XPROCESS (proc));
+
+  if (ret < GNUTLS_E_SUCCESS)
+    return gnutls_make_error (ret);
+
+  /* Now verify the peer, following
+     http://www.gnu.org/software/gnutls/manual/html_node/Verifying-peer_0027s-certificate.html.
+     The peer should present at least one certificate in the chain; do a
+     check of the certificate's hostname with
+     gnutls_x509_crt_check_hostname() against :hostname.  */
+
+  ret = gnutls_certificate_verify_peers2 (state, &peer_verification);
+
+  if (ret < GNUTLS_E_SUCCESS)
+    return gnutls_make_error (ret);
+  
+  if (XINT (loglevel) > 0 && peer_verification & GNUTLS_CERT_INVALID)
+    message ("%s certificate could not be verified.", 
+             c_hostname);
+ 
+ if (peer_verification & GNUTLS_CERT_REVOKED)
+   GNUTLS_LOG2 (1, max_log_level, "certificate was revoked (CRL):",
+                c_hostname);
+ 
+ if (peer_verification & GNUTLS_CERT_SIGNER_NOT_FOUND)
+   GNUTLS_LOG2 (1, max_log_level, "certificate signer was not found:",
+                c_hostname);
+ 
+ if (peer_verification & GNUTLS_CERT_SIGNER_NOT_CA)
+   GNUTLS_LOG2 (1, max_log_level, "certificate signer is not a CA:",
+                c_hostname);
+
+ if (peer_verification & GNUTLS_CERT_INSECURE_ALGORITHM)
+   GNUTLS_LOG2 (1, max_log_level,
+                "certificate was signed with an insecure algorithm:",
+                c_hostname);
+
+ if (peer_verification & GNUTLS_CERT_NOT_ACTIVATED)
+   GNUTLS_LOG2 (1, max_log_level, "certificate is not yet activated:",
+                c_hostname);
+
+ if (peer_verification & GNUTLS_CERT_EXPIRED)
+   GNUTLS_LOG2 (1, max_log_level, "certificate has expired:",
+                c_hostname);
+
+ if (peer_verification != 0)
+   {
+     if (NILP (verify_hostname_error))
+       {
+         GNUTLS_LOG2 (1, max_log_level, "certificate validation failed:",
+                      c_hostname);
+       }
+     else
+       {
+         error ("Certificate validation failed %s, verification code %d",
+                c_hostname, peer_verification);
+       }
+   }
+
+  /* Up to here the process is the same for X.509 certificates and
+     OpenPGP keys.  From now on X.509 certificates are assumed.  This
+     can be easily extended to work with openpgp keys as well.  */
+  if (gnutls_certificate_type_get (state) == GNUTLS_CRT_X509)
+    {
+      ret = gnutls_x509_crt_init (&gnutls_verify_cert);
+
+      if (ret < GNUTLS_E_SUCCESS)
+        return gnutls_make_error (ret);
+
+      gnutls_verify_cert_list = 
+        gnutls_certificate_get_peers (state, &gnutls_verify_cert_list_size);
+
+      if (NULL == gnutls_verify_cert_list)
+        {
+          error ("No x509 certificate was found!\n");
+        }
+
+      /* We only check the first certificate in the given chain.  */
+      ret = gnutls_x509_crt_import (gnutls_verify_cert,
+                                    &gnutls_verify_cert_list[0],
+                                    GNUTLS_X509_FMT_DER);
+
+      if (ret < GNUTLS_E_SUCCESS)
+        {
+          gnutls_x509_crt_deinit (gnutls_verify_cert);
+          return gnutls_make_error (ret);
+        }
+
+      if (!gnutls_x509_crt_check_hostname (gnutls_verify_cert, c_hostname))
+        {
+          if (NILP (verify_hostname_error))
+            {
+              GNUTLS_LOG2 (1, max_log_level, "x509 certificate does not match:",
+                           c_hostname);
+            }
+          else
+            {
+              gnutls_x509_crt_deinit (gnutls_verify_cert);
+              error ("The x509 certificate does not match \"%s\"",
+                     c_hostname);
+            }
+        }
+
+      gnutls_x509_crt_deinit (gnutls_verify_cert);
+    }
+
+  return gnutls_make_error (ret);
 }
 
 DEFUN ("gnutls-bye", Fgnutls_bye,
@@ -579,7 +843,10 @@
 void
 syms_of_gnutls (void)
 {
-  global_initialized = 0;
+  gnutls_global_initialized = 0;
+
+  Qgnutls_log_level = intern_c_string ("gnutls-log-level");
+  staticpro (&Qgnutls_log_level);
 
   Qgnutls_code = intern_c_string ("gnutls-code");
   staticpro (&Qgnutls_code);
@@ -590,6 +857,9 @@
   Qgnutls_x509pki = intern_c_string ("gnutls-x509pki");
   staticpro (&Qgnutls_x509pki);
 
+  Qgnutls_bootprop_hostname = intern_c_string (":hostname");
+  staticpro (&Qgnutls_bootprop_hostname);
+
   Qgnutls_bootprop_priority = intern_c_string (":priority");
   staticpro (&Qgnutls_bootprop_priority);
 
@@ -602,9 +872,21 @@
   Qgnutls_bootprop_callbacks = intern_c_string (":callbacks");
   staticpro (&Qgnutls_bootprop_callbacks);
 
+  Qgnutls_bootprop_callbacks_verify = intern_c_string ("verify");
+  staticpro (&Qgnutls_bootprop_callbacks_verify);
+
   Qgnutls_bootprop_loglevel = intern_c_string (":loglevel");
   staticpro (&Qgnutls_bootprop_loglevel);
 
+  Qgnutls_bootprop_verify_flags = intern_c_string (":verify-flags");
+  staticpro (&Qgnutls_bootprop_verify_flags);
+
+  Qgnutls_bootprop_verify_hostname_error = intern_c_string (":verify-error");
+  staticpro (&Qgnutls_bootprop_verify_error);
+
+  Qgnutls_bootprop_verify_hostname_error = intern_c_string (":verify-hostname-error");
+  staticpro (&Qgnutls_bootprop_verify_hostname_error);
+
   Qgnutls_e_interrupted = intern_c_string ("gnutls-e-interrupted");
   staticpro (&Qgnutls_e_interrupted);
   Fput (Qgnutls_e_interrupted, Qgnutls_code,

=== modified file 'src/gnutls.h'
--- src/gnutls.h	2011-04-15 08:22:34 +0000
+++ src/gnutls.h	2011-04-22 12:43:09 +0000
@@ -21,6 +21,7 @@
 
 #ifdef HAVE_GNUTLS
 #include <gnutls/gnutls.h>
+#include <gnutls/x509.h>
 
 typedef enum
 {
@@ -28,6 +29,7 @@
   GNUTLS_STAGE_EMPTY = 0,
   GNUTLS_STAGE_CRED_ALLOC,
   GNUTLS_STAGE_FILES,
+  GNUTLS_STAGE_CALLBACKS,
   GNUTLS_STAGE_INIT,
   GNUTLS_STAGE_PRIORITY,
   GNUTLS_STAGE_CRED_SET,

=== modified file 'src/makefile.w32-in'
--- src/makefile.w32-in	2011-03-19 03:22:14 +0000
+++ src/makefile.w32-in	2011-04-22 12:43:09 +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)
 
 #
@@ -948,6 +950,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-04-16 22:04:41 +0000
+++ src/process.c	2011-04-22 13:03:35 +0000
@@ -4532,6 +4532,22 @@
              &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 /* Check for valid process.  */
+              /* Do we have pending data?  */
+              && gnutls_record_check_pending (wait_proc->gnutls_state) > 0)
+          {
+              nfds = 1;
+              /* Set to Available.  */
+              FD_SET (wait_proc->infd, &Available);
+          }
+#endif
 	}
 
       xerrno = errno;

=== modified file 'src/w32.c'
--- src/w32.c	2011-04-06 16:05:49 +0000
+++ src/w32.c	2011-04-22 12:43:09 +0000
@@ -6102,5 +6102,72 @@
   p->childp = childp2;
 }
 
+#ifdef HAVE_GNUTLS
+
+ssize_t
+emacs_gnutls_pull (gnutls_transport_ptr_t p, void* buf, size_t sz)
+{
+  int n, sc, err;
+  SELECT_TYPE fdset;
+  EMACS_TIME timeout;
+  struct Lisp_Process *process = (struct Lisp_Process *)p;
+  int fd = process->infd;
+
+  for (;;)
+    {
+      n = sys_read(fd, (char*)buf, sz);
+
+      if (n >= 0)
+        return n;
+
+      err = errno;
+
+      if (err == EWOULDBLOCK)
+        {
+          /* Set a small timeout.  */
+          EMACS_SET_SECS_USECS(timeout, 1, 0);
+          FD_ZERO (&fdset);
+          FD_SET ((int)fd, &fdset);
+
+          /* Use select with the timeout to poll the selector.  */
+          sc = select (fd + 1, &fdset, (SELECT_TYPE *)0, (SELECT_TYPE *)0,
+                       &timeout);
+
+          if (sc > 0)
+            continue;  /* Try again.  */
+
+          /* Translate the WSAEWOULDBLOCK alias EWOULDBLOCK to EAGAIN.
+             Also accept select return 0 as an indicator to EAGAIN.  */
+          if (sc == 0 || errno == EWOULDBLOCK)
+            err = EAGAIN;
+          else
+            err = errno; /* Other errors are just passed on.  */
+        }
+
+      gnutls_transport_set_errno (process->gnutls_state, err);
+
+      return -1;
+    }
+}
+
+ssize_t
+emacs_gnutls_push (gnutls_transport_ptr_t p, const void* buf, size_t sz)
+{
+  struct Lisp_Process *process = (struct Lisp_Process *)p;
+  int fd = proc->outfd;
+  ssize_t n = sys_write(fd, buf, sz);
+
+  /* 0 or more bytes written means everything went fine.  */
+  if (n >= 0)
+    return n;
+
+  /* Negative bytes written means we got an error in errno.
+     Translate the WSAEWOULDBLOCK alias EWOULDBLOCK to EAGAIN.  */
+  gnutls_transport_set_errno (process->gnutls_state,
+                              errno == EWOULDBLOCK ? EAGAIN : errno);
+
+  return -1;
+}
+#endif /* HAVE_GNUTLS */
+
 /* end of w32.c */
-

=== modified file 'src/w32.h'
--- src/w32.h	2011-01-25 04:08:28 +0000
+++ src/w32.h	2011-04-22 12:43:09 +0000
@@ -143,5 +143,17 @@
 extern int _sys_read_ahead (int fd);
 extern int _sys_wait_accept (int fd);
 
+#ifdef HAVE_GNUTLS
+#include <gnutls/gnutls.h>
+
+/* GnuTLS pull (read from remote) interface.  */
+extern ssize_t emacs_gnutls_pull (gnutls_transport_ptr_t p,
+                                  void* buf, size_t sz);
+
+/* GnuTLS push (write to remote) interface.  */
+extern ssize_t emacs_gnutls_push (gnutls_transport_ptr_t p,
+                                  const void* buf, size_t sz);
+#endif /* HAVE_GNUTLS */
+
 #endif /* EMACS_W32_H */
 

Re: [PATCH] GnuTLS support on Woe32

[Ted Zlatanov]

On Fri, 22 Apr 2011 08:12:58 -0500 Ted Zlatanov <tzz@lifelogs.com> wrote: 

TZ> I rewrote even more and attributed things appropriately.  For
TZ> configure.bat specifically, the changes looked large but they were just
TZ> a copy of the PNG detection code; I redid them and they look very much
TZ> the same.  

TZ> Now, minus comments, there are less than 15 lines by Claudio in the
TZ> patch and I'm listed as the author of the rest.  May I commit it?

Committed with revisions 103995 through 103999 on the trunk.

Please yell if it breaks things for you.  Also please test it on W32 and
I hope we can start shipping the binaries for that platform with the
GnuTLS support enabled.

Ted

Re: [PATCH] GnuTLS support on Woe32

[Christoph Scholtes]

On 4/24/2011 7:35 PM, Ted Zlatanov wrote:

> Please yell if it breaks things for you.  Also please test it on W32 and
> I hope we can start shipping the binaries for that platform with the
> GnuTLS support enabled.

I used the gnutls-2.10.5-x86 library headers from 
ftp://ftp.gnu.org/gnu/gnutls/ and I get this error when running `make 
bootstrap' from a clean tree:

gcc -I. -c -gdwarf-2 -g3 -mno-cygwin -mtune=pentium4 -O2 
-DENABLE_CHECKING -DXASSERTS -fno-crossjumping 
-IC:/Progra~2/GnuWin32/include -ID:/devel/emacs/libXpm-3.5.8/include 
-ID:/devel/emacs/libXpm-3.5.8/src 
-ID:/devel/emacs/gnutls-2.10.5-x86/include -Demacs=1 -DHAVE_CONFIG_H 
-I../lib -I../nt/inc -DHAVE_NTGUI=1 -DUSE_CRT_DLL=1 -DPURESIZE=5000000 
-o oo-spd/i386/w32.o w32.c
w32.c: In function 'emacs_gnutls_push':
w32.c:6179:12: error: 'proc' undeclared (first use in this function)
w32.c:6179:12: note: each undeclared identifier is reported only once 
for each function it appears in
mingw32-make[2]: *** [oo-spd/i386/w32.o] Error 1
mingw32-make[2]: Leaving directory 
`D:/devel/emacs/emacs-bzr/trunk_readonly/src'

mingw32-make[1]: *** [bootstrap-temacs] Error 2
mingw32-make[1]: Leaving directory 
`D:/devel/emacs/emacs-bzr/trunk_readonly/src'

mingw32-make: *** [bootstrap-gmake] Error 2

Christoph

Re: [PATCH] GnuTLS support on Woe32

[Ted Zlatanov]

On Mon, 25 Apr 2011 06:42:01 -0600 Christoph Scholtes <cschol2112@googlemail.com> wrote: 

CS> On 4/24/2011 7:35 PM, Ted Zlatanov wrote:
>> Please yell if it breaks things for you.  Also please test it on W32 and
>> I hope we can start shipping the binaries for that platform with the
>> GnuTLS support enabled.

CS> I used the gnutls-2.10.5-x86 library headers from
CS> ftp://ftp.gnu.org/gnu/gnutls/ and I get this error when running `make
CS> bootstrap' from a clean tree:

CS> w32.c: In function 'emacs_gnutls_push':
CS> w32.c:6179:12: error: 'proc' undeclared (first use in this function)

Sorry about that typo, fixed.

Ted

Re: [PATCH] GnuTLS support on Woe32

[Christoph Scholtes]

On 4/24/2011 7:35 PM, Ted Zlatanov wrote:

> Please yell if it breaks things for you.  Also please test it on W32 and
> I hope we can start shipping the binaries for that platform with the
> GnuTLS support enabled.

I compiled the trunk with GnuTLS support on Windows 7. If I dont provide 
the dlls (libgnutls-26.dll, libgcrypt.dll etc.) Emacs issues an error 
message on startup ("Dll x not found.") and does not start at all.

Can we make it behave like for any of the graphics dll's, where the 
support might be enabled at compile time, but the dll must not 
necessarily be present to use Emacs at all?

Then, I am trying to use GnuTLS for receiving email with Gnus. How do 
configure Emacs to use GnuTLS? Is there any documentation?

This is my server configuration

(setq gnus-select-method
       '(nnimap "gmail"
                 (nnimap-address "imap.gmail.com")
                 (nnimap-stream starttls)
                 (nnimap-server-port 993)))

Should this be enough or do I need to do anything else?

On M-x gnus Emacs hangs with the message "Opening connection to 
imap.gmail.com..." in the minibuffer and nothing happens.

Christoph

Re: [PATCH] GnuTLS support on Woe32

[Ted Zlatanov]

On Tue, 26 Apr 2011 19:50:58 -0600 Christoph Scholtes <cschol2112@googlemail.com> wrote: 

CS> On 4/24/2011 7:35 PM, Ted Zlatanov wrote:
>> Please yell if it breaks things for you.  Also please test it on W32 and
>> I hope we can start shipping the binaries for that platform with the
>> GnuTLS support enabled.

CS> I compiled the trunk with GnuTLS support on Windows 7. If I dont
CS> provide the dlls (libgnutls-26.dll, libgcrypt.dll etc.) Emacs issues
CS> an error message on startup ("Dll x not found.") and does not start at
CS> all.

CS> Can we make it behave like for any of the graphics dll's, where the
CS> support might be enabled at compile time, but the dll must not
CS> necessarily be present to use Emacs at all?

Sure, but someone with access to W32 machines would have to write and
test it, I can't.

CS> Then, I am trying to use GnuTLS for receiving email with Gnus. How do
CS> configure Emacs to use GnuTLS? Is there any documentation?

CS> This is my server configuration

CS> (setq gnus-select-method
CS>       '(nnimap "gmail"
CS>                 (nnimap-address "imap.gmail.com")
CS>                 (nnimap-stream starttls)
CS>                 (nnimap-server-port 993)))

CS> Should this be enough or do I need to do anything else?

CS> On M-x gnus Emacs hangs with the message "Opening connection to
CS> imap.gmail.com..." in the minibuffer and nothing happens.

It depends on what version of Gnus and Emacs you are using.  If you're
using the trunk version of both, I think you want (nnimap-stream ssl),
but I honestly don't remember all the permutations before then.

You can test that GnuTLS support works, in any case, with

(require 'gnutls)
(open-gnutls-stream "tls" "tls-buffer" "imap.gmail.com" "imaps")

Set `gnutls-log-level' to 1 to get details in *Messages*.

Ted

Re: [PATCH] GnuTLS support on Woe32

[Christoph Scholtes]

On 4/26/2011 9:35 PM, Ted Zlatanov wrote:

> CS>  Can we make it behave like for any of the graphics dll's, where the
> CS>  support might be enabled at compile time, but the dll must not
> CS>  necessarily be present to use Emacs at all?
>
> Sure, but someone with access to W32 machines would have to write and
> test it, I can't.

I will take a look at that. I have access to Windows XP, Windows 7 and 
various flavors of GNU/Linux.

> It depends on what version of Gnus and Emacs you are using.  If you're
> using the trunk version of both, I think you want (nnimap-stream ssl),
> but I honestly don't remember all the permutations before then.

Yes. I am using the trunk versions of both. `ssl' does not work, btw.

> You can test that GnuTLS support works, in any case, with
>
> (require 'gnutls)
> (open-gnutls-stream "tls" "tls-buffer" "imap.gmail.com" "imaps")
>
> Set `gnutls-log-level' to 1 to get details in *Messages*.

I get this:

gnutls.c: [1] (Emacs) allocating credentials
gnutls.c: [1] (Emacs) gnutls callbacks
gnutls.c: [1] (Emacs) gnutls_init
gnutls.c: [1] (Emacs) got non-default priority string: NORMAL
gnutls.c: [1] (Emacs) setting the priority string
imap.gmail.com certificate could not be verified.
gnutls.c: [1] (Emacs) certificate signer was not found: imap.gmail.com
gnutls.c: [1] (Emacs) certificate validation failed: imap.gmail.com
#<process tls>

and

* OK Gimap ready for requests from ...(my IP address I guess)

in the tls-buffer.

I am not sure if this means it is working or not.

Christoph

open-network-stream problems on W32 (was: [PATCH] GnuTLS support on Woe32)

[Ted Zlatanov]

On Tue, 26 Apr 2011 21:57:13 -0600 Christoph Scholtes <cschol2112@googlemail.com> wrote: 

CS> On 4/26/2011 9:35 PM, Ted Zlatanov wrote:

>> It depends on what version of Gnus and Emacs you are using.  If you're
>> using the trunk version of both, I think you want (nnimap-stream ssl),
>> but I honestly don't remember all the permutations before then.

CS> Yes. I am using the trunk versions of both. `ssl' does not work, btw.

It should work, it's what I'm using.  Are you loading gnutls.el before
Gnus?

See `open-network-stream' for the code that Gnus is calling.  I changed
the subject and I hope that will get Lars and Chong's attention.

>> You can test that GnuTLS support works, in any case, with
>> 
>> (require 'gnutls)
>> (open-gnutls-stream "tls" "tls-buffer" "imap.gmail.com" "imaps")
>> 
>> Set `gnutls-log-level' to 1 to get details in *Messages*.

CS> I get this:

CS> gnutls.c: [1] (Emacs) allocating credentials
CS> gnutls.c: [1] (Emacs) gnutls callbacks
CS> gnutls.c: [1] (Emacs) gnutls_init
CS> gnutls.c: [1] (Emacs) got non-default priority string: NORMAL
CS> gnutls.c: [1] (Emacs) setting the priority string
CS> imap.gmail.com certificate could not be verified.
CS> gnutls.c: [1] (Emacs) certificate signer was not found: imap.gmail.com
CS> gnutls.c: [1] (Emacs) certificate validation failed: imap.gmail.com
CS> #<process tls>

CS> and

CS> * OK Gimap ready for requests from ...(my IP address I guess)

CS> in the tls-buffer.

CS> I am not sure if this means it is working or not.

This means that you established the connection but the SSL certificate
could not be verified (by default, not fatal because the `verify-error'
and `verify-hostname-error' parameters to `gnutls-negotiate' are nil by
default).

Chances are that the default certificate bundle,
/etc/ssl/certs/ca-certificates.crt, is not available on your system.  We
may have to attach this bundle to Emacs itself on W32 if there is
nothing suitable on the system (I would not depend on a Firefox or
Chrome or cygwin installation).  We should also set up a customizable
`gnutls-trustfiles' variable instead of the currently hard-coded string
in `gnutls-negotiate'.  But none of this should be breaking your
connection, the original problem you reported.

I won't be able to work on the bundle issue above for a few days so if
anyone else wants to do it, go ahead.

Ted

Re: open-network-stream problems on W32

[Christoph Scholtes]

On 4/26/2011 10:13 PM, Ted Zlatanov wrote:

> It should work, it's what I'm using.  Are you loading gnutls.el before
> Gnus?

No, I wasnt. Duh. Gnus works fine now with `ssl'. Thanks.

> See `open-network-stream' for the code that Gnus is calling.  I changed
> the subject and I hope that will get Lars and Chong's attention.
> This means that you established the connection but the SSL certificate
> could not be verified (by default, not fatal because the `verify-error'
> and `verify-hostname-error' parameters to `gnutls-negotiate' are nil by
> default).

> Chances are that the default certificate bundle,
> /etc/ssl/certs/ca-certificates.crt, is not available on your system.  We
> may have to attach this bundle to Emacs itself on W32 if there is
> nothing suitable on the system (I would not depend on a Firefox or
> Chrome or cygwin installation).

This does not seem to be a problem with Gnus (now that the other issue 
is resolved).

Receiving mail with Gnus works. However, sending mail does still not work.

I get an SMTP protocol error (from *Messages* w/gnutls-log-level=1):

Sending via mail...
No STARTTLS program was available (tried 'gnutls-cli')
220 mx.google.com ESMTP h74sm253108yhm.11
250-mx.google.com at your service, [...]
250-SIZE 35882577
250-8BITMIME
250-STARTTLS
250 ENHANCEDSTATUSCODES
530 5.7.0 Must issue a STARTTLS command first. h74sm253108yhm.11
221 2.0.0 closing connection h74sm253108yhm.11
smtpmail-send-it: Sending failed; SMTP protocol error

Do you think this is related to GnuTLS?

Christoph

Re: [PATCH] GnuTLS support on Woe32

[Juanma Barranquero]

2011/4/27 Ted Zlatanov <tzz@lifelogs.com>:

> CS> Can we make it behave like for any of the graphics dll's, where the
> CS> support might be enabled at compile time, but the dll must not
> CS> necessarily be present to use Emacs at all?
>
> Sure, but someone with access to W32 machines would have to write and
> test it, I can't.

GnuTLS was one of the reasons that prompted me to change
`image-library-alist' to `dynamic-library-alist', so yes, I plan to do
it if nobody beats me to it.

But I won't be able to spend time on that in at least a week or two,
perhaps more, so there's ample time for someone to step in...

    Juanma

Re: [PATCH] GnuTLS support on Woe32

[Juanma Barranquero]

On Wed, Apr 27, 2011 at 14:19, Juanma Barranquero <lekktu@gmail.com> wrote:

> GnuTLS was one of the reasons that prompted me to change
> `image-library-alist' to `dynamic-library-alist', so yes, I plan to do
> it if nobody beats me to it.
>
> But I won't be able to spend time on that in at least a week or two,
> perhaps more, so there's ample time for someone to step in...

I'm working on this.

First question: what should the code do when the gnutls library cannot
be loaded at runtime? I mean, which is the single point that can
return a failure exit code, let's say, GNUTLS_EMACS_ERROR_NOT_LOADED
(== GNUTLS_E_APPLICATION_ERROR_MIN + 1), so the rest of the GnuTLS
code is disabled?

I'm thinking there will be a function init_gnutls_functions (), called
from syms_of_gnutls or Fgnutls_boot, which in addition to adjusting
the function pointers, sets a success/failure flag. And then, from the
elisp side, either that variable of a function gnutls-is-loaded-p
which the gnutls.el functions will have to consult.

Does that sound right? If so, can you take care of the gnutls.el side of things?

    Juanma

Re: [PATCH] GnuTLS support on Woe32

[Ted Zlatanov]

On Mon, 2 May 2011 18:20:56 +0200 Juanma Barranquero <lekktu@gmail.com> wrote: 

JB> On Wed, Apr 27, 2011 at 14:19, Juanma Barranquero <lekktu@gmail.com> wrote:
>> GnuTLS was one of the reasons that prompted me to change
>> `image-library-alist' to `dynamic-library-alist', so yes, I plan to do
>> it if nobody beats me to it.
>> 
>> But I won't be able to spend time on that in at least a week or two,
>> perhaps more, so there's ample time for someone to step in...

JB> I'm working on this.

JB> First question: what should the code do when the gnutls library cannot
JB> be loaded at runtime? I mean, which is the single point that can
JB> return a failure exit code, let's say, GNUTLS_EMACS_ERROR_NOT_LOADED
JB> (== GNUTLS_E_APPLICATION_ERROR_MIN + 1), so the rest of the GnuTLS
JB> code is disabled?

JB> I'm thinking there will be a function init_gnutls_functions (), called
JB> from syms_of_gnutls or Fgnutls_boot, which in addition to adjusting
JB> the function pointers, sets a success/failure flag. And then, from the
JB> elisp side, either that variable of a function gnutls-is-loaded-p
JB> which the gnutls.el functions will have to consult.

All the C GnuTLS init code (currently `gnutls-boot') calls
`emacs_gnutls_global_init' *every time*, which is short enough to quote
here:

#+begin_src c
static Lisp_Object
emacs_gnutls_global_init (void)
{
  int ret = GNUTLS_E_SUCCESS;

  if (!gnutls_global_initialized)
    ret = gnutls_global_init ();

  gnutls_global_initialized = 1;

  return gnutls_make_error (ret);
}
#+end_src

... and then in `gnutls-boot':

#+begin_src c
  /* always initialize globals.  */
  global_init = emacs_gnutls_global_init ();
  if (! NILP (Fgnutls_errorp (global_init)))
    return global_init;

#+end_src

So we just need to modify `emacs_gnutls_global_init' to load and check
the GnuTLS library and return an appropriate error (which can be any
ELisp number object, so you can attach debug info to it).  Or you can do
it once at init time, which seems less convenient to the user but less
work.  I don't have an opinion either way.

JB> Does that sound right? If so, can you take care of the gnutls.el side of things?

I think gnutls.el should not know about this.  It should simply get an
error from the C layer if the library could not be loaded.

Ted

Re: open-network-stream problems on W32

[Ted Zlatanov]

On Tue, 26 Apr 2011 22:34:51 -0600 Christoph Scholtes <cschol2112@googlemail.com> wrote: 

CS> Receiving mail with Gnus works. However, sending mail does still not work.

CS> I get an SMTP protocol error (from *Messages* w/gnutls-log-level=1):

CS> Sending via mail...
CS> No STARTTLS program was available (tried 'gnutls-cli')
CS> 220 mx.google.com ESMTP h74sm253108yhm.11
CS> 250-mx.google.com at your service, [...]
CS> 250-SIZE 35882577
CS> 250-8BITMIME
CS> 250-STARTTLS
CS> 250 ENHANCEDSTATUSCODES
CS> 530 5.7.0 Must issue a STARTTLS command first. h74sm253108yhm.11
CS> 221 2.0.0 closing connection h74sm253108yhm.11
CS> smtpmail-send-it: Sending failed; SMTP protocol error

CS> Do you think this is related to GnuTLS?

It should Just Work; you're never hitting the GnuTLS code and
`smtpmail-send-it' is trying to use just the "gnutls-cli" command-line
utility.  `smtpmail-send-it' needs to be configured or fixed in code
(probably the former).

For me, I just

(setq smtpmail-starttls-credentials '(("mysmtpserver.com" 587 nil nil)))

and then put this line:

machine mysmtpserver.com login tzz password mypassword

in my ~/.authinfo.gpg.  But my configuration has many layers so the
above may need to be modified a bit and you need to dig into it or
submit a bug if it still fails.

Ted

Re: open-network-stream problems on W32

[Ted Zlatanov]

On Mon, 02 May 2011 13:37:04 -0500 Ted Zlatanov <tzz@lifelogs.com> wrote: 

TZ> On Tue, 26 Apr 2011 22:34:51 -0600 Christoph Scholtes <cschol2112@googlemail.com> wrote: 
CS> Receiving mail with Gnus works. However, sending mail does still not work.

CS> I get an SMTP protocol error (from *Messages* w/gnutls-log-level=1):

CS> Sending via mail...
CS> No STARTTLS program was available (tried 'gnutls-cli')
CS> 220 mx.google.com ESMTP h74sm253108yhm.11
CS> 250-mx.google.com at your service, [...]
CS> 250-SIZE 35882577
CS> 250-8BITMIME
CS> 250-STARTTLS
CS> 250 ENHANCEDSTATUSCODES
CS> 530 5.7.0 Must issue a STARTTLS command first. h74sm253108yhm.11
CS> 221 2.0.0 closing connection h74sm253108yhm.11
CS> smtpmail-send-it: Sending failed; SMTP protocol error

CS> Do you think this is related to GnuTLS?

TZ> It should Just Work; you're never hitting the GnuTLS code and
TZ> `smtpmail-send-it' is trying to use just the "gnutls-cli" command-line
TZ> utility.  `smtpmail-send-it' needs to be configured or fixed in code
TZ> (probably the former).

TZ> For me, I just

TZ> (setq smtpmail-starttls-credentials '(("mysmtpserver.com" 587 nil nil)))

TZ> and then put this line:

TZ> machine mysmtpserver.com login tzz password mypassword

TZ> in my ~/.authinfo.gpg.  But my configuration has many layers so the
TZ> above may need to be modified a bit and you need to dig into it or
TZ> submit a bug if it still fails.

Hmm, I just saw that STARTTLS is not implemented yet in Lars' message
earlier last week.  So you need to either use port 587 (where SSL is
required), or ask Lars in that other thread to implement STARTTLS for
smtpmail.el :)  Sorry for confusing you, I got confused myself.

Ted

Re: [PATCH] GnuTLS support on Woe32

[Juanma Barranquero]

2011/5/2 Ted Zlatanov <tzz@lifelogs.com>:

> All the C GnuTLS init code (currently `gnutls-boot') calls
> `emacs_gnutls_global_init' *every time*, which is short enough to quote
> here:
[...]
> So we just need to modify `emacs_gnutls_global_init' to load and check
> the GnuTLS library and return an appropriate error (which can be any
> ELisp number object, so you can attach debug info to it).  Or you can do
> it once at init time, which seems less convenient to the user but less
> work.  I don't have an opinion either way.

No, I prefer to do it in emacs_gnutls_global_init, so the .DLLs are
loaded on demand. But to avoid repeated attempts in case the library
is not present, I'll do as with the image libraries: cache the result.
That means that the library must be present the fist time it is used,
or it won't be available during the complete run of that Emacs
instance.

> I think gnutls.el should not know about this.  It should simply get an
> error from the C layer if the library could not be loaded.

What if some elisp code wants to know whether GnuTLS is available?
(fboundp 'gnutls-whatever) won't do, because the functions are defined
(just non-functional). IMO

  (if (gnutls-available-p)
      ; do something
    ; do something else

seems cleaner that

  (condition-case err
       ; use gnutls
    (;catch the error))

but it is your call.

    Juanma

Re: [PATCH] GnuTLS support on Woe32

[Ted Zlatanov]

On Mon, 2 May 2011 21:00:40 +0200 Juanma Barranquero <lekktu@gmail.com> wrote: 

JB> 2011/5/2 Ted Zlatanov <tzz@lifelogs.com>:
>> All the C GnuTLS init code (currently `gnutls-boot') calls
>> `emacs_gnutls_global_init' *every time*, which is short enough to quote
>> here:
JB> [...]
>> So we just need to modify `emacs_gnutls_global_init' to load and check
>> the GnuTLS library and return an appropriate error (which can be any
>> ELisp number object, so you can attach debug info to it).  Or you can do
>> it once at init time, which seems less convenient to the user but less
>> work.  I don't have an opinion either way.

JB> No, I prefer to do it in emacs_gnutls_global_init, so the .DLLs are
JB> loaded on demand. But to avoid repeated attempts in case the library
JB> is not present, I'll do as with the image libraries: cache the result.
JB> That means that the library must be present the fist time it is used,
JB> or it won't be available during the complete run of that Emacs
JB> instance.

OK with me, just make sure you log it :)

>> I think gnutls.el should not know about this.  It should simply get an
>> error from the C layer if the library could not be loaded.

JB> What if some elisp code wants to know whether GnuTLS is available?
JB> (fboundp 'gnutls-whatever) won't do, because the functions are defined
JB> (just non-functional). IMO

JB>   (if (gnutls-available-p)
JB>       ; do something
JB>     ; do something else

JB> seems cleaner that

JB>   (condition-case err
JB>        ; use gnutls
JB>     (;catch the error))

JB> but it is your call.

My hope is that gnutls.el won't be used directly and
`open-network-stream' will be used instead, to avoid the mess of
starttls/gnutls-cli/openssl special process calls we had before.
So this problem is isolated to `open-network-stream' and Lars should
decide how he wants to handle it, IMO.  If he wants `gnutls-available-p'
I'll write it.

Ted

Re: [PATCH] GnuTLS support on Woe32

[Lars Magne Ingebrigtsen]

Juanma Barranquero <lekktu@gmail.com> writes:

> What if some elisp code wants to know whether GnuTLS is available?
> (fboundp 'gnutls-whatever) won't do, because the functions are defined
> (just non-functional). IMO
>
>   (if (gnutls-available-p)
>       ; do something
>     ; do something else

Yes, having a function like that would be very handy.

-- 
(domestic pets only, the antidote for overdose, milk.)
  bloggy blog http://lars.ingebrigtsen.no/

Re: open-network-stream problems on W32

[Lars Magne Ingebrigtsen]

Ted Zlatanov <tzz@lifelogs.com> writes:

> Hmm, I just saw that STARTTLS is not implemented yet in Lars' message
> earlier last week.

STARTTLS is enabled in smtpmail.el, but it's not opportunistic, and it
uses its own gnutls-cli-based implementation.

-- 
(domestic pets only, the antidote for overdose, milk.)
  bloggy blog http://lars.ingebrigtsen.no/

Re: open-network-stream problems on W32

[Ted Zlatanov]

On Mon, 02 May 2011 21:15:34 +0200 Lars Magne Ingebrigtsen <larsi@gnus.org> wrote: 

LMI> Ted Zlatanov <tzz@lifelogs.com> writes:
>> Hmm, I just saw that STARTTLS is not implemented yet in Lars' message
>> earlier last week.

LMI> STARTTLS is enabled in smtpmail.el, but it's not opportunistic, and it
LMI> uses its own gnutls-cli-based implementation.

Right, which was the problem reported :)

Ted

Re: [PATCH] GnuTLS support on Woe32

[Juanma Barranquero]

2011/5/2 Ted Zlatanov <tzz@lifelogs.com>:

> OK with me, just make sure you log it :)

Hm, thanks for bringing this up.

> My hope is that gnutls.el won't be used directly and
> `open-network-stream' will be used instead, to avoid the mess of
> starttls/gnutls-cli/openssl special process calls we had before.

From a package developer's POV, how do you test whether GnuTLS is
available with open-network-stream?

> So this problem is isolated to `open-network-stream' and Lars should
> decide how he wants to handle it, IMO.  If he wants `gnutls-available-p'
> I'll write it.

Oh, that function is just

DEFUN ("gnutls-available-p", Fgnutls_available_p
       Sgnutls_available_p, 0, 0, 0,
       doc: /* Return t if GnuTLS is available in this Emacs session.  */)
  (void)
{
#ifdef WINDOWSNT
  Lisp_Object found = Fassq (Qgnutls_dll, Vlibrary_cache);
  if (CONSP (found))
    return XCDR (found);
  else
    return init_gnutls_functions () ? Qt : Qnil;
#else
  return Qnil
#endif
}

    Juanma

Re: [PATCH] GnuTLS support on Woe32

[Juanma Barranquero]

On Mon, May 2, 2011 at 21:38, Juanma Barranquero <lekktu@gmail.com> wrote:

> #else
>  return Qnil
> #endif

  return Qt

obviously ;-)

    Juanma

Re: [PATCH] GnuTLS support on Woe32

[Ted Zlatanov]

On Mon, 2 May 2011 21:38:52 +0200 Juanma Barranquero <lekktu@gmail.com> wrote: 

JB> 2011/5/2 Ted Zlatanov <tzz@lifelogs.com>:
>> OK with me, just make sure you log it :)

JB> Hm, thanks for bringing this up.

>> My hope is that gnutls.el won't be used directly and
>> `open-network-stream' will be used instead, to avoid the mess of
>> starttls/gnutls-cli/openssl special process calls we had before.

JB> From a package developer's POV, how do you test whether GnuTLS is
JB> available with open-network-stream?

You shouldn't care generally, and if you do, network-stream.el should
provide the necessary introspection.  So I'll provide whatever
information network-stream.el needs, but want to avoid making gnutls.el
a standalone networking library.

>> So this problem is isolated to `open-network-stream' and Lars should
>> decide how he wants to handle it, IMO.  If he wants `gnutls-available-p'
>> I'll write it.

JB> Oh, that function is just

DEFUN ("gnutls-available-p", Fgnutls_available_p
       Sgnutls_available_p, 0, 0, 0,
       doc: /* Return t if GnuTLS is available in this Emacs session.  */)
  (void)
{
#ifdef WINDOWSNT
  Lisp_Object found = Fassq (Qgnutls_dll, Vlibrary_cache);
  if (CONSP (found))
    return XCDR (found);
  else
    return init_gnutls_functions () ? Qt : Qnil;
#else
  return Qnil
#endif
}

I think that would return Qnil for non-WINDOWSNT cases?  And maybe it
should be called gnutls-dll-available-p, so then we can say

(defun gnutls-available-p ()
  "..."
  (and (gnutls-dll-available-p)
       (fboundp 'gnutls-boot)
        ...etc...))

Ted

Re: [PATCH] GnuTLS support on Woe32

[Juanma Barranquero]

2011/5/2 Ted Zlatanov <tzz@lifelogs.com>:

> I think that would return Qnil for non-WINDOWSNT cases?

No. GnuTLS is available_
  - for w32, when the DLLs is loaded, and
  - for non-w32, whenever the GnuTLS support is compiled in.

> And maybe it
> should be called gnutls-dll-available-p, so then we can say
>
> (defun gnutls-available-p ()

To be useful, gnutls-available-p should be used always. It's cleaner than

  (if (and (eq system-type 'w32) (gnutls-available-p)) ...)

It's the same with the image libraries. Correct image code from elisp
should always do

  (if (image-type-available-p 'png)
     ...
    )

regardless of the OS Emacs is running on.

    Juanma

Re: [PATCH] GnuTLS support on Woe32

[Tom Tromey]

>>>>> "Juanma" == Juanma Barranquero <lekktu@gmail.com> writes:

Juanma> Oh, that function is just
Juanma> DEFUN ("gnutls-available-p", Fgnutls_available_p

How about just using featurep instead?
Just provide the feature under the correct conditions at startup.

Tom

Re: [PATCH] GnuTLS support on Woe32

[Juanma Barranquero]

On Mon, May 2, 2011 at 22:10, Tom Tromey <tromey@redhat.com> wrote:

> How about just using featurep instead?
> Just provide the feature under the correct conditions at startup.

I don't want to load the DLLs at startup, but on demand.

    Juanma

Re: [PATCH] GnuTLS support on Woe32

[Eli Zaretskii]

> From: Juanma Barranquero <lekktu@gmail.com>
> Date: Mon, 2 May 2011 22:14:26 +0200
> Cc: Ted Zlatanov <tzz@lifelogs.com>, emacs-devel@gnu.org
> 
> On Mon, May 2, 2011 at 22:10, Tom Tromey <tromey@redhat.com> wrote:
> 
> > How about just using featurep instead?
> > Just provide the feature under the correct conditions at startup.
> 
> I don't want to load the DLLs at startup, but on demand.

Right.  A session that doesn't use TLS should have no business loading
the library.

Re: [PATCH] GnuTLS support on Woe32

[Chong Yidong]

Juanma Barranquero <lekktu@gmail.com> writes:

> To be useful, gnutls-available-p should be used always. It's cleaner than
>
>   (if (and (eq system-type 'w32) (gnutls-available-p)) ...)
>
> It's the same with the image libraries. Correct image code from elisp
> should always do
>
>   (if (image-type-available-p 'png)

In the case of open-network-stream, why do you need to use
gnutls-available-p?  Why not either use `starttls', or do `tls' and then
`network' if that fails?  After all, gnutls not being available is only
one of many possible failure modes, so it's better to just let
open-network-stream handle them.

Re: [PATCH] GnuTLS support on Woe32

[Lars Magne Ingebrigtsen]

Chong Yidong <cyd@stupidchicken.com> writes:

> In the case of open-network-stream, why do you need to use
> gnutls-available-p?  Why not either use `starttls', or do `tls' and then
> `network' if that fails?  After all, gnutls not being available is only
> one of many possible failure modes, so it's better to just let
> open-network-stream handle them.

Well, this is to allow `open-network-stream' to handle that.  Today it
uses (fboundp 'open-gnutls-stream), which is a very bad test, since it
only tests for whether someone has loaded the gnutls.el library, which
says nothing about whether Emacs has been linked against gnutls, or (in
Windows) whether the DLL has been loaded.

-- 
(domestic pets only, the antidote for overdose, milk.)
  bloggy blog http://lars.ingebrigtsen.no/

Re: [PATCH] GnuTLS support on Woe32

[Lars Magne Ingebrigtsen]

Juanma Barranquero <lekktu@gmail.com> writes:

> Oh, that function is just
>
> DEFUN ("gnutls-available-p", Fgnutls_available_p

Looks good to me.  Please put it into Emacs so that I can flip the
gnutls defaults in `open-network-stream'.  :-)

-- 
(domestic pets only, the antidote for overdose, milk.)
  bloggy blog http://lars.ingebrigtsen.no/

Re: [PATCH] GnuTLS support on Woe32

[Juanma Barranquero]

On Mon, May 2, 2011 at 23:16, Chong Yidong <cyd@stupidchicken.com> wrote:

> In the case of open-network-stream, why do you need to use
> gnutls-available-p?  Why not either use `starttls', or do `tls' and then
> `network' if that fails?

Lars already answered, but I'd like to comment on this:

> After all, gnutls not being available is only
> one of many possible failure modes, so it's better to just let
> open-network-stream handle them.

For the Windows port, having libgnutls-26.dll unavailable is not a
failure; it's entirely parallel to the non-Windows ports being built
withouth GnuTLS support. Checking that the library it is available
should be totally equivalent (modulo the moment it happens) to a
feature check or (if (fboundp 'whatever) ...).

    Juanma

Re: [PATCH] GnuTLS support on Woe32

[Juanma Barranquero]

On Tue, May 3, 2011 at 00:46, Lars Magne Ingebrigtsen <larsi@gnus.org> wrote:

> Looks good to me.  Please put it into Emacs so that I can flip the
> gnutls defaults in `open-network-stream'.  :-)

I'll do, with the rest of the dynamic loading changes.

    Juanma

Re: [PATCH] GnuTLS support on Woe32

[Juanma Barranquero]

[-- Attachment #1: Type: text/plain, Size: 628 bytes --]

2011/5/2 Ted Zlatanov <tzz@lifelogs.com>:

> So we just need to modify `emacs_gnutls_global_init' to load and check
> the GnuTLS library

emacs_gnutls_global_init is called too late, after
gnutls_global_set_log_function and gnutls_global_set_log_level have
been called. I've chosen to call Fgnutls_available_p at the start of
Fgnutls_boot.

Please take a look at the attached patch, which is a rough cut; it
lacks any documentation (no ChangeLog entries) and I'm not really sure
what am I doing with the errors :-)  Also, I haven't added GNUTLS_LOG
calls; feel free to suggest them as appropriate.

    Juanma

[-- Attachment #2: gnutls2.patch --]
[-- Type: application/octet-stream, Size: 29256 bytes --]

=== modified file 'lisp/term/w32-win.el'
--- lisp/term/w32-win.el	2011-02-03 07:31:42 +0000
+++ lisp/term/w32-win.el	2011-05-02 01:12:42 +0000
@@ -208,7 +208,8 @@
         '(svg "librsvg-2-2.dll")
         '(gdk-pixbuf "libgdk_pixbuf-2.0-0.dll")
         '(glib "libglib-2.0-0.dll")
-	'(gobject "libgobject-2.0-0.dll")))
+       '(gobject "libgobject-2.0-0.dll")
+       '(gnutls "libgnutls-26.dll")))
 
 ;;; multi-tty support
 (defvar w32-initialized nil

=== modified file 'src/gnutls.c'
--- src/gnutls.c	2011-05-02 02:49:06 +0000
+++ src/gnutls.c	2011-05-03 02:21:35 +0000
@@ -34,6 +34,7 @@
 static int
 emacs_gnutls_handle_error (gnutls_session_t, int err);
 
+static Lisp_Object Qgnutls_dll;
 static Lisp_Object Qgnutls_log_level;
 static Lisp_Object Qgnutls_code;
 static Lisp_Object Qgnutls_anon, Qgnutls_x509pki;
@@ -55,6 +56,145 @@
 /* Callback keys for `gnutls-boot'.  Unused currently.  */
 static Lisp_Object Qgnutls_bootprop_callbacks_verify;
 
+#ifdef WINDOWSNT
+
+/* Macro for defining functions that will be loaded from the GnuTLS DLL.  */
+#define DEF_GNUTLS_FN(rettype,func,args) rettype (FAR CDECL *fn_##func)args
+
+/* Macro for loading GnuTLS functions from the library.  */
+#define LOAD_GNUTLS_FN(lib,func) {					\
+    fn_##func = (void *) GetProcAddress (lib, #func);			\
+    if (!fn_##func) return 0;						\
+  }
+
+DEF_GNUTLS_FN (gnutls_alert_description_t, gnutls_alert_get, (gnutls_session_t));
+DEF_GNUTLS_FN (const char *, gnutls_alert_get_name, (gnutls_alert_description_t));
+DEF_GNUTLS_FN (int, gnutls_alert_send_appropriate, (gnutls_session_t, int));
+DEF_GNUTLS_FN (int, gnutls_anon_allocate_client_credentials, (gnutls_anon_client_credentials_t *));
+DEF_GNUTLS_FN (void, gnutls_anon_free_client_credentials, (gnutls_anon_client_credentials_t));
+DEF_GNUTLS_FN (int, gnutls_bye, (gnutls_session_t, gnutls_close_request_t));
+DEF_GNUTLS_FN (int, gnutls_certificate_allocate_credentials, (gnutls_certificate_credentials_t *));
+DEF_GNUTLS_FN (void, gnutls_certificate_free_credentials, (gnutls_certificate_credentials_t));
+DEF_GNUTLS_FN (const gnutls_datum_t *, gnutls_certificate_get_peers, (gnutls_session_t, unsigned int *));
+DEF_GNUTLS_FN (void, gnutls_certificate_set_verify_flags, (gnutls_certificate_credentials_t, unsigned int));
+DEF_GNUTLS_FN (int, gnutls_certificate_set_x509_crl_file, (gnutls_certificate_credentials_t, const char *, gnutls_x509_crt_fmt_t));
+DEF_GNUTLS_FN (int, gnutls_certificate_set_x509_trust_file, (gnutls_certificate_credentials_t, const char *, gnutls_x509_crt_fmt_t));
+DEF_GNUTLS_FN (gnutls_certificate_type_t, gnutls_certificate_type_get, (gnutls_session_t));
+DEF_GNUTLS_FN (int, gnutls_certificate_verify_peers2, (gnutls_session_t, unsigned int *));
+DEF_GNUTLS_FN (int, gnutls_credentials_set, (gnutls_session_t, gnutls_credentials_type_t, void *));
+DEF_GNUTLS_FN (void, gnutls_deinit, (gnutls_session_t));
+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));
+DEF_GNUTLS_FN (void, gnutls_global_set_log_level, (int));
+DEF_GNUTLS_FN (int, gnutls_handshake, (gnutls_session_t));
+DEF_GNUTLS_FN (int, gnutls_init, (gnutls_session_t *, gnutls_connection_end_t));
+DEF_GNUTLS_FN (int, gnutls_priority_set_direct, (gnutls_session_t, const char *, const char **));
+DEF_GNUTLS_FN (size_t, gnutls_record_check_pending, (gnutls_session_t));
+DEF_GNUTLS_FN (ssize_t, gnutls_record_recv, (gnutls_session_t, void *, size_t));
+DEF_GNUTLS_FN (ssize_t, gnutls_record_send, (gnutls_session_t, const void *, size_t));
+DEF_GNUTLS_FN (const char *, gnutls_strerror, (int));
+DEF_GNUTLS_FN (void, gnutls_transport_set_errno, (gnutls_session_t, int));
+DEF_GNUTLS_FN (void, gnutls_transport_set_lowat, (gnutls_session_t, int));
+DEF_GNUTLS_FN (void, gnutls_transport_set_ptr2, (gnutls_session_t, gnutls_transport_ptr_t, gnutls_transport_ptr_t));
+DEF_GNUTLS_FN (void, gnutls_transport_set_pull_function, (gnutls_session_t, gnutls_pull_func));
+DEF_GNUTLS_FN (void, gnutls_transport_set_push_function, (gnutls_session_t, gnutls_push_func));
+DEF_GNUTLS_FN (int, gnutls_x509_crt_check_hostname, (gnutls_x509_crt_t, const char *));
+DEF_GNUTLS_FN (void, gnutls_x509_crt_deinit, (gnutls_x509_crt_t));
+DEF_GNUTLS_FN (int, gnutls_x509_crt_import, (gnutls_x509_crt_t, const gnutls_datum_t *, 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)
+{
+  HMODULE library;
+
+  if (!(library = w32_delayed_load (libraries, Qgnutls_dll)))
+    return 0;
+
+  LOAD_GNUTLS_FN (library, gnutls_alert_get);
+  LOAD_GNUTLS_FN (library, gnutls_alert_get_name);
+  LOAD_GNUTLS_FN (library, gnutls_alert_send_appropriate);
+  LOAD_GNUTLS_FN (library, gnutls_anon_allocate_client_credentials);
+  LOAD_GNUTLS_FN (library, gnutls_anon_free_client_credentials);
+  LOAD_GNUTLS_FN (library, gnutls_bye);
+  LOAD_GNUTLS_FN (library, gnutls_certificate_allocate_credentials);
+  LOAD_GNUTLS_FN (library, gnutls_certificate_free_credentials);
+  LOAD_GNUTLS_FN (library, gnutls_certificate_get_peers);
+  LOAD_GNUTLS_FN (library, gnutls_certificate_set_verify_flags);
+  LOAD_GNUTLS_FN (library, gnutls_certificate_set_x509_crl_file);
+  LOAD_GNUTLS_FN (library, gnutls_certificate_set_x509_trust_file);
+  LOAD_GNUTLS_FN (library, gnutls_certificate_type_get);
+  LOAD_GNUTLS_FN (library, gnutls_certificate_verify_peers2);
+  LOAD_GNUTLS_FN (library, gnutls_credentials_set);
+  LOAD_GNUTLS_FN (library, gnutls_deinit);
+  LOAD_GNUTLS_FN (library, gnutls_error_is_fatal);
+  LOAD_GNUTLS_FN (library, gnutls_global_init);
+  LOAD_GNUTLS_FN (library, gnutls_global_set_log_function);
+  LOAD_GNUTLS_FN (library, gnutls_global_set_log_level);
+  LOAD_GNUTLS_FN (library, gnutls_handshake);
+  LOAD_GNUTLS_FN (library, gnutls_init);
+  LOAD_GNUTLS_FN (library, gnutls_priority_set_direct);
+  LOAD_GNUTLS_FN (library, gnutls_record_check_pending);
+  LOAD_GNUTLS_FN (library, gnutls_record_recv);
+  LOAD_GNUTLS_FN (library, gnutls_record_send);
+  LOAD_GNUTLS_FN (library, gnutls_strerror);
+  LOAD_GNUTLS_FN (library, gnutls_transport_set_errno);
+  LOAD_GNUTLS_FN (library, gnutls_transport_set_lowat);
+  LOAD_GNUTLS_FN (library, gnutls_transport_set_ptr2);
+  LOAD_GNUTLS_FN (library, gnutls_transport_set_pull_function);
+  LOAD_GNUTLS_FN (library, gnutls_transport_set_push_function);
+  LOAD_GNUTLS_FN (library, gnutls_x509_crt_check_hostname);
+  LOAD_GNUTLS_FN (library, gnutls_x509_crt_deinit);
+  LOAD_GNUTLS_FN (library, gnutls_x509_crt_import);
+  LOAD_GNUTLS_FN (library, gnutls_x509_crt_init);
+
+  return 1;
+}
+
+#else /* !WINDOWSNT */
+
+#define fn_gnutls_alert_get			gnutls_alert_get
+#define fn_gnutls_alert_get_name		gnutls_alert_get_name
+#define fn_gnutls_alert_send_appropriate	gnutls_alert_send_appropriate
+#define fn_gnutls_anon_allocate_client_credentials gnutls_anon_allocate_client_credentials
+#define fn_gnutls_anon_free_client_credentials	gnutls_anon_free_client_credentials
+#define fn_gnutls_bye				gnutls_bye
+#define fn_gnutls_certificate_allocate_credentials gnutls_certificate_allocate_credentials
+#define fn_gnutls_certificate_free_credentials	gnutls_certificate_free_credentials
+#define fn_gnutls_certificate_get_peers		gnutls_certificate_get_peers
+#define fn_gnutls_certificate_set_verify_flags	gnutls_certificate_set_verify_flags
+#define fn_gnutls_certificate_set_x509_crl_file	gnutls_certificate_set_x509_crl_file
+#define fn_gnutls_certificate_set_x509_trust_file gnutls_certificate_set_x509_trust_file
+#define fn_gnutls_certificate_type_get		gnutls_certificate_type_get
+#define fn_gnutls_certificate_verify_peers2	gnutls_certificate_verify_peers2
+#define fn_gnutls_credentials_set		gnutls_credentials_set
+#define fn_gnutls_deinit			gnutls_deinit
+#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
+#define fn_gnutls_global_set_log_level		gnutls_global_set_log_level
+#define fn_gnutls_handshake			gnutls_handshake
+#define fn_gnutls_init				gnutls_init
+#define fn_gnutls_priority_set_direct		gnutls_priority_set_direct
+#define fn_gnutls_record_check_pending		gnutls_record_check_pending
+#define fn_gnutls_record_recv			gnutls_record_recv
+#define fn_gnutls_record_send			gnutls_record_send
+#define fn_gnutls_strerror			gnutls_strerror
+#define fn_gnutls_transport_set_errno		gnutls_transport_set_errno
+#define fn_gnutls_transport_set_lowat		gnutls_transport_set_lowat
+#define fn_gnutls_transport_set_ptr2		gnutls_transport_set_ptr2
+#define fn_gnutls_transport_set_pull_function	gnutls_transport_set_pull_function
+#define fn_gnutls_transport_set_push_function	gnutls_transport_set_push_function
+#define fn_gnutls_x509_crt_check_hostname	gnutls_x509_crt_check_hostname
+#define fn_gnutls_x509_crt_deinit		gnutls_x509_crt_deinit
+#define fn_gnutls_x509_crt_import		gnutls_x509_crt_import
+#define fn_gnutls_x509_crt_init			gnutls_x509_crt_init
+
+#endif /* !WINDOWSNT */
+
+\f
+
 static void
 gnutls_log_function (int level, const char* string)
 {
@@ -82,11 +222,11 @@
       /* On W32 we cannot transfer socket handles between different runtime
          libraries, so we tell GnuTLS to use our special push/pull
          functions.  */
-      gnutls_transport_set_ptr2 (state,
+      fn_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);
+      fn_gnutls_transport_set_push_function (state, &emacs_gnutls_push);
+      fn_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
@@ -95,12 +235,12 @@
          (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);
+      fn_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,
+      fn_gnutls_transport_set_ptr2 (state,
         			 (gnutls_transport_ptr_t) (long) proc->infd,
         			 (gnutls_transport_ptr_t) (long) proc->outfd);
 #endif
@@ -110,10 +250,10 @@
 
   do
     {
-      ret = gnutls_handshake (state);
+      ret = fn_gnutls_handshake (state);
       emacs_gnutls_handle_error (state, ret);
     }
-  while (ret < 0 && gnutls_error_is_fatal (ret) == 0);
+  while (ret < 0 && fn_gnutls_error_is_fatal (ret) == 0);
 
   proc->gnutls_initstage = GNUTLS_STAGE_HANDSHAKE_TRIED;
 
@@ -124,11 +264,23 @@
     }
   else
     {
-        gnutls_alert_send_appropriate (state, ret);
+        fn_gnutls_alert_send_appropriate (state, ret);
     }
   return ret;
 }
 
+int
+emacs_gnutls_record_check_pending (gnutls_session_t state)
+{
+  return fn_gnutls_record_check_pending (state);
+}
+
+void
+emacs_gnutls_transport_set_errno (gnutls_session_t state, int err)
+{
+  fn_gnutls_transport_set_errno (state, err);
+}
+
 EMACS_INT
 emacs_gnutls_write (int fildes, struct Lisp_Process *proc, const char *buf,
                     EMACS_INT nbyte)
@@ -151,7 +303,7 @@
 
   while (nbyte > 0)
     {
-      rtnval = gnutls_write (state, buf, nbyte);
+      rtnval = fn_gnutls_record_send (state, buf, nbyte);
 
       if (rtnval < 0)
         {
@@ -182,7 +334,7 @@
       emacs_gnutls_handshake (proc);
       return -1;
     }
-  rtnval = gnutls_read (state, buf, nbyte);
+  rtnval = fn_gnutls_record_recv (state, buf, nbyte);
   if (rtnval >= 0)
     return rtnval;
   else if (emacs_gnutls_handle_error (state, rtnval) == 0)
@@ -214,11 +366,11 @@
 
   /* TODO: use gnutls-error-fatalp and gnutls-error-string.  */
 
-  str = gnutls_strerror (err);
+  str = fn_gnutls_strerror (err);
   if (!str)
     str = "unknown";
 
-  if (gnutls_error_is_fatal (err))
+  if (fn_gnutls_error_is_fatal (err))
     {
       ret = err;
       GNUTLS_LOG2 (0, max_log_level, "fatal error:", str);
@@ -233,9 +385,9 @@
   if (err == GNUTLS_E_WARNING_ALERT_RECEIVED
       || err == GNUTLS_E_FATAL_ALERT_RECEIVED)
     {
-      int alert = gnutls_alert_get (session);
+      int alert = fn_gnutls_alert_get (session);
       int level = (err == GNUTLS_E_FATAL_ALERT_RECEIVED) ? 0 : 1;
-      str = gnutls_alert_get_name (alert);
+      str = fn_gnutls_alert_get_name (alert);
       if (!str)
 	str = "unknown";
 
@@ -313,7 +465,7 @@
   if (!NUMBERP (err))
     error ("Not an error symbol or code");
 
-  if (0 == gnutls_error_is_fatal (XINT (err)))
+  if (0 == fn_gnutls_error_is_fatal (XINT (err)))
     return Qnil;
 
   return Qt;
@@ -345,7 +497,7 @@
   if (!NUMBERP (err))
     return build_string ("Not an error symbol or code");
 
-  return build_string (gnutls_strerror (XINT (err)));
+  return build_string (fn_gnutls_strerror (XINT (err)));
 }
 
 DEFUN ("gnutls-deinit", Fgnutls_deinit, Sgnutls_deinit, 1, 1, 0,
@@ -360,13 +512,34 @@
 
   if (GNUTLS_INITSTAGE (proc) >= GNUTLS_STAGE_INIT)
     {
-      gnutls_deinit (state);
+      fn_gnutls_deinit (state);
       GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_INIT - 1;
     }
 
   return Qt;
 }
 
+DEFUN ("gnutls-available-p", Fgnutls_available_p, Sgnutls_available_p, 0, 0, 0,
+       doc: /* Return t if GnuTLS is available in this instance of Emacs.  */)
+     (void)
+{
+#ifdef WINDOWSNT
+  Lisp_Object found = Fassq (Qgnutls_dll, Vlibrary_cache);
+  if (CONSP (found))
+    return XCDR (found);
+  else
+    {
+      Lisp_Object status;
+      status = init_gnutls_functions (Vdynamic_library_alist) ? Qt : Qnil;
+      Vlibrary_cache = Fcons (Fcons (Qgnutls_dll, status), Vlibrary_cache);
+      return status;
+    }
+#else
+  return Qt;
+#endif
+}
+
+
 /* Initializes global GnuTLS state to defaults.
 Call `gnutls-global-deinit' when GnuTLS usage is no longer needed.
 Returns zero on success.  */
@@ -376,8 +549,7 @@
   int ret = GNUTLS_E_SUCCESS;
 
   if (!gnutls_global_initialized)
-    ret = gnutls_global_init ();
-
+    ret = fn_gnutls_global_init ();
   gnutls_global_initialized = 1;
 
   return gnutls_make_error (ret);
@@ -483,6 +655,12 @@
   CHECK_SYMBOL (type);
   CHECK_LIST (proplist);
 
+  if (NILP (Fgnutls_available_p ()))
+    {
+      error ("GnuTLS not available");
+      return gnutls_make_error (GNUTLS_EMACS_ERROR_NOT_LOADED);
+    }
+
   hostname              = Fplist_get (proplist, Qgnutls_bootprop_hostname);
   priority_string       = Fplist_get (proplist, Qgnutls_bootprop_priority);
   trustfiles            = Fplist_get (proplist, Qgnutls_bootprop_trustfiles);
@@ -503,8 +681,8 @@
 
   if (NUMBERP (loglevel))
     {
-      gnutls_global_set_log_function (gnutls_log_function);
-      gnutls_global_set_log_level (XINT (loglevel));
+      fn_gnutls_global_set_log_function (gnutls_log_function);
+      fn_gnutls_global_set_log_level (XINT (loglevel));
       max_log_level = XINT (loglevel);
       XPROCESS (proc)->gnutls_log_level = max_log_level;
     }
@@ -523,13 +701,13 @@
 	{
           GNUTLS_LOG (2, max_log_level, "deallocating x509 credentials");
           x509_cred = XPROCESS (proc)->gnutls_x509_cred;
-          gnutls_certificate_free_credentials (x509_cred);
+          fn_gnutls_certificate_free_credentials (x509_cred);
 	}
       else if (EQ (type, Qgnutls_anon))
 	{
           GNUTLS_LOG (2, max_log_level, "deallocating anon credentials");
           anon_cred = XPROCESS (proc)->gnutls_anon_cred;
-          gnutls_anon_free_client_credentials (anon_cred);
+          fn_gnutls_anon_free_client_credentials (anon_cred);
 	}
       else
 	{
@@ -552,7 +730,7 @@
     {
       GNUTLS_LOG (2, max_log_level, "allocating x509 credentials");
       x509_cred = XPROCESS (proc)->gnutls_x509_cred;
-      if (gnutls_certificate_allocate_credentials (&x509_cred) < 0)
+      if (fn_gnutls_certificate_allocate_credentials (&x509_cred) < 0)
         memory_full ();
 
       if (NUMBERP (verify_flags))
@@ -570,13 +748,13 @@
           /* The default is already GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT.  */
           GNUTLS_LOG (2, max_log_level, "ignoring invalid verify-flags");
         }
-      gnutls_certificate_set_verify_flags (x509_cred, gnutls_verify_flags);
+      fn_gnutls_certificate_set_verify_flags (x509_cred, gnutls_verify_flags);
     }
   else if (EQ (type, Qgnutls_anon))
     {
       GNUTLS_LOG (2, max_log_level, "allocating anon credentials");
       anon_cred = XPROCESS (proc)->gnutls_anon_cred;
-      if (gnutls_anon_allocate_client_credentials (&anon_cred) < 0)
+      if (fn_gnutls_anon_allocate_client_credentials (&anon_cred) < 0)
         memory_full ();
     }
   else
@@ -599,7 +777,7 @@
             {
               GNUTLS_LOG2 (1, max_log_level, "setting the trustfile: ",
                            SSDATA (trustfile));
-              ret = gnutls_certificate_set_x509_trust_file
+              ret = fn_gnutls_certificate_set_x509_trust_file
                 (x509_cred,
                  SSDATA (trustfile),
                  file_format);
@@ -621,7 +799,7 @@
             {
               GNUTLS_LOG2 (1, max_log_level, "setting the keyfile: ",
                            SSDATA (keyfile));
-              ret = gnutls_certificate_set_x509_crl_file
+              ret = fn_gnutls_certificate_set_x509_crl_file
                 (x509_cred,
                  SSDATA (keyfile),
                  file_format);
@@ -649,7 +827,7 @@
 
   GNUTLS_LOG (1, max_log_level, "gnutls_init");
 
-  ret = gnutls_init (&state, GNUTLS_CLIENT);
+  ret = fn_gnutls_init (&state, GNUTLS_CLIENT);
 
   if (ret < GNUTLS_E_SUCCESS)
     return gnutls_make_error (ret);
@@ -672,7 +850,7 @@
 
   GNUTLS_LOG (1, max_log_level, "setting the priority string");
 
-  ret = gnutls_priority_set_direct (state,
+  ret = fn_gnutls_priority_set_direct (state,
 				    priority_string_ptr,
 				    NULL);
 
@@ -683,11 +861,11 @@
 
   if (EQ (type, Qgnutls_x509pki))
     {
-      ret = gnutls_cred_set (state, GNUTLS_CRD_CERTIFICATE, x509_cred);
+      ret = fn_gnutls_credentials_set (state, GNUTLS_CRD_CERTIFICATE, x509_cred);
     }
   else if (EQ (type, Qgnutls_anon))
     {
-      ret = gnutls_cred_set (state, GNUTLS_CRD_ANON, anon_cred);
+      ret = fn_gnutls_credentials_set (state, GNUTLS_CRD_ANON, anon_cred);
     }
   else
     {
@@ -715,7 +893,7 @@
      check of the certificate's hostname with
      gnutls_x509_crt_check_hostname() against :hostname.  */
 
-  ret = gnutls_certificate_verify_peers2 (state, &peer_verification);
+  ret = fn_gnutls_certificate_verify_peers2 (state, &peer_verification);
 
   if (ret < GNUTLS_E_SUCCESS)
     return gnutls_make_error (ret);
@@ -766,15 +944,15 @@
   /* Up to here the process is the same for X.509 certificates and
      OpenPGP keys.  From now on X.509 certificates are assumed.  This
      can be easily extended to work with openpgp keys as well.  */
-  if (gnutls_certificate_type_get (state) == GNUTLS_CRT_X509)
+  if (fn_gnutls_certificate_type_get (state) == GNUTLS_CRT_X509)
     {
-      ret = gnutls_x509_crt_init (&gnutls_verify_cert);
+      ret = fn_gnutls_x509_crt_init (&gnutls_verify_cert);
 
       if (ret < GNUTLS_E_SUCCESS)
         return gnutls_make_error (ret);
 
       gnutls_verify_cert_list =
-        gnutls_certificate_get_peers (state, &gnutls_verify_cert_list_size);
+        fn_gnutls_certificate_get_peers (state, &gnutls_verify_cert_list_size);
 
       if (NULL == gnutls_verify_cert_list)
         {
@@ -782,17 +960,17 @@
         }
 
       /* We only check the first certificate in the given chain.  */
-      ret = gnutls_x509_crt_import (gnutls_verify_cert,
+      ret = fn_gnutls_x509_crt_import (gnutls_verify_cert,
                                     &gnutls_verify_cert_list[0],
                                     GNUTLS_X509_FMT_DER);
 
       if (ret < GNUTLS_E_SUCCESS)
         {
-          gnutls_x509_crt_deinit (gnutls_verify_cert);
+          fn_gnutls_x509_crt_deinit (gnutls_verify_cert);
           return gnutls_make_error (ret);
         }
 
-      if (!gnutls_x509_crt_check_hostname (gnutls_verify_cert, c_hostname))
+      if (!fn_gnutls_x509_crt_check_hostname (gnutls_verify_cert, c_hostname))
         {
           if (NILP (verify_hostname_error))
             {
@@ -801,13 +979,13 @@
             }
           else
             {
-              gnutls_x509_crt_deinit (gnutls_verify_cert);
+              fn_gnutls_x509_crt_deinit (gnutls_verify_cert);
               error ("The x509 certificate does not match \"%s\"",
                      c_hostname);
             }
         }
 
-      gnutls_x509_crt_deinit (gnutls_verify_cert);
+      fn_gnutls_x509_crt_deinit (gnutls_verify_cert);
     }
 
   return gnutls_make_error (ret);
@@ -836,7 +1014,7 @@
 
   state = XPROCESS (proc)->gnutls_state;
 
-  ret = gnutls_bye (state,
+  ret = fn_gnutls_bye (state,
                     NILP (cont) ? GNUTLS_SHUT_RDWR : GNUTLS_SHUT_WR);
 
   return gnutls_make_error (ret);
@@ -847,6 +1025,9 @@
 {
   gnutls_global_initialized = 0;
 
+  Qgnutls_dll = intern_c_string ("gnutls");
+  staticpro (&Qgnutls_dll);
+
   Qgnutls_log_level = intern_c_string ("gnutls-log-level");
   staticpro (&Qgnutls_log_level);
 
@@ -917,6 +1098,7 @@
   defsubr (&Sgnutls_boot);
   defsubr (&Sgnutls_deinit);
   defsubr (&Sgnutls_bye);
+  defsubr (&Sgnutls_available_p);
 }
 
 #endif /* HAVE_GNUTLS */

=== modified file 'src/gnutls.h'
--- src/gnutls.h	2011-04-25 01:30:51 +0000
+++ src/gnutls.h	2011-05-03 01:08:23 +0000
@@ -42,6 +42,7 @@
   GNUTLS_STAGE_READY,
 } gnutls_initstage_t;
 
+#define GNUTLS_EMACS_ERROR_NOT_LOADED GNUTLS_E_APPLICATION_ERROR_MIN + 1
 #define GNUTLS_EMACS_ERROR_INVALID_TYPE GNUTLS_E_APPLICATION_ERROR_MIN
 
 #define GNUTLS_INITSTAGE(proc) (XPROCESS (proc)->gnutls_initstage)
@@ -52,13 +53,16 @@
 
 #define GNUTLS_LOG2(level, max, string, extra) if (level <= max) { gnutls_log_function2 (level, "(Emacs) " string, extra); }
 
-EMACS_INT
+extern EMACS_INT
 emacs_gnutls_write (int fildes, struct Lisp_Process *proc, const char *buf,
                     EMACS_INT nbyte);
-EMACS_INT
+extern EMACS_INT
 emacs_gnutls_read (int fildes, struct Lisp_Process *proc, char *buf,
                    EMACS_INT nbyte);
 
+extern int emacs_gnutls_record_check_pending (gnutls_session_t state);
+extern void emacs_gnutls_transport_set_errno (gnutls_session_t state, int err);
+
 extern void syms_of_gnutls (void);
 
 #endif

=== modified file 'src/image.c'
--- src/image.c	2011-04-25 21:34:39 +0000
+++ src/image.c	2011-05-02 01:48:17 +0000
@@ -67,6 +67,7 @@
 
 
 #ifdef HAVE_NTGUI
+#include "w32.h"
 #include "w32term.h"
 
 /* W32_TODO : Color tables on W32.  */
@@ -556,10 +557,6 @@
 
 static struct image_type *image_types;
 
-/* Cache for delayed-loading image types.  */
-
-static Lisp_Object Vimage_type_cache;
-
 /* The symbol `xbm' which is used as the type symbol for XBM images.  */
 
 static Lisp_Object Qxbm;
@@ -589,7 +586,7 @@
                                    Lisp_Object);
 
 #define CACHE_IMAGE_TYPE(type, status) \
-  do { Vimage_type_cache = Fcons (Fcons (type, status), Vimage_type_cache); } while (0)
+  do { Vlibrary_cache = Fcons (Fcons (type, status), Vlibrary_cache); } while (0)
 
 #define ADD_IMAGE_TYPE(type) \
   do { Vimage_types = Fcons (type, Vimage_types); } while (0)
@@ -1900,34 +1897,6 @@
     if (!fn_##func) return 0;						\
   }
 
-/* Load a DLL implementing an image type.
-   The argument LIBRARIES is usually the variable
-   `dynamic-library-alist', which associates a symbol, identifying
-   an external DLL library, to a list of possible filenames.
-   The function returns NULL if no library could be loaded for
-   the given symbol, or if the library was previously loaded;
-   else the handle of the DLL.  */
-static HMODULE
-w32_delayed_load (Lisp_Object libraries, Lisp_Object type)
-{
-  HMODULE library = NULL;
-
-  if (CONSP (libraries) && NILP (Fassq (type, Vimage_type_cache)))
-    {
-      Lisp_Object dlls = Fassq (type, libraries);
-
-      if (CONSP (dlls))
-        for (dlls = XCDR (dlls); CONSP (dlls); dlls = XCDR (dlls))
-          {
-            CHECK_STRING_CAR (dlls);
-            if (library = LoadLibrary (SDATA (XCAR (dlls))))
-              break;
-          }
-    }
-
-  return library;
-}
-
 #endif /* HAVE_NTGUI */
 
 static int x_create_x_image_and_pixmap (struct frame *, int, int, int,
@@ -8634,7 +8603,7 @@
   Lisp_Object tested;
 
   /* Don't try to reload the library.  */
-  tested = Fassq (type, Vimage_type_cache);
+  tested = Fassq (type, Vlibrary_cache);
   if (CONSP (tested))
     return XCDR (tested);
 
@@ -8714,9 +8683,6 @@
 non-numeric, there is no explicit limit on the size of images.  */);
   Vmax_image_size = make_float (MAX_IMAGE_SIZE);
 
-  Vimage_type_cache = Qnil;
-  staticpro (&Vimage_type_cache);
-
   Qpbm = intern_c_string ("pbm");
   staticpro (&Qpbm);
   ADD_IMAGE_TYPE (Qpbm);

=== modified file 'src/process.c'
--- src/process.c	2011-04-30 09:31:01 +0000
+++ src/process.c	2011-05-03 01:08:37 +0000
@@ -4540,7 +4540,7 @@
           if (nfds == 0 && 
               wait_proc && wait_proc->gnutls_p /* Check for valid process.  */
               /* Do we have pending data?  */
-              && gnutls_record_check_pending (wait_proc->gnutls_state) > 0)
+              && emacs_gnutls_record_check_pending (wait_proc->gnutls_state) > 0)
           {
               nfds = 1;
               /* Set to Available.  */

=== modified file 'src/w32.c'
--- src/w32.c	2011-04-28 19:51:12 +0000
+++ src/w32.c	2011-05-03 01:10:10 +0000
@@ -5712,6 +5712,40 @@
   return localtime (t);
 }
 
+
+\f
+/* Delayed loading of libraries.  */
+
+Lisp_Object Vlibrary_cache;
+
+/* The argument LIBRARIES is usually the variable
+   `dynamic-library-alist', which associates a symbol, identifying
+   an external DLL library, to a list of possible filenames.
+   The function returns NULL if no library could be loaded for
+   the given symbol, or if the library was previously loaded;
+   else the handle of the DLL.  */
+HMODULE
+w32_delayed_load (Lisp_Object libraries, Lisp_Object library_id)
+{
+  HMODULE library_dll = NULL;
+
+  if (CONSP (libraries) && NILP (Fassq (library_id, Vlibrary_cache)))
+    {
+      Lisp_Object dlls = Fassq (library_id, libraries);
+
+      if (CONSP (dlls))
+        for (dlls = XCDR (dlls); CONSP (dlls); dlls = XCDR (dlls))
+          {
+            CHECK_STRING_CAR (dlls);
+            if (library_dll = LoadLibrary (SDATA (XCAR (dlls))))
+              break;
+          }
+    }
+
+  return library_dll;
+}
+
+\f
 static void
 check_windows_init_file (void)
 {
@@ -5910,6 +5944,9 @@
   get_process_times_fn = (GetProcessTimes_Proc)
     GetProcAddress (kernel32, "GetProcessTimes");
 
+  Vlibrary_cache = Qnil;
+  staticpro (&Vlibrary_cache);
+
   g_b_init_is_windows_9x = 0;
   g_b_init_open_process_token = 0;
   g_b_init_get_token_information = 0;
@@ -6178,7 +6215,7 @@
             err = errno; /* Other errors are just passed on.  */
         }
 
-      gnutls_transport_set_errno (process->gnutls_state, err);
+      emacs_gnutls_transport_set_errno (process->gnutls_state, err);
 
       return -1;
     }
@@ -6197,7 +6234,7 @@
 
   /* Negative bytes written means we got an error in errno.
      Translate the WSAEWOULDBLOCK alias EWOULDBLOCK to EAGAIN.  */
-  gnutls_transport_set_errno (process->gnutls_state,
+  emacs_gnutls_transport_set_errno (process->gnutls_state,
                               errno == EWOULDBLOCK ? EAGAIN : errno);
 
   return -1;

=== modified file 'src/w32.h'
--- src/w32.h	2011-04-25 01:30:51 +0000
+++ src/w32.h	2011-05-02 01:47:27 +0000
@@ -1,6 +1,8 @@
 #ifndef EMACS_W32_H
 #define EMACS_W32_H
 
+#include "lisp.h"
+
 /* Support routines for the NT version of Emacs.
    Copyright (C) 1994, 2001-2011  Free Software Foundation, Inc.
 
@@ -143,6 +145,9 @@
 extern int _sys_read_ahead (int fd);
 extern int _sys_wait_accept (int fd);
 
+extern Lisp_Object Vlibrary_cache;
+extern HMODULE w32_delayed_load (Lisp_Object, Lisp_Object);
+
 #ifdef HAVE_GNUTLS
 #include <gnutls/gnutls.h>
 

Re: [PATCH] GnuTLS support on Woe32

[Eli Zaretskii]

> From: Juanma Barranquero <lekktu@gmail.com>
> Date: Tue, 3 May 2011 04:27:55 +0200
> Cc: emacs-devel@gnu.org
> 
> Please take a look at the attached patch, which is a rough cut

It's mostly a mechanical change, and looks fine to me upon first
reading.

However, this:

> --- src/w32.h	2011-04-25 01:30:51 +0000
> +++ src/w32.h	2011-05-02 01:47:27 +0000
> @@ -1,6 +1,8 @@
>  #ifndef EMACS_W32_H
>  #define EMACS_W32_H
>  
> +#include "lisp.h"

is bad: lisp.h is already included in too many places.  Why did you
need this?

Also, this:

> +/* The argument LIBRARIES is usually the variable
> +   `dynamic-library-alist', which associates a symbol, identifying
> +   an external DLL library, to a list of possible filenames.
> +   The function returns NULL if no library could be loaded for
> +   the given symbol, or if the library was previously loaded;
> +   else the handle of the DLL.  */
> +HMODULE
> +w32_delayed_load (Lisp_Object libraries, Lisp_Object library_id)

has a couple of problems in the commentary:

 . it should describe the structure of the LIBRARIES alist explicitly,
   like you'd do in a doc string, not just refer to
   `dynamic-library-alist'

 . it says nothing about the second argument (and IIUC what it means,
   the "_id" part of the variable name is misleading)

Btw, why is it a good idea to return NULL if the library is already
loaded?  Why not return its handle instead?

Re: [PATCH] GnuTLS support on Woe32

[Juanma Barranquero]

On Tue, May 3, 2011 at 06:19, Eli Zaretskii <eliz@gnu.org> wrote:

> However, this:
>
>> +#include "lisp.h"
>
> is bad: lisp.h is already included in too many places.  Why did you
> need this?

Because of Lisp_Object. The alternative would be to put Vlibrary_cache
and w32_delayed_load in another module.

>> +/* The argument LIBRARIES is usually the variable
>> +   `dynamic-library-alist', which associates a symbol, identifying
>> +   an external DLL library, to a list of possible filenames.
>> +   The function returns NULL if no library could be loaded for
>> +   the given symbol, or if the library was previously loaded;
>> +   else the handle of the DLL.  */
>> +HMODULE
>> +w32_delayed_load (Lisp_Object libraries, Lisp_Object library_id)
>
> has a couple of problems in the commentary:
>
>  . it should describe the structure of the LIBRARIES alist explicitly,
>   like you'd do in a doc string, not just refer to
>   `dynamic-library-alist'
>
>  . it says nothing about the second argument (and IIUC what it means,
>   the "_id" part of the variable name is misleading)

IIRC, I just moved the code from image.c to here and renamed the
variables. I'll try to fix it.

> Btw, why is it a good idea to return NULL if the library is already
> loaded?  Why not return its handle instead?

Honestly, I asked myself the same question. That was in the image.c
version (written almost seven years ago) and I don't remember why I
thought it was a good idea in the first place. But I was concentrating
in getting GnuTLS loading to work, not on improvements. I'll check.

Thanks for your comments,

    Juanma

Re: [PATCH] GnuTLS support on Woe32

[Ted Zlatanov]

On Tue, 3 May 2011 04:27:55 +0200 Juanma Barranquero <lekktu@gmail.com> wrote: 

JB> 2011/5/2 Ted Zlatanov <tzz@lifelogs.com>:
>> So we just need to modify `emacs_gnutls_global_init' to load and check
>> the GnuTLS library

JB> emacs_gnutls_global_init is called too late, after
JB> gnutls_global_set_log_function and gnutls_global_set_log_level have
JB> been called. I've chosen to call Fgnutls_available_p at the start of
JB> Fgnutls_boot.

OK.

JB> Please take a look at the attached patch, which is a rough cut; it
JB> lacks any documentation (no ChangeLog entries) and I'm not really sure
JB> what am I doing with the errors :-)  Also, I haven't added GNUTLS_LOG
JB> calls; feel free to suggest them as appropriate.

It seems like we have to keep the list of imported functions up to date
and remember to always use the fn_NAME version.  Is there a way to
automate that with a macro like CALL_GNUTLS_FUNCTION(NAME, args) or with
a .h file?  The way you have it is pretty easy to forget and it's hard
to grep for it.

JB> +  Lisp_Object found = Fassq (Qgnutls_dll, Vlibrary_cache);
JB> +  if (CONSP (found))
JB> +    return XCDR (found);
JB> +  else
JB> +    {
JB> +      Lisp_Object status;
JB> +      status = init_gnutls_functions (Vdynamic_library_alist) ? Qt : Qnil;
JB> +      Vlibrary_cache = Fcons (Fcons (Qgnutls_dll, status), Vlibrary_cache);
JB> +      return status;
JB> +    }

Can `found' ever be true but not a cons?  Should we redo the
initialization in that case?

The else block above should log things at level 1, I think, since it's a
rare event and important to know:

CHECK_STRING (Qgnutls_dll);
GNUTLS_LOG2 (1, max_log_level, "loading the GnuTLS DLL: ", SSDATA (Qgnutls_dll));

Otherwise it looks OK to me, though I don't know the W32 side at all so
I can't comment on the w32.* changes.

Ted

Re: [PATCH] GnuTLS support on Woe32

[Eli Zaretskii]

> From: Juanma Barranquero <lekktu@gmail.com>
> Date: Tue, 3 May 2011 12:01:17 +0200
> Cc: tzz@lifelogs.com, emacs-devel@gnu.org
> 
> On Tue, May 3, 2011 at 06:19, Eli Zaretskii <eliz@gnu.org> wrote:
> 
> > However, this:
> >
> >> +#include "lisp.h"
> >
> > is bad: lisp.h is already included in too many places.  Why did you
> > need this?
> 
> Because of Lisp_Object. The alternative would be to put Vlibrary_cache
> and w32_delayed_load in another module.

?? But we have gobs of other headers that use Lisp_Object, and none of
them includes lisp.h.  We simply should be careful to include lisp.h
before everything else, including w32.h.  Doesn't that work for you?

> >  . it should describe the structure of the LIBRARIES alist explicitly,
> >   like you'd do in a doc string, not just refer to
> >   `dynamic-library-alist'
> >
> >  . it says nothing about the second argument (and IIUC what it means,
> >   the "_id" part of the variable name is misleading)
> 
> IIRC, I just moved the code from image.c to here and renamed the
> variables.

Yes, I know.  I thought it was good to clean it up a bit while you are
at that.  But if you want to leave fixing this to another rainy day, I
will understand.

Thanks.

Re: [PATCH] GnuTLS support on Woe32

[Andreas Schwab]

Ted Zlatanov <tzz@lifelogs.com> writes:

> On Tue, 3 May 2011 04:27:55 +0200 Juanma Barranquero <lekktu@gmail.com> wrote: 
>
> JB> +  Lisp_Object found = Fassq (Qgnutls_dll, Vlibrary_cache);
> JB> +  if (CONSP (found))
> JB> +    return XCDR (found);
> JB> +  else
> JB> +    {
> JB> +      Lisp_Object status;
> JB> +      status = init_gnutls_functions (Vdynamic_library_alist) ? Qt : Qnil;
> JB> +      Vlibrary_cache = Fcons (Fcons (Qgnutls_dll, status), Vlibrary_cache);
> JB> +      return status;
> JB> +    }
>
> Can `found' ever be true but not a cons?

assq always returns a list.

Andreas.

-- 
Andreas Schwab, schwab@linux-m68k.org
GPG Key fingerprint = 58CA 54C7 6D53 942B 1756  01D3 44D5 214B 8276 4ED5
"And now for something completely different."

RE: [PATCH] GnuTLS support on Woe32

[Drew Adams]

> assq always returns a list.

But not always a cons.

Re: [PATCH] GnuTLS support on Woe32

[Juanma Barranquero]

On Tue, May 3, 2011 at 20:32, Andreas Schwab <schwab@linux-m68k.org> wrote:

> assq always returns a list.

nil is not a consp. And certainly assq can return nil.

    Juanma

Re: [PATCH] GnuTLS support on Woe32

[Juanma Barranquero]

On Tue, May 3, 2011 at 18:47, Eli Zaretskii <eliz@gnu.org> wrote:

> ?? But we have gobs of other headers that use Lisp_Object, and none of
> them includes lisp.h. We simply should be careful to include lisp.h
> before everything else, including w32.h.  Doesn't that work for you?

Yes, of course.

> I thought it was good to clean it up a bit while you are
> at that.  But if you want to leave fixing this to another rainy day, I
> will understand.

No, I'll revise these issues and send a new patch; hopefully tonight.

Thanks,

    Juanma

Re: [PATCH] GnuTLS support on Woe32

[Juanma Barranquero]

2011/5/3 Ted Zlatanov <tzz@lifelogs.com>:

> It seems like we have to keep the list of imported functions up to date
> and remember to always use the fn_NAME version.

Don't worry, as soon as you forget to declare one function, the
Windows port will complain during linking.

>
> JB> +  Lisp_Object found = Fassq (Qgnutls_dll, Vlibrary_cache);
> JB> +  if (CONSP (found))
> JB> +    return XCDR (found);
> JB> +  else
> JB> +    {
> JB> +      Lisp_Object status;
> JB> +      status = init_gnutls_functions (Vdynamic_library_alist) ? Qt : Qnil;
> JB> +      Vlibrary_cache = Fcons (Fcons (Qgnutls_dll, status), Vlibrary_cache);
> JB> +      return status;
> JB> +    }
>
> Can `found' ever be true but not a cons?

The cases are:
  found = nil  ; the value has not yet been cached, let's try to load
the library
  found = (gnutls . t)  ; library already loaded
  found = (gnutls . nil)  ; library already searched for and not found

> Should we redo the
> initialization in that case?

The idea is to never retry loading, because looking for the .DLLs can
be slow (for example, network latencies).

> The else block above should log things at level 1, I think, since it's a
> rare event and important to know:
>
> CHECK_STRING (Qgnutls_dll);
> GNUTLS_LOG2 (1, max_log_level, "loading the GnuTLS DLL: ", SSDATA (Qgnutls_dll));

Aha, thanks.

> Otherwise it looks OK to me, though I don't know the W32 side at all so
> I can't comment on the w32.* changes.

It's more or less a copy of what's already done in image.c.

    Juanma

Re: [PATCH] GnuTLS support on Woe32

[Ted Zlatanov]

On Tue, 3 May 2011 21:35:35 +0200 Juanma Barranquero <lekktu@gmail.com> wrote: 

JB> 2011/5/3 Ted Zlatanov <tzz@lifelogs.com>:
>> It seems like we have to keep the list of imported functions up to date
>> and remember to always use the fn_NAME version.

JB> Don't worry, as soon as you forget to declare one function, the
JB> Windows port will complain during linking.

Simply as a matter of style it looks ugly to me.  But if this is normal
with W32 linkage elsewhere in Emacs, I can live with it.

Ted

Re: [PATCH] GnuTLS support on Woe32

[Juanma Barranquero]

> Simply as a matter of style it looks ugly to me.

It is not pretty, but as changing function calls to function pointers
is unavoidable, we're bound to have some ugliness.

    Juanma

Re: [PATCH] GnuTLS support on Woe32

[Andreas Schwab]

Juanma Barranquero <lekktu@gmail.com> writes:

> On Tue, May 3, 2011 at 20:32, Andreas Schwab <schwab@linux-m68k.org> wrote:
>
>> assq always returns a list.
>
> nil is not a consp.

In which way is this a contradiction?

Andreas.

-- 
Andreas Schwab, schwab@linux-m68k.org
GPG Key fingerprint = 58CA 54C7 6D53 942B 1756  01D3 44D5 214B 8276 4ED5
"And now for something completely different."

Re: [PATCH] GnuTLS support on Woe32

[Andreas Schwab]

"Drew Adams" <drew.adams@oracle.com> writes:

>> assq always returns a list.
>
> But not always a cons.

Did you read the question?

Andreas.

-- 
Andreas Schwab, schwab@linux-m68k.org
GPG Key fingerprint = 58CA 54C7 6D53 942B 1756  01D3 44D5 214B 8276 4ED5
"And now for something completely different."

Re: [PATCH] GnuTLS support on Woe32

[Juanma Barranquero]

On Tue, May 3, 2011 at 23:26, Andreas Schwab <schwab@linux-m68k.org> wrote:

> In which way is this a contradiction?

In which way your comment is useful?

    Juanma

Re: [PATCH] GnuTLS support on Woe32

[Juanma Barranquero]

On Tue, May 3, 2011 at 06:19, Eli Zaretskii <eliz@gnu.org> wrote:

> Btw, why is it a good idea to return NULL if the library is already
> loaded?  Why not return its handle instead?

[After taking a look at the code]  If the library has already been
loaded, we don't know the handle. Once we locate the right library for
a given symbol (image type, in all cases until now), we load the
library and get the handle, initialize the function pointers, and
promptly forget the handle again. We don't even remember the name
under which the library was found. To return the handle in this case
we would have either to cache it, or search again for the library and
reload it. That is not useful, because w32_delayed_load() is used from
init functions which are typically just called once. So I think it is
better to leave it as is, until we determine that caching the handle
has a use case.

    Juanma

Re: [PATCH] GnuTLS support on Woe32

[Juanma Barranquero]

[-- Attachment #1: Type: text/plain, Size: 926 bytes --]

2011/5/3 Ted Zlatanov <tzz@lifelogs.com>:

> The else block above should log things at level 1, I think, since it's a
> rare event and important to know:
>
> CHECK_STRING (Qgnutls_dll);
> GNUTLS_LOG2 (1, max_log_level, "loading the GnuTLS DLL: ", SSDATA (Qgnutls_dll));

Qgnutls_dll is not really the file name, but just the symbol `gnutls'.
The file name is not known outside of w32_delayed_load, so it can't
really be used in the message.

I thought of adding GNUTLS_LOG (1, max_log_level, "..."), but isn't
GnuTLS required to be able to compute max_log_level? If so, it can
only be used to log a successful load, and then its place is really in
Fgnutls_boot, not Fgnutls_available_p.

Attached is the new patch, which is like the previous one, with the
changes requested by Eli and a clarification in nt/INSTALL. I think it
is ready to install once we settle on the issue of GNUTLS_LOG.

    Juanma

[-- Attachment #2: gnutls2.patch --]
[-- Type: application/octet-stream, Size: 31674 bytes --]

=== modified file 'lisp/term/w32-win.el'
--- lisp/term/w32-win.el	2011-02-03 07:31:42 +0000
+++ lisp/term/w32-win.el	2011-05-02 01:12:42 +0000
@@ -208,7 +208,8 @@
         '(svg "librsvg-2-2.dll")
         '(gdk-pixbuf "libgdk_pixbuf-2.0-0.dll")
         '(glib "libglib-2.0-0.dll")
-	'(gobject "libgobject-2.0-0.dll")))
+       '(gobject "libgobject-2.0-0.dll")
+       '(gnutls "libgnutls-26.dll")))
 
 ;;; multi-tty support
 (defvar w32-initialized nil

=== modified file 'nt/INSTALL'
--- nt/INSTALL	2011-04-28 20:28:51 +0000
+++ nt/INSTALL	2011-05-03 23:27:48 +0000
@@ -325,12 +325,17 @@
 
 * Optional GnuTLS support
 
-  You can build Emacs with GnuTLS support.  Put the gnutls/gnutls.h header in
-  the include path and link to the appropriate libraries (gnutls.dll and
-  gcrypt.dll) with the --lib option.
+  If configure.bat finds the gnutls/gnutls.h file in the include path,
+  Emacs is built with GnuTLS support by default; to avoid that you can
+  pass the argument --without-gnutls.
+
+  In order to support GnuTLS at runtime, a GnuTLS-enabled Emacs must
+  be able to find the relevant DLLs during startup; failure to do so
+  is not an error, but GnuTLS won't be available to the running
+  session.
 
-  You can get pre-built binaries and an installer at
-  http://josefsson.org/gnutls4win/.
+  You can get pre-built binaries (including any required DLL and the
+  gnutls.h file) and an installer at http://josefsson.org/gnutls4win/.
 
 * Experimental SVG support
 

=== modified file 'src/callproc.c'
--- src/callproc.c	2011-05-01 09:02:01 +0000
+++ src/callproc.c	2011-05-03 22:49:39 +0000
@@ -29,6 +29,8 @@
 #include <sys/file.h>
 #include <fcntl.h>
 
+#include "lisp.h"
+
 #ifdef WINDOWSNT
 #define NOMINMAX
 #include <windows.h>
@@ -41,7 +43,6 @@
 #include <sys/param.h>
 #endif /* MSDOS */
 
-#include "lisp.h"
 #include "commands.h"
 #include "buffer.h"
 #include "character.h"

=== modified file 'src/emacs.c'
--- src/emacs.c	2011-04-16 20:21:26 +0000
+++ src/emacs.c	2011-05-03 22:48:49 +0000
@@ -29,6 +29,8 @@
 #include <setjmp.h>
 #include <unistd.h>
 
+#include "lisp.h"
+
 #ifdef WINDOWSNT
 #include <fcntl.h>
 #include <windows.h> /* just for w32.h */
@@ -41,7 +43,6 @@
 #include <GNUstepBase/GSConfig.h>
 #endif
 
-#include "lisp.h"
 #include "commands.h"
 #include "intervals.h"
 #include "buffer.h"

=== modified file 'src/gnutls.c'
--- src/gnutls.c	2011-05-02 02:49:06 +0000
+++ src/gnutls.c	2011-05-04 01:07:15 +0000
@@ -34,6 +34,7 @@
 static int
 emacs_gnutls_handle_error (gnutls_session_t, int err);
 
+static Lisp_Object Qgnutls_dll;
 static Lisp_Object Qgnutls_log_level;
 static Lisp_Object Qgnutls_code;
 static Lisp_Object Qgnutls_anon, Qgnutls_x509pki;
@@ -55,6 +56,145 @@
 /* Callback keys for `gnutls-boot'.  Unused currently.  */
 static Lisp_Object Qgnutls_bootprop_callbacks_verify;
 
+\f
+#ifdef WINDOWSNT
+
+/* Macro for defining functions that will be loaded from the GnuTLS DLL.  */
+#define DEF_GNUTLS_FN(rettype,func,args) rettype (FAR CDECL *fn_##func)args
+
+/* Macro for loading GnuTLS functions from the library.  */
+#define LOAD_GNUTLS_FN(lib,func) {					\
+    fn_##func = (void *) GetProcAddress (lib, #func);			\
+    if (!fn_##func) return 0;						\
+  }
+
+DEF_GNUTLS_FN (gnutls_alert_description_t, gnutls_alert_get, (gnutls_session_t));
+DEF_GNUTLS_FN (const char *, gnutls_alert_get_name, (gnutls_alert_description_t));
+DEF_GNUTLS_FN (int, gnutls_alert_send_appropriate, (gnutls_session_t, int));
+DEF_GNUTLS_FN (int, gnutls_anon_allocate_client_credentials, (gnutls_anon_client_credentials_t *));
+DEF_GNUTLS_FN (void, gnutls_anon_free_client_credentials, (gnutls_anon_client_credentials_t));
+DEF_GNUTLS_FN (int, gnutls_bye, (gnutls_session_t, gnutls_close_request_t));
+DEF_GNUTLS_FN (int, gnutls_certificate_allocate_credentials, (gnutls_certificate_credentials_t *));
+DEF_GNUTLS_FN (void, gnutls_certificate_free_credentials, (gnutls_certificate_credentials_t));
+DEF_GNUTLS_FN (const gnutls_datum_t *, gnutls_certificate_get_peers, (gnutls_session_t, unsigned int *));
+DEF_GNUTLS_FN (void, gnutls_certificate_set_verify_flags, (gnutls_certificate_credentials_t, unsigned int));
+DEF_GNUTLS_FN (int, gnutls_certificate_set_x509_crl_file, (gnutls_certificate_credentials_t, const char *, gnutls_x509_crt_fmt_t));
+DEF_GNUTLS_FN (int, gnutls_certificate_set_x509_trust_file, (gnutls_certificate_credentials_t, const char *, gnutls_x509_crt_fmt_t));
+DEF_GNUTLS_FN (gnutls_certificate_type_t, gnutls_certificate_type_get, (gnutls_session_t));
+DEF_GNUTLS_FN (int, gnutls_certificate_verify_peers2, (gnutls_session_t, unsigned int *));
+DEF_GNUTLS_FN (int, gnutls_credentials_set, (gnutls_session_t, gnutls_credentials_type_t, void *));
+DEF_GNUTLS_FN (void, gnutls_deinit, (gnutls_session_t));
+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));
+DEF_GNUTLS_FN (void, gnutls_global_set_log_level, (int));
+DEF_GNUTLS_FN (int, gnutls_handshake, (gnutls_session_t));
+DEF_GNUTLS_FN (int, gnutls_init, (gnutls_session_t *, gnutls_connection_end_t));
+DEF_GNUTLS_FN (int, gnutls_priority_set_direct, (gnutls_session_t, const char *, const char **));
+DEF_GNUTLS_FN (size_t, gnutls_record_check_pending, (gnutls_session_t));
+DEF_GNUTLS_FN (ssize_t, gnutls_record_recv, (gnutls_session_t, void *, size_t));
+DEF_GNUTLS_FN (ssize_t, gnutls_record_send, (gnutls_session_t, const void *, size_t));
+DEF_GNUTLS_FN (const char *, gnutls_strerror, (int));
+DEF_GNUTLS_FN (void, gnutls_transport_set_errno, (gnutls_session_t, int));
+DEF_GNUTLS_FN (void, gnutls_transport_set_lowat, (gnutls_session_t, int));
+DEF_GNUTLS_FN (void, gnutls_transport_set_ptr2, (gnutls_session_t, gnutls_transport_ptr_t, gnutls_transport_ptr_t));
+DEF_GNUTLS_FN (void, gnutls_transport_set_pull_function, (gnutls_session_t, gnutls_pull_func));
+DEF_GNUTLS_FN (void, gnutls_transport_set_push_function, (gnutls_session_t, gnutls_push_func));
+DEF_GNUTLS_FN (int, gnutls_x509_crt_check_hostname, (gnutls_x509_crt_t, const char *));
+DEF_GNUTLS_FN (void, gnutls_x509_crt_deinit, (gnutls_x509_crt_t));
+DEF_GNUTLS_FN (int, gnutls_x509_crt_import, (gnutls_x509_crt_t, const gnutls_datum_t *, 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)
+{
+  HMODULE library;
+
+  if (!(library = w32_delayed_load (libraries, Qgnutls_dll)))
+    return 0;
+
+  LOAD_GNUTLS_FN (library, gnutls_alert_get);
+  LOAD_GNUTLS_FN (library, gnutls_alert_get_name);
+  LOAD_GNUTLS_FN (library, gnutls_alert_send_appropriate);
+  LOAD_GNUTLS_FN (library, gnutls_anon_allocate_client_credentials);
+  LOAD_GNUTLS_FN (library, gnutls_anon_free_client_credentials);
+  LOAD_GNUTLS_FN (library, gnutls_bye);
+  LOAD_GNUTLS_FN (library, gnutls_certificate_allocate_credentials);
+  LOAD_GNUTLS_FN (library, gnutls_certificate_free_credentials);
+  LOAD_GNUTLS_FN (library, gnutls_certificate_get_peers);
+  LOAD_GNUTLS_FN (library, gnutls_certificate_set_verify_flags);
+  LOAD_GNUTLS_FN (library, gnutls_certificate_set_x509_crl_file);
+  LOAD_GNUTLS_FN (library, gnutls_certificate_set_x509_trust_file);
+  LOAD_GNUTLS_FN (library, gnutls_certificate_type_get);
+  LOAD_GNUTLS_FN (library, gnutls_certificate_verify_peers2);
+  LOAD_GNUTLS_FN (library, gnutls_credentials_set);
+  LOAD_GNUTLS_FN (library, gnutls_deinit);
+  LOAD_GNUTLS_FN (library, gnutls_error_is_fatal);
+  LOAD_GNUTLS_FN (library, gnutls_global_init);
+  LOAD_GNUTLS_FN (library, gnutls_global_set_log_function);
+  LOAD_GNUTLS_FN (library, gnutls_global_set_log_level);
+  LOAD_GNUTLS_FN (library, gnutls_handshake);
+  LOAD_GNUTLS_FN (library, gnutls_init);
+  LOAD_GNUTLS_FN (library, gnutls_priority_set_direct);
+  LOAD_GNUTLS_FN (library, gnutls_record_check_pending);
+  LOAD_GNUTLS_FN (library, gnutls_record_recv);
+  LOAD_GNUTLS_FN (library, gnutls_record_send);
+  LOAD_GNUTLS_FN (library, gnutls_strerror);
+  LOAD_GNUTLS_FN (library, gnutls_transport_set_errno);
+  LOAD_GNUTLS_FN (library, gnutls_transport_set_lowat);
+  LOAD_GNUTLS_FN (library, gnutls_transport_set_ptr2);
+  LOAD_GNUTLS_FN (library, gnutls_transport_set_pull_function);
+  LOAD_GNUTLS_FN (library, gnutls_transport_set_push_function);
+  LOAD_GNUTLS_FN (library, gnutls_x509_crt_check_hostname);
+  LOAD_GNUTLS_FN (library, gnutls_x509_crt_deinit);
+  LOAD_GNUTLS_FN (library, gnutls_x509_crt_import);
+  LOAD_GNUTLS_FN (library, gnutls_x509_crt_init);
+
+  return 1;
+}
+
+#else /* !WINDOWSNT */
+
+#define fn_gnutls_alert_get			gnutls_alert_get
+#define fn_gnutls_alert_get_name		gnutls_alert_get_name
+#define fn_gnutls_alert_send_appropriate	gnutls_alert_send_appropriate
+#define fn_gnutls_anon_allocate_client_credentials gnutls_anon_allocate_client_credentials
+#define fn_gnutls_anon_free_client_credentials	gnutls_anon_free_client_credentials
+#define fn_gnutls_bye				gnutls_bye
+#define fn_gnutls_certificate_allocate_credentials gnutls_certificate_allocate_credentials
+#define fn_gnutls_certificate_free_credentials	gnutls_certificate_free_credentials
+#define fn_gnutls_certificate_get_peers		gnutls_certificate_get_peers
+#define fn_gnutls_certificate_set_verify_flags	gnutls_certificate_set_verify_flags
+#define fn_gnutls_certificate_set_x509_crl_file	gnutls_certificate_set_x509_crl_file
+#define fn_gnutls_certificate_set_x509_trust_file gnutls_certificate_set_x509_trust_file
+#define fn_gnutls_certificate_type_get		gnutls_certificate_type_get
+#define fn_gnutls_certificate_verify_peers2	gnutls_certificate_verify_peers2
+#define fn_gnutls_credentials_set		gnutls_credentials_set
+#define fn_gnutls_deinit			gnutls_deinit
+#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
+#define fn_gnutls_global_set_log_level		gnutls_global_set_log_level
+#define fn_gnutls_handshake			gnutls_handshake
+#define fn_gnutls_init				gnutls_init
+#define fn_gnutls_priority_set_direct		gnutls_priority_set_direct
+#define fn_gnutls_record_check_pending		gnutls_record_check_pending
+#define fn_gnutls_record_recv			gnutls_record_recv
+#define fn_gnutls_record_send			gnutls_record_send
+#define fn_gnutls_strerror			gnutls_strerror
+#define fn_gnutls_transport_set_errno		gnutls_transport_set_errno
+#define fn_gnutls_transport_set_lowat		gnutls_transport_set_lowat
+#define fn_gnutls_transport_set_ptr2		gnutls_transport_set_ptr2
+#define fn_gnutls_transport_set_pull_function	gnutls_transport_set_pull_function
+#define fn_gnutls_transport_set_push_function	gnutls_transport_set_push_function
+#define fn_gnutls_x509_crt_check_hostname	gnutls_x509_crt_check_hostname
+#define fn_gnutls_x509_crt_deinit		gnutls_x509_crt_deinit
+#define fn_gnutls_x509_crt_import		gnutls_x509_crt_import
+#define fn_gnutls_x509_crt_init			gnutls_x509_crt_init
+
+#endif /* !WINDOWSNT */
+
+\f
 static void
 gnutls_log_function (int level, const char* string)
 {
@@ -82,11 +222,11 @@
       /* On W32 we cannot transfer socket handles between different runtime
          libraries, so we tell GnuTLS to use our special push/pull
          functions.  */
-      gnutls_transport_set_ptr2 (state,
+      fn_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);
+      fn_gnutls_transport_set_push_function (state, &emacs_gnutls_push);
+      fn_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
@@ -95,12 +235,12 @@
          (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);
+      fn_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,
+      fn_gnutls_transport_set_ptr2 (state,
         			 (gnutls_transport_ptr_t) (long) proc->infd,
         			 (gnutls_transport_ptr_t) (long) proc->outfd);
 #endif
@@ -110,10 +250,10 @@
 
   do
     {
-      ret = gnutls_handshake (state);
+      ret = fn_gnutls_handshake (state);
       emacs_gnutls_handle_error (state, ret);
     }
-  while (ret < 0 && gnutls_error_is_fatal (ret) == 0);
+  while (ret < 0 && fn_gnutls_error_is_fatal (ret) == 0);
 
   proc->gnutls_initstage = GNUTLS_STAGE_HANDSHAKE_TRIED;
 
@@ -124,11 +264,23 @@
     }
   else
     {
-        gnutls_alert_send_appropriate (state, ret);
+      fn_gnutls_alert_send_appropriate (state, ret);
     }
   return ret;
 }
 
+int
+emacs_gnutls_record_check_pending (gnutls_session_t state)
+{
+  return fn_gnutls_record_check_pending (state);
+}
+
+void
+emacs_gnutls_transport_set_errno (gnutls_session_t state, int err)
+{
+  fn_gnutls_transport_set_errno (state, err);
+}
+
 EMACS_INT
 emacs_gnutls_write (int fildes, struct Lisp_Process *proc, const char *buf,
                     EMACS_INT nbyte)
@@ -151,7 +303,7 @@
 
   while (nbyte > 0)
     {
-      rtnval = gnutls_write (state, buf, nbyte);
+      rtnval = fn_gnutls_record_send (state, buf, nbyte);
 
       if (rtnval < 0)
         {
@@ -182,7 +334,7 @@
       emacs_gnutls_handshake (proc);
       return -1;
     }
-  rtnval = gnutls_read (state, buf, nbyte);
+  rtnval = fn_gnutls_record_recv (state, buf, nbyte);
   if (rtnval >= 0)
     return rtnval;
   else if (emacs_gnutls_handle_error (state, rtnval) == 0)
@@ -214,11 +366,11 @@
 
   /* TODO: use gnutls-error-fatalp and gnutls-error-string.  */
 
-  str = gnutls_strerror (err);
+  str = fn_gnutls_strerror (err);
   if (!str)
     str = "unknown";
 
-  if (gnutls_error_is_fatal (err))
+  if (fn_gnutls_error_is_fatal (err))
     {
       ret = err;
       GNUTLS_LOG2 (0, max_log_level, "fatal error:", str);
@@ -233,9 +385,9 @@
   if (err == GNUTLS_E_WARNING_ALERT_RECEIVED
       || err == GNUTLS_E_FATAL_ALERT_RECEIVED)
     {
-      int alert = gnutls_alert_get (session);
+      int alert = fn_gnutls_alert_get (session);
       int level = (err == GNUTLS_E_FATAL_ALERT_RECEIVED) ? 0 : 1;
-      str = gnutls_alert_get_name (alert);
+      str = fn_gnutls_alert_get_name (alert);
       if (!str)
 	str = "unknown";
 
@@ -313,7 +465,7 @@
   if (!NUMBERP (err))
     error ("Not an error symbol or code");
 
-  if (0 == gnutls_error_is_fatal (XINT (err)))
+  if (0 == fn_gnutls_error_is_fatal (XINT (err)))
     return Qnil;
 
   return Qt;
@@ -345,7 +497,7 @@
   if (!NUMBERP (err))
     return build_string ("Not an error symbol or code");
 
-  return build_string (gnutls_strerror (XINT (err)));
+  return build_string (fn_gnutls_strerror (XINT (err)));
 }
 
 DEFUN ("gnutls-deinit", Fgnutls_deinit, Sgnutls_deinit, 1, 1, 0,
@@ -360,13 +512,34 @@
 
   if (GNUTLS_INITSTAGE (proc) >= GNUTLS_STAGE_INIT)
     {
-      gnutls_deinit (state);
+      fn_gnutls_deinit (state);
       GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_INIT - 1;
     }
 
   return Qt;
 }
 
+DEFUN ("gnutls-available-p", Fgnutls_available_p, Sgnutls_available_p, 0, 0, 0,
+       doc: /* Return t if GnuTLS is available in this instance of Emacs.  */)
+     (void)
+{
+#ifdef WINDOWSNT
+  Lisp_Object found = Fassq (Qgnutls_dll, Vlibrary_cache);
+  if (CONSP (found))
+    return XCDR (found);
+  else
+    {
+      Lisp_Object status;
+      status = init_gnutls_functions (Vdynamic_library_alist) ? Qt : Qnil;
+      Vlibrary_cache = Fcons (Fcons (Qgnutls_dll, status), Vlibrary_cache);
+      return status;
+    }
+#else
+  return Qt;
+#endif
+}
+
+
 /* Initializes global GnuTLS state to defaults.
 Call `gnutls-global-deinit' when GnuTLS usage is no longer needed.
 Returns zero on success.  */
@@ -376,8 +549,7 @@
   int ret = GNUTLS_E_SUCCESS;
 
   if (!gnutls_global_initialized)
-    ret = gnutls_global_init ();
-
+    ret = fn_gnutls_global_init ();
   gnutls_global_initialized = 1;
 
   return gnutls_make_error (ret);
@@ -483,6 +655,12 @@
   CHECK_SYMBOL (type);
   CHECK_LIST (proplist);
 
+  if (NILP (Fgnutls_available_p ()))
+    {
+      error ("GnuTLS not available");
+      return gnutls_make_error (GNUTLS_EMACS_ERROR_NOT_LOADED);
+    }
+
   hostname              = Fplist_get (proplist, Qgnutls_bootprop_hostname);
   priority_string       = Fplist_get (proplist, Qgnutls_bootprop_priority);
   trustfiles            = Fplist_get (proplist, Qgnutls_bootprop_trustfiles);
@@ -503,8 +681,8 @@
 
   if (NUMBERP (loglevel))
     {
-      gnutls_global_set_log_function (gnutls_log_function);
-      gnutls_global_set_log_level (XINT (loglevel));
+      fn_gnutls_global_set_log_function (gnutls_log_function);
+      fn_gnutls_global_set_log_level (XINT (loglevel));
       max_log_level = XINT (loglevel);
       XPROCESS (proc)->gnutls_log_level = max_log_level;
     }
@@ -523,13 +701,13 @@
 	{
           GNUTLS_LOG (2, max_log_level, "deallocating x509 credentials");
           x509_cred = XPROCESS (proc)->gnutls_x509_cred;
-          gnutls_certificate_free_credentials (x509_cred);
+          fn_gnutls_certificate_free_credentials (x509_cred);
 	}
       else if (EQ (type, Qgnutls_anon))
 	{
           GNUTLS_LOG (2, max_log_level, "deallocating anon credentials");
           anon_cred = XPROCESS (proc)->gnutls_anon_cred;
-          gnutls_anon_free_client_credentials (anon_cred);
+          fn_gnutls_anon_free_client_credentials (anon_cred);
 	}
       else
 	{
@@ -552,7 +730,7 @@
     {
       GNUTLS_LOG (2, max_log_level, "allocating x509 credentials");
       x509_cred = XPROCESS (proc)->gnutls_x509_cred;
-      if (gnutls_certificate_allocate_credentials (&x509_cred) < 0)
+      if (fn_gnutls_certificate_allocate_credentials (&x509_cred) < 0)
         memory_full ();
 
       if (NUMBERP (verify_flags))
@@ -570,13 +748,13 @@
           /* The default is already GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT.  */
           GNUTLS_LOG (2, max_log_level, "ignoring invalid verify-flags");
         }
-      gnutls_certificate_set_verify_flags (x509_cred, gnutls_verify_flags);
+      fn_gnutls_certificate_set_verify_flags (x509_cred, gnutls_verify_flags);
     }
   else if (EQ (type, Qgnutls_anon))
     {
       GNUTLS_LOG (2, max_log_level, "allocating anon credentials");
       anon_cred = XPROCESS (proc)->gnutls_anon_cred;
-      if (gnutls_anon_allocate_client_credentials (&anon_cred) < 0)
+      if (fn_gnutls_anon_allocate_client_credentials (&anon_cred) < 0)
         memory_full ();
     }
   else
@@ -599,7 +777,7 @@
             {
               GNUTLS_LOG2 (1, max_log_level, "setting the trustfile: ",
                            SSDATA (trustfile));
-              ret = gnutls_certificate_set_x509_trust_file
+              ret = fn_gnutls_certificate_set_x509_trust_file
                 (x509_cred,
                  SSDATA (trustfile),
                  file_format);
@@ -621,7 +799,7 @@
             {
               GNUTLS_LOG2 (1, max_log_level, "setting the keyfile: ",
                            SSDATA (keyfile));
-              ret = gnutls_certificate_set_x509_crl_file
+              ret = fn_gnutls_certificate_set_x509_crl_file
                 (x509_cred,
                  SSDATA (keyfile),
                  file_format);
@@ -649,7 +827,7 @@
 
   GNUTLS_LOG (1, max_log_level, "gnutls_init");
 
-  ret = gnutls_init (&state, GNUTLS_CLIENT);
+  ret = fn_gnutls_init (&state, GNUTLS_CLIENT);
 
   if (ret < GNUTLS_E_SUCCESS)
     return gnutls_make_error (ret);
@@ -672,7 +850,7 @@
 
   GNUTLS_LOG (1, max_log_level, "setting the priority string");
 
-  ret = gnutls_priority_set_direct (state,
+  ret = fn_gnutls_priority_set_direct (state,
 				    priority_string_ptr,
 				    NULL);
 
@@ -683,11 +861,11 @@
 
   if (EQ (type, Qgnutls_x509pki))
     {
-      ret = gnutls_cred_set (state, GNUTLS_CRD_CERTIFICATE, x509_cred);
+      ret = fn_gnutls_credentials_set (state, GNUTLS_CRD_CERTIFICATE, x509_cred);
     }
   else if (EQ (type, Qgnutls_anon))
     {
-      ret = gnutls_cred_set (state, GNUTLS_CRD_ANON, anon_cred);
+      ret = fn_gnutls_credentials_set (state, GNUTLS_CRD_ANON, anon_cred);
     }
   else
     {
@@ -715,7 +893,7 @@
      check of the certificate's hostname with
      gnutls_x509_crt_check_hostname() against :hostname.  */
 
-  ret = gnutls_certificate_verify_peers2 (state, &peer_verification);
+  ret = fn_gnutls_certificate_verify_peers2 (state, &peer_verification);
 
   if (ret < GNUTLS_E_SUCCESS)
     return gnutls_make_error (ret);
@@ -766,15 +944,15 @@
   /* Up to here the process is the same for X.509 certificates and
      OpenPGP keys.  From now on X.509 certificates are assumed.  This
      can be easily extended to work with openpgp keys as well.  */
-  if (gnutls_certificate_type_get (state) == GNUTLS_CRT_X509)
+  if (fn_gnutls_certificate_type_get (state) == GNUTLS_CRT_X509)
     {
-      ret = gnutls_x509_crt_init (&gnutls_verify_cert);
+      ret = fn_gnutls_x509_crt_init (&gnutls_verify_cert);
 
       if (ret < GNUTLS_E_SUCCESS)
         return gnutls_make_error (ret);
 
       gnutls_verify_cert_list =
-        gnutls_certificate_get_peers (state, &gnutls_verify_cert_list_size);
+        fn_gnutls_certificate_get_peers (state, &gnutls_verify_cert_list_size);
 
       if (NULL == gnutls_verify_cert_list)
         {
@@ -782,17 +960,17 @@
         }
 
       /* We only check the first certificate in the given chain.  */
-      ret = gnutls_x509_crt_import (gnutls_verify_cert,
+      ret = fn_gnutls_x509_crt_import (gnutls_verify_cert,
                                     &gnutls_verify_cert_list[0],
                                     GNUTLS_X509_FMT_DER);
 
       if (ret < GNUTLS_E_SUCCESS)
         {
-          gnutls_x509_crt_deinit (gnutls_verify_cert);
+          fn_gnutls_x509_crt_deinit (gnutls_verify_cert);
           return gnutls_make_error (ret);
         }
 
-      if (!gnutls_x509_crt_check_hostname (gnutls_verify_cert, c_hostname))
+      if (!fn_gnutls_x509_crt_check_hostname (gnutls_verify_cert, c_hostname))
         {
           if (NILP (verify_hostname_error))
             {
@@ -801,13 +979,13 @@
             }
           else
             {
-              gnutls_x509_crt_deinit (gnutls_verify_cert);
+              fn_gnutls_x509_crt_deinit (gnutls_verify_cert);
               error ("The x509 certificate does not match \"%s\"",
                      c_hostname);
             }
         }
 
-      gnutls_x509_crt_deinit (gnutls_verify_cert);
+      fn_gnutls_x509_crt_deinit (gnutls_verify_cert);
     }
 
   return gnutls_make_error (ret);
@@ -836,7 +1014,7 @@
 
   state = XPROCESS (proc)->gnutls_state;
 
-  ret = gnutls_bye (state,
+  ret = fn_gnutls_bye (state,
                     NILP (cont) ? GNUTLS_SHUT_RDWR : GNUTLS_SHUT_WR);
 
   return gnutls_make_error (ret);
@@ -847,6 +1025,9 @@
 {
   gnutls_global_initialized = 0;
 
+  Qgnutls_dll = intern_c_string ("gnutls");
+  staticpro (&Qgnutls_dll);
+
   Qgnutls_log_level = intern_c_string ("gnutls-log-level");
   staticpro (&Qgnutls_log_level);
 
@@ -917,6 +1098,7 @@
   defsubr (&Sgnutls_boot);
   defsubr (&Sgnutls_deinit);
   defsubr (&Sgnutls_bye);
+  defsubr (&Sgnutls_available_p);
 }
 
 #endif /* HAVE_GNUTLS */

=== modified file 'src/gnutls.h'
--- src/gnutls.h	2011-04-25 01:30:51 +0000
+++ src/gnutls.h	2011-05-03 01:08:23 +0000
@@ -42,6 +42,7 @@
   GNUTLS_STAGE_READY,
 } gnutls_initstage_t;
 
+#define GNUTLS_EMACS_ERROR_NOT_LOADED GNUTLS_E_APPLICATION_ERROR_MIN + 1
 #define GNUTLS_EMACS_ERROR_INVALID_TYPE GNUTLS_E_APPLICATION_ERROR_MIN
 
 #define GNUTLS_INITSTAGE(proc) (XPROCESS (proc)->gnutls_initstage)
@@ -52,13 +53,16 @@
 
 #define GNUTLS_LOG2(level, max, string, extra) if (level <= max) { gnutls_log_function2 (level, "(Emacs) " string, extra); }
 
-EMACS_INT
+extern EMACS_INT
 emacs_gnutls_write (int fildes, struct Lisp_Process *proc, const char *buf,
                     EMACS_INT nbyte);
-EMACS_INT
+extern EMACS_INT
 emacs_gnutls_read (int fildes, struct Lisp_Process *proc, char *buf,
                    EMACS_INT nbyte);
 
+extern int emacs_gnutls_record_check_pending (gnutls_session_t state);
+extern void emacs_gnutls_transport_set_errno (gnutls_session_t state, int err);
+
 extern void syms_of_gnutls (void);
 
 #endif

=== modified file 'src/image.c'
--- src/image.c	2011-04-25 21:34:39 +0000
+++ src/image.c	2011-05-03 22:58:07 +0000
@@ -67,6 +67,7 @@
 
 
 #ifdef HAVE_NTGUI
+#include "w32.h"
 #include "w32term.h"
 
 /* W32_TODO : Color tables on W32.  */
@@ -556,10 +557,6 @@
 
 static struct image_type *image_types;
 
-/* Cache for delayed-loading image types.  */
-
-static Lisp_Object Vimage_type_cache;
-
 /* The symbol `xbm' which is used as the type symbol for XBM images.  */
 
 static Lisp_Object Qxbm;
@@ -589,7 +586,7 @@
                                    Lisp_Object);
 
 #define CACHE_IMAGE_TYPE(type, status) \
-  do { Vimage_type_cache = Fcons (Fcons (type, status), Vimage_type_cache); } while (0)
+  do { Vlibrary_cache = Fcons (Fcons (type, status), Vlibrary_cache); } while (0)
 
 #define ADD_IMAGE_TYPE(type) \
   do { Vimage_types = Fcons (type, Vimage_types); } while (0)
@@ -1900,34 +1897,6 @@
     if (!fn_##func) return 0;						\
   }
 
-/* Load a DLL implementing an image type.
-   The argument LIBRARIES is usually the variable
-   `dynamic-library-alist', which associates a symbol, identifying
-   an external DLL library, to a list of possible filenames.
-   The function returns NULL if no library could be loaded for
-   the given symbol, or if the library was previously loaded;
-   else the handle of the DLL.  */
-static HMODULE
-w32_delayed_load (Lisp_Object libraries, Lisp_Object type)
-{
-  HMODULE library = NULL;
-
-  if (CONSP (libraries) && NILP (Fassq (type, Vimage_type_cache)))
-    {
-      Lisp_Object dlls = Fassq (type, libraries);
-
-      if (CONSP (dlls))
-        for (dlls = XCDR (dlls); CONSP (dlls); dlls = XCDR (dlls))
-          {
-            CHECK_STRING_CAR (dlls);
-            if (library = LoadLibrary (SDATA (XCAR (dlls))))
-              break;
-          }
-    }
-
-  return library;
-}
-
 #endif /* HAVE_NTGUI */
 
 static int x_create_x_image_and_pixmap (struct frame *, int, int, int,
@@ -5452,7 +5421,6 @@
 {
   HMODULE library;
 
-  /* Try loading libpng under probable names.  */
   if (!(library = w32_delayed_load (libraries, Qpng)))
     return 0;
 
@@ -8634,7 +8602,7 @@
   Lisp_Object tested;
 
   /* Don't try to reload the library.  */
-  tested = Fassq (type, Vimage_type_cache);
+  tested = Fassq (type, Vlibrary_cache);
   if (CONSP (tested))
     return XCDR (tested);
 
@@ -8714,9 +8682,6 @@
 non-numeric, there is no explicit limit on the size of images.  */);
   Vmax_image_size = make_float (MAX_IMAGE_SIZE);
 
-  Vimage_type_cache = Qnil;
-  staticpro (&Vimage_type_cache);
-
   Qpbm = intern_c_string ("pbm");
   staticpro (&Qpbm);
   ADD_IMAGE_TYPE (Qpbm);

=== modified file 'src/process.c'
--- src/process.c	2011-04-30 09:31:01 +0000
+++ src/process.c	2011-05-03 22:51:23 +0000
@@ -33,6 +33,8 @@
 #include <unistd.h>
 #include <fcntl.h>
 
+#include "lisp.h"
+
 /* Only MS-DOS does not define `subprocesses'.  */
 #ifdef subprocesses
 
@@ -77,7 +79,6 @@
 
 #endif	/* subprocesses */
 
-#include "lisp.h"
 #include "systime.h"
 #include "systty.h"
 
@@ -4540,7 +4541,7 @@
           if (nfds == 0 && 
               wait_proc && wait_proc->gnutls_p /* Check for valid process.  */
               /* Do we have pending data?  */
-              && gnutls_record_check_pending (wait_proc->gnutls_state) > 0)
+              && emacs_gnutls_record_check_pending (wait_proc->gnutls_state) > 0)
           {
               nfds = 1;
               /* Set to Available.  */

=== modified file 'src/w32.c'
--- src/w32.c	2011-04-28 19:51:12 +0000
+++ src/w32.c	2011-05-03 23:21:32 +0000
@@ -5712,6 +5712,44 @@
   return localtime (t);
 }
 
+
+\f
+/* Delayed loading of libraries.  */
+
+Lisp_Object Vlibrary_cache;
+
+/* The argument LIBRARIES is an alist that associates a symbol
+   LIBRARY_ID, identifying an external DLL library known to Emacs, to
+   a list of filenames under which the library is usually found.  In
+   most cases, the argument passed as LIBRARIES is the variable
+   `dynamic-library-alist', which is initialized to a list of common
+   library names.  The function returns NULL if no library could be
+   loaded for the given LIBRARY_ID, or if the library was previously
+   loaded; else the handle of the DLL.  */
+HMODULE
+w32_delayed_load (Lisp_Object libraries, Lisp_Object library_id)
+{
+  HMODULE library_dll = NULL;
+
+  CHECK_SYMBOL (library_id);
+
+  if (CONSP (libraries) && NILP (Fassq (library_id, Vlibrary_cache)))
+    {
+      Lisp_Object dlls = Fassq (library_id, libraries);
+
+      if (CONSP (dlls))
+        for (dlls = XCDR (dlls); CONSP (dlls); dlls = XCDR (dlls))
+          {
+            CHECK_STRING_CAR (dlls);
+            if (library_dll = LoadLibrary (SDATA (XCAR (dlls))))
+              break;
+          }
+    }
+
+  return library_dll;
+}
+
+\f
 static void
 check_windows_init_file (void)
 {
@@ -5910,6 +5948,9 @@
   get_process_times_fn = (GetProcessTimes_Proc)
     GetProcAddress (kernel32, "GetProcessTimes");
 
+  Vlibrary_cache = Qnil;
+  staticpro (&Vlibrary_cache);
+
   g_b_init_is_windows_9x = 0;
   g_b_init_open_process_token = 0;
   g_b_init_get_token_information = 0;
@@ -6178,7 +6219,7 @@
             err = errno; /* Other errors are just passed on.  */
         }
 
-      gnutls_transport_set_errno (process->gnutls_state, err);
+      emacs_gnutls_transport_set_errno (process->gnutls_state, err);
 
       return -1;
     }
@@ -6197,7 +6238,7 @@
 
   /* Negative bytes written means we got an error in errno.
      Translate the WSAEWOULDBLOCK alias EWOULDBLOCK to EAGAIN.  */
-  gnutls_transport_set_errno (process->gnutls_state,
+  emacs_gnutls_transport_set_errno (process->gnutls_state,
                               errno == EWOULDBLOCK ? EAGAIN : errno);
 
   return -1;

=== modified file 'src/w32.h'
--- src/w32.h	2011-04-25 01:30:51 +0000
+++ src/w32.h	2011-05-03 22:47:52 +0000
@@ -143,6 +143,9 @@
 extern int _sys_read_ahead (int fd);
 extern int _sys_wait_accept (int fd);
 
+extern Lisp_Object Vlibrary_cache;
+extern HMODULE w32_delayed_load (Lisp_Object, Lisp_Object);
+
 #ifdef HAVE_GNUTLS
 #include <gnutls/gnutls.h>
 

Re: [PATCH] GnuTLS support on Woe32

[Ted Zlatanov]

On Wed, 4 May 2011 03:30:23 +0200 Juanma Barranquero <lekktu@gmail.com> wrote: 

JB> 2011/5/3 Ted Zlatanov <tzz@lifelogs.com>:
>> The else block above should log things at level 1, I think, since it's a
>> rare event and important to know:
>> 
>> CHECK_STRING (Qgnutls_dll);
>> GNUTLS_LOG2 (1, max_log_level, "loading the GnuTLS DLL: ", SSDATA (Qgnutls_dll));

JB> Qgnutls_dll is not really the file name, but just the symbol `gnutls'.
JB> The file name is not known outside of w32_delayed_load, so it can't
JB> really be used in the message.

Could you push it into the :dll property of that symbol (always a list)?
Then just loop on all the names when logging later.

JB> I thought of adding GNUTLS_LOG (1, max_log_level, "..."), but isn't
JB> GnuTLS required to be able to compute max_log_level? If so, it can
JB> only be used to log a successful load, and then its place is really in
JB> Fgnutls_boot, not Fgnutls_available_p.

You could just say GNUTLS_LOG2 (1, 1, "loading the GnuTLS DLL: ",
filename) so it's unconditional (not the end of the world) or use the
int value of `gnutls-log-level' directly from gnutls.el...  Either way
is fine with me, but logging the file name is IMO important if possible.
If not just use GNUTLS_LOG as you say.

JB> Attached is the new patch, which is like the previous one, with the
JB> changes requested by Eli and a clarification in nt/INSTALL. I think it
JB> is ready to install once we settle on the issue of GNUTLS_LOG.

Thanks so much!

Ted

Re: [PATCH] GnuTLS support on Woe32

[Eli Zaretskii]

> From: Juanma Barranquero <lekktu@gmail.com>
> Date: Wed, 4 May 2011 01:08:51 +0200
> Cc: tzz@lifelogs.com, emacs-devel@gnu.org
> 
> On Tue, May 3, 2011 at 06:19, Eli Zaretskii <eliz@gnu.org> wrote:
> 
> > Btw, why is it a good idea to return NULL if the library is already
> > loaded?  Why not return its handle instead?
> 
> [After taking a look at the code]  If the library has already been
> loaded, we don't know the handle. Once we locate the right library for
> a given symbol (image type, in all cases until now), we load the
> library and get the handle, initialize the function pointers, and
> promptly forget the handle again. We don't even remember the name
> under which the library was found. To return the handle in this case
> we would have either to cache it, or search again for the library and
> reload it. That is not useful, because w32_delayed_load() is used from
> init functions which are typically just called once. So I think it is
> better to leave it as is, until we determine that caching the handle
> has a use case.

Please add some of this information to the commentary.

Re: [PATCH] GnuTLS support on Woe32

[Juanma Barranquero]

[-- Attachment #1: Type: text/plain, Size: 810 bytes --]

2011/5/4 Ted Zlatanov <tzz@lifelogs.com>:

> Could you push it into the :dll property of that symbol (always a list)?
> Then just loop on all the names when logging later.

What I've done is to add a property :loaded-from to the library-id
(the symbol identifying the library). So in case the loading fails, I
just log that it failed, but not the filenames that were tried,
because they are exactly (cdr (assq 'gnutls dynamic-library-alist)).
If the loading is successfull, I log the filename too.

> You could just say GNUTLS_LOG2 (1, 1, "loading the GnuTLS DLL: ",
> filename) so it's unconditional (not the end of the world)

I've opted for the easiest option, so GNUTLS_LOG2 (1, 1, ...). Feel
free to change it once installed.

Attached is the third version of the patch.

    Juanma

[-- Attachment #2: gnutls3.patch --]
[-- Type: application/octet-stream, Size: 33844 bytes --]

=== modified file 'lisp/term/w32-win.el'
--- lisp/term/w32-win.el	2011-02-03 07:31:42 +0000
+++ lisp/term/w32-win.el	2011-05-02 01:12:42 +0000
@@ -208,7 +208,8 @@
         '(svg "librsvg-2-2.dll")
         '(gdk-pixbuf "libgdk_pixbuf-2.0-0.dll")
         '(glib "libglib-2.0-0.dll")
-	'(gobject "libgobject-2.0-0.dll")))
+       '(gobject "libgobject-2.0-0.dll")
+       '(gnutls "libgnutls-26.dll")))
 
 ;;; multi-tty support
 (defvar w32-initialized nil

=== modified file 'nt/INSTALL'
--- nt/INSTALL	2011-04-28 20:28:51 +0000
+++ nt/INSTALL	2011-05-03 23:27:48 +0000
@@ -325,12 +325,17 @@
 
 * Optional GnuTLS support
 
-  You can build Emacs with GnuTLS support.  Put the gnutls/gnutls.h header in
-  the include path and link to the appropriate libraries (gnutls.dll and
-  gcrypt.dll) with the --lib option.
+  If configure.bat finds the gnutls/gnutls.h file in the include path,
+  Emacs is built with GnuTLS support by default; to avoid that you can
+  pass the argument --without-gnutls.
+
+  In order to support GnuTLS at runtime, a GnuTLS-enabled Emacs must
+  be able to find the relevant DLLs during startup; failure to do so
+  is not an error, but GnuTLS won't be available to the running
+  session.
 
-  You can get pre-built binaries and an installer at
-  http://josefsson.org/gnutls4win/.
+  You can get pre-built binaries (including any required DLL and the
+  gnutls.h file) and an installer at http://josefsson.org/gnutls4win/.
 
 * Experimental SVG support
 

=== modified file 'src/callproc.c'
--- src/callproc.c	2011-05-01 09:02:01 +0000
+++ src/callproc.c	2011-05-03 22:49:39 +0000
@@ -29,6 +29,8 @@
 #include <sys/file.h>
 #include <fcntl.h>
 
+#include "lisp.h"
+
 #ifdef WINDOWSNT
 #define NOMINMAX
 #include <windows.h>
@@ -41,7 +43,6 @@
 #include <sys/param.h>
 #endif /* MSDOS */
 
-#include "lisp.h"
 #include "commands.h"
 #include "buffer.h"
 #include "character.h"

=== modified file 'src/emacs.c'
--- src/emacs.c	2011-04-16 20:21:26 +0000
+++ src/emacs.c	2011-05-03 22:48:49 +0000
@@ -29,6 +29,8 @@
 #include <setjmp.h>
 #include <unistd.h>
 
+#include "lisp.h"
+
 #ifdef WINDOWSNT
 #include <fcntl.h>
 #include <windows.h> /* just for w32.h */
@@ -41,7 +43,6 @@
 #include <GNUstepBase/GSConfig.h>
 #endif
 
-#include "lisp.h"
 #include "commands.h"
 #include "intervals.h"
 #include "buffer.h"

=== modified file 'src/gnutls.c'
--- src/gnutls.c	2011-05-04 01:45:27 +0000
+++ src/gnutls.c	2011-05-04 03:03:39 +0000
@@ -34,6 +34,7 @@
 static int
 emacs_gnutls_handle_error (gnutls_session_t, int err);
 
+static Lisp_Object Qgnutls_dll;
 static Lisp_Object Qgnutls_log_level;
 static Lisp_Object Qgnutls_code;
 static Lisp_Object Qgnutls_anon, Qgnutls_x509pki;
@@ -56,6 +57,181 @@
 /* Callback keys for `gnutls-boot'.  Unused currently.  */
 static Lisp_Object Qgnutls_bootprop_callbacks_verify;
 
+static void gnutls_log_function (int, const char *);
+static void gnutls_log_function2 (int, const char*, const char*);
+
+\f
+#ifdef WINDOWSNT
+
+/* Macro for defining functions that will be loaded from the GnuTLS DLL.  */
+#define DEF_GNUTLS_FN(rettype,func,args) rettype (FAR CDECL *fn_##func)args
+
+/* Macro for loading GnuTLS functions from the library.  */
+#define LOAD_GNUTLS_FN(lib,func) {					\
+    fn_##func = (void *) GetProcAddress (lib, #func);			\
+    if (!fn_##func) return 0;						\
+  }
+
+DEF_GNUTLS_FN (gnutls_alert_description_t, gnutls_alert_get,
+               (gnutls_session_t));
+DEF_GNUTLS_FN (const char *, gnutls_alert_get_name,
+               (gnutls_alert_description_t));
+DEF_GNUTLS_FN (int, gnutls_alert_send_appropriate, (gnutls_session_t, int));
+DEF_GNUTLS_FN (int, gnutls_anon_allocate_client_credentials,
+               (gnutls_anon_client_credentials_t *));
+DEF_GNUTLS_FN (void, gnutls_anon_free_client_credentials,
+               (gnutls_anon_client_credentials_t));
+DEF_GNUTLS_FN (int, gnutls_bye, (gnutls_session_t, gnutls_close_request_t));
+DEF_GNUTLS_FN (int, gnutls_certificate_allocate_credentials,
+               (gnutls_certificate_credentials_t *));
+DEF_GNUTLS_FN (void, gnutls_certificate_free_credentials,
+               (gnutls_certificate_credentials_t));
+DEF_GNUTLS_FN (const gnutls_datum_t *, gnutls_certificate_get_peers,
+               (gnutls_session_t, unsigned int *));
+DEF_GNUTLS_FN (void, gnutls_certificate_set_verify_flags,
+               (gnutls_certificate_credentials_t, unsigned int));
+DEF_GNUTLS_FN (int, gnutls_certificate_set_x509_crl_file,
+               (gnutls_certificate_credentials_t, const char *,
+                gnutls_x509_crt_fmt_t));
+DEF_GNUTLS_FN (int, gnutls_certificate_set_x509_key_file,
+               (gnutls_certificate_credentials_t, const char *, const char *,
+                gnutls_x509_crt_fmt_t));
+DEF_GNUTLS_FN (int, gnutls_certificate_set_x509_trust_file,
+               (gnutls_certificate_credentials_t, const char *,
+                gnutls_x509_crt_fmt_t));
+DEF_GNUTLS_FN (gnutls_certificate_type_t, gnutls_certificate_type_get,
+               (gnutls_session_t));
+DEF_GNUTLS_FN (int, gnutls_certificate_verify_peers2,
+               (gnutls_session_t, unsigned int *));
+DEF_GNUTLS_FN (int, gnutls_credentials_set,
+               (gnutls_session_t, gnutls_credentials_type_t, void *));
+DEF_GNUTLS_FN (void, gnutls_deinit, (gnutls_session_t));
+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));
+DEF_GNUTLS_FN (void, gnutls_global_set_log_level, (int));
+DEF_GNUTLS_FN (int, gnutls_handshake, (gnutls_session_t));
+DEF_GNUTLS_FN (int, gnutls_init, (gnutls_session_t *, gnutls_connection_end_t));
+DEF_GNUTLS_FN (int, gnutls_priority_set_direct,
+               (gnutls_session_t, const char *, const char **));
+DEF_GNUTLS_FN (size_t, gnutls_record_check_pending, (gnutls_session_t));
+DEF_GNUTLS_FN (ssize_t, gnutls_record_recv, (gnutls_session_t, void *, size_t));
+DEF_GNUTLS_FN (ssize_t, gnutls_record_send,
+               (gnutls_session_t, const void *, size_t));
+DEF_GNUTLS_FN (const char *, gnutls_strerror, (int));
+DEF_GNUTLS_FN (void, gnutls_transport_set_errno, (gnutls_session_t, int));
+DEF_GNUTLS_FN (void, gnutls_transport_set_lowat, (gnutls_session_t, int));
+DEF_GNUTLS_FN (void, gnutls_transport_set_ptr2,
+               (gnutls_session_t, gnutls_transport_ptr_t,
+                gnutls_transport_ptr_t));
+DEF_GNUTLS_FN (void, gnutls_transport_set_pull_function,
+               (gnutls_session_t, gnutls_pull_func));
+DEF_GNUTLS_FN (void, gnutls_transport_set_push_function,
+               (gnutls_session_t, gnutls_push_func));
+DEF_GNUTLS_FN (int, gnutls_x509_crt_check_hostname,
+               (gnutls_x509_crt_t, const char *));
+DEF_GNUTLS_FN (void, gnutls_x509_crt_deinit, (gnutls_x509_crt_t));
+DEF_GNUTLS_FN (int, gnutls_x509_crt_import,
+               (gnutls_x509_crt_t, const gnutls_datum_t *,
+                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)
+{
+  HMODULE library;
+
+  if (!(library = w32_delayed_load (libraries, Qgnutls_dll)))
+    {
+      GNUTLS_LOG (1, 1, "GnuTLS library not found");
+      return 0;
+    }
+
+  LOAD_GNUTLS_FN (library, gnutls_alert_get);
+  LOAD_GNUTLS_FN (library, gnutls_alert_get_name);
+  LOAD_GNUTLS_FN (library, gnutls_alert_send_appropriate);
+  LOAD_GNUTLS_FN (library, gnutls_anon_allocate_client_credentials);
+  LOAD_GNUTLS_FN (library, gnutls_anon_free_client_credentials);
+  LOAD_GNUTLS_FN (library, gnutls_bye);
+  LOAD_GNUTLS_FN (library, gnutls_certificate_allocate_credentials);
+  LOAD_GNUTLS_FN (library, gnutls_certificate_free_credentials);
+  LOAD_GNUTLS_FN (library, gnutls_certificate_get_peers);
+  LOAD_GNUTLS_FN (library, gnutls_certificate_set_verify_flags);
+  LOAD_GNUTLS_FN (library, gnutls_certificate_set_x509_crl_file);
+  LOAD_GNUTLS_FN (library, gnutls_certificate_set_x509_key_file);
+  LOAD_GNUTLS_FN (library, gnutls_certificate_set_x509_trust_file);
+  LOAD_GNUTLS_FN (library, gnutls_certificate_type_get);
+  LOAD_GNUTLS_FN (library, gnutls_certificate_verify_peers2);
+  LOAD_GNUTLS_FN (library, gnutls_credentials_set);
+  LOAD_GNUTLS_FN (library, gnutls_deinit);
+  LOAD_GNUTLS_FN (library, gnutls_error_is_fatal);
+  LOAD_GNUTLS_FN (library, gnutls_global_init);
+  LOAD_GNUTLS_FN (library, gnutls_global_set_log_function);
+  LOAD_GNUTLS_FN (library, gnutls_global_set_log_level);
+  LOAD_GNUTLS_FN (library, gnutls_handshake);
+  LOAD_GNUTLS_FN (library, gnutls_init);
+  LOAD_GNUTLS_FN (library, gnutls_priority_set_direct);
+  LOAD_GNUTLS_FN (library, gnutls_record_check_pending);
+  LOAD_GNUTLS_FN (library, gnutls_record_recv);
+  LOAD_GNUTLS_FN (library, gnutls_record_send);
+  LOAD_GNUTLS_FN (library, gnutls_strerror);
+  LOAD_GNUTLS_FN (library, gnutls_transport_set_errno);
+  LOAD_GNUTLS_FN (library, gnutls_transport_set_lowat);
+  LOAD_GNUTLS_FN (library, gnutls_transport_set_ptr2);
+  LOAD_GNUTLS_FN (library, gnutls_transport_set_pull_function);
+  LOAD_GNUTLS_FN (library, gnutls_transport_set_push_function);
+  LOAD_GNUTLS_FN (library, gnutls_x509_crt_check_hostname);
+  LOAD_GNUTLS_FN (library, gnutls_x509_crt_deinit);
+  LOAD_GNUTLS_FN (library, gnutls_x509_crt_import);
+  LOAD_GNUTLS_FN (library, gnutls_x509_crt_init);
+
+  GNUTLS_LOG2 (1, 1, "GnuTLS library loaded:",
+               SDATA (Fget (Qgnutls_dll, QCloaded_from)));
+  return 1;
+}
+
+#else /* !WINDOWSNT */
+
+#define fn_gnutls_alert_get			gnutls_alert_get
+#define fn_gnutls_alert_get_name		gnutls_alert_get_name
+#define fn_gnutls_alert_send_appropriate	gnutls_alert_send_appropriate
+#define fn_gnutls_anon_allocate_client_credentials gnutls_anon_allocate_client_credentials
+#define fn_gnutls_anon_free_client_credentials	gnutls_anon_free_client_credentials
+#define fn_gnutls_bye				gnutls_bye
+#define fn_gnutls_certificate_allocate_credentials gnutls_certificate_allocate_credentials
+#define fn_gnutls_certificate_free_credentials	gnutls_certificate_free_credentials
+#define fn_gnutls_certificate_get_peers		gnutls_certificate_get_peers
+#define fn_gnutls_certificate_set_verify_flags	gnutls_certificate_set_verify_flags
+#define fn_gnutls_certificate_set_x509_crl_file	gnutls_certificate_set_x509_crl_file
+#define fn_gnutls_certificate_set_x509_trust_file gnutls_certificate_set_x509_trust_file
+#define fn_gnutls_certificate_type_get		gnutls_certificate_type_get
+#define fn_gnutls_certificate_verify_peers2	gnutls_certificate_verify_peers2
+#define fn_gnutls_credentials_set		gnutls_credentials_set
+#define fn_gnutls_deinit			gnutls_deinit
+#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
+#define fn_gnutls_global_set_log_level		gnutls_global_set_log_level
+#define fn_gnutls_handshake			gnutls_handshake
+#define fn_gnutls_init				gnutls_init
+#define fn_gnutls_priority_set_direct		gnutls_priority_set_direct
+#define fn_gnutls_record_check_pending		gnutls_record_check_pending
+#define fn_gnutls_record_recv			gnutls_record_recv
+#define fn_gnutls_record_send			gnutls_record_send
+#define fn_gnutls_strerror			gnutls_strerror
+#define fn_gnutls_transport_set_errno		gnutls_transport_set_errno
+#define fn_gnutls_transport_set_lowat		gnutls_transport_set_lowat
+#define fn_gnutls_transport_set_ptr2		gnutls_transport_set_ptr2
+#define fn_gnutls_transport_set_pull_function	gnutls_transport_set_pull_function
+#define fn_gnutls_transport_set_push_function	gnutls_transport_set_push_function
+#define fn_gnutls_x509_crt_check_hostname	gnutls_x509_crt_check_hostname
+#define fn_gnutls_x509_crt_deinit		gnutls_x509_crt_deinit
+#define fn_gnutls_x509_crt_import		gnutls_x509_crt_import
+#define fn_gnutls_x509_crt_init			gnutls_x509_crt_init
+
+#endif /* !WINDOWSNT */
+
+\f
 static void
 gnutls_log_function (int level, const char* string)
 {
@@ -83,11 +259,11 @@
       /* On W32 we cannot transfer socket handles between different runtime
          libraries, so we tell GnuTLS to use our special push/pull
          functions.  */
-      gnutls_transport_set_ptr2 (state,
+      fn_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);
+      fn_gnutls_transport_set_push_function (state, &emacs_gnutls_push);
+      fn_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
@@ -96,12 +272,12 @@
          (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);
+      fn_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,
+      fn_gnutls_transport_set_ptr2 (state,
         			 (gnutls_transport_ptr_t) (long) proc->infd,
         			 (gnutls_transport_ptr_t) (long) proc->outfd);
 #endif
@@ -111,10 +287,10 @@
 
   do
     {
-      ret = gnutls_handshake (state);
+      ret = fn_gnutls_handshake (state);
       emacs_gnutls_handle_error (state, ret);
     }
-  while (ret < 0 && gnutls_error_is_fatal (ret) == 0);
+  while (ret < 0 && fn_gnutls_error_is_fatal (ret) == 0);
 
   proc->gnutls_initstage = GNUTLS_STAGE_HANDSHAKE_TRIED;
 
@@ -125,11 +301,23 @@
     }
   else
     {
-        gnutls_alert_send_appropriate (state, ret);
+      fn_gnutls_alert_send_appropriate (state, ret);
     }
   return ret;
 }
 
+int
+emacs_gnutls_record_check_pending (gnutls_session_t state)
+{
+  return fn_gnutls_record_check_pending (state);
+}
+
+void
+emacs_gnutls_transport_set_errno (gnutls_session_t state, int err)
+{
+  fn_gnutls_transport_set_errno (state, err);
+}
+
 EMACS_INT
 emacs_gnutls_write (int fildes, struct Lisp_Process *proc, const char *buf,
                     EMACS_INT nbyte)
@@ -152,7 +340,7 @@
 
   while (nbyte > 0)
     {
-      rtnval = gnutls_write (state, buf, nbyte);
+      rtnval = fn_gnutls_record_send (state, buf, nbyte);
 
       if (rtnval < 0)
         {
@@ -183,7 +371,7 @@
       emacs_gnutls_handshake (proc);
       return -1;
     }
-  rtnval = gnutls_read (state, buf, nbyte);
+  rtnval = fn_gnutls_record_recv (state, buf, nbyte);
   if (rtnval >= 0)
     return rtnval;
   else if (emacs_gnutls_handle_error (state, rtnval) == 0)
@@ -215,11 +403,11 @@
 
   /* TODO: use gnutls-error-fatalp and gnutls-error-string.  */
 
-  str = gnutls_strerror (err);
+  str = fn_gnutls_strerror (err);
   if (!str)
     str = "unknown";
 
-  if (gnutls_error_is_fatal (err))
+  if (fn_gnutls_error_is_fatal (err))
     {
       ret = err;
       GNUTLS_LOG2 (0, max_log_level, "fatal error:", str);
@@ -234,9 +422,9 @@
   if (err == GNUTLS_E_WARNING_ALERT_RECEIVED
       || err == GNUTLS_E_FATAL_ALERT_RECEIVED)
     {
-      int alert = gnutls_alert_get (session);
+      int alert = fn_gnutls_alert_get (session);
       int level = (err == GNUTLS_E_FATAL_ALERT_RECEIVED) ? 0 : 1;
-      str = gnutls_alert_get_name (alert);
+      str = fn_gnutls_alert_get_name (alert);
       if (!str)
 	str = "unknown";
 
@@ -314,7 +502,7 @@
   if (!NUMBERP (err))
     error ("Not an error symbol or code");
 
-  if (0 == gnutls_error_is_fatal (XINT (err)))
+  if (0 == fn_gnutls_error_is_fatal (XINT (err)))
     return Qnil;
 
   return Qt;
@@ -346,7 +534,7 @@
   if (!NUMBERP (err))
     return build_string ("Not an error symbol or code");
 
-  return build_string (gnutls_strerror (XINT (err)));
+  return build_string (fn_gnutls_strerror (XINT (err)));
 }
 
 DEFUN ("gnutls-deinit", Fgnutls_deinit, Sgnutls_deinit, 1, 1, 0,
@@ -361,13 +549,34 @@
 
   if (GNUTLS_INITSTAGE (proc) >= GNUTLS_STAGE_INIT)
     {
-      gnutls_deinit (state);
+      fn_gnutls_deinit (state);
       GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_INIT - 1;
     }
 
   return Qt;
 }
 
+DEFUN ("gnutls-available-p", Fgnutls_available_p, Sgnutls_available_p, 0, 0, 0,
+       doc: /* Return t if GnuTLS is available in this instance of Emacs.  */)
+     (void)
+{
+#ifdef WINDOWSNT
+  Lisp_Object found = Fassq (Qgnutls_dll, Vlibrary_cache);
+  if (CONSP (found))
+    return XCDR (found);
+  else
+    {
+      Lisp_Object status;
+      status = init_gnutls_functions (Vdynamic_library_alist) ? Qt : Qnil;
+      Vlibrary_cache = Fcons (Fcons (Qgnutls_dll, status), Vlibrary_cache);
+      return status;
+    }
+#else
+  return Qt;
+#endif
+}
+
+
 /* Initializes global GnuTLS state to defaults.
 Call `gnutls-global-deinit' when GnuTLS usage is no longer needed.
 Returns zero on success.  */
@@ -377,8 +586,7 @@
   int ret = GNUTLS_E_SUCCESS;
 
   if (!gnutls_global_initialized)
-    ret = gnutls_global_init ();
-
+    ret = fn_gnutls_global_init ();
   gnutls_global_initialized = 1;
 
   return gnutls_make_error (ret);
@@ -488,6 +696,12 @@
   CHECK_SYMBOL (type);
   CHECK_LIST (proplist);
 
+  if (NILP (Fgnutls_available_p ()))
+    {
+      error ("GnuTLS not available");
+      return gnutls_make_error (GNUTLS_EMACS_ERROR_NOT_LOADED);
+    }
+
   hostname              = Fplist_get (proplist, Qgnutls_bootprop_hostname);
   priority_string       = Fplist_get (proplist, Qgnutls_bootprop_priority);
   trustfiles            = Fplist_get (proplist, Qgnutls_bootprop_trustfiles);
@@ -509,8 +723,8 @@
 
   if (NUMBERP (loglevel))
     {
-      gnutls_global_set_log_function (gnutls_log_function);
-      gnutls_global_set_log_level (XINT (loglevel));
+      fn_gnutls_global_set_log_function (gnutls_log_function);
+      fn_gnutls_global_set_log_level (XINT (loglevel));
       max_log_level = XINT (loglevel);
       XPROCESS (proc)->gnutls_log_level = max_log_level;
     }
@@ -529,13 +743,13 @@
 	{
           GNUTLS_LOG (2, max_log_level, "deallocating x509 credentials");
           x509_cred = XPROCESS (proc)->gnutls_x509_cred;
-          gnutls_certificate_free_credentials (x509_cred);
+          fn_gnutls_certificate_free_credentials (x509_cred);
 	}
       else if (EQ (type, Qgnutls_anon))
 	{
           GNUTLS_LOG (2, max_log_level, "deallocating anon credentials");
           anon_cred = XPROCESS (proc)->gnutls_anon_cred;
-          gnutls_anon_free_client_credentials (anon_cred);
+          fn_gnutls_anon_free_client_credentials (anon_cred);
 	}
       else
 	{
@@ -558,7 +772,7 @@
     {
       GNUTLS_LOG (2, max_log_level, "allocating x509 credentials");
       x509_cred = XPROCESS (proc)->gnutls_x509_cred;
-      if (gnutls_certificate_allocate_credentials (&x509_cred) < 0)
+      if (fn_gnutls_certificate_allocate_credentials (&x509_cred) < 0)
         memory_full ();
 
       if (NUMBERP (verify_flags))
@@ -576,13 +790,13 @@
           /* The default is already GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT.  */
           GNUTLS_LOG (2, max_log_level, "ignoring invalid verify-flags");
         }
-      gnutls_certificate_set_verify_flags (x509_cred, gnutls_verify_flags);
+      fn_gnutls_certificate_set_verify_flags (x509_cred, gnutls_verify_flags);
     }
   else if (EQ (type, Qgnutls_anon))
     {
       GNUTLS_LOG (2, max_log_level, "allocating anon credentials");
       anon_cred = XPROCESS (proc)->gnutls_anon_cred;
-      if (gnutls_anon_allocate_client_credentials (&anon_cred) < 0)
+      if (fn_gnutls_anon_allocate_client_credentials (&anon_cred) < 0)
         memory_full ();
     }
   else
@@ -605,7 +819,7 @@
             {
               GNUTLS_LOG2 (1, max_log_level, "setting the trustfile: ",
                            SSDATA (trustfile));
-              ret = gnutls_certificate_set_x509_trust_file
+              ret = fn_gnutls_certificate_set_x509_trust_file
                 (x509_cred,
                  SSDATA (trustfile),
                  file_format);
@@ -627,7 +841,7 @@
             {
               GNUTLS_LOG2 (1, max_log_level, "setting the CRL file: ",
                            SSDATA (crlfile));
-              ret = gnutls_certificate_set_x509_crl_file
+              ret = fn_gnutls_certificate_set_x509_crl_file
                 (x509_cred,
                  SSDATA (crlfile),
                  file_format);
@@ -652,7 +866,7 @@
                            SSDATA (keyfile));
               GNUTLS_LOG2 (1, max_log_level, "setting the client cert file: ",
                            SSDATA (certfile));
-              ret = gnutls_certificate_set_x509_key_file
+              ret = fn_gnutls_certificate_set_x509_key_file
                 (x509_cred,
                  SSDATA (certfile),
                  SSDATA (keyfile),
@@ -685,7 +899,7 @@
 
   GNUTLS_LOG (1, max_log_level, "gnutls_init");
 
-  ret = gnutls_init (&state, GNUTLS_CLIENT);
+  ret = fn_gnutls_init (&state, GNUTLS_CLIENT);
 
   if (ret < GNUTLS_E_SUCCESS)
     return gnutls_make_error (ret);
@@ -708,7 +922,7 @@
 
   GNUTLS_LOG (1, max_log_level, "setting the priority string");
 
-  ret = gnutls_priority_set_direct (state,
+  ret = fn_gnutls_priority_set_direct (state,
 				    priority_string_ptr,
 				    NULL);
 
@@ -719,11 +933,11 @@
 
   if (EQ (type, Qgnutls_x509pki))
     {
-      ret = gnutls_cred_set (state, GNUTLS_CRD_CERTIFICATE, x509_cred);
+      ret = fn_gnutls_credentials_set (state, GNUTLS_CRD_CERTIFICATE, x509_cred);
     }
   else if (EQ (type, Qgnutls_anon))
     {
-      ret = gnutls_cred_set (state, GNUTLS_CRD_ANON, anon_cred);
+      ret = fn_gnutls_credentials_set (state, GNUTLS_CRD_ANON, anon_cred);
     }
   else
     {
@@ -751,7 +965,7 @@
      check of the certificate's hostname with
      gnutls_x509_crt_check_hostname() against :hostname.  */
 
-  ret = gnutls_certificate_verify_peers2 (state, &peer_verification);
+  ret = fn_gnutls_certificate_verify_peers2 (state, &peer_verification);
 
   if (ret < GNUTLS_E_SUCCESS)
     return gnutls_make_error (ret);
@@ -802,15 +1016,15 @@
   /* Up to here the process is the same for X.509 certificates and
      OpenPGP keys.  From now on X.509 certificates are assumed.  This
      can be easily extended to work with openpgp keys as well.  */
-  if (gnutls_certificate_type_get (state) == GNUTLS_CRT_X509)
+  if (fn_gnutls_certificate_type_get (state) == GNUTLS_CRT_X509)
     {
-      ret = gnutls_x509_crt_init (&gnutls_verify_cert);
+      ret = fn_gnutls_x509_crt_init (&gnutls_verify_cert);
 
       if (ret < GNUTLS_E_SUCCESS)
         return gnutls_make_error (ret);
 
       gnutls_verify_cert_list =
-        gnutls_certificate_get_peers (state, &gnutls_verify_cert_list_size);
+        fn_gnutls_certificate_get_peers (state, &gnutls_verify_cert_list_size);
 
       if (NULL == gnutls_verify_cert_list)
         {
@@ -818,17 +1032,17 @@
         }
 
       /* We only check the first certificate in the given chain.  */
-      ret = gnutls_x509_crt_import (gnutls_verify_cert,
+      ret = fn_gnutls_x509_crt_import (gnutls_verify_cert,
                                     &gnutls_verify_cert_list[0],
                                     GNUTLS_X509_FMT_DER);
 
       if (ret < GNUTLS_E_SUCCESS)
         {
-          gnutls_x509_crt_deinit (gnutls_verify_cert);
+          fn_gnutls_x509_crt_deinit (gnutls_verify_cert);
           return gnutls_make_error (ret);
         }
 
-      if (!gnutls_x509_crt_check_hostname (gnutls_verify_cert, c_hostname))
+      if (!fn_gnutls_x509_crt_check_hostname (gnutls_verify_cert, c_hostname))
         {
           if (NILP (verify_hostname_error))
             {
@@ -837,13 +1051,13 @@
             }
           else
             {
-              gnutls_x509_crt_deinit (gnutls_verify_cert);
+              fn_gnutls_x509_crt_deinit (gnutls_verify_cert);
               error ("The x509 certificate does not match \"%s\"",
                      c_hostname);
             }
         }
 
-      gnutls_x509_crt_deinit (gnutls_verify_cert);
+      fn_gnutls_x509_crt_deinit (gnutls_verify_cert);
     }
 
   return gnutls_make_error (ret);
@@ -872,7 +1086,7 @@
 
   state = XPROCESS (proc)->gnutls_state;
 
-  ret = gnutls_bye (state,
+  ret = fn_gnutls_bye (state,
                     NILP (cont) ? GNUTLS_SHUT_RDWR : GNUTLS_SHUT_WR);
 
   return gnutls_make_error (ret);
@@ -883,6 +1097,9 @@
 {
   gnutls_global_initialized = 0;
 
+  Qgnutls_dll = intern_c_string ("gnutls");
+  staticpro (&Qgnutls_dll);
+
   Qgnutls_log_level = intern_c_string ("gnutls-log-level");
   staticpro (&Qgnutls_log_level);
 
@@ -956,6 +1173,7 @@
   defsubr (&Sgnutls_boot);
   defsubr (&Sgnutls_deinit);
   defsubr (&Sgnutls_bye);
+  defsubr (&Sgnutls_available_p);
 }
 
 #endif /* HAVE_GNUTLS */

=== modified file 'src/gnutls.h'
--- src/gnutls.h	2011-04-25 01:30:51 +0000
+++ src/gnutls.h	2011-05-03 01:08:23 +0000
@@ -42,6 +42,7 @@
   GNUTLS_STAGE_READY,
 } gnutls_initstage_t;
 
+#define GNUTLS_EMACS_ERROR_NOT_LOADED GNUTLS_E_APPLICATION_ERROR_MIN + 1
 #define GNUTLS_EMACS_ERROR_INVALID_TYPE GNUTLS_E_APPLICATION_ERROR_MIN
 
 #define GNUTLS_INITSTAGE(proc) (XPROCESS (proc)->gnutls_initstage)
@@ -52,13 +53,16 @@
 
 #define GNUTLS_LOG2(level, max, string, extra) if (level <= max) { gnutls_log_function2 (level, "(Emacs) " string, extra); }
 
-EMACS_INT
+extern EMACS_INT
 emacs_gnutls_write (int fildes, struct Lisp_Process *proc, const char *buf,
                     EMACS_INT nbyte);
-EMACS_INT
+extern EMACS_INT
 emacs_gnutls_read (int fildes, struct Lisp_Process *proc, char *buf,
                    EMACS_INT nbyte);
 
+extern int emacs_gnutls_record_check_pending (gnutls_session_t state);
+extern void emacs_gnutls_transport_set_errno (gnutls_session_t state, int err);
+
 extern void syms_of_gnutls (void);
 
 #endif

=== modified file 'src/image.c'
--- src/image.c	2011-04-25 21:34:39 +0000
+++ src/image.c	2011-05-03 22:58:07 +0000
@@ -67,6 +67,7 @@
 
 
 #ifdef HAVE_NTGUI
+#include "w32.h"
 #include "w32term.h"
 
 /* W32_TODO : Color tables on W32.  */
@@ -556,10 +557,6 @@
 
 static struct image_type *image_types;
 
-/* Cache for delayed-loading image types.  */
-
-static Lisp_Object Vimage_type_cache;
-
 /* The symbol `xbm' which is used as the type symbol for XBM images.  */
 
 static Lisp_Object Qxbm;
@@ -589,7 +586,7 @@
                                    Lisp_Object);
 
 #define CACHE_IMAGE_TYPE(type, status) \
-  do { Vimage_type_cache = Fcons (Fcons (type, status), Vimage_type_cache); } while (0)
+  do { Vlibrary_cache = Fcons (Fcons (type, status), Vlibrary_cache); } while (0)
 
 #define ADD_IMAGE_TYPE(type) \
   do { Vimage_types = Fcons (type, Vimage_types); } while (0)
@@ -1900,34 +1897,6 @@
     if (!fn_##func) return 0;						\
   }
 
-/* Load a DLL implementing an image type.
-   The argument LIBRARIES is usually the variable
-   `dynamic-library-alist', which associates a symbol, identifying
-   an external DLL library, to a list of possible filenames.
-   The function returns NULL if no library could be loaded for
-   the given symbol, or if the library was previously loaded;
-   else the handle of the DLL.  */
-static HMODULE
-w32_delayed_load (Lisp_Object libraries, Lisp_Object type)
-{
-  HMODULE library = NULL;
-
-  if (CONSP (libraries) && NILP (Fassq (type, Vimage_type_cache)))
-    {
-      Lisp_Object dlls = Fassq (type, libraries);
-
-      if (CONSP (dlls))
-        for (dlls = XCDR (dlls); CONSP (dlls); dlls = XCDR (dlls))
-          {
-            CHECK_STRING_CAR (dlls);
-            if (library = LoadLibrary (SDATA (XCAR (dlls))))
-              break;
-          }
-    }
-
-  return library;
-}
-
 #endif /* HAVE_NTGUI */
 
 static int x_create_x_image_and_pixmap (struct frame *, int, int, int,
@@ -5452,7 +5421,6 @@
 {
   HMODULE library;
 
-  /* Try loading libpng under probable names.  */
   if (!(library = w32_delayed_load (libraries, Qpng)))
     return 0;
 
@@ -8634,7 +8602,7 @@
   Lisp_Object tested;
 
   /* Don't try to reload the library.  */
-  tested = Fassq (type, Vimage_type_cache);
+  tested = Fassq (type, Vlibrary_cache);
   if (CONSP (tested))
     return XCDR (tested);
 
@@ -8714,9 +8682,6 @@
 non-numeric, there is no explicit limit on the size of images.  */);
   Vmax_image_size = make_float (MAX_IMAGE_SIZE);
 
-  Vimage_type_cache = Qnil;
-  staticpro (&Vimage_type_cache);
-
   Qpbm = intern_c_string ("pbm");
   staticpro (&Qpbm);
   ADD_IMAGE_TYPE (Qpbm);

=== modified file 'src/process.c'
--- src/process.c	2011-04-30 09:31:01 +0000
+++ src/process.c	2011-05-03 22:51:23 +0000
@@ -33,6 +33,8 @@
 #include <unistd.h>
 #include <fcntl.h>
 
+#include "lisp.h"
+
 /* Only MS-DOS does not define `subprocesses'.  */
 #ifdef subprocesses
 
@@ -77,7 +79,6 @@
 
 #endif	/* subprocesses */
 
-#include "lisp.h"
 #include "systime.h"
 #include "systty.h"
 
@@ -4540,7 +4541,7 @@
           if (nfds == 0 && 
               wait_proc && wait_proc->gnutls_p /* Check for valid process.  */
               /* Do we have pending data?  */
-              && gnutls_record_check_pending (wait_proc->gnutls_state) > 0)
+              && emacs_gnutls_record_check_pending (wait_proc->gnutls_state) > 0)
           {
               nfds = 1;
               /* Set to Available.  */

=== modified file 'src/w32.c'
--- src/w32.c	2011-04-28 19:51:12 +0000
+++ src/w32.c	2011-05-04 03:16:15 +0000
@@ -150,6 +150,8 @@
 typedef HRESULT (WINAPI * ShGetFolderPath_fn)
   (IN HWND, IN int, IN HANDLE, IN DWORD, OUT char *);
 
+Lisp_Object QCloaded_from;
+
 void globals_of_w32 (void);
 static DWORD get_rid (PSID);
 
@@ -5712,6 +5714,54 @@
   return localtime (t);
 }
 
+
+\f
+/* Delayed loading of libraries.  */
+
+Lisp_Object Vlibrary_cache;
+
+/* The argument LIBRARIES is an alist that associates a symbol
+   LIBRARY_ID, identifying an external DLL library known to Emacs, to
+   a list of filenames under which the library is usually found.  In
+   most cases, the argument passed as LIBRARIES is the variable
+   `dynamic-library-alist', which is initialized to a list of common
+   library names.  If the function loads the library successfully, it
+   returns the handle of the DLL, and records the filename in the
+   property :loaded-from of LIBRARY_ID; it returns NULL if the library
+   could not be found, or when it was already loaded (because the
+   handle is not recorded anywhere, and so is lost after use).  It
+   would be trivial to save the handle too in :loaded-from, but
+   currently there's no use case for it.  */
+HMODULE
+w32_delayed_load (Lisp_Object libraries, Lisp_Object library_id)
+{
+  HMODULE library_dll = NULL;
+
+  CHECK_SYMBOL (library_id);
+
+  if (CONSP (libraries) && NILP (Fassq (library_id, Vlibrary_cache)))
+    {
+      Lisp_Object found = Qnil;
+      Lisp_Object dlls = Fassq (library_id, libraries);
+
+      if (CONSP (dlls))
+        for (dlls = XCDR (dlls); CONSP (dlls); dlls = XCDR (dlls))
+          {
+            CHECK_STRING_CAR (dlls);
+            if (library_dll = LoadLibrary (SDATA (XCAR (dlls))))
+              {
+                found = XCAR (dlls);
+                break;
+              }
+          }
+
+      Fput (library_id, QCloaded_from, found);
+    }
+
+  return library_dll;
+}
+
+\f
 static void
 check_windows_init_file (void)
 {
@@ -5910,6 +5960,12 @@
   get_process_times_fn = (GetProcessTimes_Proc)
     GetProcAddress (kernel32, "GetProcessTimes");
 
+  QCloaded_from = intern_c_string (":loaded-from");
+  staticpro (&QCloaded_from);
+
+  Vlibrary_cache = Qnil;
+  staticpro (&Vlibrary_cache);
+
   g_b_init_is_windows_9x = 0;
   g_b_init_open_process_token = 0;
   g_b_init_get_token_information = 0;
@@ -6178,7 +6234,7 @@
             err = errno; /* Other errors are just passed on.  */
         }
 
-      gnutls_transport_set_errno (process->gnutls_state, err);
+      emacs_gnutls_transport_set_errno (process->gnutls_state, err);
 
       return -1;
     }
@@ -6197,7 +6253,7 @@
 
   /* Negative bytes written means we got an error in errno.
      Translate the WSAEWOULDBLOCK alias EWOULDBLOCK to EAGAIN.  */
-  gnutls_transport_set_errno (process->gnutls_state,
+  emacs_gnutls_transport_set_errno (process->gnutls_state,
                               errno == EWOULDBLOCK ? EAGAIN : errno);
 
   return -1;

=== modified file 'src/w32.h'
--- src/w32.h	2011-04-25 01:30:51 +0000
+++ src/w32.h	2011-05-04 03:20:25 +0000
@@ -143,6 +143,9 @@
 extern int _sys_read_ahead (int fd);
 extern int _sys_wait_accept (int fd);
 
+extern Lisp_Object Vlibrary_cache, QCloaded_from;
+extern HMODULE w32_delayed_load (Lisp_Object, Lisp_Object);
+
 #ifdef HAVE_GNUTLS
 #include <gnutls/gnutls.h>
 

Re: [PATCH] GnuTLS support on Woe32

[Juanma Barranquero]

On Wed, May 4, 2011 at 05:05, Eli Zaretskii <eliz@gnu.org> wrote:

> Please add some of this information to the commentary.

Please see the patch, release 3, and feel free to turn my gibberish
into english.

    Juanma

Re: [PATCH] GnuTLS support on Woe32

[David Kastrup]

Juanma Barranquero <lekktu@gmail.com> writes:

> On Tue, May 3, 2011 at 20:32, Andreas Schwab <schwab@linux-m68k.org> wrote:
>
>> assq always returns a list.
>
> nil is not a consp. And certainly assq can return nil.

listp is a built-in function in `C source code'.

(listp OBJECT)

Return t if OBJECT is a list, that is, a cons cell or nil.
Otherwise, return nil.

[back]


-- 
David Kastrup

Re: [PATCH] GnuTLS support on Woe32

[Andreas Schwab]

Juanma Barranquero <lekktu@gmail.com> writes:

> On Tue, May 3, 2011 at 23:26, Andreas Schwab <schwab@linux-m68k.org> wrote:
>
>> In which way is this a contradiction?
>
> In which way your comment is useful?

A lot more useful than your comments.

Andreas.

-- 
Andreas Schwab, schwab@linux-m68k.org
GPG Key fingerprint = 58CA 54C7 6D53 942B 1756  01D3 44D5 214B 8276 4ED5
"And now for something completely different."

Re: [PATCH] GnuTLS support on Woe32

[Juanma Barranquero]

On Wed, May 4, 2011 at 09:50, Andreas Schwab <schwab@linux-m68k.org> wrote:

> A lot more useful than your comments.

The avalanche has already started.  It is too late for the pebbles to vote.

    Juanma

Re: [PATCH] GnuTLS support on Woe32

[David Kastrup]

Juanma Barranquero <lekktu@gmail.com> writes:

> On Wed, May 4, 2011 at 09:50, Andreas Schwab <schwab@linux-m68k.org> wrote:
>
>> A lot more useful than your comments.
>
> The avalanche has already started.  It is too late for the pebbles to
> vote.

I vote to keep Dadaism off this list.  It is not really helpful to Emacs
development.

-- 
David Kastrup

Re: [PATCH] GnuTLS support on Woe32

[Ted Zlatanov]

On Wed, 4 May 2011 05:25:07 +0200 Juanma Barranquero <lekktu@gmail.com> wrote: 

JB> 2011/5/4 Ted Zlatanov <tzz@lifelogs.com>:
>> Could you push it into the :dll property of that symbol (always a list)?
>> Then just loop on all the names when logging later.

JB> What I've done is to add a property :loaded-from to the library-id
JB> (the symbol identifying the library). So in case the loading fails, I
JB> just log that it failed, but not the filenames that were tried,
JB> because they are exactly (cdr (assq 'gnutls dynamic-library-alist)).
JB> If the loading is successfull, I log the filename too.

That looks great, thanks for fixing it.

>> You could just say GNUTLS_LOG2 (1, 1, "loading the GnuTLS DLL: ",
>> filename) so it's unconditional (not the end of the world)

JB> I've opted for the easiest option, so GNUTLS_LOG2 (1, 1, ...). Feel
JB> free to change it once installed.

JB> Attached is the third version of the patch.

Everything looks OK to me.  I'll put some ERT tests on gnutls.el on my
TODO list (though anyone should feel free to do it) so we can test a few
of the connection cases.

Thanks
Ted

Re: [PATCH] GnuTLS support on Woe32

[Eli Zaretskii]

> From: Juanma Barranquero <lekktu@gmail.com>
> Date: Wed, 4 May 2011 05:25:07 +0200
> Cc: emacs-devel@gnu.org
> 
> Attached is the third version of the patch.

Looks fine to me, thanks.

> +  You can get pre-built binaries (including any required DLL and the
> +  gnutls.h file) and an installer at http://josefsson.org/gnutls4win/.

Are there any binary compatibility issues with different version of
the gnutls DLL, like we have with libpng?  If so, we may need to do
something, at least advise what version should be installed to work
with the precompiled binaries.

Re: [PATCH] GnuTLS support on Woe32

[Juanma Barranquero]

> I vote to keep Dadaism off this list.  It is not really helpful to Emacs
> development.

Then try to convince our Vorlon wannabe in residence.

    Juanma

Re: [PATCH] GnuTLS support on Woe32

[Juanma Barranquero]

On Wed, May 4, 2011 at 12:00, Eli Zaretskii <eliz@gnu.org> wrote:

> Are there any binary compatibility issues with different version of
> the gnutls DLL, like we have with libpng?

None known at this moment, I think.

    Juanma

Re: open-network-stream problems on W32

[Christoph Scholtes]

On 5/2/2011 12:37 PM, Ted Zlatanov wrote:

> It should Just Work; you're never hitting the GnuTLS code and
> `smtpmail-send-it' is trying to use just the "gnutls-cli" command-line
> utility.  `smtpmail-send-it' needs to be configured or fixed in code
> (probably the former).

What do you mean by "you're never hitting the GnuTLS code"?

I have been doing some more testing and compared behavior of the latest 
Emacs trunk on Debian (Squeeze) and Windows 7. I am using the same 
configuration in both instances:

(require 'smtpmail)
(setq send-mail-function 'smtpmail-send-it
       message-send-mail-function 'smtpmail-send-it
       smtpmail-starttls-credentials '(("smtp.gmail.com" 587 nil nil))
       smtpmail-auth-credentials (expand-file-name "~/.authinfo.gpg")
       smtpmail-default-smtp-server "smtp.gmail.com"
       smtpmail-smtp-server "smtp.gmail.com"
       smtpmail-smtp-service 587
       user-mail-address "myadress@gmail.com"
       smtpmail-debug-info t)

On Debian, at first, I didn't have `gnutls-bin' installed, so it failed 
with the same error as on Windows ("SMTP protocol error", see my earlier 
post). I then installed `gnutls-bin' and then everything worked fine.

Sending...
Sending via mail...
Opening STARTTLS connection to `smtp.gmail.com:587'...done
220 mx.google.com ESMTP d9sm723168ibb.19
250-mx.google.com at your service,
250-SIZE 35882577
250-8BITMIME
250-STARTTLS
250 ENHANCEDSTATUSCODES
220 2.0.0 Ready to start TLS
250-mx.google.com at your service,
250-SIZE 35882577
250-8BITMIME
250-AUTH LOGIN PLAIN XOAUTH
250 ENHANCEDSTATUSCODES
235 2.7.0 Accepted
250 2.1.0 OK d9sm723168ibb.19
250 2.1.5 OK d9sm723168ibb.19
354  Go ahead d9sm723168ibb.19
250 2.0.0 OK 1304566065 d9sm723168ibb.19
Sending...done

On Windows, I noticed that it couldn't find `gnutls-cli' either so I 
added the directory with the executable to the Emacs path.

Now I get this:

Sending...
Sending via mail...
Opening STARTTLS connection to `smtp.gmail.com:587'...done
220 mx.google.com ESMTP 4sm723326ibc.15
250-mx.google.com at your service,
250-SIZE 35882577
250-8BITMIME
250-STARTTLS
250 ENHANCEDSTATUSCODES
c:/Users/Christoph/A: 0% (0/105)
c:/Users/Christoph/A: 100% (105/105)
c:/Users/Christoph/A: 0% (0/105)
c:/Users/Christoph/A: 100% (105/105)
530 5.7.0 Must issue a STARTTLS command first. 4sm723326ibc.15
221 2.0.0 closing connection 4sm723326ibc.15
while: Sending failed; SMTP protocol error

Why is the behavior with the same configuration different on Windows 
than on GNU/Linux? For the record, I made sure that I am using the same 
GnuTLS version on Windows and GNU/Linux, v2.8.6.

Christoph

Re: open-network-stream problems on W32

[Eli Zaretskii]

> Date: Wed, 04 May 2011 21:47:32 -0600
> From: Christoph Scholtes <cschol2112@googlemail.com>
> 
> On Windows, I noticed that it couldn't find `gnutls-cli' either so I 
> added the directory with the executable to the Emacs path.

What do you mean by "Emacs path"?  If that's exec-path, then it might
not be enough: you need also to add that directory to PATH outside
Emacs.  IOW, add it to PATH and restart Emacs.  Only then you can be
sure that the problems you see are not due to local misconfiguration.

Re: open-network-stream problems on W32

[Ted Zlatanov]

On Wed, 04 May 2011 21:47:32 -0600 Christoph Scholtes <cschol2112@googlemail.com> wrote: 

CS> On 5/2/2011 12:37 PM, Ted Zlatanov wrote:
>> It should Just Work; you're never hitting the GnuTLS code and
>> `smtpmail-send-it' is trying to use just the "gnutls-cli" command-line
>> utility.  `smtpmail-send-it' needs to be configured or fixed in code
>> (probably the former).

CS> What do you mean by "you're never hitting the GnuTLS code"?

I made a mistake.  Lars will add GnuTLS STARTTLS support to smtpmail.el
and when he does, things will work wihout external binaries on any
platform with GnuTLS support.

CS> I have been doing some more testing and compared behavior of the
CS> latest Emacs trunk on Debian (Squeeze) and Windows 7. I am using the
CS> same configuration in both instances:

CS> (require 'smtpmail)
CS> (setq send-mail-function 'smtpmail-send-it
CS>       message-send-mail-function 'smtpmail-send-it
CS>       smtpmail-starttls-credentials '(("smtp.gmail.com" 587 nil nil))
CS>       smtpmail-auth-credentials (expand-file-name "~/.authinfo.gpg")
CS>       smtpmail-default-smtp-server "smtp.gmail.com"
CS>       smtpmail-smtp-server "smtp.gmail.com"
CS>       smtpmail-smtp-service 587
CS>       user-mail-address "myadress@gmail.com"
CS>       smtpmail-debug-info t)

Lars and I were just talking about reworking this, especially
`smtpmail-starttls-credentials', to use auth-source credentials
exclusively.  Stay tuned.

CS> On Debian, at first, I didn't have `gnutls-bin' installed, so it
CS> failed with the same error as on Windows ("SMTP protocol error", see
CS> my earlier post). I then installed `gnutls-bin' and then everything
CS> worked fine.
...
CS> On Windows, I noticed that it couldn't find `gnutls-cli' either so I
CS> added the directory with the executable to the Emacs path.
...
CS> while: Sending failed; SMTP protocol error

CS> Why is the behavior with the same configuration different on Windows
CS> than on GNU/Linux? For the record, I made sure that I am using the
CS> same GnuTLS version on Windows and GNU/Linux, v2.8.6.

I know for sure neither platform is using GnuTLS for you.  When Lars
updates smtpmail.el we can re-test, but meanwhile you can look at the
docs on the Emacs Wiki for configuring `gnutls-cli' on W32.  I don't use
W32 so I don't know what's breaking there.

Ted

Re: open-network-stream problems on W32

[Christoph Scholtes]

On 5/5/2011 4:37 AM, Eli Zaretskii wrote:

> What do you mean by "Emacs path"?  If that's exec-path, then it might
> not be enough: you need also to add that directory to PATH outside
> Emacs.  IOW, add it to PATH and restart Emacs.  Only then you can be
> sure that the problems you see are not due to local misconfiguration.

Sorry, for my confusing terminology. It has been added to all 
appropriate places to make sure Emacs finds it, i.e. PATH and exec-path.

I am pretty sure it is not due to misconfiguration.

Christoph