Commit 17f64612 authored by Lars Ingebrigtsen's avatar Lars Ingebrigtsen

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.
parent 42b33405
Pipeline #6084 failed with stage
in 22 seconds
......@@ -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}
......
......@@ -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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment