master 17f6461: Allow open-network-stream to use different TLS capability commands

[Lars Ingebrigtsen]

branch: master
commit 17f646128f04e9e8590f0371026a14d516f21c63
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>

    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.
---
 doc/lispref/processes.texi |  5 +++-
 etc/NEWS                   |  6 +++++
 lisp/gnus/nntp.el          | 12 ++++++++-
 lisp/net/network-stream.el | 64 ++++++++++++++++++++++++++++++++--------------
 4 files changed, 66 insertions(+), 21 deletions(-)

diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi
index 22c5093..4002004 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 7e6be00..7fbe630 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -687,6 +687,12 @@ 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 02d9060..a5c8244 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 1c371f5..e86426d 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