1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-06 06:20:55 -08:00

Use CL-style keyword arguments for `gnutls-negotiate' and allow :keylist and :crlfiles arguments.

* lisp/net/gnutls.el (gnutls-negotiate): Use CL-style keyword arguments
instead of positional arguments.  Allow :keylist and :crlfiles
arguments.
(open-gnutls-stream): Call it.

* lisp/net/network-stream.el (network-stream-open-starttls): Adjust to
call `gnutls-negotiate' with :process and :hostname arguments.
This commit is contained in:
Ted Zlatanov 2011-05-03 20:44:58 -05:00
parent ef80fc093a
commit 48e79d6a80
3 changed files with 34 additions and 16 deletions

View file

@ -1,3 +1,13 @@
2011-05-04 Teodor Zlatanov <tzz@lifelogs.com>
* net/gnutls.el (gnutls-negotiate): Use CL-style keyword arguments
instead of positional arguments. Allow :keylist and :crlfiles
arguments.
(open-gnutls-stream): Call it.
* net/network-stream.el (network-stream-open-starttls): Adjust to
call `gnutls-negotiate' with :process and :hostname arguments.
2011-05-04 Stefan Monnier <monnier@iro.umontreal.ca> 2011-05-04 Stefan Monnier <monnier@iro.umontreal.ca>
* minibuffer.el (completion--message): New function. * minibuffer.el (completion--message): New function.

View file

@ -35,6 +35,8 @@
;;; Code: ;;; Code:
(eval-when-compile (require 'cl))
(defgroup gnutls nil (defgroup gnutls nil
"Emacs interface to the GnuTLS library." "Emacs interface to the GnuTLS library."
:prefix "gnutls-" :prefix "gnutls-"
@ -72,9 +74,9 @@ This is a very simple wrapper around `gnutls-negotiate'. See its
documentation for the specific parameters you can use to open a documentation for the specific parameters you can use to open a
GnuTLS connection, including specifying the credential type, GnuTLS connection, including specifying the credential type,
trust and key files, and priority string." trust and key files, and priority string."
(gnutls-negotiate (open-network-stream name buffer host service) (gnutls-negotiate :process (open-network-stream name buffer host service)
'gnutls-x509pki :type 'gnutls-x509pki
host)) :hostname host))
(put 'gnutls-error (put 'gnutls-error
'error-conditions 'error-conditions
@ -85,16 +87,23 @@ trust and key files, and priority string."
(declare-function gnutls-boot "gnutls.c" (proc type proplist)) (declare-function gnutls-boot "gnutls.c" (proc type proplist))
(declare-function gnutls-errorp "gnutls.c" (error)) (declare-function gnutls-errorp "gnutls.c" (error))
(defun gnutls-negotiate (proc type hostname &optional priority-string (defun* gnutls-negotiate
trustfiles keyfiles verify-flags (&rest spec
verify-error verify-hostname-error) &key process type hostname priority-string
trustfiles crlfiles keylist verify-flags
verify-error verify-hostname-error
&allow-other-keys)
"Negotiate a SSL/TLS connection. Returns proc. Signals gnutls-error. "Negotiate a SSL/TLS connection. Returns proc. Signals gnutls-error.
Note arguments are passed CL style, :type TYPE instead of just TYPE.
TYPE is `gnutls-x509pki' (default) or `gnutls-anon'. Use nil for the default. TYPE is `gnutls-x509pki' (default) or `gnutls-anon'. Use nil for the default.
PROC is a process returned by `open-network-stream'. PROCESS is a process returned by `open-network-stream'.
HOSTNAME is the remote hostname. It must be a valid string. HOSTNAME is the remote hostname. It must be a valid string.
PRIORITY-STRING is as per the GnuTLS docs, default is \"NORMAL\". PRIORITY-STRING is as per the GnuTLS docs, default is \"NORMAL\".
TRUSTFILES is a list of CA bundles. TRUSTFILES is a list of CA bundles.
KEYFILES is a list of client keys. CRLFILES is a list of CRL files.
KEYLIST is an alist of (client key file, client cert file) pairs.
When VERIFY-HOSTNAME-ERROR is not nil, an error will be raised When VERIFY-HOSTNAME-ERROR is not nil, an error will be raised
when the hostname does not match the presented certificate's host when the hostname does not match the presented certificate's host
@ -141,7 +150,8 @@ defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT."
:hostname ,hostname :hostname ,hostname
:loglevel ,gnutls-log-level :loglevel ,gnutls-log-level
:trustfiles ,trustfiles :trustfiles ,trustfiles
:keyfiles ,keyfiles :crlfiles ,crlfiles
:keylist ,keylist
:verify-flags ,verify-flags :verify-flags ,verify-flags
:verify-error ,verify-error :verify-error ,verify-error
:verify-hostname-error ,verify-hostname-error :verify-hostname-error ,verify-hostname-error
@ -149,14 +159,14 @@ defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT."
ret) ret)
(gnutls-message-maybe (gnutls-message-maybe
(setq ret (gnutls-boot proc type params)) (setq ret (gnutls-boot process type params))
"boot: %s" params) "boot: %s" params)
(when (gnutls-errorp ret) (when (gnutls-errorp ret)
;; This is a error from the underlying C code. ;; This is a error from the underlying C code.
(signal 'gnutls-error (list proc ret))) (signal 'gnutls-error (list process ret)))
proc)) process))
(declare-function gnutls-error-string "gnutls.c" (error)) (declare-function gnutls-error-string "gnutls.c" (error))

View file

@ -45,9 +45,7 @@
(require 'tls) (require 'tls)
(require 'starttls) (require 'starttls)
(declare-function gnutls-negotiate "gnutls" (declare-function gnutls-negotiate "gnutls" (&rest spec))
(proc type host &optional priority-string trustfiles keyfiles
verify-flags verify-error verify-hostname-error))
;;;###autoload ;;;###autoload
(defun open-network-stream (name buffer host service &rest parameters) (defun open-network-stream (name buffer host service &rest parameters)
@ -203,7 +201,7 @@ asynchronously, if possible."
(network-stream-command stream starttls-command eoc)) (network-stream-command stream starttls-command eoc))
;; The server said it was OK to begin STARTTLS negotiations. ;; The server said it was OK to begin STARTTLS negotiations.
(if (fboundp 'open-gnutls-stream) (if (fboundp 'open-gnutls-stream)
(gnutls-negotiate stream nil host) (gnutls-negotiate :process stream :hostname host)
(unless (starttls-negotiate stream) (unless (starttls-negotiate stream)
(delete-process stream))) (delete-process stream)))
(if (memq (process-status stream) '(open run)) (if (memq (process-status stream) '(open run))