;;; smtp.el --- basic functions to send mail with SMTP server
-;; Copyright (C) 1995, 1996, 1998, 1999, 2000 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1996, 1998, 1999, 2000, 2001 ,2002, 2004
+;; Free Software Foundation, Inc.
;; Author: Tomoji Kagatani <kagatani@rbc.ncl.omron.co.jp>
;; Simon Leinen <simon@switch.ch> (ESMTP support)
;; You should have received a copy of the GNU General Public License
;; along with this program; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
-;;
+;;
;;; Code:
(function :tag "Function"))
:group 'smtp)
+(defcustom smtp-send-by-myself nil
+ "If non-nil, smtp.el send a mail by myself without smtp-server.
+This option requires \"dig.el\"."
+ :type 'boolean
+ :group 'smtp)
+
(defcustom smtp-service "smtp"
"SMTP service port number. \"smtp\" or 25."
:type '(choice (integer :tag "25" 25)
- (string :tag "smtp" "smtp"))
+ (string :tag "smtp" "smtp"))
:group 'smtp)
(defcustom smtp-local-domain nil
:type 'boolean
:group 'smtp-extensions)
+(defcustom smtp-use-starttls-ignore-error nil
+ "If non-nil, do not use STARTTLS if STARTTLS is not available."
+ :type 'boolean
+ :group 'smtp-extensions)
+
+(defcustom smtp-starttls-program "starttls"
+ "The program to run in a subprocess to open an TLSv1 connection."
+ :group 'smtp-extensions)
+
+(defcustom smtp-starttls-extra-args nil
+ "Extra arguments to `starttls-program'"
+ :group 'smtp-extensions)
+
(defcustom smtp-use-sasl nil
"If non-nil, use SMTP Authentication (RFC2554) if available."
:type 'boolean
:type '(repeat string)
:group 'smtp-extensions)
+(defcustom smtp-progress-message-format nil
+ "Format string used to show progress message while sending mails.
+It allows the following special format specifiers:
+
+%b means show the number of bytes which has been sent
+ and the total bytes of a mail.
+%k means show the number of kilobytes which has been sent
+ and the total kilobytes of a mail.
+%l means show the number of lines which has been sent
+ and the total lines of a mail.
+
+For instance, the value \"Sending (%k)...\" shows like
+\"Sending (45k/123k)...\" in the echo area."
+ :type '(radio (string :format "%v\n" :size 0 :value "Sending (%k)...")
+ (const :tag "Don't show progress message" nil))
+ :group 'smtp)
+
(defvar sasl-mechanisms)
;;;###autoload
-(defvar smtp-open-connection-function #'open-network-stream)
+(defvar smtp-open-connection-function #'open-network-stream
+ "*Function used for connecting to a SMTP server.
+The function will be called with the same four arguments as
+`open-network-stream' and should return a process object.
+Here is an example:
+
+\(setq smtp-open-connection-function
+ #'(lambda (name buffer host service)
+ (let ((process-connection-type nil))
+ (start-process name buffer \"ssh\" \"-C\" host
+ \"nc\" host service))))
+
+It connects to a SMTP server using \"ssh\" before actually connecting
+to the SMTP port. Where the command \"nc\" is the netcat executable;
+see http://www.atstake.com/research/tools/index.html#network_utilities
+for details. In addition, you will have to modify the value for
+`smtp-end-of-line' to \"\\n\" if you use \"telnet\" instead of \"nc\".")
(defvar smtp-read-point nil)
(defvar smtp-submit-package-function #'smtp-submit-package)
+(defvar smtp-end-of-line "\r\n"
+ "*String to use as end-of-line marker when talking to a SMTP server.
+This is \"\\r\\n\" by default, but it may have to be \"\\n\" when using a non
+native connection function. See also `smtp-open-connection-function'.")
+
;;; @ SMTP package
;;; A package contains a mail message, an envelope sender address,
;;; and one or more envelope recipient addresses. In ESMTP model
smtp-connection-alist))
connection)))
+(eval-and-compile
+ (autoload 'dig-invoke "dig")
+ (autoload 'dig-extract-rr "dig"))
+
+(defun smtp-find-mx (domain &optional doerror)
+ (let (server)
+ ;; dig.el resolves only primally MX.
+ (cond ((setq server (smtp-dig domain "MX"))
+ (progn (string-match " \\([^ ]*\\)$" server)
+ (match-string 1 server)))
+ ((smtp-dig domain "A")
+ domain)
+ (t
+ (if doerror
+ (error (format "SMTP cannot resolve %s" domain)))))))
+
+(defun smtp-dig (domain type)
+ (let (dig-buf)
+ (set-buffer
+ (setq dig-buf (dig-invoke domain type)))
+ (prog1
+ (dig-extract-rr domain type)
+ (kill-buffer dig-buf))))
+
+(defun smtp-find-server (recipients)
+ (save-excursion
+ (let ((rec
+ (mapcar (lambda (recipient)
+ (let (server)
+ (if (and (string-match "@\\([^\t\n ]*\\)" recipient)
+ (setq server
+ (smtp-find-mx
+ (match-string 1 recipient))))
+ (cons server (list recipient))
+ (error (format "cannot find server for %s." recipient)))))
+ recipients))
+ ret rets rlist)
+ (while (setq rets (pop rec))
+ (if (setq ret (assoc (car rets) rec))
+ (setcdr ret
+ (append (cdr ret) (cdr rets)))
+ (setq rlist
+ (append rlist (list rets)))))
+ rlist)))
+
;;;###autoload
(defun smtp-via-smtp (sender recipients buffer)
"Like `smtp-send-buffer', but sucks in any errors."
SENDER is an envelope sender address.
RECIPIENTS is a list of envelope recipient addresses.
BUFFER may be a buffer or a buffer name which contains mail message."
- (let ((server
- (if (functionp smtp-server)
- (funcall smtp-server sender recipients)
- smtp-server))
- (package
- (smtp-make-package sender recipients buffer))
- (smtp-open-connection-function
- (if smtp-use-starttls
- #'starttls-open-stream
- smtp-open-connection-function)))
- (save-excursion
- (set-buffer
- (get-buffer-create
- (format "*trace of SMTP session to %s*" server)))
- (erase-buffer)
- (buffer-disable-undo)
- (unless (smtp-find-connection (current-buffer))
- (smtp-open-connection (current-buffer) server smtp-service))
- (make-local-variable 'smtp-read-point)
- (setq smtp-read-point (point-min))
- (funcall smtp-submit-package-function package))))
+ (if smtp-send-by-myself
+ (smtp-send-buffer-by-myself sender recipients buffer)
+ (let* ((server
+ (if (functionp smtp-server)
+ (funcall smtp-server sender recipients)
+ (or smtp-server
+ (error "`smtp-server' not defined"))))
+ (package
+ (smtp-make-package sender recipients buffer))
+ (starttls-program smtp-starttls-program)
+ (starttls-extra-args smtp-starttls-extra-args)
+ (smtp-open-connection-function
+ (if smtp-use-starttls
+ #'starttls-open-stream
+ smtp-open-connection-function)))
+ (save-excursion
+ (set-buffer
+ (get-buffer-create
+ (format "*trace of SMTP session to %s*" server)))
+ (erase-buffer)
+ (buffer-disable-undo)
+ (unless (smtp-find-connection (current-buffer))
+ (smtp-open-connection (current-buffer) server smtp-service))
+ (make-local-variable 'smtp-read-point)
+ (setq smtp-read-point (point-min))
+ (funcall smtp-submit-package-function package)))))
(defun smtp-submit-package (package)
(unwind-protect
(smtp-response-error
(smtp-primitive-helo package)))
(if smtp-use-starttls
- (progn
- (smtp-primitive-starttls package)
- (smtp-primitive-ehlo package)))
+ (if (assq 'starttls
+ (smtp-connection-extensions-internal
+ (smtp-find-connection (current-buffer))))
+ (progn
+ (smtp-primitive-starttls package)
+ (smtp-primitive-ehlo package))
+ (unless smtp-use-starttls-ignore-error
+ (error "STARTTLS is not supported on this server"))))
(if smtp-use-sasl
(smtp-primitive-auth package))
(smtp-primitive-mailfrom package)
(smtp-primitive-quit package)
(smtp-close-connection connection)))))
+(defun smtp-send-buffer-by-myself (sender recipients buffer)
+ "Send a message by myself.
+SENDER is an envelope sender address.
+RECIPIENTS is a list of envelope recipient addresses.
+BUFFER may be a buffer or a buffer name which contains mail message."
+ (let ((servers
+ (smtp-find-server recipients))
+ (smtp-open-connection-function
+ (if smtp-use-starttls
+ #'starttls-open-stream
+ smtp-open-connection-function))
+ server package)
+ (while (car servers)
+ (setq server (caar servers))
+ (setq recipients (cdar servers))
+ (if (not (and server recipients))
+ ;; MAILER-DAEMON is required. :)
+ (error (format "Cannot send <%s>"
+ (mapconcat 'concat recipients ">,<"))))
+ (setq package
+ (smtp-make-package sender recipients buffer))
+ (save-excursion
+ (set-buffer
+ (get-buffer-create
+ (format "*trace of SMTP session to %s*" server)))
+ (erase-buffer)
+ (buffer-disable-undo)
+ (unless (smtp-find-connection (current-buffer))
+ (smtp-open-connection (current-buffer) server smtp-service))
+ (make-local-variable 'smtp-read-point)
+ (setq smtp-read-point (point-min))
+ (let ((smtp-use-sasl nil)
+ (smtp-use-starttls-ignore-error t))
+ (funcall smtp-submit-package-function package)))
+ (setq servers (cdr servers)))))
+
;;; @ hook methods for `smtp-submit-package'
;;;
(defun smtp-primitive-data (package)
(let* ((connection
(smtp-find-connection (current-buffer)))
- response)
+ response def prev)
(smtp-send-command connection "DATA")
(setq response (smtp-read-response connection))
(if (/= (car response) 354)
(smtp-response-error response))
(save-excursion
(set-buffer (smtp-package-buffer-internal package))
+ (setq def (smtp-parse-progress-message-format))
(goto-char (point-min))
(while (not (eobp))
(smtp-send-data
connection (buffer-substring (point) (progn (end-of-line)(point))))
- (beginning-of-line 2)))
+ (beginning-of-line 2)
+ (setq prev (smtp-show-progress-message def prev))))
(smtp-send-command connection ".")
(setq response (smtp-read-response connection))
(if (/= (car response) 250)
response)
(while response-continue
(goto-char smtp-read-point)
- (while (not (search-forward "\r\n" nil t))
+ (while (not (search-forward smtp-end-of-line nil t))
(accept-process-output (smtp-connection-process-internal connection))
(goto-char smtp-read-point))
(if decoder
(let ((string (buffer-substring smtp-read-point (- (point) 2))))
(delete-region smtp-read-point (point))
- (insert (funcall decoder string) "\r\n")))
+ (insert (funcall decoder string) smtp-end-of-line)))
(setq response
(nconc response
(list (buffer-substring
(smtp-connection-encoder-internal connection)))
(set-buffer (process-buffer process))
(goto-char (point-max))
- (setq command (concat command "\r\n"))
+ (setq command (concat command smtp-end-of-line))
(insert command)
(setq smtp-read-point (point))
(if encoder
(smtp-connection-encoder-internal connection)))
;; Escape "." at start of a line.
(if (eq (string-to-char data) ?.)
- (setq data (concat "." data "\r\n"))
- (setq data (concat data "\r\n")))
+ (setq data (concat "." data smtp-end-of-line))
+ (setq data (concat data smtp-end-of-line)))
(if encoder
(setq data (funcall encoder data)))
(process-send-string process data)))
(mail-strip-quoted-names
(buffer-substring this-line this-line-end)))))
(erase-buffer)
- (insert-string " ")
- (insert-string simple-address-list)
- (insert-string "\n")
+ (insert " " simple-address-list "\n")
;; newline --> blank
(subst-char-in-region (point-min) (point-max) 10 ? t)
;; comma --> blank
recipient-address-list))
(kill-buffer smtp-address-buffer))))
+;;; @ functions used to show progress message
+;;;
+(defun smtp-parse-progress-message-format ()
+ "Parse the `smtp-progress-message-format' variable.
+Return nil, or a cons of an ordinary format string and a type including
+nil, the symbols `b', `k' and `l'."
+ (when smtp-progress-message-format
+ (let ((format smtp-progress-message-format)
+ (index 0)
+ type)
+ (while (string-match "%\\([bkl]\\)\\|%\\([^%bkl]\\|\\'\\)" format index)
+ (if (and (not type)
+ (match-beginning 1))
+ (setq index (match-end 0)
+ type (intern (match-string 1 format))
+ format (replace-match
+ (cond ((eq type 'b)
+ (concat "%d/"
+ (number-to-string (buffer-size))))
+ ((eq type 'k)
+ (if (>= (buffer-size) 512)
+ (concat "%dk/"
+ (number-to-string
+ (/ (+ (buffer-size) 512) 1024))
+ "k")
+ (setq type 'b)
+ (concat "%d/"
+ (number-to-string (buffer-size)))))
+ (t
+ (concat "%d/"
+ (number-to-string
+ (count-lines (point-min)
+ (point-max))))))
+ nil nil format))
+ (setq index (1+ (match-end 0))
+ format (replace-match "%\\&" nil nil format))))
+ (cons format type))))
+
+(defun smtp-show-progress-message (def prev)
+ "Show progress message while sending mails.
+DEF is a cons cell which is pre-computed by the
+`smtp-parse-progress-message-format' function or nil.
+PREV is a number shown last time or nil.
+Return a number computed this time."
+ (when (car def)
+ (let* ((fmt (car def))
+ (type (cdr def))
+ (value (cond ((eq type 'b)
+ (- (point) (point-min)))
+ ((eq type 'k)
+ (/ (- (point) (point-min) -512) 1024))
+ ((eq type 'l)
+ (count-lines (point-min) (point)))))
+ message-log-max)
+ (unless (and prev
+ value
+ (eq type 'k)
+ (<= value prev))
+ (cond ((featurep 'xemacs)
+ (display-message 'no-log (if value
+ (format fmt value)
+ fmt)))
+ (value
+ (message fmt value))
+ (t
+ (message "%s" fmt))))
+ value)))
+
(provide 'smtp)
;;; smtp.el ends here