Allow open-network-stream to use different TLS capability commands
* doc/lispref/processes.texi (Network): Document non-string capability command. * lisp/gnus/nntp.el (nntp-open-connection): Use HELP for Typhoon and CAPABILITIES for everything else (bug#41960). * lisp/net/network-stream.el (open-network-stream): Document function variety of :capability-command. (network-stream-open-starttls): Use it. (network-stream-open-tls): Ditto. (network-stream-open-shell): Ditto. (network-stream--capability-command): New helper function.
This commit is contained in:
Lars Ingebrigtsen
parent
42b33405c2
commit
17f646128f
4 changed files with 66 additions and 21 deletions
|
|
@ -2511,7 +2511,10 @@ If non-@code{nil}, always ask for the server's capabilities, even when
|
|||
doing a @samp{plain} connection.
|
||||
|
||||
@item :capability-command @var{capability-command}
|
||||
Command string to query the host capabilities.
|
||||
Command to query the host capabilities. This can either be a string
|
||||
(which will then be sent verbatim to the server), or a function
|
||||
(called with a single parameter; the "greeting" from the server when
|
||||
connecting), and should return a string.
|
||||
|
||||
@item :end-of-command @var{regexp}
|
||||
@itemx :end-of-capability @var{regexp}
|
||||
|
|
|
|||
6
etc/NEWS
6
etc/NEWS
|
|
@ -686,6 +686,12 @@ This allows specifying the coding systems used by a network process
|
|||
for encoding and decoding without having to bind
|
||||
'coding-system-for-{read,write}' or call 'set-process-coding-system'.
|
||||
|
||||
+++
|
||||
** 'open-network-stream' can now take a :capability-command that's a function.
|
||||
The function is called with the greeting from the server as its only
|
||||
parameter, and allows sending different TLS capability commands to the
|
||||
server based on that greeting.
|
||||
|
||||
+++
|
||||
** 'open-gnutls-stream' now also accepts a ':coding' argument.
|
||||
|
||||
|
|
|
|||
|
|
@ -1263,7 +1263,17 @@ If SEND-IF-FORCE, only send authinfo to the server if the
|
|||
"nntpd" pbuffer nntp-address nntp-port-number
|
||||
:type (cadr (assoc nntp-open-connection-function map))
|
||||
:end-of-command "^\\([2345]\\|[.]\\).*\n"
|
||||
:capability-command "HELP\r\n"
|
||||
:capability-command
|
||||
(lambda (greeting)
|
||||
(if (and greeting
|
||||
(string-match "Typhoon" greeting))
|
||||
;; Certain versions of the Typhoon server
|
||||
;; doesn't understand the CAPABILITIES
|
||||
;; command, but includes the capability
|
||||
;; data in the HELP command instead.
|
||||
"HELP\r\n"
|
||||
;; Use the correct command for everything else.
|
||||
"CAPABILITIES\r\n"))
|
||||
:success "^3"
|
||||
:starttls-function
|
||||
(lambda (capabilities)
|
||||
|
|
|
|||
|
|
@ -139,7 +139,10 @@ writes. See `make-network-process' for details.
|
|||
|
||||
:capability-command specifies a command used to query the HOST
|
||||
for its capabilities. For instance, for IMAP this should be
|
||||
\"1 CAPABILITY\\r\\n\".
|
||||
\"1 CAPABILITY\\r\\n\". This can either be a string (which will
|
||||
then be sent verbatim to the server), or a function (called with
|
||||
a single parameter; the \"greeting\" from the server when connecting),
|
||||
and should return a string to send to the server.
|
||||
|
||||
:starttls-function specifies a function for handling STARTTLS.
|
||||
This function should take one parameter, the response to the
|
||||
|
|
@ -280,8 +283,11 @@ gnutls-boot (as returned by `gnutls-boot-parameters')."
|
|||
:coding (plist-get parameters :coding)))
|
||||
(greeting (and (not (plist-get parameters :nogreeting))
|
||||
(network-stream-get-response stream start eoc)))
|
||||
(capabilities (network-stream-command stream capability-command
|
||||
eo-capa))
|
||||
(capabilities
|
||||
(network-stream-command
|
||||
stream
|
||||
(network-stream--capability-command capability-command greeting)
|
||||
eo-capa))
|
||||
(resulting-type 'plain)
|
||||
starttls-available starttls-command error)
|
||||
|
||||
|
|
@ -329,7 +335,10 @@ gnutls-boot (as returned by `gnutls-boot-parameters')."
|
|||
;; Requery capabilities for protocols that require it; i.e.,
|
||||
;; EHLO for SMTP.
|
||||
(when (plist-get parameters :always-query-capabilities)
|
||||
(network-stream-command stream capability-command eo-capa)))
|
||||
(network-stream-command
|
||||
stream
|
||||
(network-stream--capability-command capability-command greeting)
|
||||
eo-capa)))
|
||||
(when (let ((response
|
||||
(network-stream-command stream starttls-command eoc)))
|
||||
(and response (string-match success-string response)))
|
||||
|
|
@ -365,7 +374,10 @@ gnutls-boot (as returned by `gnutls-boot-parameters')."
|
|||
host service))
|
||||
;; Re-get the capabilities, which may have now changed.
|
||||
(setq capabilities
|
||||
(network-stream-command stream capability-command eo-capa))))
|
||||
(network-stream-command
|
||||
stream
|
||||
(network-stream--capability-command capability-command greeting)
|
||||
eo-capa))))
|
||||
|
||||
;; If TLS is mandatory, close the connection if it's unencrypted.
|
||||
(when (and require-tls
|
||||
|
|
@ -428,7 +440,8 @@ gnutls-boot (as returned by `gnutls-boot-parameters')."
|
|||
parameters)
|
||||
(require 'tls)
|
||||
(open-tls-stream name buffer host service)))
|
||||
(eoc (plist-get parameters :end-of-command)))
|
||||
(eoc (plist-get parameters :end-of-command))
|
||||
greeting)
|
||||
(if (plist-get parameters :nowait)
|
||||
(list stream nil nil 'tls)
|
||||
;; Check certificate validity etc.
|
||||
|
|
@ -440,17 +453,22 @@ gnutls-boot (as returned by `gnutls-boot-parameters')."
|
|||
;; openssl/gnutls-cli.
|
||||
(when (and (not (gnutls-available-p))
|
||||
eoc)
|
||||
(network-stream-get-response stream start eoc)
|
||||
(setq greeting (network-stream-get-response stream start eoc))
|
||||
(goto-char (point-min))
|
||||
(when (re-search-forward eoc nil t)
|
||||
(goto-char (match-beginning 0))
|
||||
(delete-region (point-min) (line-beginning-position))))
|
||||
(let ((capability-command (plist-get parameters :capability-command))
|
||||
(let ((capability-command
|
||||
(plist-get parameters :capability-command))
|
||||
(eo-capa (or (plist-get parameters :end-of-capability)
|
||||
eoc)))
|
||||
(list stream
|
||||
(network-stream-get-response stream start eoc)
|
||||
(network-stream-command stream capability-command eo-capa)
|
||||
(network-stream-command
|
||||
stream
|
||||
(network-stream--capability-command
|
||||
capability-command greeting)
|
||||
eo-capa)
|
||||
'tls)))))))
|
||||
|
||||
(defun network-stream-open-shell (name buffer host service parameters)
|
||||
|
|
@ -464,21 +482,29 @@ gnutls-boot (as returned by `gnutls-boot-parameters')."
|
|||
(format-spec
|
||||
(plist-get parameters :shell-command)
|
||||
`((?s . ,host)
|
||||
(?p . ,service)))))))
|
||||
(?p . ,service))))))
|
||||
greeting)
|
||||
(when coding (if (consp coding)
|
||||
(set-process-coding-system stream
|
||||
(car coding)
|
||||
(cdr coding))
|
||||
(set-process-coding-system stream
|
||||
coding
|
||||
coding)))
|
||||
(car coding)
|
||||
(cdr coding))
|
||||
(set-process-coding-system stream
|
||||
coding
|
||||
coding)))
|
||||
(list stream
|
||||
(network-stream-get-response stream start eoc)
|
||||
(network-stream-command stream capability-command
|
||||
(or (plist-get parameters :end-of-capability)
|
||||
eoc))
|
||||
(setq greeting (network-stream-get-response stream start eoc))
|
||||
(network-stream-command
|
||||
stream
|
||||
(network-stream--capability-command capability-command greeting)
|
||||
(or (plist-get parameters :end-of-capability)
|
||||
eoc))
|
||||
'plain)))
|
||||
|
||||
(defun network-stream--capability-command (command greeting)
|
||||
(if (functionp command)
|
||||
(funcall command greeting)
|
||||
command))
|
||||
|
||||
(provide 'network-stream)
|
||||
|
||||
;;; network-stream.el ends here
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue