[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: |
Fri, 22 Apr 2011 08:12:58 -0500 |
|
User-agent: |
Gnus/5.110016 (No Gnus v0.16) Emacs/24.0.50 (gnu/linux) |
On Fri, 22 Apr 2011 03:07:18 -0400 Glenn Morris <address@hidden> 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
=== 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 <address@hidden>
+
+ * configure.in: Check for GnuTLS certificate verify callbacks.
+
2011-04-20 Stefan Monnier <address@hidden>
* 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 <address@hidden>
+
+ * makefile.w32-in (obj): Added gnutls.o.
+
2011-04-16 Paul Eggert <address@hidden>
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 <address@hidden>
+
+ * 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 <address@hidden>.
+ (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 <address@hidden>
* 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 <address@hidden>
+
+ * 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 <address@hidden>
* 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 <address@hidden>
+
+ * 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 <address@hidden> (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 <address@hidden>
* 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, (continued)
- Re: [PATCH] GnuTLS support on Woe32, Ted Zlatanov, 2011/04/15
- Re: [PATCH] GnuTLS support on Woe32, Eli Zaretskii, 2011/04/15
- Re: [PATCH] GnuTLS support on Woe32, Richard Stallman, 2011/04/15
- Re: [PATCH] GnuTLS support on Woe32, Ted Zlatanov, 2011/04/15
- Re: [PATCH] GnuTLS support on Woe32, Lars Magne Ingebrigtsen, 2011/04/15
- Re: [PATCH] GnuTLS support on Woe32, Ted Zlatanov, 2011/04/18
- Re: [PATCH] GnuTLS support on Woe32, Ted Zlatanov, 2011/04/21
- Re: [PATCH] GnuTLS support on Woe32, Glenn Morris, 2011/04/22
- Re: [PATCH] GnuTLS support on Woe32,
Ted Zlatanov <=
- Re: [PATCH] GnuTLS support on Woe32, Ted Zlatanov, 2011/04/24
- Re: [PATCH] GnuTLS support on Woe32, Christoph Scholtes, 2011/04/25
- Re: [PATCH] GnuTLS support on Woe32, Ted Zlatanov, 2011/04/25
- Re: [PATCH] GnuTLS support on Woe32, Christoph Scholtes, 2011/04/26
- Re: [PATCH] GnuTLS support on Woe32, Ted Zlatanov, 2011/04/26
- Re: [PATCH] GnuTLS support on Woe32, Christoph Scholtes, 2011/04/26
- open-network-stream problems on W32 (was: [PATCH] GnuTLS support on Woe32), Ted Zlatanov, 2011/04/27
- Re: open-network-stream problems on W32, Christoph Scholtes, 2011/04/27
- Re: [PATCH] GnuTLS support on Woe32, Juanma Barranquero, 2011/04/27