Re: smtpmail failure

[Denys Duchier <denys.duchier@univ-orleans.fr>]

[-- Attachment #1: Type: text/plain, Size: 683 bytes --]

I am beginning to understand the issues here and below I have attached a
proposed fix: it adds support for legacy ssl-only smtp servers.  I have
based this patch on the version of smtpmail that can be found in
gnus/contrib.

The patch is mostly a conservative extension, except in one respect:
previously, when credentials where found in
smtpmail-starttls-credentials but gnutls-cli was not found,
smtpmail-open-stream would open a non secured connection to the smtp
server.  I think that's a bug: if the user has explicitly added an entry
in smtpmail-starttls-credentials, then clearly he expects a secured
connection: a non-secured connection should not silently be used
instead.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: support ssl smtp connections --]
[-- Type: text/x-patch, Size: 3207 bytes --]

Index: contrib/smtpmail.el
===================================================================
RCS file: /usr/local/cvsroot/gnus/contrib/smtpmail.el,v
retrieving revision 7.12
diff -u -r7.12 smtpmail.el
--- contrib/smtpmail.el	20 Jan 2008 05:23:59 -0000	7.12
+++ contrib/smtpmail.el	21 Mar 2008 09:35:14 -0000
@@ -84,6 +84,7 @@
 (autoload 'netrc-parse "netrc")
 (autoload 'netrc-machine "netrc")
 (autoload 'netrc-get "netrc")
+(autoload 'open-tls-stream "tls")
 
 ;;;
 (defgroup smtpmail nil
@@ -195,6 +196,15 @@
   :version "21.1"
   :group 'smtpmail)
 
+(defcustom smtpmail-ssl-servers '()
+  "servers requiring an SSL connection.
+This is a list of 2-element lists with `servername' (a string)
+and `port' (an integer)."
+  :type '(repeat (list (string :tag "Server")
+		       (integer :tag "Port")))
+  :version "22.1"
+  :group 'smtpmail)
+
 (defcustom smtpmail-warn-about-unknown-extensions nil
   "*If set, print warnings about unknown SMTP extensions.
 This is mainly useful for development purposes, to learn about
@@ -513,34 +523,38 @@
 (defun smtpmail-open-stream (process-buffer host port)
   (let ((cred (smtpmail-find-credentials
 	       smtpmail-starttls-credentials host port)))
-    (if (null (and cred (condition-case ()
-			    (with-no-warnings
-			      (require 'starttls)
-			      (call-process (if starttls-use-gnutls
-						starttls-gnutls-program
-					      starttls-program)))
-			  (error nil))))
-	;; The normal case.
-	(open-network-stream "SMTP" process-buffer host port)
+    (if (null cred)
+	;; we reuse smtpmail-find-credentials to search in
+	;; smtpmail-ssl-servers because it does the right
+	;; kind of lookup
+	(let ((entry (smtpmail-find-credentials
+		      smtpmail-ssl-servers host port)))
+	  (if (null entry)
+	      ;; The normal case
+	      (open-network-stream "SMTP" process-buffer host port)
+	    ;; The SSL case
+	    (prog1 (open-tls-stream "SMTP" process-buffer host port)
+	      (with-current-buffer process-buffer
+		(delete-region (point-min) (point))
+		(goto-char (point-min))))))
+      ;; The TLS case
       (let* ((cred-key (smtpmail-cred-key cred))
 	     (cred-cert (smtpmail-cred-cert cred))
+	     (cred-found
+	      (and (stringp cred-key) (stringp cred-cert)
+		   (file-regular-p
+		    (setq cred-key (expand-file-name cred-key)))
+		   (file-regular-p
+		    (setq cred-cert (expand-file-name cred-cert)))))
 	     (starttls-extra-args
 	      (append
 	       starttls-extra-args
-	       (when (and (stringp cred-key) (stringp cred-cert)
-			  (file-regular-p
-			   (setq cred-key (expand-file-name cred-key)))
-			  (file-regular-p
-			   (setq cred-cert (expand-file-name cred-cert))))
+	       (when cred-found
 		 (list "--key-file" cred-key "--cert-file" cred-cert))))
 	     (starttls-extra-arguments
 	      (append
 	       starttls-extra-arguments
-	       (when (and (stringp cred-key) (stringp cred-cert)
-			  (file-regular-p
-			   (setq cred-key (expand-file-name cred-key)))
-			  (file-regular-p
-			   (setq cred-cert (expand-file-name cred-cert))))
+	       (when cred-found
 		 (list "--x509keyfile" cred-key "--x509certfile" cred-cert)))))
 	(starttls-open-stream "SMTP" process-buffer host port)))))
 

[-- Attachment #3: Type: text/plain, Size: 18 bytes --]


Cheers,

--Denys