1 ;;; smtpmail.el --- SMTP interface for mail-mode
3 ;; Copyright (C) 1995,96,98,99,2000,01,02 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 this program; see the file COPYING. If not, write to
22 ;; the 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) ; if you use `mail'
32 ;;(setq message-send-mail-function 'smtpmail-send-it) ; if you are using Gnus.
33 ;;(setq smtp-default-server "YOUR SMTP HOST")
34 ;;(setq smtp-service "smtp")
35 ;;(setq smtp-local-domain "YOUR DOMAIN NAME")
36 ;;(setq smtp-debug-info t)
37 ;;(autoload 'smtpmail-send-it "smtpmail")
38 ;;(setq user-full-name "YOUR NAME HERE")
40 ;; To queue mail, set smtpmail-queue-mail to t and use
41 ;; smtpmail-send-queued-mail to send.
50 (require 'mel) ; binary-write-decoded-region, binary-find-file-noselect
52 (eval-when-compile (require 'static))
54 ;; (static-when (featurep 'xemacs)
55 ;; (define-obsolete-variable-alias 'smtpmail-default-smtp-server
56 ;; 'smtp-default-server)
57 ;; (define-obsolete-variable-alias 'smtpmail-smtp-server 'smtp-server)
58 ;; (define-obsolete-variable-alias 'smtpmail-smtp-service 'smtp-service)
59 ;; (define-obsolete-variable-alias 'smtpmail-local-domain 'smtp-local-domain)
60 ;; (define-obsolete-variable-alias 'smtpmail-debug-info 'smtp-debug-info)
65 (defcustom smtpmail-queue-mail nil
66 "Specify if mail is queued (if t) or sent immediately (if nil).
67 If queued, it is stored in the directory `smtpmail-queue-dir'
68 and sent with `smtpmail-send-queued-mail'."
72 (defcustom smtpmail-queue-dir "~/Mail/queued-mail/"
73 "Directory where `smtpmail.el' stores queued mail."
77 (defvar smtpmail-queue-index-file "index"
78 "File name of queued mail index,
79 This is relative to `smtpmail-queue-dir'.")
81 (defvar smtpmail-queue-index
82 (concat (file-name-as-directory smtpmail-queue-dir)
83 smtpmail-queue-index-file))
85 (defvar smtpmail-recipient-address-list nil)
93 (defun smtpmail-send-it ()
95 (let ((errbuf (if mail-interactive
96 (generate-new-buffer " smtpmail errors")
98 (tembuf (generate-new-buffer " smtpmail temp"))
99 (case-fold-search nil)
102 (mailbuf (current-buffer)))
107 (insert-buffer-substring mailbuf)
108 (goto-char (point-max))
109 ;; require one newline at the end.
110 (or (= (preceding-char) ?\n)
112 ;; Change header-delimiter to be what sendmail expects.
113 (goto-char (point-min))
114 (if (re-search-forward
115 (concat "^\\(" (regexp-quote mail-header-separator) "\\)?\n"))
116 (replace-match "\n"))
118 (setq delimline (point-marker))
119 ;; (sendmail-synch-aliases)
120 (if (and mail-aliases (fboundp 'expand-mail-aliases)) ; XEmacs
121 (expand-mail-aliases (point-min) delimline))
122 (goto-char (point-min))
123 ;; ignore any blank lines in the header
124 (while (and (re-search-forward "\n\n\n*" delimline t)
125 (< (point) delimline))
126 (replace-match "\n"))
127 (let ((case-fold-search t))
128 (goto-char (point-min))
129 (goto-char (point-min))
130 (while (re-search-forward "^Resent-to:" delimline t)
131 (setq resend-to-addresses
133 (narrow-to-region (point)
136 (while (looking-at "^[ \t]")
139 (append (mail-parse-comma-list)
140 resend-to-addresses))))
141 ;;; Apparently this causes a duplicate Sender.
142 ;;; ;; If the From is different than current user, insert Sender.
143 ;;; (goto-char (point-min))
144 ;;; (and (re-search-forward "^From:" delimline t)
146 ;;; (require 'mail-utils)
147 ;;; (not (string-equal
148 ;;; (mail-strip-quoted-names
149 ;;; (save-restriction
150 ;;; (narrow-to-region (point-min) delimline)
151 ;;; (mail-fetch-field "From")))
152 ;;; (user-login-name))))
155 ;;; (insert "Sender: " (user-login-name) "\n")))
156 ;; Don't send out a blank subject line
157 (goto-char (point-min))
158 (if (re-search-forward "^Subject:\\([ \t]*\n\\)+\\b" delimline t)
160 ;; This one matches a Subject just before the header delimiter.
161 (if (and (re-search-forward "^Subject:\\([ \t]*\n\\)+" delimline t)
162 (= (match-end 0) delimline))
164 ;; Put the "From:" field in unless for some odd reason
165 ;; they put one in themselves.
166 (goto-char (point-min))
167 (if (not (re-search-forward "^From:" delimline t))
168 (let* ((login user-mail-address)
169 (fullname (user-full-name)))
170 (cond ((eq mail-from-style 'angles)
171 (insert "From: " fullname)
172 (let ((fullname-start (+ (point-min) 6))
173 (fullname-end (point-marker)))
174 (goto-char fullname-start)
175 ;; Look for a character that cannot appear unquoted
176 ;; according to RFC 822.
177 (if (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]"
180 ;; Quote fullname, escaping specials.
181 (goto-char fullname-start)
183 (while (re-search-forward "[\"\\]"
185 (replace-match "\\\\\\&" t))
187 (insert " <" login ">\n"))
188 ((eq mail-from-style 'parens)
189 (insert "From: " login " (")
190 (let ((fullname-start (point)))
192 (let ((fullname-end (point-marker)))
193 (goto-char fullname-start)
194 ;; RFC 822 says \ and nonmatching parentheses
195 ;; must be escaped in comments.
196 ;; Escape every instance of ()\ ...
197 (while (re-search-forward "[()\\]" fullname-end 1)
198 (replace-match "\\\\\\&" t))
199 ;; ... then undo escaping of matching parentheses,
200 ;; including matching nested parentheses.
201 (goto-char fullname-start)
202 (while (re-search-forward
203 "\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)"
205 (replace-match "\\1(\\3)" t)
206 (goto-char fullname-start))))
208 ((null mail-from-style)
209 (insert "From: " login "\n")))))
210 ;; Insert an extra newline if we need it to work around
211 ;; Sun's bug that swallows newlines.
212 (goto-char (1+ delimline))
213 (if (eval mail-mailer-swallows-blank-line)
215 ;; Find and handle any FCC fields.
216 (goto-char (point-min))
217 (if (re-search-forward "^FCC:" delimline t)
218 (mail-do-fcc delimline))
226 (setq smtpmail-recipient-address-list
227 (or resend-to-addresses
228 (smtp-deduce-address-list tembuf (point-min) delimline)))
230 (smtpmail-do-bcc delimline)
232 (if (not smtpmail-queue-mail)
233 (if smtpmail-recipient-address-list
234 (smtp-send-buffer user-mail-address
235 smtpmail-recipient-address-list
237 (error "Sending failed; no recipients"))
238 (let* ((file-data (convert-standard-filename
240 (file-name-as-directory smtpmail-queue-dir)
241 (time-stamp-yyyy-mm-dd)
242 "_" (time-stamp-hh:mm:ss))))
243 (file-elisp (concat file-data ".el"))
244 (buffer-data (create-file-buffer file-data))
245 (buffer-elisp (create-file-buffer file-elisp))
246 (buffer-scratch "*queue-mail*"))
248 (set-buffer buffer-data)
250 (insert-buffer tembuf)
251 (or (file-directory-p smtpmail-queue-dir)
252 (make-directory smtpmail-queue-dir t))
253 (binary-write-decoded-region (point-min) (point-max) file-data)
254 (set-buffer buffer-elisp)
257 "(setq smtpmail-recipient-address-list '"
258 (prin1-to-string smtpmail-recipient-address-list)
260 (write-file file-elisp)
261 (set-buffer (generate-new-buffer buffer-scratch))
262 (insert (concat file-data "\n"))
263 (append-to-file (point-min)
265 smtpmail-queue-index)
267 (kill-buffer buffer-scratch)
268 (kill-buffer buffer-data)
269 (kill-buffer buffer-elisp))))
272 (kill-buffer errbuf)))))
274 (defun smtpmail-send-queued-mail ()
275 "Send mail that was queued as a result of setting `smtpmail-queue-mail'."
277 ;;; Get index, get first mail, send it, get second mail, etc...
278 (let ((buffer-index (find-file-noselect smtpmail-queue-index))
282 (set-buffer buffer-index)
283 (beginning-of-buffer)
285 (setq file-msg (buffer-substring (point) (save-excursion
289 ;; Insert the message literally: it is already encoded as per
290 ;; the MIME headers, and code conversions might guess the
292 (setq tembuf (find-file-noselect file-msg nil t))
293 (if smtpmail-recipient-address-list
294 (smtp-send-buffer user-mail-address
295 smtpmail-recipient-address-list tembuf)
296 (error "Sending failed; no recipients"))
297 (delete-file file-msg)
298 (delete-file (concat file-msg ".el"))
301 (set-buffer buffer-index)
302 (save-buffer smtpmail-queue-index)
303 (kill-buffer buffer-index)
307 (defun smtpmail-do-bcc (header-end)
308 "Delete BCC: and their continuation lines from the header area.
309 There may be multiple BCC: lines, and each may have arbitrarily
310 many continuation lines."
311 (let ((case-fold-search t))
313 (goto-char (point-min))
314 ;; iterate over all BCC: lines
315 (while (re-search-forward "^BCC:" header-end t)
316 (delete-region (match-beginning 0) (progn (forward-line 1) (point)))
317 ;; get rid of any continuation lines
318 (while (and (looking-at "^[ \t].*\n") (< (point) header-end))
330 ;;; smtpmail.el ends here