;;; smtpmail.el --- simple SMTP protocol (RFC 821) for sending mail
-;; Copyright (C) 1995, 1996, 2001, 2002, 2003, 2004, 2005,
-;; 2006, 2007, 2008 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>
;; 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 3, 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
;; 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:
(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")
(autoload 'netrc-parse "netrc")
(autoload 'netrc-machine "netrc")
(autoload 'netrc-get "netrc")
+(autoload 'auth-source-user-or-password "auth-source")
;;;
(defgroup smtpmail nil
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.")
;;;
;;;
(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))
(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
(provide 'smtpmail)
-;;; arch-tag: a76992df-6d71-43b7-9e72-4bacc6c05466
+;; arch-tag: a76992df-6d71-43b7-9e72-4bacc6c05466
;;; smtpmail.el ends here