Remove netscape/my-deja, since they no longer exist.

[gnus] / contrib / smtpmail.el

diff --git a/contrib/smtpmail.el b/contrib/smtpmail.el
index fc551e5..43e8405 100644 (file)
--- a/contrib/smtpmail.el
+++ b/contrib/smtpmail.el
@@ -1,7 +1,7 @@
 ;;; smtpmail.el --- simple SMTP protocol (RFC 821) for sending mail
 
-;; Copyright (C) 1995, 1996, 2001, 2002, 2003, 2004, 2005,
-;;   2006, 2007 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1996, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
+;;   2008, 2009  Free Software Foundation, Inc.
 
 ;; Author: Tomoji Kagatani <kagatani@rbc.ncl.omron.co.jp>
 ;; Maintainer: Simon Josefsson <simon@josefsson.org>
@@ -14,10 +14,10 @@
 
 ;; This file is part of GNU Emacs.
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -25,9 +25,7 @@
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
@@ -75,6 +73,7 @@
     (error "Please use `smtpmail.el' bundled with Emacs.")))
 
 (require 'sendmail)
+(autoload 'starttls-any-program-available "starttls")
 (autoload 'starttls-open-stream "starttls")
 (autoload 'starttls-negotiate "starttls")
 (autoload 'mail-strip-quoted-names "mail-utils")
@@ -84,6 +83,7 @@
 (autoload 'netrc-parse "netrc")
 (autoload 'netrc-machine "netrc")
 (autoload 'netrc-get "netrc")
+(autoload 'auth-source-user-or-password "auth-source")
 
 ;;;
 (defgroup smtpmail nil
@@ -219,7 +219,8 @@ This is relative to `smtpmail-queue-dir'.")
                                     smtpmail-queue-index-file))
 
 (defconst smtpmail-auth-supported '(cram-md5 plain login)
-  "List of supported SMTP AUTH mechanisms.")
+  "List of supported SMTP AUTH mechanisms.
+The list is in preference order.")
 
 ;;;
 ;;;
@@ -513,13 +514,7 @@ This is relative to `smtpmail-queue-dir'.")
 (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))))
+    (if (null (and cred (starttls-any-program-available)))
        ;; The normal case.
        (open-network-stream "SMTP" process-buffer host port)
       (let* ((cred-key (smtpmail-cred-key cred))
@@ -546,18 +541,30 @@ This is relative to `smtpmail-queue-dir'.")
 
 (defun smtpmail-try-auth-methods (process supported-extensions host port)
   (let* ((mechs (cdr-safe (assoc 'auth supported-extensions)))
-        (mech (car (smtpmail-intersection smtpmail-auth-supported mechs)))
-        (cred (if (stringp smtpmail-auth-credentials)
-                  (let* ((netrc (netrc-parse smtpmail-auth-credentials))
-                          (port-name (format "%s" (or port "smtp")))
-                         (hostentry (netrc-machine netrc host port-name
-                                                    port-name)))
-                     (when hostentry
-                       (list host port
-                             (netrc-get hostentry "login")
-                             (netrc-get hostentry "password"))))
-                (smtpmail-find-credentials
-                 smtpmail-auth-credentials host port)))
+        (mech (car (smtpmail-intersection mechs smtpmail-auth-supported)))
+        (auth-user (auth-source-user-or-password
+                    "login" host (or port "smtp")))
+        (auth-pass (auth-source-user-or-password
+                    "password" host (or port "smtp")))
+        (cred (if (and auth-user auth-pass) ; try user-auth-* before netrc-*
+                  (list host port auth-user auth-pass)
+                ;; else, if auth-source didn't return them...
+                (if (stringp smtpmail-auth-credentials)
+                    (let* ((netrc (netrc-parse smtpmail-auth-credentials))
+                           (port-name (format "%s" (or port "smtp")))
+                           (hostentry (netrc-machine netrc host port-name
+                                                     port-name)))
+                      (when hostentry
+                        (list host port
+                              (netrc-get hostentry "login")
+                              (netrc-get hostentry "password"))))
+                  ;; else, try smtpmail-find-credentials since
+                  ;; smtpmail-auth-credentials is not a string
+                  (smtpmail-find-credentials
+                   smtpmail-auth-credentials host port))))
+        (prompt (when cred (format "SMTP password for %s:%s: "
+                                   (smtpmail-cred-server cred)
+                                   (smtpmail-cred-port cred))))
         (passwd (when cred
                   (or (smtpmail-cred-passwd cred)
                       (read-passwd
@@ -1030,5 +1037,4 @@ many continuation lines."
 
 (provide 'smtpmail)
 
-;;; arch-tag: a76992df-6d71-43b7-9e72-4bacc6c05466
 ;;; smtpmail.el ends here