Mercurial > emacs
annotate lisp/mail/smtpmail.el @ 33067:adc6c04ffe30
*** empty log message ***
author | Stefan Monnier <monnier@iro.umontreal.ca> |
---|---|
date | Mon, 30 Oct 2000 15:21:36 +0000 |
parents | a0126ac842dc |
children | 595c23d107f8 |
rev | line source |
---|---|
17517 | 1 ;;; smtpmail.el --- simple SMTP protocol (RFC 821) for sending mail |
26028
a0126ac842dc
(smtpmail-via-smtp): Add support for
Gerd Moellmann <gerd@gnu.org>
parents:
24871
diff
changeset
|
2 ;;; ### Hacked by Mike Taylor, 11th October 1999 to add support for |
a0126ac842dc
(smtpmail-via-smtp): Add support for
Gerd Moellmann <gerd@gnu.org>
parents:
24871
diff
changeset
|
3 ;;; automatically appending a domain to RCPT TO: addresses. |
15345 | 4 |
15451
89c1e7fe879a
(smtpmail-smtp-service): Use port 25 as default.
Richard M. Stallman <rms@gnu.org>
parents:
15372
diff
changeset
|
5 ;; Copyright (C) 1995, 1996 Free Software Foundation, Inc. |
15345 | 6 |
7 ;; Author: Tomoji Kagatani <kagatani@rbc.ncl.omron.co.jp> | |
15452
6f41e17b3452
(smtpmail-send-it): Don't handle FCC fields until after determining FROM field.
Richard M. Stallman <rms@gnu.org>
parents:
15451
diff
changeset
|
8 ;; Maintainer: Brian D. Carlstrom <bdc@ai.mit.edu> |
18092
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
9 ;; ESMTP support: Simon Leinen <simon@switch.ch> |
15345 | 10 ;; Keywords: mail |
11 | |
12 ;; This file is part of GNU Emacs. | |
13 | |
14 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
15 ;; it under the terms of the GNU General Public License as published by | |
16 ;; the Free Software Foundation; either version 2, or (at your option) | |
17 ;; any later version. | |
18 | |
19 ;; GNU Emacs is distributed in the hope that it will be useful, | |
20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
22 ;; GNU General Public License for more details. | |
23 | |
24 ;; You should have received a copy of the GNU General Public License | |
25 ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
26 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
27 ;; Boston, MA 02111-1307, USA. | |
28 | |
29 ;;; Commentary: | |
30 | |
31 ;; Send Mail to smtp host from smtpmail temp buffer. | |
32 | |
23142
98c430cac424
(smtpmail-send-it): Add autoload cookie.
Karl Heuer <kwzh@gnu.org>
parents:
22037
diff
changeset
|
33 ;; Please add these lines in your .emacs(_emacs) or use customize. |
15345 | 34 ;; |
23142
98c430cac424
(smtpmail-send-it): Add autoload cookie.
Karl Heuer <kwzh@gnu.org>
parents:
22037
diff
changeset
|
35 ;;(setq send-mail-function 'smtpmail-send-it) ; if you use `mail' |
98c430cac424
(smtpmail-send-it): Add autoload cookie.
Karl Heuer <kwzh@gnu.org>
parents:
22037
diff
changeset
|
36 ;;(setq message-send-mail-function 'smtpmail-send-it) ; if you use `message' |
15345 | 37 ;;(setq smtpmail-default-smtp-server "YOUR SMTP HOST") |
38 ;;(setq smtpmail-local-domain "YOUR DOMAIN NAME") | |
26028
a0126ac842dc
(smtpmail-via-smtp): Add support for
Gerd Moellmann <gerd@gnu.org>
parents:
24871
diff
changeset
|
39 ;;(setq smtpmail-sendto-domain "YOUR DOMAIN NAME") |
23142
98c430cac424
(smtpmail-send-it): Add autoload cookie.
Karl Heuer <kwzh@gnu.org>
parents:
22037
diff
changeset
|
40 ;;(setq smtpmail-debug-info t) ; only to debug problems |
15345 | 41 |
18094 | 42 ;; To queue mail, set smtpmail-queue-mail to t and use |
43 ;; smtpmail-send-queued-mail to send. | |
44 | |
45 | |
15345 | 46 ;;; Code: |
47 | |
48 (require 'sendmail) | |
18094 | 49 (require 'time-stamp) |
15345 | 50 |
51 ;;; | |
17436
2a9fdbfcb993
Add defgroup; use defcustom for user vars.
Richard M. Stallman <rms@gnu.org>
parents:
16907
diff
changeset
|
52 (defgroup smtpmail nil |
2a9fdbfcb993
Add defgroup; use defcustom for user vars.
Richard M. Stallman <rms@gnu.org>
parents:
16907
diff
changeset
|
53 "SMTP protocol for sending mail." |
2a9fdbfcb993
Add defgroup; use defcustom for user vars.
Richard M. Stallman <rms@gnu.org>
parents:
16907
diff
changeset
|
54 :group 'mail) |
2a9fdbfcb993
Add defgroup; use defcustom for user vars.
Richard M. Stallman <rms@gnu.org>
parents:
16907
diff
changeset
|
55 |
15345 | 56 |
17436
2a9fdbfcb993
Add defgroup; use defcustom for user vars.
Richard M. Stallman <rms@gnu.org>
parents:
16907
diff
changeset
|
57 (defcustom smtpmail-default-smtp-server nil |
2a9fdbfcb993
Add defgroup; use defcustom for user vars.
Richard M. Stallman <rms@gnu.org>
parents:
16907
diff
changeset
|
58 "*Specify default SMTP server." |
2a9fdbfcb993
Add defgroup; use defcustom for user vars.
Richard M. Stallman <rms@gnu.org>
parents:
16907
diff
changeset
|
59 :type '(choice (const nil) string) |
2a9fdbfcb993
Add defgroup; use defcustom for user vars.
Richard M. Stallman <rms@gnu.org>
parents:
16907
diff
changeset
|
60 :group 'smtpmail) |
2a9fdbfcb993
Add defgroup; use defcustom for user vars.
Richard M. Stallman <rms@gnu.org>
parents:
16907
diff
changeset
|
61 |
2a9fdbfcb993
Add defgroup; use defcustom for user vars.
Richard M. Stallman <rms@gnu.org>
parents:
16907
diff
changeset
|
62 (defcustom smtpmail-smtp-server |
15451
89c1e7fe879a
(smtpmail-smtp-service): Use port 25 as default.
Richard M. Stallman <rms@gnu.org>
parents:
15372
diff
changeset
|
63 (or (getenv "SMTPSERVER") smtpmail-default-smtp-server) |
17436
2a9fdbfcb993
Add defgroup; use defcustom for user vars.
Richard M. Stallman <rms@gnu.org>
parents:
16907
diff
changeset
|
64 "*The name of the host running SMTP server." |
2a9fdbfcb993
Add defgroup; use defcustom for user vars.
Richard M. Stallman <rms@gnu.org>
parents:
16907
diff
changeset
|
65 :type '(choice (const nil) string) |
2a9fdbfcb993
Add defgroup; use defcustom for user vars.
Richard M. Stallman <rms@gnu.org>
parents:
16907
diff
changeset
|
66 :group 'smtpmail) |
15345 | 67 |
17436
2a9fdbfcb993
Add defgroup; use defcustom for user vars.
Richard M. Stallman <rms@gnu.org>
parents:
16907
diff
changeset
|
68 (defcustom smtpmail-smtp-service 25 |
2a9fdbfcb993
Add defgroup; use defcustom for user vars.
Richard M. Stallman <rms@gnu.org>
parents:
16907
diff
changeset
|
69 "*SMTP service port number. smtp or 25 ." |
2a9fdbfcb993
Add defgroup; use defcustom for user vars.
Richard M. Stallman <rms@gnu.org>
parents:
16907
diff
changeset
|
70 :type 'integer |
2a9fdbfcb993
Add defgroup; use defcustom for user vars.
Richard M. Stallman <rms@gnu.org>
parents:
16907
diff
changeset
|
71 :group 'smtpmail) |
15345 | 72 |
17436
2a9fdbfcb993
Add defgroup; use defcustom for user vars.
Richard M. Stallman <rms@gnu.org>
parents:
16907
diff
changeset
|
73 (defcustom smtpmail-local-domain nil |
15345 | 74 "*Local domain name without a host name. |
75 If the function (system-name) returns the full internet address, | |
17436
2a9fdbfcb993
Add defgroup; use defcustom for user vars.
Richard M. Stallman <rms@gnu.org>
parents:
16907
diff
changeset
|
76 don't define this value." |
2a9fdbfcb993
Add defgroup; use defcustom for user vars.
Richard M. Stallman <rms@gnu.org>
parents:
16907
diff
changeset
|
77 :type '(choice (const nil) string) |
2a9fdbfcb993
Add defgroup; use defcustom for user vars.
Richard M. Stallman <rms@gnu.org>
parents:
16907
diff
changeset
|
78 :group 'smtpmail) |
15345 | 79 |
26028
a0126ac842dc
(smtpmail-via-smtp): Add support for
Gerd Moellmann <gerd@gnu.org>
parents:
24871
diff
changeset
|
80 (defcustom smtpmail-sendto-domain nil |
a0126ac842dc
(smtpmail-via-smtp): Add support for
Gerd Moellmann <gerd@gnu.org>
parents:
24871
diff
changeset
|
81 "*Local domain name without a host name. |
a0126ac842dc
(smtpmail-via-smtp): Add support for
Gerd Moellmann <gerd@gnu.org>
parents:
24871
diff
changeset
|
82 This is appended (with an @-sign) to any specified recipients which do |
a0126ac842dc
(smtpmail-via-smtp): Add support for
Gerd Moellmann <gerd@gnu.org>
parents:
24871
diff
changeset
|
83 not include an @-sign, so that each RCPT TO address is fully qualified. |
a0126ac842dc
(smtpmail-via-smtp): Add support for
Gerd Moellmann <gerd@gnu.org>
parents:
24871
diff
changeset
|
84 \(Some configurations of sendmail require this.) |
a0126ac842dc
(smtpmail-via-smtp): Add support for
Gerd Moellmann <gerd@gnu.org>
parents:
24871
diff
changeset
|
85 |
a0126ac842dc
(smtpmail-via-smtp): Add support for
Gerd Moellmann <gerd@gnu.org>
parents:
24871
diff
changeset
|
86 Don't bother to set this unless you have get an error like: |
a0126ac842dc
(smtpmail-via-smtp): Add support for
Gerd Moellmann <gerd@gnu.org>
parents:
24871
diff
changeset
|
87 Sending failed; SMTP protocol error |
a0126ac842dc
(smtpmail-via-smtp): Add support for
Gerd Moellmann <gerd@gnu.org>
parents:
24871
diff
changeset
|
88 when sending mail, and the *trace of SMTP session to <somewhere>* |
a0126ac842dc
(smtpmail-via-smtp): Add support for
Gerd Moellmann <gerd@gnu.org>
parents:
24871
diff
changeset
|
89 buffer includes an exchange like: |
a0126ac842dc
(smtpmail-via-smtp): Add support for
Gerd Moellmann <gerd@gnu.org>
parents:
24871
diff
changeset
|
90 RCPT TO: <someone> |
a0126ac842dc
(smtpmail-via-smtp): Add support for
Gerd Moellmann <gerd@gnu.org>
parents:
24871
diff
changeset
|
91 501 <someone>: recipient address must contain a domain |
a0126ac842dc
(smtpmail-via-smtp): Add support for
Gerd Moellmann <gerd@gnu.org>
parents:
24871
diff
changeset
|
92 " |
a0126ac842dc
(smtpmail-via-smtp): Add support for
Gerd Moellmann <gerd@gnu.org>
parents:
24871
diff
changeset
|
93 :type '(choice (const nil) string) |
a0126ac842dc
(smtpmail-via-smtp): Add support for
Gerd Moellmann <gerd@gnu.org>
parents:
24871
diff
changeset
|
94 :group 'smtpmail) |
a0126ac842dc
(smtpmail-via-smtp): Add support for
Gerd Moellmann <gerd@gnu.org>
parents:
24871
diff
changeset
|
95 |
a0126ac842dc
(smtpmail-via-smtp): Add support for
Gerd Moellmann <gerd@gnu.org>
parents:
24871
diff
changeset
|
96 (defun maybe-append-domain (recipient) |
a0126ac842dc
(smtpmail-via-smtp): Add support for
Gerd Moellmann <gerd@gnu.org>
parents:
24871
diff
changeset
|
97 (if (or (not smtpmail-sendto-domain) |
a0126ac842dc
(smtpmail-via-smtp): Add support for
Gerd Moellmann <gerd@gnu.org>
parents:
24871
diff
changeset
|
98 (string-match "@" recipient)) |
a0126ac842dc
(smtpmail-via-smtp): Add support for
Gerd Moellmann <gerd@gnu.org>
parents:
24871
diff
changeset
|
99 recipient |
a0126ac842dc
(smtpmail-via-smtp): Add support for
Gerd Moellmann <gerd@gnu.org>
parents:
24871
diff
changeset
|
100 (concat recipient "@" smtpmail-sendto-domain))) |
a0126ac842dc
(smtpmail-via-smtp): Add support for
Gerd Moellmann <gerd@gnu.org>
parents:
24871
diff
changeset
|
101 |
17436
2a9fdbfcb993
Add defgroup; use defcustom for user vars.
Richard M. Stallman <rms@gnu.org>
parents:
16907
diff
changeset
|
102 (defcustom smtpmail-debug-info nil |
2a9fdbfcb993
Add defgroup; use defcustom for user vars.
Richard M. Stallman <rms@gnu.org>
parents:
16907
diff
changeset
|
103 "*smtpmail debug info printout. messages and process buffer." |
2a9fdbfcb993
Add defgroup; use defcustom for user vars.
Richard M. Stallman <rms@gnu.org>
parents:
16907
diff
changeset
|
104 :type 'boolean |
2a9fdbfcb993
Add defgroup; use defcustom for user vars.
Richard M. Stallman <rms@gnu.org>
parents:
16907
diff
changeset
|
105 :group 'smtpmail) |
15345 | 106 |
17436
2a9fdbfcb993
Add defgroup; use defcustom for user vars.
Richard M. Stallman <rms@gnu.org>
parents:
16907
diff
changeset
|
107 (defcustom smtpmail-code-conv-from nil ;; *junet* |
2a9fdbfcb993
Add defgroup; use defcustom for user vars.
Richard M. Stallman <rms@gnu.org>
parents:
16907
diff
changeset
|
108 "*smtpmail code convert from this code to *internal*..for tiny-mime.." |
2a9fdbfcb993
Add defgroup; use defcustom for user vars.
Richard M. Stallman <rms@gnu.org>
parents:
16907
diff
changeset
|
109 :type 'boolean |
2a9fdbfcb993
Add defgroup; use defcustom for user vars.
Richard M. Stallman <rms@gnu.org>
parents:
16907
diff
changeset
|
110 :group 'smtpmail) |
15345 | 111 |
18094 | 112 (defcustom smtpmail-queue-mail nil |
113 "*Specify if mail is queued (if t) or sent immediately (if nil). | |
114 If queued, it is stored in the directory `smtpmail-queue-dir' | |
115 and sent with `smtpmail-send-queued-mail'." | |
116 :type 'boolean | |
117 :group 'smtpmail) | |
118 | |
119 (defcustom smtpmail-queue-dir "~/Mail/queued-mail/" | |
120 "*Directory where `smtpmail.el' stores queued mail." | |
121 :type 'directory | |
122 :group 'smtpmail) | |
123 | |
124 (defvar smtpmail-queue-index-file "index" | |
125 "File name of queued mail index, | |
126 This is relative to `smtpmail-queue-dir'.") | |
127 | |
23444
a632871d7cfa
(smtpmail-send-data-1): Use encode-coding-string.
Richard M. Stallman <rms@gnu.org>
parents:
23181
diff
changeset
|
128 (defvar smtpmail-address-buffer) |
a632871d7cfa
(smtpmail-send-data-1): Use encode-coding-string.
Richard M. Stallman <rms@gnu.org>
parents:
23181
diff
changeset
|
129 (defvar smtpmail-recipient-address-list) |
a632871d7cfa
(smtpmail-send-data-1): Use encode-coding-string.
Richard M. Stallman <rms@gnu.org>
parents:
23181
diff
changeset
|
130 |
a632871d7cfa
(smtpmail-send-data-1): Use encode-coding-string.
Richard M. Stallman <rms@gnu.org>
parents:
23181
diff
changeset
|
131 ;; Buffer-local variable. |
a632871d7cfa
(smtpmail-send-data-1): Use encode-coding-string.
Richard M. Stallman <rms@gnu.org>
parents:
23181
diff
changeset
|
132 (defvar smtpmail-read-point) |
a632871d7cfa
(smtpmail-send-data-1): Use encode-coding-string.
Richard M. Stallman <rms@gnu.org>
parents:
23181
diff
changeset
|
133 |
18094 | 134 (defvar smtpmail-queue-index (concat smtpmail-queue-dir |
135 smtpmail-queue-index-file)) | |
136 | |
15345 | 137 ;;; |
138 ;;; | |
139 ;;; | |
140 | |
23142
98c430cac424
(smtpmail-send-it): Add autoload cookie.
Karl Heuer <kwzh@gnu.org>
parents:
22037
diff
changeset
|
141 ;;;###autoload |
15345 | 142 (defun smtpmail-send-it () |
15451
89c1e7fe879a
(smtpmail-smtp-service): Use port 25 as default.
Richard M. Stallman <rms@gnu.org>
parents:
15372
diff
changeset
|
143 (require 'mail-utils) |
15345 | 144 (let ((errbuf (if mail-interactive |
145 (generate-new-buffer " smtpmail errors") | |
146 0)) | |
147 (tembuf (generate-new-buffer " smtpmail temp")) | |
148 (case-fold-search nil) | |
149 delimline | |
24773 | 150 (mailbuf (current-buffer)) |
151 (smtpmail-code-conv-from | |
152 (if enable-multibyte-characters | |
153 (let ((sendmail-coding-system smtpmail-code-conv-from)) | |
154 (select-message-coding-system))))) | |
15345 | 155 (unwind-protect |
156 (save-excursion | |
157 (set-buffer tembuf) | |
158 (erase-buffer) | |
159 (insert-buffer-substring mailbuf) | |
160 (goto-char (point-max)) | |
161 ;; require one newline at the end. | |
162 (or (= (preceding-char) ?\n) | |
163 (insert ?\n)) | |
164 ;; Change header-delimiter to be what sendmail expects. | |
21862
c0569fcdef88
(smtpmail-send-it): Use mail-sendmail-undelimit-header.
Richard M. Stallman <rms@gnu.org>
parents:
21683
diff
changeset
|
165 (mail-sendmail-undelimit-header) |
15345 | 166 (setq delimline (point-marker)) |
15451
89c1e7fe879a
(smtpmail-smtp-service): Use port 25 as default.
Richard M. Stallman <rms@gnu.org>
parents:
15372
diff
changeset
|
167 ;; (sendmail-synch-aliases) |
15345 | 168 (if mail-aliases |
169 (expand-mail-aliases (point-min) delimline)) | |
170 (goto-char (point-min)) | |
171 ;; ignore any blank lines in the header | |
172 (while (and (re-search-forward "\n\n\n*" delimline t) | |
173 (< (point) delimline)) | |
174 (replace-match "\n")) | |
175 (let ((case-fold-search t)) | |
21683
dfb671ba22f8
(smtpmail-send-it): Deleted all code related to Resent-To: processing.
Richard M. Stallman <rms@gnu.org>
parents:
20058
diff
changeset
|
176 ;; We used to process Resent-... headers here, |
dfb671ba22f8
(smtpmail-send-it): Deleted all code related to Resent-To: processing.
Richard M. Stallman <rms@gnu.org>
parents:
20058
diff
changeset
|
177 ;; but it was not done properly, and the job |
dfb671ba22f8
(smtpmail-send-it): Deleted all code related to Resent-To: processing.
Richard M. Stallman <rms@gnu.org>
parents:
20058
diff
changeset
|
178 ;; is done correctly in smtpmail-deduce-address-list. |
15345 | 179 ;; Don't send out a blank subject line |
180 (goto-char (point-min)) | |
21683
dfb671ba22f8
(smtpmail-send-it): Deleted all code related to Resent-To: processing.
Richard M. Stallman <rms@gnu.org>
parents:
20058
diff
changeset
|
181 (if (re-search-forward "^Subject:\\([ \t]*\n\\)+\\b" delimline t) |
dfb671ba22f8
(smtpmail-send-it): Deleted all code related to Resent-To: processing.
Richard M. Stallman <rms@gnu.org>
parents:
20058
diff
changeset
|
182 (replace-match "") |
dfb671ba22f8
(smtpmail-send-it): Deleted all code related to Resent-To: processing.
Richard M. Stallman <rms@gnu.org>
parents:
20058
diff
changeset
|
183 ;; This one matches a Subject just before the header delimiter. |
dfb671ba22f8
(smtpmail-send-it): Deleted all code related to Resent-To: processing.
Richard M. Stallman <rms@gnu.org>
parents:
20058
diff
changeset
|
184 (if (and (re-search-forward "^Subject:\\([ \t]*\n\\)+" delimline t) |
dfb671ba22f8
(smtpmail-send-it): Deleted all code related to Resent-To: processing.
Richard M. Stallman <rms@gnu.org>
parents:
20058
diff
changeset
|
185 (= (match-end 0) delimline)) |
dfb671ba22f8
(smtpmail-send-it): Deleted all code related to Resent-To: processing.
Richard M. Stallman <rms@gnu.org>
parents:
20058
diff
changeset
|
186 (replace-match ""))) |
15452
6f41e17b3452
(smtpmail-send-it): Don't handle FCC fields until after determining FROM field.
Richard M. Stallman <rms@gnu.org>
parents:
15451
diff
changeset
|
187 ;; Put the "From:" field in unless for some odd reason |
6f41e17b3452
(smtpmail-send-it): Don't handle FCC fields until after determining FROM field.
Richard M. Stallman <rms@gnu.org>
parents:
15451
diff
changeset
|
188 ;; they put one in themselves. |
6f41e17b3452
(smtpmail-send-it): Don't handle FCC fields until after determining FROM field.
Richard M. Stallman <rms@gnu.org>
parents:
15451
diff
changeset
|
189 (goto-char (point-min)) |
6f41e17b3452
(smtpmail-send-it): Don't handle FCC fields until after determining FROM field.
Richard M. Stallman <rms@gnu.org>
parents:
15451
diff
changeset
|
190 (if (not (re-search-forward "^From:" delimline t)) |
6f41e17b3452
(smtpmail-send-it): Don't handle FCC fields until after determining FROM field.
Richard M. Stallman <rms@gnu.org>
parents:
15451
diff
changeset
|
191 (let* ((login user-mail-address) |
6f41e17b3452
(smtpmail-send-it): Don't handle FCC fields until after determining FROM field.
Richard M. Stallman <rms@gnu.org>
parents:
15451
diff
changeset
|
192 (fullname (user-full-name))) |
6f41e17b3452
(smtpmail-send-it): Don't handle FCC fields until after determining FROM field.
Richard M. Stallman <rms@gnu.org>
parents:
15451
diff
changeset
|
193 (cond ((eq mail-from-style 'angles) |
6f41e17b3452
(smtpmail-send-it): Don't handle FCC fields until after determining FROM field.
Richard M. Stallman <rms@gnu.org>
parents:
15451
diff
changeset
|
194 (insert "From: " fullname) |
6f41e17b3452
(smtpmail-send-it): Don't handle FCC fields until after determining FROM field.
Richard M. Stallman <rms@gnu.org>
parents:
15451
diff
changeset
|
195 (let ((fullname-start (+ (point-min) 6)) |
6f41e17b3452
(smtpmail-send-it): Don't handle FCC fields until after determining FROM field.
Richard M. Stallman <rms@gnu.org>
parents:
15451
diff
changeset
|
196 (fullname-end (point-marker))) |
6f41e17b3452
(smtpmail-send-it): Don't handle FCC fields until after determining FROM field.
Richard M. Stallman <rms@gnu.org>
parents:
15451
diff
changeset
|
197 (goto-char fullname-start) |
6f41e17b3452
(smtpmail-send-it): Don't handle FCC fields until after determining FROM field.
Richard M. Stallman <rms@gnu.org>
parents:
15451
diff
changeset
|
198 ;; Look for a character that cannot appear unquoted |
6f41e17b3452
(smtpmail-send-it): Don't handle FCC fields until after determining FROM field.
Richard M. Stallman <rms@gnu.org>
parents:
15451
diff
changeset
|
199 ;; according to RFC 822. |
6f41e17b3452
(smtpmail-send-it): Don't handle FCC fields until after determining FROM field.
Richard M. Stallman <rms@gnu.org>
parents:
15451
diff
changeset
|
200 (if (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]" |
6f41e17b3452
(smtpmail-send-it): Don't handle FCC fields until after determining FROM field.
Richard M. Stallman <rms@gnu.org>
parents:
15451
diff
changeset
|
201 fullname-end 1) |
6f41e17b3452
(smtpmail-send-it): Don't handle FCC fields until after determining FROM field.
Richard M. Stallman <rms@gnu.org>
parents:
15451
diff
changeset
|
202 (progn |
6f41e17b3452
(smtpmail-send-it): Don't handle FCC fields until after determining FROM field.
Richard M. Stallman <rms@gnu.org>
parents:
15451
diff
changeset
|
203 ;; Quote fullname, escaping specials. |
6f41e17b3452
(smtpmail-send-it): Don't handle FCC fields until after determining FROM field.
Richard M. Stallman <rms@gnu.org>
parents:
15451
diff
changeset
|
204 (goto-char fullname-start) |
6f41e17b3452
(smtpmail-send-it): Don't handle FCC fields until after determining FROM field.
Richard M. Stallman <rms@gnu.org>
parents:
15451
diff
changeset
|
205 (insert "\"") |
6f41e17b3452
(smtpmail-send-it): Don't handle FCC fields until after determining FROM field.
Richard M. Stallman <rms@gnu.org>
parents:
15451
diff
changeset
|
206 (while (re-search-forward "[\"\\]" |
6f41e17b3452
(smtpmail-send-it): Don't handle FCC fields until after determining FROM field.
Richard M. Stallman <rms@gnu.org>
parents:
15451
diff
changeset
|
207 fullname-end 1) |
6f41e17b3452
(smtpmail-send-it): Don't handle FCC fields until after determining FROM field.
Richard M. Stallman <rms@gnu.org>
parents:
15451
diff
changeset
|
208 (replace-match "\\\\\\&" t)) |
6f41e17b3452
(smtpmail-send-it): Don't handle FCC fields until after determining FROM field.
Richard M. Stallman <rms@gnu.org>
parents:
15451
diff
changeset
|
209 (insert "\"")))) |
6f41e17b3452
(smtpmail-send-it): Don't handle FCC fields until after determining FROM field.
Richard M. Stallman <rms@gnu.org>
parents:
15451
diff
changeset
|
210 (insert " <" login ">\n")) |
6f41e17b3452
(smtpmail-send-it): Don't handle FCC fields until after determining FROM field.
Richard M. Stallman <rms@gnu.org>
parents:
15451
diff
changeset
|
211 ((eq mail-from-style 'parens) |
6f41e17b3452
(smtpmail-send-it): Don't handle FCC fields until after determining FROM field.
Richard M. Stallman <rms@gnu.org>
parents:
15451
diff
changeset
|
212 (insert "From: " login " (") |
6f41e17b3452
(smtpmail-send-it): Don't handle FCC fields until after determining FROM field.
Richard M. Stallman <rms@gnu.org>
parents:
15451
diff
changeset
|
213 (let ((fullname-start (point))) |
6f41e17b3452
(smtpmail-send-it): Don't handle FCC fields until after determining FROM field.
Richard M. Stallman <rms@gnu.org>
parents:
15451
diff
changeset
|
214 (insert fullname) |
6f41e17b3452
(smtpmail-send-it): Don't handle FCC fields until after determining FROM field.
Richard M. Stallman <rms@gnu.org>
parents:
15451
diff
changeset
|
215 (let ((fullname-end (point-marker))) |
6f41e17b3452
(smtpmail-send-it): Don't handle FCC fields until after determining FROM field.
Richard M. Stallman <rms@gnu.org>
parents:
15451
diff
changeset
|
216 (goto-char fullname-start) |
6f41e17b3452
(smtpmail-send-it): Don't handle FCC fields until after determining FROM field.
Richard M. Stallman <rms@gnu.org>
parents:
15451
diff
changeset
|
217 ;; RFC 822 says \ and nonmatching parentheses |
6f41e17b3452
(smtpmail-send-it): Don't handle FCC fields until after determining FROM field.
Richard M. Stallman <rms@gnu.org>
parents:
15451
diff
changeset
|
218 ;; must be escaped in comments. |
6f41e17b3452
(smtpmail-send-it): Don't handle FCC fields until after determining FROM field.
Richard M. Stallman <rms@gnu.org>
parents:
15451
diff
changeset
|
219 ;; Escape every instance of ()\ ... |
6f41e17b3452
(smtpmail-send-it): Don't handle FCC fields until after determining FROM field.
Richard M. Stallman <rms@gnu.org>
parents:
15451
diff
changeset
|
220 (while (re-search-forward "[()\\]" fullname-end 1) |
6f41e17b3452
(smtpmail-send-it): Don't handle FCC fields until after determining FROM field.
Richard M. Stallman <rms@gnu.org>
parents:
15451
diff
changeset
|
221 (replace-match "\\\\\\&" t)) |
6f41e17b3452
(smtpmail-send-it): Don't handle FCC fields until after determining FROM field.
Richard M. Stallman <rms@gnu.org>
parents:
15451
diff
changeset
|
222 ;; ... then undo escaping of matching parentheses, |
6f41e17b3452
(smtpmail-send-it): Don't handle FCC fields until after determining FROM field.
Richard M. Stallman <rms@gnu.org>
parents:
15451
diff
changeset
|
223 ;; including matching nested parentheses. |
6f41e17b3452
(smtpmail-send-it): Don't handle FCC fields until after determining FROM field.
Richard M. Stallman <rms@gnu.org>
parents:
15451
diff
changeset
|
224 (goto-char fullname-start) |
6f41e17b3452
(smtpmail-send-it): Don't handle FCC fields until after determining FROM field.
Richard M. Stallman <rms@gnu.org>
parents:
15451
diff
changeset
|
225 (while (re-search-forward |
6f41e17b3452
(smtpmail-send-it): Don't handle FCC fields until after determining FROM field.
Richard M. Stallman <rms@gnu.org>
parents:
15451
diff
changeset
|
226 "\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)" |
6f41e17b3452
(smtpmail-send-it): Don't handle FCC fields until after determining FROM field.
Richard M. Stallman <rms@gnu.org>
parents:
15451
diff
changeset
|
227 fullname-end 1) |
6f41e17b3452
(smtpmail-send-it): Don't handle FCC fields until after determining FROM field.
Richard M. Stallman <rms@gnu.org>
parents:
15451
diff
changeset
|
228 (replace-match "\\1(\\3)" t) |
6f41e17b3452
(smtpmail-send-it): Don't handle FCC fields until after determining FROM field.
Richard M. Stallman <rms@gnu.org>
parents:
15451
diff
changeset
|
229 (goto-char fullname-start)))) |
6f41e17b3452
(smtpmail-send-it): Don't handle FCC fields until after determining FROM field.
Richard M. Stallman <rms@gnu.org>
parents:
15451
diff
changeset
|
230 (insert ")\n")) |
6f41e17b3452
(smtpmail-send-it): Don't handle FCC fields until after determining FROM field.
Richard M. Stallman <rms@gnu.org>
parents:
15451
diff
changeset
|
231 ((null mail-from-style) |
6f41e17b3452
(smtpmail-send-it): Don't handle FCC fields until after determining FROM field.
Richard M. Stallman <rms@gnu.org>
parents:
15451
diff
changeset
|
232 (insert "From: " login "\n"))))) |
15345 | 233 ;; Insert an extra newline if we need it to work around |
234 ;; Sun's bug that swallows newlines. | |
235 (goto-char (1+ delimline)) | |
236 (if (eval mail-mailer-swallows-blank-line) | |
237 (newline)) | |
15452
6f41e17b3452
(smtpmail-send-it): Don't handle FCC fields until after determining FROM field.
Richard M. Stallman <rms@gnu.org>
parents:
15451
diff
changeset
|
238 ;; Find and handle any FCC fields. |
6f41e17b3452
(smtpmail-send-it): Don't handle FCC fields until after determining FROM field.
Richard M. Stallman <rms@gnu.org>
parents:
15451
diff
changeset
|
239 (goto-char (point-min)) |
6f41e17b3452
(smtpmail-send-it): Don't handle FCC fields until after determining FROM field.
Richard M. Stallman <rms@gnu.org>
parents:
15451
diff
changeset
|
240 (if (re-search-forward "^FCC:" delimline t) |
6f41e17b3452
(smtpmail-send-it): Don't handle FCC fields until after determining FROM field.
Richard M. Stallman <rms@gnu.org>
parents:
15451
diff
changeset
|
241 (mail-do-fcc delimline)) |
15345 | 242 (if mail-interactive |
243 (save-excursion | |
244 (set-buffer errbuf) | |
245 (erase-buffer)))) | |
246 ;; | |
247 ;; | |
248 ;; | |
249 (setq smtpmail-address-buffer (generate-new-buffer "*smtp-mail*")) | |
250 (setq smtpmail-recipient-address-list | |
21683
dfb671ba22f8
(smtpmail-send-it): Deleted all code related to Resent-To: processing.
Richard M. Stallman <rms@gnu.org>
parents:
20058
diff
changeset
|
251 (smtpmail-deduce-address-list tembuf (point-min) delimline)) |
15345 | 252 (kill-buffer smtpmail-address-buffer) |
18094 | 253 |
15345 | 254 (smtpmail-do-bcc delimline) |
18094 | 255 ; Send or queue |
256 (if (not smtpmail-queue-mail) | |
257 (if (not (null smtpmail-recipient-address-list)) | |
258 (if (not (smtpmail-via-smtp | |
259 smtpmail-recipient-address-list tembuf)) | |
260 (error "Sending failed; SMTP protocol error")) | |
261 (error "Sending failed; no recipients")) | |
262 (let* ((file-data (concat | |
263 smtpmail-queue-dir | |
20058
7077ba8a265b
(smtpmail-send-it): Don't use time-stamp-strftime.
Karl Heuer <kwzh@gnu.org>
parents:
18094
diff
changeset
|
264 (concat (time-stamp-yyyy-mm-dd) |
7077ba8a265b
(smtpmail-send-it): Don't use time-stamp-strftime.
Karl Heuer <kwzh@gnu.org>
parents:
18094
diff
changeset
|
265 "_" (time-stamp-hh:mm:ss)))) |
24871
45799f110d16
(smtpmail-send-it): Use convert-standard-filename to make file names
Andrew Innes <andrewi@gnu.org>
parents:
24773
diff
changeset
|
266 (file-data (convert-standard-filename file-data)) |
45799f110d16
(smtpmail-send-it): Use convert-standard-filename to make file names
Andrew Innes <andrewi@gnu.org>
parents:
24773
diff
changeset
|
267 (file-elisp (concat file-data ".el")) |
18094 | 268 (buffer-data (create-file-buffer file-data)) |
269 (buffer-elisp (create-file-buffer file-elisp)) | |
270 (buffer-scratch "*queue-mail*")) | |
271 (save-excursion | |
272 (set-buffer buffer-data) | |
273 (erase-buffer) | |
274 (insert-buffer tembuf) | |
275 (write-file file-data) | |
276 (set-buffer buffer-elisp) | |
277 (erase-buffer) | |
278 (insert (concat | |
279 "(setq smtpmail-recipient-address-list '" | |
280 (prin1-to-string smtpmail-recipient-address-list) | |
281 ")\n")) | |
282 (write-file file-elisp) | |
283 (set-buffer (generate-new-buffer buffer-scratch)) | |
284 (insert (concat file-data "\n")) | |
285 (append-to-file (point-min) | |
286 (point-max) | |
287 smtpmail-queue-index) | |
288 ) | |
289 (kill-buffer buffer-scratch) | |
290 (kill-buffer buffer-data) | |
291 (kill-buffer buffer-elisp)))) | |
15345 | 292 (kill-buffer tembuf) |
293 (if (bufferp errbuf) | |
294 (kill-buffer errbuf))))) | |
295 | |
18094 | 296 (defun smtpmail-send-queued-mail () |
297 "Send mail that was queued as a result of setting `smtpmail-queue-mail'." | |
298 (interactive) | |
299 ;;; Get index, get first mail, send it, get second mail, etc... | |
300 (let ((buffer-index (find-file-noselect smtpmail-queue-index)) | |
301 (file-msg "") | |
302 (tembuf nil)) | |
303 (save-excursion | |
304 (set-buffer buffer-index) | |
305 (beginning-of-buffer) | |
306 (while (not (eobp)) | |
307 (setq file-msg (buffer-substring (point) (save-excursion | |
308 (end-of-line) | |
309 (point)))) | |
310 (load file-msg) | |
311 (setq tembuf (find-file-noselect file-msg)) | |
312 (if (not (null smtpmail-recipient-address-list)) | |
313 (if (not (smtpmail-via-smtp smtpmail-recipient-address-list | |
314 tembuf)) | |
315 (error "Sending failed; SMTP protocol error")) | |
316 (error "Sending failed; no recipients")) | |
317 (delete-file file-msg) | |
318 (delete-file (concat file-msg ".el")) | |
319 (kill-buffer tembuf) | |
320 (kill-line 1)) | |
321 (set-buffer buffer-index) | |
322 (save-buffer smtpmail-queue-index) | |
323 (kill-buffer buffer-index) | |
324 ))) | |
15345 | 325 |
326 ;(defun smtpmail-via-smtp (host,port,sender,destination,smtpmail-text-buffer) | |
327 | |
328 (defun smtpmail-fqdn () | |
329 (if smtpmail-local-domain | |
330 (concat (system-name) "." smtpmail-local-domain) | |
331 (system-name))) | |
332 | |
333 (defun smtpmail-via-smtp (recipient smtpmail-text-buffer) | |
334 (let ((process nil) | |
23142
98c430cac424
(smtpmail-send-it): Add autoload cookie.
Karl Heuer <kwzh@gnu.org>
parents:
22037
diff
changeset
|
335 (host (or smtpmail-smtp-server |
98c430cac424
(smtpmail-send-it): Add autoload cookie.
Karl Heuer <kwzh@gnu.org>
parents:
22037
diff
changeset
|
336 (error "`smtpmail-smtp-server' not defined"))) |
15346
4cd6ff2384dc
(smtpmail-send-it): Fix error messages.
Richard M. Stallman <rms@gnu.org>
parents:
15345
diff
changeset
|
337 (port smtpmail-smtp-service) |
15345 | 338 response-code |
15346
4cd6ff2384dc
(smtpmail-send-it): Fix error messages.
Richard M. Stallman <rms@gnu.org>
parents:
15345
diff
changeset
|
339 greeting |
18092
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
340 process-buffer |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
341 (supported-extensions '())) |
15345 | 342 (unwind-protect |
343 (catch 'done | |
344 ;; get or create the trace buffer | |
345 (setq process-buffer | |
346 (get-buffer-create (format "*trace of SMTP session to %s*" host))) | |
347 | |
348 ;; clear the trace buffer of old output | |
349 (save-excursion | |
350 (set-buffer process-buffer) | |
351 (erase-buffer)) | |
352 | |
353 ;; open the connection to the server | |
354 (setq process (open-network-stream "SMTP" process-buffer host port)) | |
355 (and (null process) (throw 'done nil)) | |
356 | |
357 ;; set the send-filter | |
358 (set-process-filter process 'smtpmail-process-filter) | |
359 | |
360 (save-excursion | |
361 (set-buffer process-buffer) | |
22037
cb95bfcd442a
(smtpmail-via-smtp): Speciy process coding system.
Richard M. Stallman <rms@gnu.org>
parents:
21862
diff
changeset
|
362 (set-buffer-process-coding-system 'raw-text-unix 'raw-text-unix) |
15345 | 363 (make-local-variable 'smtpmail-read-point) |
364 (setq smtpmail-read-point (point-min)) | |
365 | |
366 | |
367 (if (or (null (car (setq greeting (smtpmail-read-response process)))) | |
368 (not (integerp (car greeting))) | |
369 (>= (car greeting) 400)) | |
370 (throw 'done nil) | |
371 ) | |
372 | |
18092
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
373 ;; EHLO |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
374 (smtpmail-send-command process (format "EHLO %s" (smtpmail-fqdn))) |
15345 | 375 |
376 (if (or (null (car (setq response-code (smtpmail-read-response process)))) | |
377 (not (integerp (car response-code))) | |
378 (>= (car response-code) 400)) | |
18092
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
379 (progn |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
380 ;; HELO |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
381 (smtpmail-send-command process (format "HELO %s" (smtpmail-fqdn))) |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
382 |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
383 (if (or (null (car (setq response-code (smtpmail-read-response process)))) |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
384 (not (integerp (car response-code))) |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
385 (>= (car response-code) 400)) |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
386 (throw 'done nil))) |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
387 (let ((extension-lines (cdr (cdr response-code)))) |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
388 (while extension-lines |
23181
89d6facea3b5
(smtpmail-via-smtp): Parse out the first word
Karl Heuer <kwzh@gnu.org>
parents:
23142
diff
changeset
|
389 (let ((name (intern (downcase (car (split-string (substring (car extension-lines) 4) "[ ]")))))) |
18092
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
390 (and name |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
391 (cond ((memq name '(verb xvrb 8bitmime onex xone |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
392 expn size dsn etrn |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
393 help xusr)) |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
394 (setq supported-extensions |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
395 (cons name supported-extensions))) |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
396 (t (message "unknown extension %s" |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
397 name))))) |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
398 (setq extension-lines (cdr extension-lines))))) |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
399 |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
400 (if (or (member 'onex supported-extensions) |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
401 (member 'xone supported-extensions)) |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
402 (progn |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
403 (smtpmail-send-command process (format "ONEX")) |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
404 (if (or (null (car (setq response-code (smtpmail-read-response process)))) |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
405 (not (integerp (car response-code))) |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
406 (>= (car response-code) 400)) |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
407 (throw 'done nil)))) |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
408 |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
409 (if (and smtpmail-debug-info |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
410 (or (member 'verb supported-extensions) |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
411 (member 'xvrb supported-extensions))) |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
412 (progn |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
413 (smtpmail-send-command process (format "VERB")) |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
414 (if (or (null (car (setq response-code (smtpmail-read-response process)))) |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
415 (not (integerp (car response-code))) |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
416 (>= (car response-code) 400)) |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
417 (throw 'done nil)))) |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
418 |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
419 (if (member 'xusr supported-extensions) |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
420 (progn |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
421 (smtpmail-send-command process (format "XUSR")) |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
422 (if (or (null (car (setq response-code (smtpmail-read-response process)))) |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
423 (not (integerp (car response-code))) |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
424 (>= (car response-code) 400)) |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
425 (throw 'done nil)))) |
15345 | 426 |
427 ;; MAIL FROM: <sender> | |
18092
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
428 (let ((size-part |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
429 (if (member 'size supported-extensions) |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
430 (format " SIZE=%d" |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
431 (save-excursion |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
432 (set-buffer smtpmail-text-buffer) |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
433 ;; size estimate: |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
434 (+ (- (point-max) (point-min)) |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
435 ;; Add one byte for each change-of-line |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
436 ;; because or CR-LF representation: |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
437 (count-lines (point-min) (point-max)) |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
438 ;; For some reason, an empty line is |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
439 ;; added to the message. Maybe this |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
440 ;; is a bug, but it can't hurt to add |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
441 ;; those two bytes anyway: |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
442 2))) |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
443 "")) |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
444 (body-part |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
445 (if (member '8bitmime supported-extensions) |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
446 ;; FIXME: |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
447 ;; Code should be added here that transforms |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
448 ;; the contents of the message buffer into |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
449 ;; something the receiving SMTP can handle. |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
450 ;; For a receiver that supports 8BITMIME, this |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
451 ;; may mean converting BINARY to BASE64, or |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
452 ;; adding Content-Transfer-Encoding and the |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
453 ;; other MIME headers. The code should also |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
454 ;; return an indication of what encoding the |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
455 ;; message buffer is now, i.e. ASCII or |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
456 ;; 8BITMIME. |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
457 (if nil |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
458 " BODY=8BITMIME" |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
459 "") |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
460 ""))) |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
461 ; (smtpmail-send-command process (format "MAIL FROM:%s@%s" (user-login-name) (smtpmail-fqdn))) |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
462 (smtpmail-send-command process (format "MAIL FROM: <%s>%s%s" |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
463 user-mail-address |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
464 size-part |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
465 body-part)) |
15345 | 466 |
18092
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
467 (if (or (null (car (setq response-code (smtpmail-read-response process)))) |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
468 (not (integerp (car response-code))) |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
469 (>= (car response-code) 400)) |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
470 (throw 'done nil) |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
471 )) |
15345 | 472 |
473 ;; RCPT TO: <recipient> | |
15346
4cd6ff2384dc
(smtpmail-send-it): Fix error messages.
Richard M. Stallman <rms@gnu.org>
parents:
15345
diff
changeset
|
474 (let ((n 0)) |
4cd6ff2384dc
(smtpmail-send-it): Fix error messages.
Richard M. Stallman <rms@gnu.org>
parents:
15345
diff
changeset
|
475 (while (not (null (nth n recipient))) |
26028
a0126ac842dc
(smtpmail-via-smtp): Add support for
Gerd Moellmann <gerd@gnu.org>
parents:
24871
diff
changeset
|
476 (smtpmail-send-command process (format "RCPT TO: <%s>" (maybe-append-domain (nth n recipient)))) |
15346
4cd6ff2384dc
(smtpmail-send-it): Fix error messages.
Richard M. Stallman <rms@gnu.org>
parents:
15345
diff
changeset
|
477 (setq n (1+ n)) |
15345 | 478 |
18092
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
479 (setq response-code (smtpmail-read-response process)) |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
480 (if (or (null (car response-code)) |
15346
4cd6ff2384dc
(smtpmail-send-it): Fix error messages.
Richard M. Stallman <rms@gnu.org>
parents:
15345
diff
changeset
|
481 (not (integerp (car response-code))) |
4cd6ff2384dc
(smtpmail-send-it): Fix error messages.
Richard M. Stallman <rms@gnu.org>
parents:
15345
diff
changeset
|
482 (>= (car response-code) 400)) |
4cd6ff2384dc
(smtpmail-send-it): Fix error messages.
Richard M. Stallman <rms@gnu.org>
parents:
15345
diff
changeset
|
483 (throw 'done nil) |
4cd6ff2384dc
(smtpmail-send-it): Fix error messages.
Richard M. Stallman <rms@gnu.org>
parents:
15345
diff
changeset
|
484 ) |
4cd6ff2384dc
(smtpmail-send-it): Fix error messages.
Richard M. Stallman <rms@gnu.org>
parents:
15345
diff
changeset
|
485 )) |
15345 | 486 |
487 ;; DATA | |
488 (smtpmail-send-command process "DATA") | |
489 | |
490 (if (or (null (car (setq response-code (smtpmail-read-response process)))) | |
491 (not (integerp (car response-code))) | |
492 (>= (car response-code) 400)) | |
493 (throw 'done nil) | |
494 ) | |
495 | |
496 ;; Mail contents | |
497 (smtpmail-send-data process smtpmail-text-buffer) | |
498 | |
499 ;;DATA end "." | |
500 (smtpmail-send-command process ".") | |
501 | |
502 (if (or (null (car (setq response-code (smtpmail-read-response process)))) | |
503 (not (integerp (car response-code))) | |
504 (>= (car response-code) 400)) | |
505 (throw 'done nil) | |
506 ) | |
507 | |
508 ;;QUIT | |
509 ; (smtpmail-send-command process "QUIT") | |
510 ; (and (null (car (smtpmail-read-response process))) | |
511 ; (throw 'done nil)) | |
512 t )) | |
513 (if process | |
514 (save-excursion | |
515 (set-buffer (process-buffer process)) | |
516 (smtpmail-send-command process "QUIT") | |
517 (smtpmail-read-response process) | |
518 | |
519 ; (if (or (null (car (setq response-code (smtpmail-read-response process)))) | |
520 ; (not (integerp (car response-code))) | |
521 ; (>= (car response-code) 400)) | |
522 ; (throw 'done nil) | |
523 ; ) | |
524 (delete-process process)))))) | |
525 | |
526 | |
527 (defun smtpmail-process-filter (process output) | |
528 (save-excursion | |
529 (set-buffer (process-buffer process)) | |
530 (goto-char (point-max)) | |
531 (insert output))) | |
532 | |
533 (defun smtpmail-read-response (process) | |
534 (let ((case-fold-search nil) | |
18092
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
535 (response-strings nil) |
15345 | 536 (response-continue t) |
18092
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
537 (return-value '(nil ())) |
15345 | 538 match-end) |
539 | |
540 (while response-continue | |
15454
85313b347ed9
(smtpmail-read-response): Goto smtpmail-read-point
Richard M. Stallman <rms@gnu.org>
parents:
15453
diff
changeset
|
541 (goto-char smtpmail-read-point) |
15345 | 542 (while (not (search-forward "\r\n" nil t)) |
543 (accept-process-output process) | |
544 (goto-char smtpmail-read-point)) | |
545 | |
546 (setq match-end (point)) | |
18092
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
547 (setq response-strings |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
548 (cons (buffer-substring smtpmail-read-point (- match-end 2)) |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
549 response-strings)) |
15345 | 550 |
551 (goto-char smtpmail-read-point) | |
552 (if (looking-at "[0-9]+ ") | |
18092
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
553 (let ((begin (match-beginning 0)) |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
554 (end (match-end 0))) |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
555 (if smtpmail-debug-info |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
556 (message "%s" (car response-strings))) |
15345 | 557 |
18092
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
558 (setq smtpmail-read-point match-end) |
15345 | 559 |
18092
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
560 ;; ignore lines that start with "0" |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
561 (if (looking-at "0[0-9]+ ") |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
562 nil |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
563 (setq response-continue nil) |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
564 (setq return-value |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
565 (cons (string-to-int |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
566 (buffer-substring begin end)) |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
567 (nreverse response-strings))))) |
15345 | 568 |
569 (if (looking-at "[0-9]+-") | |
18092
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
570 (progn (if smtpmail-debug-info |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
571 (message "%s" (car response-strings))) |
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
572 (setq smtpmail-read-point match-end) |
15345 | 573 (setq response-continue t)) |
574 (progn | |
575 (setq smtpmail-read-point match-end) | |
576 (setq response-continue nil) | |
577 (setq return-value | |
18092
8428d56cd207
(smtpmail-via-smtp): Recognize XVRB as a synonym for
Richard M. Stallman <rms@gnu.org>
parents:
17517
diff
changeset
|
578 (cons nil (nreverse response-strings))) |
15345 | 579 ) |
580 ))) | |
581 (setq smtpmail-read-point match-end) | |
582 return-value)) | |
583 | |
584 | |
585 (defun smtpmail-send-command (process command) | |
586 (goto-char (point-max)) | |
587 (if (= (aref command 0) ?P) | |
588 (insert "PASS <omitted>\r\n") | |
589 (insert command "\r\n")) | |
590 (setq smtpmail-read-point (point)) | |
591 (process-send-string process command) | |
592 (process-send-string process "\r\n")) | |
593 | |
594 (defun smtpmail-send-data-1 (process data) | |
595 (goto-char (point-max)) | |
596 | |
24773 | 597 (if (and (multibyte-string-p data) |
598 smtpmail-code-conv-from) | |
599 (setq data (string-as-multibyte | |
600 (encode-coding-string data smtpmail-code-conv-from)))) | |
15345 | 601 |
602 (if smtpmail-debug-info | |
603 (insert data "\r\n")) | |
604 | |
605 (setq smtpmail-read-point (point)) | |
15676
46d74bda4351
(smtpmail-send-data-1): Escape "." at the start of
Karl Heuer <kwzh@gnu.org>
parents:
15648
diff
changeset
|
606 ;; Escape "." at start of a line |
46d74bda4351
(smtpmail-send-data-1): Escape "." at the start of
Karl Heuer <kwzh@gnu.org>
parents:
15648
diff
changeset
|
607 (if (eq (string-to-char data) ?.) |
46d74bda4351
(smtpmail-send-data-1): Escape "." at the start of
Karl Heuer <kwzh@gnu.org>
parents:
15648
diff
changeset
|
608 (process-send-string process ".")) |
15345 | 609 (process-send-string process data) |
610 (process-send-string process "\r\n") | |
611 ) | |
612 | |
613 (defun smtpmail-send-data (process buffer) | |
614 (let | |
615 ((data-continue t) | |
616 (sending-data nil) | |
617 this-line | |
618 this-line-end) | |
619 | |
620 (save-excursion | |
621 (set-buffer buffer) | |
622 (goto-char (point-min))) | |
623 | |
624 (while data-continue | |
625 (save-excursion | |
626 (set-buffer buffer) | |
627 (beginning-of-line) | |
628 (setq this-line (point)) | |
629 (end-of-line) | |
630 (setq this-line-end (point)) | |
631 (setq sending-data nil) | |
632 (setq sending-data (buffer-substring this-line this-line-end)) | |
633 (if (/= (forward-line 1) 0) | |
634 (setq data-continue nil))) | |
635 | |
636 (smtpmail-send-data-1 process sending-data) | |
637 ) | |
638 ) | |
639 ) | |
640 | |
641 | |
642 (defun smtpmail-deduce-address-list (smtpmail-text-buffer header-start header-end) | |
643 "Get address list suitable for smtp RCPT TO: <address>." | |
644 (require 'mail-utils) ;; pick up mail-strip-quoted-names | |
645 | |
24663
39edc9c7b235
(smtpmail-deduce-address-list): Bind variables
Andrew Innes <andrewi@gnu.org>
parents:
24455
diff
changeset
|
646 (unwind-protect |
39edc9c7b235
(smtpmail-deduce-address-list): Bind variables
Andrew Innes <andrewi@gnu.org>
parents:
24455
diff
changeset
|
647 (save-excursion |
39edc9c7b235
(smtpmail-deduce-address-list): Bind variables
Andrew Innes <andrewi@gnu.org>
parents:
24455
diff
changeset
|
648 (set-buffer smtpmail-address-buffer) (erase-buffer) |
39edc9c7b235
(smtpmail-deduce-address-list): Bind variables
Andrew Innes <andrewi@gnu.org>
parents:
24455
diff
changeset
|
649 (let |
39edc9c7b235
(smtpmail-deduce-address-list): Bind variables
Andrew Innes <andrewi@gnu.org>
parents:
24455
diff
changeset
|
650 ((case-fold-search t) |
39edc9c7b235
(smtpmail-deduce-address-list): Bind variables
Andrew Innes <andrewi@gnu.org>
parents:
24455
diff
changeset
|
651 (simple-address-list "") |
39edc9c7b235
(smtpmail-deduce-address-list): Bind variables
Andrew Innes <andrewi@gnu.org>
parents:
24455
diff
changeset
|
652 this-line |
39edc9c7b235
(smtpmail-deduce-address-list): Bind variables
Andrew Innes <andrewi@gnu.org>
parents:
24455
diff
changeset
|
653 this-line-end |
39edc9c7b235
(smtpmail-deduce-address-list): Bind variables
Andrew Innes <andrewi@gnu.org>
parents:
24455
diff
changeset
|
654 addr-regexp) |
15345 | 655 (insert-buffer-substring smtpmail-text-buffer header-start header-end) |
656 (goto-char (point-min)) | |
15648
2feeabc94834
(smtpmail-deduce-address-list): Handle RESENT-* fields.
Karl Heuer <kwzh@gnu.org>
parents:
15595
diff
changeset
|
657 ;; RESENT-* fields should stop processing of regular fields. |
2feeabc94834
(smtpmail-deduce-address-list): Handle RESENT-* fields.
Karl Heuer <kwzh@gnu.org>
parents:
15595
diff
changeset
|
658 (save-excursion |
21683
dfb671ba22f8
(smtpmail-send-it): Deleted all code related to Resent-To: processing.
Richard M. Stallman <rms@gnu.org>
parents:
20058
diff
changeset
|
659 (if (re-search-forward "^Resent-\\(to\\|cc\\|bcc\\):" header-end t) |
dfb671ba22f8
(smtpmail-send-it): Deleted all code related to Resent-To: processing.
Richard M. Stallman <rms@gnu.org>
parents:
20058
diff
changeset
|
660 (setq addr-regexp "^Resent-\\(to\\|cc\\|bcc\\):") |
dfb671ba22f8
(smtpmail-send-it): Deleted all code related to Resent-To: processing.
Richard M. Stallman <rms@gnu.org>
parents:
20058
diff
changeset
|
661 (setq addr-regexp "^\\(To:\\|Cc:\\|Bcc:\\)"))) |
15648
2feeabc94834
(smtpmail-deduce-address-list): Handle RESENT-* fields.
Karl Heuer <kwzh@gnu.org>
parents:
15595
diff
changeset
|
662 |
2feeabc94834
(smtpmail-deduce-address-list): Handle RESENT-* fields.
Karl Heuer <kwzh@gnu.org>
parents:
15595
diff
changeset
|
663 (while (re-search-forward addr-regexp header-end t) |
15345 | 664 (replace-match "") |
665 (setq this-line (match-beginning 0)) | |
666 (forward-line 1) | |
667 ;; get any continuation lines | |
668 (while (and (looking-at "^[ \t]+") (< (point) header-end)) | |
669 (forward-line 1)) | |
670 (setq this-line-end (point-marker)) | |
671 (setq simple-address-list | |
672 (concat simple-address-list " " | |
673 (mail-strip-quoted-names (buffer-substring this-line this-line-end)))) | |
674 ) | |
675 (erase-buffer) | |
676 (insert-string " ") | |
677 (insert-string simple-address-list) | |
678 (insert-string "\n") | |
679 (subst-char-in-region (point-min) (point-max) 10 ? t);; newline --> blank | |
680 (subst-char-in-region (point-min) (point-max) ?, ? t);; comma --> blank | |
681 (subst-char-in-region (point-min) (point-max) 9 ? t);; tab --> blank | |
682 | |
683 (goto-char (point-min)) | |
684 ;; tidyness in case hook is not robust when it looks at this | |
685 (while (re-search-forward "[ \t]+" header-end t) (replace-match " ")) | |
686 | |
687 (goto-char (point-min)) | |
15346
4cd6ff2384dc
(smtpmail-send-it): Fix error messages.
Richard M. Stallman <rms@gnu.org>
parents:
15345
diff
changeset
|
688 (let (recipient-address-list) |
15451
89c1e7fe879a
(smtpmail-smtp-service): Use port 25 as default.
Richard M. Stallman <rms@gnu.org>
parents:
15372
diff
changeset
|
689 (while (re-search-forward " \\([^ ]+\\) " (point-max) t) |
15346
4cd6ff2384dc
(smtpmail-send-it): Fix error messages.
Richard M. Stallman <rms@gnu.org>
parents:
15345
diff
changeset
|
690 (backward-char 1) |
15451
89c1e7fe879a
(smtpmail-smtp-service): Use port 25 as default.
Richard M. Stallman <rms@gnu.org>
parents:
15372
diff
changeset
|
691 (setq recipient-address-list (cons (buffer-substring (match-beginning 1) (match-end 1)) |
89c1e7fe879a
(smtpmail-smtp-service): Use port 25 as default.
Richard M. Stallman <rms@gnu.org>
parents:
15372
diff
changeset
|
692 recipient-address-list)) |
15346
4cd6ff2384dc
(smtpmail-send-it): Fix error messages.
Richard M. Stallman <rms@gnu.org>
parents:
15345
diff
changeset
|
693 ) |
4cd6ff2384dc
(smtpmail-send-it): Fix error messages.
Richard M. Stallman <rms@gnu.org>
parents:
15345
diff
changeset
|
694 (setq smtpmail-recipient-address-list recipient-address-list)) |
15345 | 695 |
696 ) | |
24663
39edc9c7b235
(smtpmail-deduce-address-list): Bind variables
Andrew Innes <andrewi@gnu.org>
parents:
24455
diff
changeset
|
697 ) |
15345 | 698 ) |
699 ) | |
700 | |
701 | |
702 (defun smtpmail-do-bcc (header-end) | |
21683
dfb671ba22f8
(smtpmail-send-it): Deleted all code related to Resent-To: processing.
Richard M. Stallman <rms@gnu.org>
parents:
20058
diff
changeset
|
703 "Delete [Resent-]BCC: and their continuation lines from the header area. |
15345 | 704 There may be multiple BCC: lines, and each may have arbitrarily |
705 many continuation lines." | |
706 (let ((case-fold-search t)) | |
24455 | 707 (save-excursion |
708 (goto-char (point-min)) | |
709 ;; iterate over all BCC: lines | |
710 (while (re-search-forward "^\\(RESENT-\\)?BCC:" header-end t) | |
711 (delete-region (match-beginning 0) | |
712 (progn (forward-line 1) (point))) | |
713 ;; get rid of any continuation lines | |
714 (while (and (looking-at "^[ \t].*\n") (< (point) header-end)) | |
715 (replace-match "")))))) | |
15345 | 716 |
717 | |
718 (provide 'smtpmail) | |
719 | |
17517 | 720 ;;; smtpmail.el ends here |