[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: [PATCH] GnuTLS support on Woe32
|
From: |
Ted Zlatanov |
|
Subject: |
Re: [PATCH] GnuTLS support on Woe32 |
|
Date: |
Tue, 22 Mar 2011 16:14:08 -0500 |
|
User-agent: |
Gnus/5.110016 (No Gnus v0.16) Emacs/24.0.50 (gnu/linux) |
On Tue, 22 Mar 2011 14:50:06 -0400 Stefan Monnier <address@hidden> 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
=== 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 <address@hidden>
+
+ * makefile.w32-in (obj): Added gnutls.o.
+
2011-03-03 Drake Wilson <address@hidden> (tiny change)
* emacsclient.c (longopts): Add quiet.
=== modified file 'lib-src/makefile.w32-in'
--- lib-src/makefile.w32-in 2011-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 <address@hidden>
+
+ * 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 <address@hidden>
+
+ * net/gnutls.el (gnutls-negotiate): Check whether default
+ trustfile exists before going to use it. Add missing argument to
+ gnutls-message-maybe call. Return return value.
+
+
2011-03-22 Leo Liu <address@hidden>
* 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 <address@hidden>
+
+ * configure.bat: New options --without-gnutls and --lib, new build
+ variable USER_LIBS, automatically detect GnuTLS.
+ * INSTALL: Add instructions for GnuTLS support.
+ * gmake.defs: Prefix USER_LIB's with -l.
+
2011-02-27 Eli Zaretskii <address@hidden>
* inc/unistd.h (readlink, symlink): Declare prototypes.
=== modified file 'nt/INSTALL'
--- nt/INSTALL 2011-01-26 08:36:39 +0000
+++ nt/INSTALL 2011-03-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 <address@hidden>
+
+ * 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 <address@hidden>
+
+ * 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 <address@hidden>
* 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, (continued)
- Re: [PATCH] GnuTLS support on Woe32, Ted Zlatanov, 2011/03/22
- Re: [PATCH] GnuTLS support on Woe32, Robert Pluim, 2011/03/22
- Re: [PATCH] GnuTLS support on Woe32, Ted Zlatanov, 2011/03/22
- Re: [PATCH] GnuTLS support on Woe32, Robert Pluim, 2011/03/22
- Re: [PATCH] GnuTLS support on Woe32, Ted Zlatanov, 2011/03/22
- Re: [PATCH] GnuTLS support on Woe32, Stefan Monnier, 2011/03/22
- Re: [PATCH] GnuTLS support on Woe32, Robert Pluim, 2011/03/22
- Re: [PATCH] GnuTLS support on Woe32, Ted Zlatanov, 2011/03/22
- Re: [PATCH] GnuTLS support on Woe32, Robert Pluim, 2011/03/23
- Re: [PATCH] GnuTLS support on Woe32, Stefan Monnier, 2011/03/22
- Re: [PATCH] GnuTLS support on Woe32,
Ted Zlatanov <=
- Re: [PATCH] GnuTLS support on Woe32, Ted Zlatanov, 2011/03/23
- Re: [PATCH] GnuTLS support on Woe32, Robert Pluim, 2011/03/23
- Re: [PATCH] GnuTLS support on Woe32, Ted Zlatanov, 2011/03/23
- Re: [PATCH] GnuTLS support on Woe32, Robert Pluim, 2011/03/23
- Re: [PATCH] GnuTLS support on Woe32, Ted Zlatanov, 2011/03/23
- Re: [PATCH] GnuTLS support on Woe32, Stefan Monnier, 2011/03/23
- Re: [PATCH] GnuTLS support on Woe32, Ted Zlatanov, 2011/03/23
- Re: [PATCH] GnuTLS support on Woe32, Stefan Monnier, 2011/03/23
- Re: [PATCH] GnuTLS support on Woe32, Claudio Bley, 2011/03/23
- Re: [PATCH] GnuTLS support on Woe32, Ted Zlatanov, 2011/03/24