[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Another update of GNU TLS bindings
|
From: |
Simon Josefsson |
|
Subject: |
Another update of GNU TLS bindings |
|
Date: |
Sun, 03 Feb 2002 22:07:49 +0100 |
|
User-agent: |
Gnus/5.090006 (Oort Gnus v0.06) Emacs/21.2.50 (i686-pc-linux-gnu) |
This patch contains a few changes:
* GC fixes as suggested. However, Lisp_Process in process.h still
contain #ifdef's (and thus cause a binary API incompatibility)
because the type of the newly added variables is not known unless
TLS is enabled. Is this OK? I'm not sure how this could be solved.
* Hopefully all comments (documentation etc) should be fixed. (I will
commit the Gnus manual changes to the Gnus CVS unless someone has
comments on that part of the patch below.)
* It still uses variables defined in gnutls.el instead of using Emacs
symbols as was suggested. Symbols seemed like work, and the GNU TLS
library should perform sanity checks on the input anyway, so maybe
not much is gained by doing the work.
Open issues:
* Do we want a aclocal.m4? Should it be copied into configure.in?
Also, I'm not sure about the configure --help output.
* Do FSF has papers for William's ssl.el? The copyright line suggests
it.
The GNU TLS API seem to be changing, and the current patch is moving
towards the new API, but contains a few #define's that makes it
compile with GNU TLS 0.3.5 (latest release) as well. I could wait a
few weeks until the TLS code stabilizes, or maybe I could get CVS
write permissions, commit this and fix the minor problems as the GNU
TLS library evolves (which includes adding one new elisp function for
the TLS certificate callback, which requires some pending
modifications to GNU TLS).
Index: INSTALL
===================================================================
RCS file: /cvsroot/emacs/emacs/INSTALL,v
retrieving revision 1.84
diff -u -r1.84 INSTALL
--- INSTALL 29 Dec 2001 01:13:26 -0000 1.84
+++ INSTALL 3 Feb 2002 20:39:45 -0000
@@ -142,6 +142,8 @@
http://prtr-13.ucsc.edu/~badger/software/libungif/index.shtml
Ensure you get version 4.1.0b1 or higher of libungif -- a bug in
4.1.0 can crash Emacs.
+ . libgnutls for TLS network
+ support: http://www.gnu.org/software/gnutls/
Emacs will configure itself to build with these libraries if the
`configure' script finds them on your system, unless you supply the
Index: aclocal.m4
===================================================================
RCS file: aclocal.m4
diff -N aclocal.m4
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ aclocal.m4 3 Feb 2002 20:39:45 -0000
@@ -0,0 +1,175 @@
+# aclocal.m4 generated automatically by aclocal 1.5
+
+# Copyright 1996, 1997, 1998, 1999, 2000, 2001
+# Free Software Foundation, Inc.
+# This file is free software; the Free Software Foundation
+# gives unlimited permission to copy and/or distribute it,
+# with or without modifications, as long as this notice is preserved.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
+# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+# PARTICULAR PURPOSE.
+
+dnl Autoconf macros for libgnutls
+dnl $id$
+
+# Modified for LIBGNUTLS -- nmav
+# Configure paths for LIBGCRYPT
+# Shamelessly stolen from the one of XDELTA by Owen Taylor
+# Werner Koch 99-12-09
+
+dnl AM_PATH_LIBGNUTLS([MINIMUM-VERSION, [ACTION-IF-FOUND [,
ACTION-IF-NOT-FOUND ]]])
+dnl Test for libgnutls, and define LIBGNUTLS_CFLAGS and LIBGNUTLS_LIBS
+dnl
+AC_DEFUN(AM_PATH_LIBGNUTLS,
+[dnl
+dnl Get the cflags and libraries from the libgnutls-config script
+dnl
+AC_ARG_WITH(libgnutls-prefix,
+ [ --with-libgnutls-prefix=PFX Prefix where libgnutls is installed
(optional)],
+ libgnutls_config_prefix="$withval", libgnutls_config_prefix="")
+
+ if test x$libgnutls_config_prefix != x ; then
+ libgnutls_config_args="$libgnutls_config_args
--prefix=$libgnutls_config_prefix"
+ if test x${LIBGNUTLS_CONFIG+set} != xset ; then
+ LIBGNUTLS_CONFIG=$libgnutls_config_prefix/bin/libgnutls-config
+ fi
+ fi
+
+ AC_PATH_PROG(LIBGNUTLS_CONFIG, libgnutls-config, no)
+ min_libgnutls_version=ifelse([$1], ,0.1.0,$1)
+ AC_MSG_CHECKING(for libgnutls - version >= $min_libgnutls_version)
+ no_libgnutls=""
+ if test "$LIBGNUTLS_CONFIG" = "no" ; then
+ no_libgnutls=yes
+ else
+ LIBGNUTLS_CFLAGS=`$LIBGNUTLS_CONFIG $libgnutls_config_args --cflags`
+ LIBGNUTLS_LIBS=`$LIBGNUTLS_CONFIG $libgnutls_config_args --libs`
+ libgnutls_config_version=`$LIBGNUTLS_CONFIG $libgnutls_config_args
--version`
+
+
+ ac_save_CFLAGS="$CFLAGS"
+ ac_save_LIBS="$LIBS"
+ CFLAGS="$CFLAGS $LIBGNUTLS_CFLAGS"
+ LIBS="$LIBS $LIBGNUTLS_LIBS"
+dnl
+dnl Now check if the installed libgnutls is sufficiently new. Also sanity
+dnl checks the results of libgnutls-config to some extent
+dnl
+ rm -f conf.libgnutlstest
+ AC_TRY_RUN([
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <gnutls.h>
+
+int
+main ()
+{
+ system ("touch conf.libgnutlstest");
+
+ if( strcmp( gnutls_check_version(NULL), "$libgnutls_config_version" ) )
+ {
+ printf("\n*** 'libgnutls-config --version' returned %s, but LIBGNUTLS
(%s)\n",
+ "$libgnutls_config_version", gnutls_check_version(NULL) );
+ printf("*** was found! If libgnutls-config was correct, then it is
best\n");
+ printf("*** to remove the old version of LIBGNUTLS. You may also be able
to fix the error\n");
+ printf("*** by modifying your LD_LIBRARY_PATH enviroment variable, or by
editing\n");
+ printf("*** /etc/ld.so.conf. Make sure you have run ldconfig if that
is\n");
+ printf("*** required on your system.\n");
+ printf("*** If libgnutls-config was wrong, set the environment variable
LIBGNUTLS_CONFIG\n");
+ printf("*** to point to the correct copy of libgnutls-config, and remove
the file config.cache\n");
+ printf("*** before re-running configure\n");
+ }
+ else if ( strcmp(gnutls_check_version(NULL), LIBGNUTLS_VERSION ) )
+ {
+ printf("\n*** LIBGNUTLS header file (version %s) does not match\n",
LIBGNUTLS_VERSION);
+ printf("*** library (version %s)\n", gnutls_check_version(NULL) );
+ }
+ else
+ {
+ if ( gnutls_check_version( "$min_libgnutls_version" ) )
+ {
+ return 0;
+ }
+ else
+ {
+ printf("no\n*** An old version of LIBGNUTLS (%s) was found.\n",
+ gnutls_check_version(NULL) );
+ printf("*** You need a version of LIBGNUTLS newer than %s. The latest
version of\n",
+ "$min_libgnutls_version" );
+ printf("*** LIBGNUTLS is always available from
ftp://gnutls.hellug.gr/pub/gnutls.\n";);
+ printf("*** \n");
+ printf("*** If you have already installed a sufficiently new version,
this error\n");
+ printf("*** probably means that the wrong copy of the libgnutls-config
shell script is\n");
+ printf("*** being found. The easiest way to fix this is to remove the
old version\n");
+ printf("*** of LIBGNUTLS, but you can also set the LIBGNUTLS_CONFIG
environment to point to the\n");
+ printf("*** correct copy of libgnutls-config. (In this case, you will
have to\n");
+ printf("*** modify your LD_LIBRARY_PATH enviroment variable, or edit
/etc/ld.so.conf\n");
+ printf("*** so that the correct libraries are found at run-time))\n");
+ }
+ }
+ return 1;
+}
+],, no_libgnutls=yes,[echo $ac_n "cross compiling; assumed OK... $ac_c"])
+ CFLAGS="$ac_save_CFLAGS"
+ LIBS="$ac_save_LIBS"
+ fi
+
+ if test "x$no_libgnutls" = x ; then
+ AC_MSG_RESULT(yes)
+ ifelse([$2], , :, [$2])
+ else
+ if test -f conf.libgnutlstest ; then
+ :
+ else
+ AC_MSG_RESULT(no)
+ fi
+ if test "$LIBGNUTLS_CONFIG" = "no" ; then
+ echo "*** The libgnutls-config script installed by LIBGNUTLS could not
be found"
+ echo "*** If LIBGNUTLS was installed in PREFIX, make sure PREFIX/bin is
in"
+ echo "*** your path, or set the LIBGNUTLS_CONFIG environment variable
to the"
+ echo "*** full path to libgnutls-config."
+ else
+ if test -f conf.libgnutlstest ; then
+ :
+ else
+ echo "*** Could not run libgnutls test program, checking why..."
+ CFLAGS="$CFLAGS $LIBGNUTLS_CFLAGS"
+ LIBS="$LIBS $LIBGNUTLS_LIBS"
+ AC_TRY_LINK([
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <gnutls.h>
+], [ return !!gnutls_check_version(NULL); ],
+ [ echo "*** The test program compiled, but did not run. This usually
means"
+ echo "*** that the run-time linker is not finding LIBGNUTLS or
finding the wrong"
+ echo "*** version of LIBGNUTLS. If it is not finding LIBGNUTLS,
you'll need to set your"
+ echo "*** LD_LIBRARY_PATH environment variable, or edit
/etc/ld.so.conf to point"
+ echo "*** to the installed location Also, make sure you have run
ldconfig if that"
+ echo "*** is required on your system"
+ echo "***"
+ echo "*** If you have an old version installed, it is best to remove
it, although"
+ echo "*** you may also be able to get things to work by modifying
LD_LIBRARY_PATH"
+ echo "***" ],
+ [ echo "*** The test program failed to compile or link. See the file
config.log for the"
+ echo "*** exact error that occured. This usually means LIBGNUTLS was
incorrectly installed"
+ echo "*** or that you have moved LIBGNUTLS since it was installed.
In the latter case, you"
+ echo "*** may want to edit the libgnutls-config script:
$LIBGNUTLS_CONFIG" ])
+ CFLAGS="$ac_save_CFLAGS"
+ LIBS="$ac_save_LIBS"
+ fi
+ fi
+ LIBGNUTLS_CFLAGS=""
+ LIBGNUTLS_LIBS=""
+ ifelse([$3], , :, [$3])
+ fi
+ rm -f conf.libgnutlstest
+ AC_SUBST(LIBGNUTLS_CFLAGS)
+ AC_SUBST(LIBGNUTLS_LIBS)
+])
+
+dnl *-*wedit:notab*-* Please keep this as the last line.
+
Index: configure.in
===================================================================
RCS file: /cvsroot/emacs/emacs/configure.in,v
retrieving revision 1.284
diff -u -r1.284 configure.in
--- configure.in 27 Jan 2002 10:03:14 -0000 1.284
+++ configure.in 3 Feb 2002 20:39:46 -0000
@@ -1915,6 +1915,13 @@
fi
fi
+AM_PATH_LIBGNUTLS( 0.3.2,, AC_MSG_ERROR([[*** gnutls was not found]]))
+HAVE_GNUTLS=no
+if test "x$no_libgnutls" = x ; then
+ HAVE_GNUTLS=yes
+ AC_DEFINE(HAVE_GNUTLS)
+fi
+
# If netdb.h doesn't declare h_errno, we must declare it by hand.
AC_CACHE_CHECK(whether netdb declares h_errno,
emacs_cv_netdb_declares_h_errno,
@@ -2268,6 +2275,7 @@
echo " Does Emacs use -ltiff? ${HAVE_TIFF}"
echo " Does Emacs use -lungif? ${HAVE_GIF}"
echo " Does Emacs use -lpng? ${HAVE_PNG}"
+echo " Does Emacs use GNU TLS? ${HAVE_GNUTLS}"
echo " Does Emacs use X toolkit scroll bars?
${USE_TOOLKIT_SCROLL_BARS}"
echo
Index: etc/NEWS
===================================================================
RCS file: /cvsroot/emacs/emacs/etc/NEWS,v
retrieving revision 1.587
diff -u -r1.587 NEWS
--- etc/NEWS 3 Feb 2002 17:42:07 -0000 1.587
+++ etc/NEWS 3 Feb 2002 20:39:49 -0000
@@ -14,6 +14,11 @@
* Installation Changes in Emacs 21.3
+** Emacs can now be compiled with the GNU TLS library, to provide
+builtin support for TLS network connections. The location of the the
+GNU TLS library can be specified with the `--with-libgnutls-prefix'
+configure option.
+
** Emacs now supports new configure options `--program-prefix',
`--program-suffix' and `--program-transform-name' that affect the names of
installed programs.
@@ -32,6 +37,9 @@
* Changes in Emacs 21.3
+** Emacs supports TLS network connections, which can be used to access
+TLS protected IMAP, NNTP and SMTP resources using Gnus or smtpmail.el.
+
+++
** There's a new face `minibuffer-prompt'.
Emacs adds this face to the list of text properties stored in the
@@ -415,6 +423,25 @@
* Lisp Changes in Emacs 21.3
+
+** New low-level API functions for TLS support: gnutls_init,
+gnutls_deinit, gnutls_protocol_set_priority,
+gnutls_cipher_set_priority, gnutls_compression_set_priority,
+gnutls_kx_set_priority, gnutls_mac_set_priority, gnutls_cred_set,
+gnutls_handshake, gnutls_rehandshake,
+gnutls_x509pki_set_client_key_file,
+gnutls_x509pki_set_client_trust_file, gnutls_srp_set_client_cred,
+gnutls_anon_set_client_cred, gnutls_bye, gnutls_cipher_get,
+gnutls_kx_get, gnutls_mac_get, gnutls_compression_get,
+gnutls_protocol_get_version, gnutls_protocol_get_name,
+gnutls_cipher_get_name, gnutls_mac_get_name, gnutls_kx_get_name,
+gnutls_compression_get_name.
+
+** New lisp library ssl.el and a modified library starttls.el, both
+provides high-level TLS APIs compatible with previous libraries
+(ssl.el was a third party library). ssl.el provides the function
+`open-ssl-stream', and starttls.el `starttls-open-stream' and
+`starttls-negotiate'.
** New function substring-no-properties.
Index: lisp/net/gnutls.el
===================================================================
RCS file: lisp/net/gnutls.el
diff -N lisp/net/gnutls.el
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ lisp/net/gnutls.el 3 Feb 2002 20:39:50 -0000
@@ -0,0 +1,69 @@
+;;; gnutls.el --- various TLS related constants
+
+;; Copyright (C) 2001, 2002 Free Software Foundation, Inc.
+
+;; Author: Simon Josefsson <address@hidden>
+;; Keywords: comm
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This file provides constants for the builtin GNU TLS support.
+
+;;; Code:
+
+(defconst gnutls-ssl3 1)
+(defconst gnutls-tls1 2)
+
+(defconst gnutls-cipher-null 1)
+(defconst gnutls-cipher-arcfour 2)
+(defconst gnutls-cipher-3des-cbc 3)
+(defconst gnutls-cipher-rijndael-cbc 4)
+(defconst gnutls-cipher-twofish-cbc 5)
+(defconst gnutls-cipher-rijndael256-cbc 6)
+
+(defconst gnutls-comp-null 1)
+(defconst gnutls-comp-zlib 2)
+
+(defconst gnutls-kx-x509pki-rsa 1)
+(defconst gnutls-kx-x509pki-dhe-dss 2)
+(defconst gnutls-kx-x509pki-dhe-rsa 3)
+(defconst gnutls-kx-anon-dh 4)
+(defconst gnutls-kx-srp 5)
+
+(defconst gnutls-mac-null 1)
+(defconst gnutls-mac-md5 2)
+(defconst gnutls-mac-sha 3)
+
+(defconst gnutls-x509pki 1)
+(defconst gnutls-anon 2)
+(defconst gnutls-srp 3)
+
+(defconst gnutls-shut-rdwr 0)
+(defconst gnutls-shut-wr 1)
+
+(defconst gnutls-e-interrupted -52)
+(defconst gnutls-e-again -28)
+
+(defun gnutls-p ()
+ (fboundp 'gnutls-init))
+
+(provide 'gnutls)
+
+;;; gnutls.el ends here
Index: lisp/net/ssl.el
===================================================================
RCS file: lisp/net/ssl.el
diff -N lisp/net/ssl.el
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ lisp/net/ssl.el 3 Feb 2002 20:39:50 -0000
@@ -0,0 +1,198 @@
+;;; ssl.el --- SSL utilities
+
+;; Copyright (c) 1995, 1996 by William M. Perry <address@hidden>
+;; Copyright (c) 1996 - 1999 Free Software Foundation, Inc.
+;; Copyright (C) 2002 Free Software Foundation, Inc.
+
+;; Author: Simon Josefsson <address@hidden>
+;; Keywords: comm
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'starttls)
+(require 'base64)
+(eval-when-compile (require 'cl))
+
+(defgroup ssl nil
+ "Support for `Secure Sockets Layer' encryption."
+ :group 'comm)
+
+(defcustom ssl-certificate-directory "~/.w3/certs/"
+ "*Directory to store CA certificates in"
+ :group 'ssl
+ :type 'directory)
+
+(defcustom ssl-rehash-program-name "c_rehash"
+ "*Program to run after adding a cert to a directory .
+Run with one argument, the directory name."
+ :group 'ssl
+ :type 'string)
+
+(defcustom ssl-view-certificate-program-name "x509"
+ "*The program to run to provide a human-readable view of a certificate."
+ :group 'ssl
+ :type 'string)
+
+(defcustom ssl-view-certificate-program-arguments '("-text" "-inform" "DER")
+ "*Arguments that should be passed to the certificate viewing program.
+The certificate is piped to it.
+Maybe a way of passing a file should be implemented"
+ :group 'ssl
+ :type 'list)
+
+(defcustom ssl-certificate-directory-style 'ssleay
+ "*Style of cert database to use, the only valid value right now is `ssleay'.
+This means a directory of pem encoded certificates with hash symlinks."
+ :group 'ssl
+ :type '(choice (const :tag "SSLeay" :value ssleay)
+ (const :tag "OpenSSL" :value openssl)))
+
+(defcustom ssl-certificate-verification-policy 0
+ "*How far up the certificate chain we should verify."
+ :group 'ssl
+ :type '(choice (const :tag "No verification" :value 0)
+ (const :tag "Verification required" :value 1)
+ (const :tag "Reject connection if verification fails" :value 3)
+ (const :tag "SSL_VERIFY_CLIENT_ONCE" :value 5)))
+
+(defcustom ssl-program-name "openssl"
+ "*The program to run in a subprocess to open an SSL connection."
+ :group 'ssl
+ :type 'string)
+
+(defcustom ssl-program-arguments
+ '("s_client"
+ "-quiet"
+ "-host" host
+ "-port" service
+ "-verify" (int-to-string ssl-certificate-verification-policy)
+ "-CApath" ssl-certificate-directory
+ )
+ "*Arguments that should be passed to the program `ssl-program-name'.
+This should be used if your SSL program needs command line switches to
+specify any behaviour (certificate file locations, etc).
+The special symbols 'host and 'port may be used in the list of arguments
+and will be replaced with the hostname and service/port that will be connected
+to."
+ :group 'ssl
+ :type 'list)
+
+(defun ssl-certificate-information (der)
+ "Return an assoc list of information about a certificate in DER format."
+ (let ((certificate (concat "-----BEGIN CERTIFICATE-----\n"
+ (base64-encode-string der)
+ "\n-----END CERTIFICATE-----\n"))
+ (exit-code 0))
+ (save-excursion
+ (set-buffer (get-buffer-create " *openssl*"))
+ (erase-buffer)
+ (insert certificate)
+ (setq exit-code (condition-case ()
+ (call-process-region (point-min) (point-max)
+ ssl-program-name
+ t (list (current-buffer) nil) t
+ "x509"
+ "-subject" ; Print the subject DN
+ "-issuer" ; Print the issuer DN
+ "-dates" ; Both before and after
dates
+ "-serial" ; print out serial
number
+ "-noout" ; Don't spit out the
certificate
+ )
+ (error -1)))
+ (if (/= exit-code 0)
+ nil
+ (let ((vals nil))
+ (goto-char (point-min))
+ (while (re-search-forward "^\\([^=\n\r]+\\)\\s *=\\s *\\(.*\\)" nil t)
+ (push (cons (match-string 1) (match-string 2)) vals))
+ vals)))))
+
+(defun ssl-accept-ca-certificate ()
+ "Ask if the user is willing to accept a new CA certificate. The buffer-name
+should be the intended name of the certificate, and the buffer should probably
+be in DER encoding"
+ ;; TODO, check if it is really new or if we already know it
+ (let* ((process-connection-type nil)
+ (tmpbuf (generate-new-buffer "X509 CA Certificate Information"))
+ (response (save-excursion
+ (and (eq 0
+ (apply 'call-process-region
+ (point-min) (point-max)
+ ssl-view-certificate-program-name
+ nil tmpbuf t
+ ssl-view-certificate-program-arguments))
+ (switch-to-buffer tmpbuf)
+ (goto-char (point-min))
+ (or (recenter) t)
+ (yes-or-no-p
+ "Accept this CA to vouch for secure server
identities? ")
+ (kill-buffer tmpbuf)))))
+ (if (not response)
+ nil
+ (if (not (file-directory-p ssl-certificate-directory))
+ (make-directory ssl-certificate-directory))
+ (case ssl-certificate-directory-style
+ (ssleay
+ (base64-encode-region (point-min) (point-max))
+ (goto-char (point-min))
+ (insert "-----BEGIN CERTIFICATE-----\n")
+ (goto-char (point-max))
+ (insert "-----END CERTIFICATE-----\n")
+ (let ((f (expand-file-name
+ (concat (file-name-sans-extension (buffer-name)) ".pem")
+ ssl-certificate-directory)))
+ (write-file f)
+ (call-process ssl-rehash-program-name
+ nil nil nil
+ (expand-file-name ssl-certificate-directory))))))))
+
+;;;###autoload
+(defun open-ssl-stream (name buffer host service)
+ "Open a TLS connection for a service to a host.
+Returns a subprocess-object to represent the connection.
+Input and output work as for subprocesses; `delete-process' closes it.
+Args are NAME BUFFER HOST SERVICE.
+NAME is name for process. It is modified if necessary to make it unique.
+BUFFER is the buffer (or buffer-name) to associate with the process.
+ Process output goes at end of that buffer, unless you specify
+ an output stream or filter function to handle the output.
+ BUFFER may be also nil, meaning that this process is not associated
+ with any buffer
+Third arg is name of the host to connect to, or its IP address.
+Fourth arg SERVICE is name of the service desired, or an integer
+specifying a port number to connect to.
+See also `starttls-open-stream' and `starttls-negotiate'."
+ (if (integerp service) (setq service (int-to-string service)))
+ (if (gnutls-p)
+ (starttls-negotiate (starttls-open-stream name buffer host service))
+ (let* ((process-connection-type nil)
+ (port service)
+ (proc (eval
+ (`
+ (start-process name buffer ssl-program-name
+ (,@ ssl-program-arguments))))))
+ (process-kill-without-query proc)
+ proc)))
+
+(provide 'ssl)
+
+;;; ssl.el ends here
Index: lisp/net/starttls.el
===================================================================
RCS file: lisp/net/starttls.el
diff -N lisp/net/starttls.el
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ lisp/net/starttls.el 3 Feb 2002 20:39:50 -0000
@@ -0,0 +1,117 @@
+;;; starttls.el --- STARTTLS functions using builtin TLS functions
+
+;; Copyright (C) 1999, 2000, 2002 Free Software Foundation, Inc.
+
+;; Author: Daiki Ueno <address@hidden>,
+;; Simon Josefsson <address@hidden>
+;; Created: 1999/11/20
+;; Keywords: TLS, SSL, OpenSSL, mail, news
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This module defines some utility functions for STARTTLS profiles.
+;;
+;; If Emacs was linked with GNU TLS, the internal Emacs Lisp functions
+;; are used. Otherwise, the external program "starttls" is invoked.
+;;
+;; The external binary can be fetched from ftp://ftp.opaopa.org/pub/elisp/.
+;;
+;; [RFC 2595] "Using TLS with IMAP, POP3 and ACAP"
+;; by Chris Newman <address@hidden> (1999/06)
+
+;;; Code:
+
+(require 'gnutls)
+
+(defgroup starttls nil
+ "Support for `Transport Layer Security' protocol."
+ :version "21.1"
+ :group 'mail)
+
+(defcustom starttls-program "starttls"
+ "The program to run in a subprocess to open an TLSv1 connection."
+ :type 'string
+ :group 'starttls)
+
+(defcustom starttls-extra-args nil
+ "Extra arguments to `starttls-program'."
+ :type '(repeat string)
+ :group 'starttls)
+
+(defun starttls-negotiate (proc)
+ "Negotiate TLS on opened process PROC.
+If successful, the process is returned, otherwise nil is returned."
+ (if (not (fboundp 'gnutls-init))
+ (signal-process (process-id proc) 'SIGALRM)
+ (and (eq 0 (gnutls-init proc gnutls-client))
+ (eq 0 (gnutls-protocol-set-priority proc gnutls-tls1 gnutls-ssl3))
+ (eq 0 (gnutls-cipher-set-priority proc
+ gnutls-cipher-rijndael-cbc
+ gnutls-cipher-3des-cbc
+ gnutls-cipher-arcfour))
+ (eq 0 (gnutls-compression-set-priority proc
+ gnutls-comp-zlib
+ gnutls-comp-null))
+ (eq 0 (gnutls-kx-set-priority proc
+ gnutls-kx-x509pki-rsa
+ gnutls-kx-x509pki-dhe-rsa
+ gnutls-kx-srp
+ gnutls-kx-anon-dh))
+ (eq 0 (gnutls-mac-set-priority proc
+ gnutls-mac-sha
+ gnutls-mac-md5))
+ (eq 0 (gnutls-cred-set proc gnutls-x509pki))
+ (let ((ret gnutls-e-again))
+ (while (or (eq ret gnutls-e-again)
+ (eq ret gnutls-e-interrupted))
+ (setq ret (gnutls-handshake proc)))
+ (if (< ret 0)
+ nil
+ proc)))))
+
+(defun starttls-open-stream (name buffer host service)
+ "Open a TLS connection for a service to a host.
+Returns a subprocess-object to represent the connection.
+Input and output work as for subprocesses; `delete-process' closes it.
+Args are NAME BUFFER HOST SERVICE.
+NAME is name for process. It is modified if necessary to make it unique.
+BUFFER is the buffer (or `buffer-name') to associate with the process.
+ Process output goes at end of that buffer, unless you specify
+ an output stream or filter function to handle the output.
+ BUFFER may be also nil, meaning that this process is not associated
+ with any buffer
+Third arg is name of the host to connect to, or its IP address.
+Fourth arg SERVICE is name of the service desired, or an integer
+specifying a port number to connect to.
+This function uses builtin GNU TLS functions if available, otherwise
+it requires the use of a external program \"starttls\"."
+ (if (gnutls-p)
+ (apply 'open-network-stream name buffer host service)
+ (let* ((process-connection-type nil)
+ (process (apply #'start-process
+ name buffer starttls-program
+ host (format "%s" service)
+ starttls-extra-args)))
+ (process-kill-without-query process)
+ process)))
+
+(provide 'starttls)
+
+;;; starttls.el ends here
Index: lispref/processes.texi
===================================================================
RCS file: /cvsroot/emacs/emacs/lispref/processes.texi,v
retrieving revision 1.24
diff -u -r1.24 processes.texi
--- lispref/processes.texi 24 Sep 2001 19:00:26 -0000 1.24
+++ lispref/processes.texi 3 Feb 2002 20:39:51 -0000
@@ -47,6 +47,7 @@
* Sentinels:: Sentinels run when process run-status changes.
* Transaction Queues:: Transaction-based communication with subprocesses.
* Network:: Opening network connections.
+* Security Layer:: Using a security layer on network connections.
@end menu
@node Subprocess Creation
@@ -1360,4 +1361,270 @@
The arguments @var{host} and @var{service} specify where to connect to;
@var{host} is the host name (a string), and @var{service} is the name of
a defined network service (a string) or a port number (an integer).
address@hidden defun
+
address@hidden Security Layer
address@hidden Security Layer for Network Connections
address@hidden transport layer security
address@hidden TLS
address@hidden SSL
+
+Network connections (@pxref{Network}) opened by Emacs Lisp can
+optionally use a security layer, provided by the GNU TLS library.
+This functionality is only available if Emacs was compiled against the
+GNU TLS library. However, the high-level Lisp APIs are able to use
+external programs (OpenSSL and starttls) to provide the same
+interfaces even if Emacs was not compiled with GNU TLS.
+
+For casual uses, the Lisp libraries @code{ssl} and @code{starttls}
+provides functionality for opening TLS streams (@code{open-ssl-stream}
+and @code{starttls-open-stream}) and negotiating TLS on already opened
+network streams (@code{starttls-negotiate}). @code{open-ssl-stream}
+is a self-contained function that does everything necessary in order
+to get a TLS protected network connection.
address@hidden and @code{starttls-negotiate} open network
+connections in two steps, the first function merely open a network
+connection, allowing you to invoke commands (sent unprotected) to
+initiates the TLS negotition at the other end, and the second function
+initiates the TLS negotiation locally.
+
+If Emacs was compiled with GNU TLS, which can be found out using the
+function @code{gnutls-p}, the @code{starttls-open-stream} simply calls
address@hidden This means that if a network connection
+was opened using @code{open-network-stream} and TLS is wanted later,
+it can be enabled by calling @code{starttls-negotiate}. Note that if
+Emacs was not compiled with GNU TLS, this is not possible and you must
+use @code{starttls-open-stream} and the external program starttls to
+open the stream, before calling @code{starttls-negotiate}.
+
+The @code{ssl} library is implemented in terms of the @code{starttls}
+library, which in turn is implemented using the primitives described
+below.
+
+The way reading and writing to network connections works in Emacs Lisp
+is not modified. When a process has been initialized for the GNU TLS
+library (using @code{gnutls-init}), the GNU TLS functions for reading
+from and writing to the network connection are used automatically by
+Emacs. When a succesful TLS handshake has been performed, data that
+is read and written is protected by the TLS library.
+
+There are utility functions to investigate which algorithms are used;
address@hidden, @code{gnutls-kx-get}, @code{gnutls-mac-get},
address@hidden, and @code{gnutls-protocol-get-version}.
+Converting the integers returned by the previous functions into
+readable strings is done with @code{gnutls-cipher-get-name},
address@hidden @code{gnutls-mac-get-name},
address@hidden, and
address@hidden respectively.
+
+If you wish to return to using the operating system reading and
+writing primitives, you must deregister the network connection from
+GNU TLS (using @code{gnutls-deinit}).
+
+Initializing a process:
+
address@hidden gnutls-init proc
+Initializes process PROC for use as a TLS client.
+
+Processes must be initialized with this function before other GNU TLS
+functions are used. This function allocates resources which can only
+be deallocated by calling @code{gnutls-deinit}. Returns zero on success.
address@hidden defun
address@hidden gnutls-deinit proc
+Deallocate GNU TLS resources associated with process PROC.
address@hidden defun
+
+Functions that perform TLS communication:
+
address@hidden gnutls-handshake proc
+Perform GNU TLS handshake for process PROC.
+
+The identity of the peer is checked automatically. This function will
+fail if any problem is encountered, and will return a negative error
+code. In case of a client, if it has been asked to resume a session,
+but the server didn't, then a full handshake will be performed.
+
+This function may also return the non-fatal errors
address@hidden, or @code{gnutls-e-interrupted}. In that case
+you may resume the handshake (by calling this function again).
address@hidden defun
address@hidden gnutls-rehandshake proc
+Renegotiate GNU TLS security parameters for process PROC.
+
+This function will renegotiate security parameters with the
+client. This should only be called in case of a server.
+
+This message informs the peer that we want to renegotiate parameters
+(perform a handshake).
+
+If this function succeeds (returns 0), you must call the
address@hidden function in order to negotiate the new
+parameters.
+
+If the client does not wish to renegotiate parameters he will reply
+with an alert message, thus the return code will be
address@hidden and the alert will be
address@hidden
address@hidden defun
address@hidden gnutls-bye proc how
+Terminate current GNU TLS connection for process PROC.
+
+The connection should have been initiated using @code{gnutls-handshake}.
+HOW should be one of @code{gnutls-shut-rdwr}, @code{gnutls-shut-wr}.
+
+In case of @code{gnutls-shut-rdwr} then the TLS connection gets terminated
+and further receives and sends will be disallowed. If the return value
+is zero you may continue using the connection. @code{gnutls-shut-rdwr}
+actually sends an alert containing a close request and waits for the
+peer to reply with the same message.
+
+In case of @code{gnutls-shut-wr} then the TLS connection gets terminated
+and further sends will be disallowed. In order to reuse the connection
+you should wait for an EOF from the peer. @code{gnutls-shut-wr} sends an
+alert containing a close request.
+
+This function may also return @code{gnutls-e-again}, or
address@hidden
address@hidden defun
+
+Specifying algorithm priorities:
+
address@hidden gnutls-protocol-set-priority proc &rest algs
+Sets the priority on the protocol versions supported by GNU TLS for process.
+
+The first parameter must be a process. Subsequent parameters should
+be integers. Priority is higher for protocols specified before
+others. Note that the priority is set on the client. The server does
+not use the protocols's priority except for disabling protocols that
+were not specified.
address@hidden defun
address@hidden gnutls-cipher-set-priority proc &rest algs
+Sets the priority on the bulk ciphers supported by GNU TLS for process.
+
+The first parameter must be a process. Subsequent parameters should
+be integers. Priority is higher for protocols specified before
+others. Note that the priority is set on the client. The server does
+not use the protocols's priority except for disabling protocols that
+were not specified.
address@hidden defun
address@hidden gnutls-compression-set-priority proc &rest algs
+Sets the priority on compression algorithms supported by GNU TLS for process.
+
+The first parameter must be a process. Subsequent parameters should
+be integers. Priority is higher for protocols specified before
+others. Note that the priority is set on the client. The server does
+not use the protocols's priority except for disabling protocols that
+were not specified.
address@hidden defun
address@hidden gnutls-kx-set-priority proc &rest algs
+Sets the priority on key exchange algorithms supported by GNU TLS for process.
+
+The first parameter must be a process. Subsequent parameters should
+be integers. Priority is higher for protocols specified before
+others. Note that the priority is set on the client. The server does
+not use the protocols's priority except for disabling protocols that
+were not specified.
address@hidden defun
address@hidden gnutls-mac-set-priority proc &rest algs
+Sets the priority on MAC algorithms supported by GNU TLS for process.
+
+The first parameter must be a process. Subsequent parameters should
+be integers. Priority is higher for protocols specified before
+others. Note that the priority is set on the client. The server does
+not use the protocols's priority except for disabling protocols that
+were not specified.
address@hidden defun
+
+Specifying authentication information for X.509:
+
address@hidden gnutls-x509pki-set-client-key-file proc certfile keyfile
+Set X.509 client credentials for process PROC.
+
+CERTFILE is a PEM encoded file containing the certificate list (path)
+for the specified private key. KEYFILE is a PEM encoded file
+containing a private key. Returns zero on success. @code{gnutls-cred-set}
+must be invoked with the @code{gnutls-x509pki} before this function is called.
+
+This function may be called more than once (in case multiple
+keys/certificates exist for the server).
+
+Currently only PKCS-1 PEM encoded RSA private keys are accepted by
+this function.
address@hidden defun
address@hidden gnutls-x509pki-set-client-trust-file proc cafile crlfile
+Set X.509 trusted credentials for process PROC.
+
+CAFILE is a PEM encoded file containing trusted CAs. CRLFILE is a PEM
+encoded file containing CRLs (ignored for now). Returns zero on
+success. @code{gnutls-cred-set} must be invoked with the @code{gnutls-x509pki}
+before this function is called.
address@hidden defun
+
+Specifying authentication information for SRP:
+
address@hidden gnutls-srp-set-client-cred-file proc username password
+Set SRP username and password for process process PROC.
+
+USERNAME is the user's userid. PASSWORD is the user's
+password. Returns zero on success. @code{gnutls-cred-set} must be invoked
+with the @code{gnutls-srp} before this function is called.
address@hidden defun
+
+Specifying authentication information for anonymous connections:
+
address@hidden gnutls-anon-set-client-cred-file proc dh_bits
+Set the number of bits to use in Diffie-Hellman key exchange for process PROC.
+
+DH_BITS is the number of bits in DH key exchange. Always returns nil.
address@hidden defun
+
+Specifying which authenticator to use:
+
address@hidden gnutls-cred-set proc type
+Enables GNU TLS authentication for process PROC.
+
+TYPE is an integer indicating the type of the credentials, either
address@hidden, @code{gnutls-srp} or @code{gnutls-x509pki}.
+
+Each authentication type may need additional information in order to
+work. For anonymous (@code{gnutls-anon}), see also
address@hidden For SRP (@code{gnutls-srp}), see
+also @code{gnutls-srp-set-client-cred}. For X.509 PKI
+(@code{gnutls-x509pki}), see also
address@hidden,
address@hidden
address@hidden defun
+
+Utility functions:
+
address@hidden gnutls-protocol-get-version proc
+Returns the version of the currently used protocol for process PROC.
address@hidden defun
address@hidden gnutls-cipher-get proc
+Returns the currently used cipher for process PROC.
address@hidden defun
address@hidden gnutls-kx-get proc
+Returns the key exchange used in the last handshake for process PROC.
address@hidden defun
address@hidden gnutls-mac-get proc
+Returns the currently used MAC algorithm for process PROC.
address@hidden defun
address@hidden gnutls-compression-get proc
+Returns the currently used compression algorithm for process PROC.
address@hidden defun
+
address@hidden gnutls-protocol-get-name version
+Returns a string that contains the name of protocol version VERSION.
address@hidden defun
address@hidden gnutls-cipher-get-name alg
+Returns a string that contains the name of cipher algorithm ALG.
address@hidden defun
address@hidden gnutls-mac-get-name alg
+Returns a string that contains the name of MAC algorithm ALG.
address@hidden defun
address@hidden gnutls-kx-get-name alg
+Returns a string that contains the name of key exchange algorithm ALG.
address@hidden defun
address@hidden gnutls-compression-get-name alg
+Returns a string that contains the name of compression method ALG.
@end defun
Index: man/gnus.texi
===================================================================
RCS file: /cvsroot/emacs/emacs/man/gnus.texi,v
retrieving revision 1.29
diff -u -r1.29 gnus.texi
--- man/gnus.texi 4 Nov 2001 12:46:54 -0000 1.29
+++ man/gnus.texi 3 Feb 2002 20:39:55 -0000
@@ -10705,9 +10705,10 @@
@findex nntp-open-ssl-stream
@item nntp-open-ssl-stream
-Opens a connection to a server over a @dfn{secure} channel. To use this
-you must have SSLay installed
-(@uref{ftp://ftp.psy.uq.oz.au/pub/Crypto/SSL}, and you also need
+Opens a connection to a server over a @dfn{secure} channel. To use
+this you must have a recent Emacs with builtin TLS support, or either
+one of OpenSSL (@uref{http://www.openssl.org}) or SSLeay
+(@uref{ftp://ftp.psy.uq.oz.au/pub/Crypto/SSL}) together with
@file{ssl.el} (from the W3 distribution, for instance). You then
define a server as follows:
@@ -13768,7 +13769,8 @@
usage explained in this section.
A server configuration in @code{~/.gnus} with a few @sc{imap} servers
-might look something like this:
+might look something like the following. (Note that for SSL/TLS, you
+may need external programs and libraries, see below.)
@lisp
(setq gnus-secondary-select-methods
@@ -13862,10 +13864,11 @@
@command{imtest} program.
@item
@dfn{starttls:} Connect via the STARTTLS extension (similar to
-SSL)@. Requires the library @file{starttls.el} and program
address@hidden
+SSL)@. Require an Emacs with TLS support or the external library
address@hidden and program @samp{starttls}.
@item
address@hidden:} Connect through address@hidden Requires OpenSSL (the
address@hidden:} Connect through address@hidden Requires a recent Emacs with TLS
+support, or the external library @samp{ssl.el} and OpenSSL (the
program @command{openssl}) or SSLeay (@command{s_client}).
@item
@dfn{shell:} Use a shell command to start an @sc{imap} connection.
@@ -13880,13 +13883,14 @@
@command{imtest} program.
@vindex imap-ssl-program
-For SSL connections, the OpenSSL program is available from
address@hidden://www.openssl.org/}. OpenSSL was formerly known as SSLeay,
-and nnimap supports it too. However, the most recent versions of
-SSLeay, 0.9.x, are known to have serious bugs making it
-useless. Earlier versions, especially 0.8.x, of SSLeay are known to
-work. The variable @code{imap-ssl-program} contains parameters to pass
-to OpenSSL/SSLeay.
+For SSL/TLS connections, using a recent Emacs with builtin GNU TLS
+support is recommended. However, using @samp{ssl.el} with OpenSSL
+(@uref{http://www.openssl.org/}) or SSLeay also works . OpenSSL was
+formerly known as SSLeay. However, the most recent series of SSLeay,
+0.9.x, is known to have serious bugs that makes it useless. Earlier
+versions, especially 0.8.x, of SSLeay are known to work. The variable
address@hidden contain parameters to pass to OpenSSL/SSLeay.
+You also need @samp{ssl.el} (from the W3 distribution, for instance).
@vindex imap-shell-program
@vindex imap-shell-host
Index: src/Makefile.in
===================================================================
RCS file: /cvsroot/emacs/emacs/src/Makefile.in,v
retrieving revision 1.244
diff -u -r1.244 Makefile.in
--- src/Makefile.in 22 Dec 2001 13:55:02 -0000 1.244
+++ src/Makefile.in 3 Feb 2002 20:39:55 -0000
@@ -45,6 +45,9 @@
# LIBS = @LIBS@
LIBOBJS = @LIBOBJS@
+LIBGNUTLS_LIBS = @LIBGNUTLS_LIBS@
+LIBGNUTLS_CFLAGS = @LIBGNUTLS_CFLAGS@
+
# On Xenix and the IBM RS6000, double-dot gets screwed up.
dot = .
dotdot = ${dot}${dot}
@@ -266,7 +269,7 @@
/* C_SWITCH_X_SITE must come before C_SWITCH_X_MACHINE and C_SWITCH_X_SYSTEM
since it may have -I options that should override those two. */
-ALL_CFLAGS=-Demacs -DHAVE_CONFIG_H $(TOOLKIT_DEFINES) $(MYCPPFLAG) -I.
-I${srcdir} C_SWITCH_MACHINE C_SWITCH_SYSTEM C_SWITCH_SITE C_SWITCH_X_SITE
C_SWITCH_X_MACHINE C_SWITCH_X_SYSTEM ${CFLAGS}
+ALL_CFLAGS=-Demacs -DHAVE_CONFIG_H $(TOOLKIT_DEFINES) $(MYCPPFLAG) -I.
-I${srcdir} C_SWITCH_MACHINE C_SWITCH_SYSTEM C_SWITCH_SITE C_SWITCH_X_SITE
C_SWITCH_X_MACHINE C_SWITCH_X_SYSTEM $(LIBGNUTLS_CFLAGS) ${CFLAGS}
.c.o:
$(CC) -c $(CPPFLAGS) $(ALL_CFLAGS) $<
@@ -409,6 +412,12 @@
#define LIBGIF
#endif /* not HAVE_GIF */
+#if HAVE_GNUTLS
+#define LIBGNUTLS $(LIBGNUTLS_LIBS)
+#else /* not HAVE_GNUTLS */
+#define LIBGNUTLS
+#endif /* not HAVE_GNUTLS */
+
#ifdef HAVE_X11
/* LD_SWITCH_X_DEFAULT comes after everything else that specifies
options for where to find X libraries, but before those libraries. */
@@ -822,7 +831,7 @@
LIBES = $(LOADLIBES) $(LIBS) $(LIBX) $(LIBSOUND) \
LIBS_SYSTEM LIBS_MACHINE LIBS_TERMCAP \
LIBS_DEBUG $(GETLOADAVG_LIBS) $(GNULIB_VAR) LIB_MATH LIB_STANDARD \
- $(GNULIB_VAR)
+ $(GNULIB_VAR) LIBGNUTLS
/* Enable recompilation of certain other files depending on system type. */
Index: src/alloc.c
===================================================================
RCS file: /cvsroot/emacs/emacs/src/alloc.c,v
retrieving revision 1.260
diff -u -r1.260 alloc.c
--- src/alloc.c 27 Jan 2002 22:53:26 -0000 1.260
+++ src/alloc.c 3 Feb 2002 20:39:56 -0000
@@ -4666,6 +4666,30 @@
XVECTOR (h->key_and_value)->size |= ARRAY_MARK_FLAG;
}
+#ifdef HAVE_GNUTLS
+ else if (GC_PROCESSP (obj))
+ {
+ register struct Lisp_Vector *ptr = XVECTOR (obj);
+ register struct Lisp_Process *proc = XPROCESS (obj);
+ register EMACS_INT size = proc->size;
+ register int i;
+
+ /* Stop if already marked. */
+ if (size & ARRAY_MARK_FLAG)
+ break;
+
+ /* Mark it. */
+ CHECK_LIVE (live_vector_p);
+ ptr->size |= ARRAY_MARK_FLAG;
+
+ /* There is no Lisp data below the member GNUTLS_STATE in
+ struct PROCESS. Stop marking when that slot is reached. */
+ for (i = 0;
+ (char *) &ptr->contents[i] < (char *) &proc->gnutls_state;
+ i++)
+ mark_object (&ptr->contents[i]);
+ }
+#endif
else
{
register struct Lisp_Vector *ptr = XVECTOR (obj);
Index: src/config.in
===================================================================
RCS file: /cvsroot/emacs/emacs/src/config.in,v
retrieving revision 1.167
diff -u -r1.167 config.in
--- src/config.in 28 Dec 2001 19:06:08 -0000 1.167
+++ src/config.in 3 Feb 2002 20:39:56 -0000
@@ -83,6 +83,9 @@
/* Define if we have the GIF library. */
#undef HAVE_GIF
+/* Define if we have the GNU TLS library. */
+#undef HAVE_GNUTLS
+
/* Define if libXaw3d is available. */
#undef HAVE_XAW3D
Index: src/process.c
===================================================================
RCS file: /cvsroot/emacs/emacs/src/process.c,v
retrieving revision 1.351
diff -u -r1.351 process.c
--- src/process.c 7 Jan 2002 21:16:38 -0000 1.351
+++ src/process.c 3 Feb 2002 20:39:57 -0000
@@ -1109,6 +1109,12 @@
XPROCESS (proc)->sentinel = Qnil;
XPROCESS (proc)->filter = Qnil;
XPROCESS (proc)->command = Flist (nargs - 2, args + 2);
+#ifdef HAVE_GNUTLS
+ XPROCESS (proc)->gnutls_state = NULL;
+ XPROCESS (proc)->x509_cred = NULL;
+ XPROCESS (proc)->anon_cred = NULL;
+ XPROCESS (proc)->srp_cred = NULL;
+#endif
/* Make the process marker point into the process buffer (if any). */
if (!NILP (buffer))
@@ -2079,6 +2085,12 @@
FD_SET (inch, &non_keyboard_wait_mask);
if (inch > max_process_desc)
max_process_desc = inch;
+#ifdef HAVE_GNUTLS
+ XPROCESS (proc)->gnutls_state = NULL;
+ XPROCESS (proc)->x509_cred = NULL;
+ XPROCESS (proc)->anon_cred = NULL;
+ XPROCESS (proc)->srp_cred = NULL;
+#endif
{
/* Setup coding systems for communicating with the network stream. */
@@ -2883,6 +2895,58 @@
return Qt;
}
+#ifdef HAVE_GNUTLS
+
+int
+emacs_gnutls_write (fildes, state, buf, nbyte)
+ int fildes;
+ GNUTLS_STATE state;
+ char *buf;
+ unsigned int nbyte;
+{
+ register int rtnval, bytes_written;
+
+ bytes_written = 0;
+
+ while (nbyte > 0)
+ {
+ rtnval = gnutls_write (state, buf, nbyte);
+
+ if (rtnval == -1)
+ {
+ if (errno == EINTR)
+ continue;
+ else
+ return (bytes_written ? bytes_written : -1);
+ }
+
+ buf += rtnval;
+ nbyte -= rtnval;
+ bytes_written += rtnval;
+ }
+ fsync (STDOUT_FILENO);
+
+ return bytes_written;
+}
+
+int
+emacs_gnutls_read (fildes, state, buf, nbyte)
+ int fildes;
+ GNUTLS_STATE state;
+ char *buf;
+ unsigned int nbyte;
+{
+ register int rtnval;
+
+ do {
+ rtnval = gnutls_read (state, buf, nbyte);
+ } while (rtnval == GNUTLS_E_INTERRUPTED || rtnval == GNUTLS_E_AGAIN);
+ fsync (STDOUT_FILENO);
+
+ return (rtnval);
+}
+#endif
+
/* Read pending output from the process channel,
starting with our buffered-ahead character if we have one.
Yield number of decoded characters read.
@@ -2944,12 +3008,24 @@
bcopy (XSTRING (p->decoding_buf)->data, chars, carryover);
if (proc_buffered_char[channel] < 0)
- nbytes = emacs_read (channel, chars + carryover, 1024 - carryover);
+#ifdef HAVE_GNUTLS
+ if (NETCONN_P (proc) && XPROCESS (proc)->gnutls_state)
+ nbytes = emacs_gnutls_read (channel, XPROCESS (proc)->gnutls_state,
+ chars + carryover, 1024 - carryover);
+ else
+#endif
+ nbytes = emacs_read (channel, chars + carryover, 1024 - carryover);
else
{
chars[carryover] = proc_buffered_char[channel];
proc_buffered_char[channel] = -1;
- nbytes = emacs_read (channel, chars + carryover + 1, 1023 - carryover);
+#ifdef HAVE_GNUTLS
+ if (NETCONN_P (proc) && XPROCESS (proc)->gnutls_state)
+ nbytes = emacs_gnutls_read (channel, XPROCESS (proc)->gnutls_state,
+ chars + carryover + 1, 1023 - carryover);
+ else
+#endif
+ nbytes = emacs_read (channel, chars + carryover + 1, 1023 - carryover);
if (nbytes < 0)
nbytes = 1;
else
@@ -3416,8 +3492,15 @@
while (this > 0)
{
old_sigpipe = (SIGTYPE (*) ()) signal (SIGPIPE,
send_process_trap);
- rv = emacs_write (XINT (XPROCESS (proc)->outfd),
- (char *) buf, this);
+#ifdef HAVE_GNUTLS
+ if (NETCONN_P (proc) && XPROCESS (proc)->gnutls_state)
+ rv = emacs_gnutls_write (XINT (XPROCESS (proc)->outfd),
+ XPROCESS (proc)->gnutls_state,
+ (char *) buf, this);
+ else
+#endif
+ rv = emacs_write (XINT (XPROCESS (proc)->outfd),
+ (char *) buf, this);
signal (SIGPIPE, old_sigpipe);
if (rv < 0)
@@ -4546,6 +4629,647 @@
XPROCESS (proc)->encode_coding_system);
}
+#ifdef HAVE_GNUTLS
+
+DEFUN ("gnutls-init", Fgnutls_init, Sgnutls_init, 2, 2, 0,
+ doc: /* Initializes process PROC for use as a TLS client.
+Processes must be initialized with this function before other GNU TLS
+functions are used. This function allocates resources which can only
+be deallocated by calling `gnutls-deinit'. Returns zero on success. */)
+ (proc)
+ Lisp_Object proc;
+{
+ Lisp_Object lret;
+ int ret;
+
+ CHECK_PROCESS (proc);
+
+ ret = gnutls_init(&XPROCESS (proc)->gnutls_state, GNUTLS_CLIENT);
+ lret = make_number (ret);
+
+ return lret;
+}
+
+DEFUN ("gnutls-deinit", Fgnutls_deinit, Sgnutls_deinit, 1, 1, 0,
+ doc: /* Deallocate GNU TLS resources associated with process PROC.
+See also `gnutls-init'. */)
+ (proc)
+ Lisp_Object proc;
+{
+ CHECK_PROCESS (proc);
+
+ if (XPROCESS (proc)->gnutls_state)
+ gnutls_deinit(XPROCESS (proc)->gnutls_state);
+ XPROCESS (proc)->gnutls_state = NULL;
+
+ if (XPROCESS (proc)->x509_cred)
+ gnutls_x509pki_free_client_sc (XPROCESS (proc)->x509_cred);
+ XPROCESS (proc)->x509_cred = NULL;
+
+ if (XPROCESS (proc)->srp_cred)
+ gnutls_srp_free_client_sc (XPROCESS (proc)->srp_cred);
+ XPROCESS (proc)->srp_cred = NULL;
+
+ if (XPROCESS (proc)->anon_cred)
+ gnutls_anon_free_client_sc (XPROCESS (proc)->anon_cred);
+ XPROCESS (proc)->anon_cred = NULL;
+
+ return Qnil;
+}
+
+Lisp_Object
+generic_set_priority (func, nargs, args)
+ int (*func)( GNUTLS_STATE state, GNUTLS_LIST);
+ int nargs;
+ Lisp_Object *args;
+{
+ Lisp_Object proc;
+ Lisp_Object lret;
+ int *algs;
+ size_t len;
+ int ret;
+ int i;
+
+ proc = args[0];
+ CHECK_PROCESS (proc);
+
+ for (i = 1; i < nargs; i++)
+ CHECK_NUMBER (args[i]);
+
+ len = nargs * sizeof(int);
+ algs = xmalloc (len);
+ for (i = 1; i < nargs; i++)
+ algs[i-1] = XFASTINT(args[i]);
+ algs[i-1] = 0;
+ ret = (*func) (XPROCESS (proc)->gnutls_state, algs);
+ xfree(algs);
+
+ lret = make_number (ret);
+ return lret;
+}
+
+DEFUN ("gnutls-protocol-set-priority", Fgnutls_protocol_set_priority,
+ Sgnutls_protocol_set_priority, 1, MANY, 0,
+ doc: /* Sets the priority on the protocol versions supported by GNU TLS
for process.
+The first parameter must be a process. Subsequent parameters should
+be integers. Priority is higher for protocols specified before
+others. Note that the priority is set on the client. The server does
+not use the protocols's priority except for disabling protocols that
+were not specified. */)
+ (nargs, args)
+ int nargs;
+ Lisp_Object *args;
+{
+ Lisp_Object ret;
+
+ ret = generic_set_priority (&gnutls_protocol_set_priority, nargs, args);
+
+ return ret;
+}
+
+DEFUN ("gnutls-cipher-set-priority", Fgnutls_cipher_set_priority,
+ Sgnutls_cipher_set_priority, 1, MANY, 0,
+ doc: /* Sets the priority on the bulk ciphers supported by GNU TLS for
process.
+The first parameter must be a process. Subsequent parameters should
+be integers. Priority is higher for protocols specified before
+others. Note that the priority is set on the client. The server does
+not use the protocols's priority except for disabling protocols that
+were not specified. */)
+ (nargs, args)
+ int nargs;
+ Lisp_Object *args;
+{
+ Lisp_Object ret;
+
+ ret = generic_set_priority (&gnutls_cipher_set_priority, nargs, args);
+
+ return ret;
+}
+
+DEFUN ("gnutls-compression-set-priority", Fgnutls_compression_set_priority,
+ Sgnutls_compression_set_priority, 1, MANY, 0,
+ doc: /* Sets the priority on compression algorithms supported by GNU
TLS for process.
+The first parameter must be a process. Subsequent parameters should
+be integers. Priority is higher for protocols specified before
+others. Note that the priority is set on the client. The server does
+not use the protocols's priority except for disabling protocols that
+were not specified. */)
+ (nargs, args)
+ int nargs;
+ Lisp_Object *args;
+{
+ Lisp_Object ret;
+
+ ret = generic_set_priority (&gnutls_compression_set_priority, nargs, args);
+
+ return ret;
+}
+
+DEFUN ("gnutls-kx-set-priority", Fgnutls_kx_set_priority,
+ Sgnutls_kx_set_priority, 1, MANY, 0,
+ doc: /* Sets the priority on key exchange algorithms supported by GNU
TLS for process.
+The first parameter must be a process. Subsequent parameters should
+be integers. Priority is higher for protocols specified before
+others. Note that the priority is set on the client. The server does
+not use the protocols's priority except for disabling protocols that
+were not specified. */)
+ (nargs, args)
+ int nargs;
+ Lisp_Object *args;
+{
+ Lisp_Object ret;
+
+ ret = generic_set_priority (&gnutls_kx_set_priority, nargs, args);
+
+ return ret;
+}
+
+DEFUN ("gnutls-mac-set-priority", Fgnutls_mac_set_priority,
+ Sgnutls_mac_set_priority, 1, MANY, 0,
+ doc: /* Sets the priority on MAC algorithms supported by GNU TLS for
process.
+The first parameter must be a process. Subsequent parameters should
+be integers. Priority is higher for protocols specified before
+others. Note that the priority is set on the client. The server does
+not use the protocols's priority except for disabling protocols that
+were not specified. */)
+ (nargs, args)
+ int nargs;
+ Lisp_Object *args;
+{
+ Lisp_Object ret;
+
+ ret = generic_set_priority (&gnutls_mac_set_priority, nargs, args);
+
+ return ret;
+}
+
+#define gnutls_cipher_get gnutls_cipher_get_algo
+#define gnutls_kx_get gnutls_kx_get_algo
+#define gnutls_mac_get gnutls_mac_get_algo
+#define gnutls_compression_get gnutls_compression_get_algo
+
+DEFUN ("gnutls-cipher-get", Fgnutls_cipher_get,
+ Sgnutls_cipher_get, 1, 1, 0,
+ doc: /* Returns the currently used cipher for process PROC. */)
+ (proc)
+ Lisp_Object proc;
+{
+ Lisp_Object ret;
+ GNUTLS_BulkCipherAlgorithm alg;
+
+ CHECK_PROCESS (proc);
+
+ alg = gnutls_cipher_get (XPROCESS (proc)->gnutls_state);
+ ret = make_number (alg);
+
+ return ret;
+}
+
+DEFUN ("gnutls-kx-get", Fgnutls_kx_get, Sgnutls_kx_get,
+ 1, 1, 0,
+ doc: /* Returns the key exchange used in the last handshake for process
PROC. */)
+ (proc)
+ Lisp_Object proc;
+{
+ Lisp_Object ret;
+ GNUTLS_KXAlgorithm alg;
+
+ CHECK_PROCESS (proc);
+
+ alg = gnutls_kx_get (XPROCESS (proc)->gnutls_state);
+ ret = make_number (alg);
+
+ return ret;
+}
+
+DEFUN ("gnutls-mac-get", Fgnutls_mac_get, Sgnutls_mac_get,
+ 1, 1, 0,
+ doc: /* Returns the currently used MAC algorithm for process PROC. */)
+ (proc)
+ Lisp_Object proc;
+{
+ Lisp_Object ret;
+ GNUTLS_MACAlgorithm alg;
+
+ CHECK_PROCESS (proc);
+
+ alg = gnutls_mac_get (XPROCESS (proc)->gnutls_state);
+ ret = make_number (alg);
+
+ return ret;
+}
+
+DEFUN ("gnutls-compression-get", Fgnutls_compression_get,
+ Sgnutls_compression_get, 1, 1, 0,
+ doc: /* Returns the currently used compression algorithm for process
PROC. */)
+ (proc)
+ Lisp_Object proc;
+{
+ Lisp_Object ret;
+ GNUTLS_CompressionMethod alg;
+
+ CHECK_PROCESS (proc);
+
+ alg = gnutls_compression_get (XPROCESS (proc)->gnutls_state);
+ ret = make_number (alg);
+
+ return ret;
+}
+
+DEFUN ("gnutls-protocol-get-version", Fgnutls_protocol_get_version,
+ Sgnutls_protocol_get_version, 1, 1, 0,
+ doc: /* Returns the version of the currently used protocol for process
PROC. */)
+ (proc)
+ Lisp_Object proc;
+{
+ Lisp_Object ret;
+ GNUTLS_Version version;
+
+ CHECK_PROCESS (proc);
+
+ version = gnutls_protocol_get_version (XPROCESS (proc)->gnutls_state);
+ ret = make_number (version);
+
+ return ret;
+}
+
+DEFUN ("gnutls-protocol-get-name", Fgnutls_protocol_get_name,
+ Sgnutls_protocol_get_name, 1, 1, 0,
+ doc: /* Returns a string that contains the name of protocol version
VERSION. */)
+ (version)
+ Lisp_Object version;
+{
+ Lisp_Object ret;
+ char *name;
+ GNUTLS_Version cversion;
+
+ CHECK_NUMBER (version);
+
+ cversion = XINT (version);
+ name = (char*) gnutls_protocol_get_name (cversion);
+
+ if (name)
+ ret = build_string (name);
+ else
+ ret = Qnil;
+
+ return ret;
+}
+
+DEFUN ("gnutls-cipher-get-name", Fgnutls_cipher_get_name,
+ Sgnutls_cipher_get_name, 1, 1, 0,
+ doc: /* Returns a string that contains the name of cipher algorithm
ALG. */)
+ (alg)
+ Lisp_Object alg;
+{
+ Lisp_Object ret;
+ char *name;
+ GNUTLS_BulkCipherAlgorithm calg;
+
+ CHECK_NUMBER (alg);
+
+ calg = XINT (alg);
+ name = (char*) gnutls_cipher_get_name (calg);
+
+ if (name)
+ ret = build_string (name);
+ else
+ ret = Qnil;
+
+ return ret;
+}
+
+DEFUN ("gnutls-mac-get-name", Fgnutls_mac_get_name, Sgnutls_mac_get_name,
+ 1, 1, 0,
+ doc: /* Returns a string that contains the name of MAC algorithm ALG.
*/)
+ (alg)
+ Lisp_Object alg;
+{
+ Lisp_Object ret;
+ char *name;
+ GNUTLS_MACAlgorithm calg;
+
+ CHECK_NUMBER (alg);
+
+ calg = XINT (alg);
+ name = (char*) gnutls_mac_get_name (calg);
+
+ if (name)
+ ret = build_string (name);
+ else
+ ret = Qnil;
+
+ return ret;
+}
+
+DEFUN ("gnutls-kx-get-name", Fgnutls_kx_get_name,
+ Sgnutls_kx_get_name, 1, 1, 0,
+ doc: /* Returns a string that contains the name of key exchange
algorithm ALG. */)
+ (alg)
+ Lisp_Object alg;
+{
+ Lisp_Object ret;
+ char *name;
+ GNUTLS_KXAlgorithm calg;
+
+ CHECK_NUMBER (alg);
+
+ calg = XINT (alg);
+ name = (char*) gnutls_kx_get_name (calg);
+
+ if (name)
+ ret = build_string (name);
+ else
+ ret = Qnil;
+
+ return ret;
+}
+
+DEFUN ("gnutls-compression-get-name", Fgnutls_compression_get_name,
+ Sgnutls_compression_get_name, 1, 1, 0,
+ doc: /* Returns a string that contains the name of compression method
ALG. */)
+ (alg)
+ Lisp_Object alg;
+{
+ Lisp_Object ret;
+ char *name;
+ GNUTLS_CompressionMethod calg;
+
+ CHECK_NUMBER (alg);
+
+ calg = XINT (alg);
+ name = (char*) gnutls_compression_get_name (calg);
+
+ if (name)
+ ret = build_string (name);
+ else
+ ret = Qnil;
+
+ return ret;
+}
+
+DEFUN ("gnutls-cred-set", Fgnutls_cred_set,
+ Sgnutls_cred_set, 2, 2, 0,
+ doc: /* Enables GNU TLS authentication for process PROC.
+TYPE is an integer indicating the type of the credentials, either
+`gnutls-anon', `gnutls-srp' or `gnutls-x509pki'.
+
+Each authentication type may need additional information in order to
+work. For anonymous (`gnutls-anon'), see also
+`gnutls-anon-set-client-cred'. For SRP (`gnutls-srp'), see also
+`gnutls-srp-set-client-cred'. For X.509 PKI (`gnutls-x509pki'), see
+also `gnutls-x509pki-set-client-trust-file',
+`gnutls-x509pki-set-client-key-file'. */)
+ (proc, type)
+ Lisp_Object proc, type;
+{
+ int ret;
+
+ CHECK_PROCESS (proc);
+
+#define GNUTLS_CRD_CERTIFICATE GNUTLS_X509PKI
+#define GNUTLS_CRD_ANON GNUTLS_ANON
+#define GNUTLS_CRD_SRP GNUTLS_SRP
+
+ switch (XINT (type))
+ {
+ case GNUTLS_CRD_CERTIFICATE:
+ if (gnutls_x509pki_allocate_client_sc (&XPROCESS (proc)->x509_cred, 1) <
0)
+ memory_full ();
+ ret = gnutls_cred_set (XPROCESS (proc)->gnutls_state,
+ GNUTLS_CRD_CERTIFICATE,
+ XPROCESS (proc)->x509_cred);
+ break;
+
+ case GNUTLS_CRD_ANON:
+ if (gnutls_anon_allocate_client_sc (&XPROCESS (proc)->anon_cred) < 0)
+ memory_full ();
+ ret = gnutls_cred_set (XPROCESS (proc)->gnutls_state,
+ GNUTLS_CRD_ANON,
+ XPROCESS (proc)->anon_cred);
+ break;
+
+ case GNUTLS_CRD_SRP:
+ if (gnutls_srp_allocate_client_sc (&XPROCESS (proc)->srp_cred) < 0)
+ memory_full ();
+ ret = gnutls_cred_set (XPROCESS (proc)->gnutls_state,
+ GNUTLS_CRD_SRP,
+ XPROCESS (proc)->srp_cred);
+ break;
+ }
+
+ return XINT (ret);
+}
+
+DEFUN ("gnutls-x509pki-set-client-key-file",
+ Fgnutls_x509pki_set_client_key_file,
+ Sgnutls_x509pki_set_client_key_file, 3, 3, 0,
+ doc: /* Set X.509 client credentials for process PROC.
+
+CERTFILE is a PEM encoded file containing the certificate list (path)
+for the specified private key. KEYFILE is a PEM encoded file
+containing a private key. Returns zero on success. `gnutls-cred-set'
+must be invoked with the `gnutls-x509pki' before this function is called.
+
+This function may be called more than once (in case multiple
+keys/certificates exist for the server).
+
+Currently only PKCS-1 PEM encoded RSA private keys are accepted by
+this function. */)
+ (proc, certfile, keyfile)
+ Lisp_Object proc;
+ Lisp_Object certfile;
+ Lisp_Object keyfile;
+{
+ Lisp_Object lret;
+ int ret;
+
+ CHECK_STRING (certfile);
+ CHECK_STRING (keyfile);
+ CHECK_PROCESS (proc);
+
+ ret = gnutls_x509pki_set_client_key_file (XPROCESS (proc)->x509_cred,
+ XSTRING (certfile)->data,
+ XSTRING (keyfile)->data);
+
+ lret = make_number (ret);
+ return lret;
+}
+
+DEFUN ("gnutls-x509pki-set-client-trust-file",
+ Fgnutls_x509pki_set_client_trust_file,
+ Sgnutls_x509pki_set_client_trust_file, 3, 3, 0,
+ doc: /* Set X.509 trusted credentials for process PROC.
+CAFILE is a PEM encoded file containing trusted CAs. CRLFILE is a PEM
+encoded file containing CRLs (ignored for now). Returns zero on
+success. `gnutls-cred-set' must be invoked with the `gnutls-x509pki'
+before this function is called. */)
+ (proc, cafile, crlfile)
+ Lisp_Object proc;
+ Lisp_Object cafile;
+ Lisp_Object crlfile;
+{
+ Lisp_Object lret;
+ int ret;
+
+ if (!NILP (cafile))
+ CHECK_STRING (cafile);
+ if (!NILP (crlfile))
+ CHECK_STRING (crlfile);
+ CHECK_PROCESS (proc);
+
+ ret = gnutls_x509pki_set_client_trust_file (XPROCESS (proc)->x509_cred,
+ NILP (cafile) ? NULL :
+ XSTRING (cafile)->data,
+ NILP (crlfile) ? NULL :
+ XSTRING (crlfile)->data);
+
+ lret = make_number (ret);
+ return lret;
+}
+
+DEFUN ("gnutls-srp-set-client-cred", Fgnutls_srp_set_client_cred,
+ Sgnutls_srp_set_client_cred, 3, 3, 0,
+ doc: /* Set SRP username and password for process PROC.
+USERNAME is the user's userid. PASSWORD is the user's
+password. Returns zero on success. `gnutls-cred-set' must be invoked
+with the `gnutls-srp' before this function is called. */)
+ (proc, username, password)
+ Lisp_Object proc;
+ Lisp_Object username;
+ Lisp_Object password;
+{
+ Lisp_Object lret;
+ int ret;
+
+ if (!NILP (username))
+ CHECK_STRING (username);
+ if (!NILP (password))
+ CHECK_STRING (password);
+ CHECK_PROCESS (proc);
+
+ ret = gnutls_srp_set_client_cred (XPROCESS (proc)->srp_cred,
+ NILP (username) ? NULL :
+ XSTRING(username)->data,
+ NILP (password) ? NULL :
+ XSTRING(password)->data);
+
+ lret = make_number (ret);
+ return lret;
+}
+
+#define gnutls_dh_set_bits gnutls_x509pki_set_dh_bits
+
+DEFUN ("gnutls-dh-set-bits", Fgnutls_dh_set_bits, Sgnutls_dh_set_bits,
+ 2, 2, 0,
+ doc: /* Set the number of bits to use in Diffie-Hellman key exchange
for process PROC.
+
+DH_BITS is the number of bits in DH key exchange. Always returns nil. */)
+ (proc, dh_bits)
+ Lisp_Object proc;
+ Lisp_Object dh_bits;
+{
+ CHECK_PROCESS (proc);
+
+ gnutls_dh_set_bits (XPROCESS (proc)->gnutls_state, XINT (dh_bits));
+
+ return Qnil;
+}
+
+DEFUN ("gnutls-bye", Fgnutls_bye,
+ Sgnutls_bye, 2, 2, 0,
+ doc: /* Terminate current GNU TLS connection for process PROC.
+The connection should have been initiated using `gnutls-handshake'.
+HOW should be one of `gnutls-shut-rdwr', `gnutls-shut-wr'.
+
+In case of `gnutls-shut-rdwr' then the TLS connection gets terminated
+and further receives and sends will be disallowed. If the return value
+is zero you may continue using the connection. `gnutls-shut-rdwr'
+actually sends an alert containing a close request and waits for the
+peer to reply with the same message.
+
+In case of `gnutls-shut-wr' then the TLS connection gets terminated
+and further sends will be disallowed. In order to reuse the connection
+you should wait for an EOF from the peer. `gnutls-shut-wr' sends an
+alert containing a close request.
+
+This function may also return `gnutls-e-again', or
+`gnutls-e-interrupted'. */)
+ (proc, how)
+ Lisp_Object proc, how;
+{
+ Lisp_Object lret;
+ int ret;
+
+ CHECK_PROCESS (proc);
+ CHECK_NUMBER (how);
+
+ ret = gnutls_bye(XPROCESS (proc)->gnutls_state, XFASTINT(how));
+ ret = make_number (lret);
+
+ return lret;
+}
+
+DEFUN ("gnutls-handshake", Fgnutls_handshake,
+ Sgnutls_handshake, 1, 1, 0,
+ doc: /* Perform GNU TLS handshake for process PROC.
+The identity of the peer is checked automatically. This function will
+fail if any problem is encountered, and will return a negative error
+code. In case of a client, if it has been asked to resume a session,
+but the server didn't, then a full handshake will be performed.
+
+This function may also return the non-fatal errors `gnutls-e-again',
+or `gnutls-e-interrupted'. In that case you may resume the handshake
+\(by calling this function again). */)
+ (proc)
+ Lisp_Object proc;
+{
+ Lisp_Object lret;
+ int ret;
+
+ CHECK_PROCESS (proc);
+
+ gnutls_transport_set_ptr (XPROCESS (proc)->gnutls_state,
+ XPROCESS (proc)->infd);
+ ret = gnutls_handshake (XPROCESS (proc)->gnutls_state);
+ lret = make_number (ret);
+
+ return lret;
+}
+
+DEFUN ("gnutls-rehandshake", Fgnutls_rehandshake,
+ Sgnutls_rehandshake, 1, 1, 0,
+ doc: /* Renegotiate GNU TLS security parameters for process PROC.
+This function will renegotiate security parameters with the
+client. This should only be called in case of a server.
+
+This message informs the peer that we want to renegotiate parameters
+\(perform a handshake).
+
+If this function succeeds (returns 0), you must call the
+`gnutls-handshake' function in order to negotiate the new parameters.
+
+If the client does not wish to renegotiate parameters he will reply
+with an alert message, thus the return code will be
+`gnutls-e-warning-alert-received' and the alert will be
+`gnutls-e-no-renegotiation'. */)
+ (proc)
+ Lisp_Object proc;
+{
+ Lisp_Object lret;
+ int ret;
+
+ CHECK_PROCESS (proc);
+
+ gnutls_transport_set_ptr (XPROCESS (proc)->gnutls_state,
+ XPROCESS (proc)->infd);
+ ret = gnutls_rehandshake (XPROCESS (proc)->gnutls_state);
+ lret = make_number (ret);
+
+ return lret;
+}
+#endif
+
/* The first time this is called, assume keyboard input comes from DESC
instead of from where we used to expect it.
Subsequent calls mean assume input keyboard can come from DESC
@@ -4629,6 +5353,10 @@
}
bzero (proc_decode_coding_system, sizeof proc_decode_coding_system);
bzero (proc_encode_coding_system, sizeof proc_encode_coding_system);
+
+#ifdef HAVE_GNUTLS
+ gnutls_global_init();
+#endif
}
void
@@ -4716,6 +5444,33 @@
/* defsubr (&Sprocess_connection); */
defsubr (&Sset_process_coding_system);
defsubr (&Sprocess_coding_system);
+#ifdef HAVE_GNUTLS
+ defsubr (&Sgnutls_init);
+ defsubr (&Sgnutls_deinit);
+ defsubr (&Sgnutls_protocol_set_priority);
+ defsubr (&Sgnutls_cipher_set_priority);
+ defsubr (&Sgnutls_compression_set_priority);
+ defsubr (&Sgnutls_kx_set_priority);
+ defsubr (&Sgnutls_mac_set_priority);
+ defsubr (&Sgnutls_cred_set);
+ defsubr (&Sgnutls_handshake);
+ defsubr (&Sgnutls_rehandshake);
+ defsubr (&Sgnutls_x509pki_set_client_key_file);
+ defsubr (&Sgnutls_x509pki_set_client_trust_file);
+ defsubr (&Sgnutls_srp_set_client_cred);
+ defsubr (&Sgnutls_dh_set_bits);
+ defsubr (&Sgnutls_bye);
+ defsubr (&Sgnutls_cipher_get);
+ defsubr (&Sgnutls_kx_get);
+ defsubr (&Sgnutls_mac_get);
+ defsubr (&Sgnutls_compression_get);
+ defsubr (&Sgnutls_protocol_get_version);
+ defsubr (&Sgnutls_protocol_get_name);
+ defsubr (&Sgnutls_cipher_get_name);
+ defsubr (&Sgnutls_mac_get_name);
+ defsubr (&Sgnutls_kx_get_name);
+ defsubr (&Sgnutls_compression_get_name);
+#endif
}
Index: src/process.h
===================================================================
RCS file: /cvsroot/emacs/emacs/src/process.h,v
retrieving revision 1.18
diff -u -r1.18 process.h
--- src/process.h 14 Oct 2001 20:14:49 -0000 1.18
+++ src/process.h 3 Feb 2002 20:39:57 -0000
@@ -19,6 +19,10 @@
Boston, MA 02111-1307, USA. */
+#ifdef HAVE_GNUTLS
+#include <gnutls.h>
+#endif
+
/* This structure records information about a subprocess
or network connection.
@@ -91,6 +95,15 @@
/* Flag to set coding-system of the process buffer from the
coding_system used to decode process output. */
Lisp_Object inherit_coding_system_flag;
+ /* No Lisp data may follow below this point without changing
+ mark_object in alloc.c. The member gnutls_state must be the
+ first non-Lisp member. */
+#ifdef HAVE_GNUTLS
+ GNUTLS_STATE gnutls_state;
+ GNUTLS_X509PKI_CLIENT_CREDENTIALS x509_cred;
+ GNUTLS_ANON_CLIENT_CREDENTIALS anon_cred;
+ GNUTLS_SRP_CLIENT_CREDENTIALS srp_cred;
+#endif
};
/* Every field in the preceding structure except for the first two
- Another update of GNU TLS bindings,
Simon Josefsson <=
- Re: Another update of GNU TLS bindings, Eli Zaretskii, 2002/02/04
- Re: Another update of GNU TLS bindings, Simon Josefsson, 2002/02/04
- Re: Another update of GNU TLS bindings, Richard Stallman, 2002/02/07
- Re: Another update of GNU TLS bindings, Simon Josefsson, 2002/02/07
- Re: Another update of GNU TLS bindings, Richard Stallman, 2002/02/08
- Re: Another update of GNU TLS bindings, Simon Josefsson, 2002/02/09
- Re: Another update of GNU TLS bindings, Richard Stallman, 2002/02/10
- Re: Another update of GNU TLS bindings, Florian Weimer, 2002/02/13