1 ;;; smtpmail.el --- SMTP interface for mail-mode
3 ;; Copyright (C) 1995, 1996, 1998 Free Software Foundation, Inc.
5 ;; Author: Tomoji Kagatani <kagatani@rbc.ncl.omron.co.jp>
8 ;; This file is part of FLIM (Faithful Library about Internet Message).
10 ;; This program is free software; you can redistribute it and/or
11 ;; modify it under the terms of the GNU General Public License as
12 ;; published by the Free Software Foundation; either version 2, or (at
13 ;; your option) any later version.
15 ;; This program is distributed in the hope that it will be useful, but
16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
18 ;; General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
27 ;; Send Mail to smtp host from smtpmail temp buffer.
29 ;; Please add these lines in your .emacs(_emacs).
31 ;;(setq send-mail-function 'smtpmail-send-it)
32 ;;(setq smtp-default-server "YOUR SMTP HOST")
33 ;;(setq smtp-service "smtp")
34 ;;(setq smtp-local-domain "YOUR DOMAIN NAME")
35 ;;(setq smtp-debug-info t)
36 ;;(autoload 'smtpmail-send-it "smtpmail")
37 ;;(setq user-full-name "YOUR NAME HERE")
39 ;; To queue mail, set smtpmail-queue-mail to t and use
40 ;; smtpmail-send-queued-mail to send.
51 (defcustom smtpmail-queue-mail nil
52 "*Specify if mail is queued (if t) or sent immediately (if nil).
53 If queued, it is stored in the directory `smtpmail-queue-dir'
54 and sent with `smtpmail-send-queued-mail'."
58 (defcustom smtpmail-queue-dir "~/Mail/queued-mail/"
59 "*Directory where `smtpmail.el' stores queued mail."
63 (defvar smtpmail-queue-index-file "index"
64 "File name of queued mail index,
65 This is relative to `smtpmail-queue-dir'.")
67 (defvar smtpmail-queue-index (concat smtpmail-queue-dir
68 smtpmail-queue-index-file))
70 (defvar smtpmail-recipient-address-list nil)
78 (defun smtpmail-send-it ()
80 (let ((errbuf (if mail-interactive
81 (generate-new-buffer " smtpmail errors")
83 (tembuf (generate-new-buffer " smtpmail temp"))
84 (case-fold-search nil)
87 (mailbuf (current-buffer)))
92 (insert-buffer-substring mailbuf)
93 (goto-char (point-max))
94 ;; require one newline at the end.
95 (or (= (preceding-char) ?\n)
97 ;; Change header-delimiter to be what sendmail expects.
98 (goto-char (point-min))
100 (concat "^" (regexp-quote mail-header-separator) "\n"))
103 (setq delimline (point-marker))
104 ;; (sendmail-synch-aliases)
106 (expand-mail-aliases (point-min) delimline))
107 (goto-char (point-min))
108 ;; ignore any blank lines in the header
109 (while (and (re-search-forward "\n\n\n*" delimline t)
110 (< (point) delimline))
111 (replace-match "\n"))
112 (let ((case-fold-search t))
113 (goto-char (point-min))
114 (goto-char (point-min))
115 (while (re-search-forward "^Resent-to:" delimline t)
116 (setq resend-to-addresses
118 (narrow-to-region (point)
122 (append (mail-parse-comma-list)
123 resend-to-addresses))))
124 ;;; Apparently this causes a duplicate Sender.
125 ;;; ;; If the From is different than current user, insert Sender.
126 ;;; (goto-char (point-min))
127 ;;; (and (re-search-forward "^From:" delimline t)
129 ;;; (require 'mail-utils)
130 ;;; (not (string-equal
131 ;;; (mail-strip-quoted-names
132 ;;; (save-restriction
133 ;;; (narrow-to-region (point-min) delimline)
134 ;;; (mail-fetch-field "From")))
135 ;;; (user-login-name))))
138 ;;; (insert "Sender: " (user-login-name) "\n")))
139 ;; Don't send out a blank subject line
140 (goto-char (point-min))
141 (if (re-search-forward "^Subject:[ \t]*\n" delimline t)
143 ;; Put the "From:" field in unless for some odd reason
144 ;; they put one in themselves.
145 (goto-char (point-min))
146 (if (not (re-search-forward "^From:" delimline t))
147 (let* ((login user-mail-address)
148 (fullname (user-full-name)))
149 (cond ((eq mail-from-style 'angles)
150 (insert "From: " fullname)
151 (let ((fullname-start (+ (point-min) 6))
152 (fullname-end (point-marker)))
153 (goto-char fullname-start)
154 ;; Look for a character that cannot appear unquoted
155 ;; according to RFC 822.
156 (if (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]"
159 ;; Quote fullname, escaping specials.
160 (goto-char fullname-start)
162 (while (re-search-forward "[\"\\]"
164 (replace-match "\\\\\\&" t))
166 (insert " <" login ">\n"))
167 ((eq mail-from-style 'parens)
168 (insert "From: " login " (")
169 (let ((fullname-start (point)))
171 (let ((fullname-end (point-marker)))
172 (goto-char fullname-start)
173 ;; RFC 822 says \ and nonmatching parentheses
174 ;; must be escaped in comments.
175 ;; Escape every instance of ()\ ...
176 (while (re-search-forward "[()\\]" fullname-end 1)
177 (replace-match "\\\\\\&" t))
178 ;; ... then undo escaping of matching parentheses,
179 ;; including matching nested parentheses.
180 (goto-char fullname-start)
181 (while (re-search-forward
182 "\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)"
184 (replace-match "\\1(\\3)" t)
185 (goto-char fullname-start))))
187 ((null mail-from-style)
188 (insert "From: " login "\n")))))
189 ;; Insert an extra newline if we need it to work around
190 ;; Sun's bug that swallows newlines.
191 (goto-char (1+ delimline))
192 (if (eval mail-mailer-swallows-blank-line)
194 ;; Find and handle any FCC fields.
195 (goto-char (point-min))
196 (if (re-search-forward "^FCC:" delimline t)
197 (mail-do-fcc delimline))
205 (setq smtpmail-recipient-address-list
206 (or resend-to-addresses
207 (smtp-deduce-address-list tembuf (point-min) delimline)))
209 (smtpmail-do-bcc delimline)
211 (if (not smtpmail-queue-mail)
212 (if smtpmail-recipient-address-list
213 (if (not (smtp-via-smtp user-mail-address
214 smtpmail-recipient-address-list
216 (error "Sending failed; SMTP protocol error"))
217 (error "Sending failed; no recipients"))
218 (let* ((file-data (concat
221 "%02y%02m%02d-%02H%02M%02S")))
222 (file-elisp (concat file-data ".el"))
223 (buffer-data (create-file-buffer file-data))
224 (buffer-elisp (create-file-buffer file-elisp))
225 (buffer-scratch "*queue-mail*"))
227 (set-buffer buffer-data)
229 (insert-buffer tembuf)
230 (write-file file-data)
231 (set-buffer buffer-elisp)
234 "(setq smtpmail-recipient-address-list '"
235 (prin1-to-string smtpmail-recipient-address-list)
237 (write-file file-elisp)
238 (set-buffer (generate-new-buffer buffer-scratch))
239 (insert (concat file-data "\n"))
240 (append-to-file (point-min)
242 smtpmail-queue-index)
244 (kill-buffer buffer-scratch)
245 (kill-buffer buffer-data)
246 (kill-buffer buffer-elisp))))
249 (kill-buffer errbuf)))))
251 (defun smtpmail-send-queued-mail ()
252 "Send mail that was queued as a result of setting `smtpmail-queue-mail'."
254 ;;; Get index, get first mail, send it, get second mail, etc...
255 (let ((buffer-index (find-file-noselect smtpmail-queue-index))
259 (set-buffer buffer-index)
260 (beginning-of-buffer)
262 (setq file-msg (buffer-substring (point) (save-excursion
266 (setq tembuf (find-file-noselect file-msg))
267 (if smtpmail-recipient-address-list
268 (if (not (smtp-via-smtp user-mail-address
269 smtpmail-recipient-address-list tembuf))
270 (error "Sending failed; SMTP protocol error"))
271 (error "Sending failed; no recipients"))
272 (delete-file file-msg)
273 (delete-file (concat file-msg ".el"))
276 (set-buffer buffer-index)
277 (save-buffer smtpmail-queue-index)
278 (kill-buffer buffer-index)
282 (defun smtpmail-do-bcc (header-end)
283 "Delete BCC: and their continuation lines from the header area.
284 There may be multiple BCC: lines, and each may have arbitrarily
285 many continuation lines."
286 (let ((case-fold-search t))
288 (goto-char (point-min))
289 ;; iterate over all BCC: lines
290 (while (re-search-forward "^BCC:" header-end t)
291 (delete-region (match-beginning 0) (progn (forward-line 1) (point)))
292 ;; get rid of any continuation lines
293 (while (and (looking-at "^[ \t].*\n") (< (point) header-end))
305 ;;; smtpmail.el ends here