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:
parent
eb597d4095
commit
894e21df1e
8 changed files with 114 additions and 82 deletions
|
@ -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
|
||||
|
|
|
@ -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")
|
||||
|
|
|
@ -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."
|
||||
|
|
|
@ -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))
|
||||
|
|
15
src/eval.c
15
src/eval.c
|
@ -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));
|
||||
}
|
||||
|
||||
|
||||
|
|
|
@ -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);
|
||||
}
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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).
|
||||
|
|
Loading…
Add table
Reference in a new issue