Doc fixes and refactorings based on comments from Eli Zaretskii

* doc/lispref/processes.texi (Network Processes): Clarify the
meaning of :tls-parameters.

* lisp/net/gnutls.el (open-gnutls-stream): Clarify :nowait.

* lisp/net/gnutls.el (gnutls-boot-parameters): Factor out into
own function.
(gnutls-negotiate): Use it.
(open-gnutls-stream): Ditto.

* src/eval.c (vformat_string): Refactor out the printing bits
from verror.
(verror): Use it.

* src/gnutls.c (boot_error): Mark failed processes with the
real error message.

* src/lisp.h: Declare vformat_string.
This commit is contained in:
Lars Ingebrigtsen 2016-02-03 12:43:24 +11:00
parent eb597d4095
commit 894e21df1e
8 changed files with 114 additions and 82 deletions

View file

@ -2420,9 +2420,12 @@ has succeeded or failed.
@item :tls-parameters
When opening a TLS connection, this should be where the first element
is the TLS type, and the remaining elements should form a keyword list
acceptable for @code{gnutls-boot}. The TLS connection will then be
negotiated after completing the connection to the host.
is the TLS type (which should either be @code{gnutls-x509pki} or
@code{gnutls-anon}, and the remaining elements should form a keyword
list acceptable for @code{gnutls-boot}. (This keyword list can be
optained from the @code{gnutls-boot-parameters} function.) The TLS
connection will then be negotiated after completing the connection to
the host.
@item :stop @var{stopped}
If @var{stopped} is non-@code{nil}, start the network connection or

View file

@ -181,6 +181,10 @@ syntax are the same as those given to @code{open-network-stream}
Manual}). The connection process is called @var{name} (made unique if
necessary). This function returns the connection process.
The @var{nowait} parameter means that the scoket should be
asynchronous, and the connection process will be returned to the
caller before TLS negotiation has happened.
@lisp
;; open a HTTPS connection
(open-gnutls-stream "tls" "tls-buffer" "yourserver.com" "https")

View file

@ -110,7 +110,8 @@ 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.
Fifth arg NOWAIT (which is optional) means that the socket should
be opened asynchronously.
be opened asynchronously. The connection process will be
returned to the caller before TLS negotiation has happened.
Usage example:
@ -129,12 +130,13 @@ trust and key files, and priority string."
:nowait nowait
:tls-parameters
(and nowait
(gnutls-negotiate :type 'gnutls-x509pki
:return-keywords t
:hostname host)))))
(cons 'gnutls-x509pki
(gnutls-boot-parameters
:type 'gnutls-x509pki
:hostname host))))))
(if nowait
process
(gnutls-negotiate :process (open-network-stream name buffer host service)
(gnutls-negotiate :process process
:type 'gnutls-x509pki
:hostname host))))
@ -149,14 +151,48 @@ trust and key files, and priority string."
&key process type hostname priority-string
trustfiles crlfiles keylist min-prime-bits
verify-flags verify-error verify-hostname-error
return-keywords
&allow-other-keys)
"Negotiate a SSL/TLS connection. Returns proc. Signals gnutls-error.
Note arguments are passed CL style, :type TYPE instead of just TYPE.
Note that arguments are passed CL style, :type TYPE instead of just TYPE.
PROCESS is a process returned by `open-network-stream'.
For the meaning of the rest of the parameters, see `gnutls-boot-parameters'."
(let* ((type (or type 'gnutls-x509pki))
;; The gnutls library doesn't understand files delivered via
;; the special handlers, so ignore all files found via those.
(file-name-handler-alist nil)
(params (gnutls-boot-parameters
:type type
:hostname hostname
:priority-string priority-string
:trustfiles trustfiles
:crlfiles crlfiles
:keylist keylist
:min-prime-bits min-prime-bits
:verify-flags verify-flags
:verify-error verify-error
:verify-hostname-error verify-hostname-error))
ret)
(gnutls-message-maybe
(setq ret (gnutls-boot process type params))
"boot: %s" params)
(when (gnutls-errorp ret)
;; This is a error from the underlying C code.
(signal 'gnutls-error (list process ret)))
process))
(cl-defun gnutls-boot-parameters
(&rest spec
&key type hostname priority-string
trustfiles crlfiles keylist min-prime-bits
verify-flags verify-error verify-hostname-error
&allow-other-keys)
"Return a keyword list of parameters suitable for passing to `gnutls-boot'.
TYPE is `gnutls-x509pki' (default) or `gnutls-anon'. Use nil for the default.
PROCESS 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. It defaults to `gnutls-trustfiles'.
@ -201,71 +237,48 @@ here's a recent version of the list.
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.
If RETURN-KEYWORDS, don't connect to anything, but just return
the computed parameters that we otherwise would be calling
gnutls-boot with. The return value will be a list where the
first element is the TLS type, and the rest of the list consists
of the keywords."
(let* ((type (or type 'gnutls-x509pki))
;; The gnutls library doesn't understand files delivered via
;; the special handlers, so ignore all files found via those.
(file-name-handler-alist nil)
(trustfiles (or trustfiles (gnutls-trustfiles)))
(priority-string (or priority-string
(cond
((eq type 'gnutls-anon)
"NORMAL:+ANON-DH:!ARCFOUR-128")
((eq type 'gnutls-x509pki)
(if gnutls-algorithm-priority
(upcase gnutls-algorithm-priority)
"NORMAL")))))
(verify-error (or verify-error
;; this uses the value of `gnutls-verify-error'
(cond
;; if t, pass it on
((eq gnutls-verify-error t)
t)
;; if a list, look for hostname matches
((listp gnutls-verify-error)
(apply 'append
(mapcar
(lambda (check)
(when (string-match (nth 0 check)
hostname)
(nth 1 check)))
gnutls-verify-error)))
;; else it's nil
(t nil))))
(min-prime-bits (or min-prime-bits gnutls-min-prime-bits))
params ret)
defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT."
(let ((trustfiles (or trustfiles (gnutls-trustfiles)))
(priority-string (or priority-string
(cond
((eq type 'gnutls-anon)
"NORMAL:+ANON-DH:!ARCFOUR-128")
((eq type 'gnutls-x509pki)
(if gnutls-algorithm-priority
(upcase gnutls-algorithm-priority)
"NORMAL")))))
(verify-error (or verify-error
;; this uses the value of `gnutls-verify-error'
(cond
;; if t, pass it on
((eq gnutls-verify-error t)
t)
;; if a list, look for hostname matches
((listp gnutls-verify-error)
(apply 'append
(mapcar
(lambda (check)
(when (string-match (nth 0 check)
hostname)
(nth 1 check)))
gnutls-verify-error)))
;; else it's nil
(t nil))))
(min-prime-bits (or min-prime-bits gnutls-min-prime-bits)))
(when verify-hostname-error
(push :hostname verify-error))
(setq params `(:priority ,priority-string
:hostname ,hostname
:loglevel ,gnutls-log-level
:min-prime-bits ,min-prime-bits
:trustfiles ,trustfiles
:crlfiles ,crlfiles
:keylist ,keylist
:verify-flags ,verify-flags
:verify-error ,verify-error
:callbacks nil))
(if return-keywords
(cons type params)
(gnutls-message-maybe
(setq ret (gnutls-boot process type params))
"boot: %s" params)
(when (gnutls-errorp ret)
;; This is a error from the underlying C code.
(signal 'gnutls-error (list process ret)))
process)))
`(:priority ,priority-string
:hostname ,hostname
:loglevel ,gnutls-log-level
:min-prime-bits ,min-prime-bits
:trustfiles ,trustfiles
:crlfiles ,crlfiles
:keylist ,keylist
:verify-flags ,verify-flags
:verify-error ,verify-error
:callbacks nil)))
(defun gnutls-trustfiles ()
"Return a list of usable trustfiles."

View file

@ -140,9 +140,10 @@ a greeting from the server.
asynchronously, if possible.
:tls-parameters is a list that should be supplied if you're
opening a TLS connection. The first element is the TLS type, and
the remaining elements should be a keyword list accepted by
gnutls-boot."
opening a TLS connection. The first element is the TLS
type (either `gnutls-x509pki' or `gnutls-anon'), and the
remaining elements should be a keyword list accepted by
gnutls-boot (as returned by `gnutls-boot-parameters')."
(unless (featurep 'make-network-process)
(error "Emacs was compiled without networking support"))
(let ((type (plist-get parameters :type))

View file

@ -1751,9 +1751,9 @@ find_handler_clause (Lisp_Object handlers, Lisp_Object conditions)
}
/* Dump an error message; called like vprintf. */
void
verror (const char *m, va_list ap)
/* Format and return a string; called like vprintf. */
Lisp_Object
vformat_string (const char *m, va_list ap)
{
char buf[4000];
ptrdiff_t size = sizeof buf;
@ -1767,7 +1767,14 @@ verror (const char *m, va_list ap)
if (buffer != buf)
xfree (buffer);
xsignal1 (Qerror, string);
return string;
}
/* Dump an error message; called like vprintf. */
void
verror (const char *m, va_list ap)
{
xsignal1 (Qerror, vformat_string (m, ap));
}

View file

@ -1174,7 +1174,7 @@ boot_error (struct Lisp_Process *p, const char *m, ...)
va_list ap;
va_start (ap, m);
if (p->is_non_blocking_client)
pset_status (p, Qfailed);
pset_status (p, list2 (Qfailed, vformat_string (m, ap)));
else
verror (m, ap);
}

View file

@ -3908,6 +3908,8 @@ extern Lisp_Object unbind_to (ptrdiff_t, Lisp_Object);
extern _Noreturn void error (const char *, ...) ATTRIBUTE_FORMAT_PRINTF (1, 2);
extern _Noreturn void verror (const char *, va_list)
ATTRIBUTE_FORMAT_PRINTF (1, 0);
extern Lisp_Object vformat_string (const char *, va_list)
ATTRIBUTE_FORMAT_PRINTF (1, 0);
extern void un_autoload (Lisp_Object);
extern Lisp_Object call_debugger (Lisp_Object arg);
extern void *near_C_stack_top (void);

View file

@ -3454,8 +3454,10 @@ and MESSAGE is a string.
:plist PLIST -- Install PLIST as the new process's initial plist.
:tls-parameters LIST -- is a list that should be supplied if you're
opening a TLS connection. The first element is the TLS type, and the
remaining elements should be a keyword list accepted by gnutls-boot.
opening a TLS connection. The first element is the TLS type (either
`gnutls-x509pki' or `gnutls-anon'), and the remaining elements should
be a keyword list accepted by gnutls-boot (as returned by
`gnutls-boot-parameters').
:server QLEN -- if QLEN is non-nil, create a server process for the
specified FAMILY, SERVICE, and connection type (stream or datagram).