[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 08:03:12 -0500 |
|
User-agent: |
Gnus/5.110016 (No Gnus v0.16) Emacs/24.0.50 (gnu/linux) |
On Tue, 22 Mar 2011 01:40:06 -0400 Stefan Monnier <address@hidden> 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
=== 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 <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-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 <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 Chong Yidong <address@hidden>
* 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 <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-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 <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 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, (continued)
- Re: [PATCH] GnuTLS support on Woe32, Eli Zaretskii, 2011/03/12
- Re: [PATCH] GnuTLS support on Woe32, Claudio Bley, 2011/03/13
- Re: [PATCH] GnuTLS support on Woe32, Eli Zaretskii, 2011/03/13
- Re: [PATCH] GnuTLS support on Woe32, Claudio Bley, 2011/03/14
- Re: [PATCH] GnuTLS support on Woe32, Ted Zlatanov, 2011/03/14
- Re: [PATCH] GnuTLS support on Woe32, Claudio Bley, 2011/03/15
- Re: [PATCH] GnuTLS support on Woe32, Ted Zlatanov, 2011/03/15
- Re: [PATCH] GnuTLS support on Woe32, Claudio Bley, 2011/03/20
- Re: [PATCH] GnuTLS support on Woe32, Ted Zlatanov, 2011/03/21
- 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, 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, 2011/03/22