From: Lars Ingebrigtsen Date: Sun, 19 Jul 2020 00:56:40 +0000 (+0200) Subject: Allow open-network-stream to use different TLS capability commands X-Git-Tag: emacs-28.0.90~6977 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=17f646128f04e9e8590f0371026a14d516f21c63;p=emacs.git 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. --- diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi index 22c50936185..4002004cd6f 100644 --- a/doc/lispref/processes.texi +++ b/doc/lispref/processes.texi @@ -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} diff --git a/etc/NEWS b/etc/NEWS index 7e6be008614..7fbe63013e8 100644 --- a/etc/NEWS +++ b/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. diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el index 02d90603b40..a5c82447926 100644 --- a/lisp/gnus/nntp.el +++ b/lisp/gnus/nntp.el @@ -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) diff --git a/lisp/net/network-stream.el b/lisp/net/network-stream.el index 1c371f59870..e86426d4664 100644 --- a/lisp/net/network-stream.el +++ b/lisp/net/network-stream.el @@ -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