GNU bug report logs - #38066
26.1; X-Message-SMTP-Method header does not affect smtpmail-stream-type

Previous Next

Full log

View this message in rfc822 format

From: Robert Pluim <rpluim <at> gmail.com>
To: Ryan Tate <ryantate <at> ryantate.com>
Cc: 38066 <at> debbugs.gnu.org
Subject: bug#38066: 26.1; X-Message-SMTP-Method header does not affect smtpmail-stream-type
Date: Tue, 05 Nov 2019 18:24:16 +0100

(please keep 38066 <at> debbugs.gnu.org in the CC)

>>>>> On Tue, 05 Nov 2019 11:16:16 -0500, Ryan Tate <ryantate <at> ryantate.com> said:

    >> Alternatively we could put this kind of code in open-network-stream,
    >> to allow other protocols to benefit from the same kind of detection.

    Ryan> I don't know enough about the open-network-stream corner of emacs so won't argue either
    Ryan> way. At the very least, I think it certainly makes sense with regard to the X-Message-SMTP-Method
    Ryan> header because this is a convenience feature (so some small amount "magic"
    Ryan> seems permissable) and there is no existing way to set the stream type
    Ryan> here. I imagine it could be useful elsewhere in emacs though.

If we do it in the lower layers, then everyone gets to use it, not
just people using X-Message-SMTP-Method or smtpmail-stream-type.

    Ryan> Your patches look good, thank you for writing them! (Do I need to submit
    Ryan> them formally as a patch on this list?)

No, if they gain traction I can commit them. I took a look at
open-network-stream, and itʼs not too hard to do the equivalent there,
although it probably needs to be conditioned on the specified :type
being nil rather than unconditionally overriding it.

diff --git i/lisp/net/gnutls.el w/lisp/net/gnutls.el
index 9b13adaefe..a083e9df6c 100644
--- i/lisp/net/gnutls.el
+++ w/lisp/net/gnutls.el
@@ -202,6 +202,7 @@ open-gnutls-stream
          (process (open-network-stream
                    name buffer host service
                    :nowait nowait
+                   :auto-tls (plist-get parameters :auto-tls)
                    :tls-parameters
                    (and nowait
                         (cons 'gnutls-x509pki
diff --git i/lisp/net/network-stream.el w/lisp/net/network-stream.el
index 4050c83eb0..8b4bd66ef4 100644
--- i/lisp/net/network-stream.el
+++ w/lisp/net/network-stream.el
@@ -73,6 +73,35 @@ network-stream-use-client-certificates
   :type 'boolean
   :version "27.1")
 
+(defcustom network-stream-auto-tls nil
+  "Whether to automatically try with TLS for certain port
+numbers.  See `network-stream-auto-tls-alist' for the default
+settings."
+  :group 'network
+  :type 'boolean
+  :version "27.1")
+
+(defcustom network-stream-auto-tls-alist
+  '((465 . tls)
+    (587 . starttls)
+    (993 . tls))
+  "Alist used for mapping ports to TLS usage.
+Specifies which port number to map to which TLS behaviour.  See
+`open-network-stream' for a full explanation of the possible
+behaviours."
+  :group 'network
+  :type '(alist :key-type integer
+                :value-type (choice
+                             (const :tag "Possibly upgrade to STARTTLS" nil)
+                             (const :tag "Always use STARTTLS" starttls)
+                             (const :tag "Never use STARTTLS" plain)
+                             (const :tag "Use TLS/SSL" tls)))
+  :version "27.1")
+
 ;;;###autoload
 (defun open-network-stream (name buffer host service &rest parameters)
   "Open a TCP connection to HOST, optionally with encryption.
@@ -175,7 +204,19 @@ open-network-stream
   (unless (featurep 'make-network-process)
     (error "Emacs was compiled without networking support"))
   (let ((type (plist-get parameters :type))
-	(return-list (plist-get parameters :return-list)))
+	(return-list (plist-get parameters :return-list))
+        mapped-type)
+    (when (and network-stream-auto-tls (not (plist-get parameters :auto-tls)))
+      (setq mapped-type (assoc (if (integerp service)
+                                   service
+                                 (string-to-number service))
+                               network-stream-auto-tls-alist))
+      (when mapped-type
+        (setq type (cdr mapped-type)
+              parameters (plist-put
+                          (plist-put parameters :auto-tls t)
+                          :type (cdr mapped-type)))))
+    (message "Auto-TLS %s %s" type mapped-type)
     (if (and (not return-list)
 	     (or (eq type 'plain)
 		 (and (memq type '(nil network))

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.