« back to all changes in this revision
Viewing changes to mew-smtp.el
- browse files at revision 1
- compare with another revision
- download diff
- download tarball
- view history from revision 1
- Committer: Bazaar Package Importer
- Author(s): Tatsuya Kinoshita
- Date: 2004-06-13 01:11:33 UTC
- Revision ID: james.westby@ubuntu.com-20040613011133-yaef6kqhoimiq3lx
Tags: upstream-4.0.65
Import upstream version 4.0.65
- files added:
- alpha
- bin
- bin/w32
- contrib
- etc
- etc/etc
- info
added
removed
mew-smtp.el
1
;;; mew-smtp.el
2
3
;; Author: Kazu Yamamoto <Kazu@Mew.org>
4
;; Created: Dec 3, 1999
5
6
;;; Code:
7
8
(require 'mew)
9
10
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11
;;;
12
;;; SMTP info
13
;;;
14
15
(defvar mew-smtp-info-list
16
'(;; parameters to be saved
17
"raw-header" "recipients" "orig-recipients"
18
"bcc" "dcc" "fcc" "msgid" "logtime"
19
"case" ;; save for re-edit
20
;; parameters used internally
21
"server" "port" "ssh-server"
22
"user" "auth-list" "account"
23
"helo-domain"
24
"status" "process" "ssh-process" "ssl-process"
25
"qfld" "messages"
26
;; parameters used internally and should be initialized
27
"string" "error" "auth-selected" "timer" "cont" "from" "sender"
28
"done" "imapp"))
29
30
(mew-info-defun "mew-smtp-" mew-smtp-info-list)
31
32
(defvar mew-smtp-info-list-save-length 9)
33
(defvar mew-smtp-info-list-clean-length 21)
34
35
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
36
;;;
37
;;; FSM
38
;;;
39
40
(defvar mew-smtp-fsm
41
'(("greeting" ("220" . "ehlo"))
42
("ehlo" ("250" . "auth") (t . "helo"))
43
;;
44
("auth" ("250" . "next"))
45
("auth-cram-md5" ("334" . "pwd-cram-md5") (t . "wpwd"))
46
("pwd-cram-md5" ("235" . "next") (t . "wpwd"))
47
("auth-login" ("334" . "pwd-login") (t . "wpwd"))
48
("pwd-login" ("235" . "next") (t . "wpwd"))
49
("auth-plain" ("235" . "next") (t . "wpwd"))
50
;;
51
("helo" ("250" . "next"))
52
("mail-from" ("250" . "rcpt-to"))
53
("rcpt-to" ("250" . "data"))
54
("data" ("354" . "content"))
55
("content" ("250" . "done"))
56
("quit" (t . "noop"))))
57
58
(defsubst mew-smtp-fsm-by-status (status)
59
(assoc status mew-smtp-fsm))
60
61
(defsubst mew-smtp-fsm-next (status code)
62
(cdr (mew-assoc-match2 code (cdr (mew-smtp-fsm-by-status status)) 0)))
63
64
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
65
;;;
66
;;; Filters
67
;;;
68
69
(defun mew-smtp-command-ehlo (pro pnm)
70
(let ((helo-domain (mew-smtp-get-helo-domain pnm)))
71
(mew-smtp-process-send-string pro "EHLO %s" helo-domain)))
72
73
(defun mew-smtp-command-helo (pro pnm)
74
(let ((helo-domain (mew-smtp-get-helo-domain pnm)))
75
(mew-smtp-process-send-string pro "HELO %s" helo-domain)))
76
77
(defun mew-smtp-command-auth (pro pnm)
78
(cond
79
((mew-smtp-get-user pnm)
80
(let ((auth-list (mew-smtp-get-auth-list pnm))
81
(str (mew-smtp-get-string pnm)) auth func)
82
(if (and (string-match "AUTH \\([^\r\n]+\\)\r?\n" str)
83
(setq auth (mew-auth-select (match-string 1 str) auth-list))
84
(setq func (mew-smtp-auth-get-func auth))
85
(fboundp func))
86
(progn
87
(mew-smtp-set-auth-selected pnm auth)
88
(funcall func pro pnm))
89
(mew-smtp-debug "<AUTH>" "No preferred SMTP AUTH.\n")
90
;; xxx how should we act?
91
(mew-smtp-set-status pnm "next")
92
(mew-smtp-command-next pro pnm))))
93
(t
94
(mew-smtp-set-status pnm "next")
95
(mew-smtp-command-next pro pnm))))
96
97
(defun mew-smtp-command-wpwd (pro pnm)
98
(let ((auth (mew-smtp-get-auth-selected pnm)))
99
(mew-passwd-set-passwd (mew-smtp-passtag pnm) nil)
100
(mew-smtp-set-error pnm (format "SMTP %s password is wrong!" auth))
101
(mew-smtp-command-quit2 pro pnm)))
102
103
(defun mew-smtp-command-next (pro pnm)
104
(let ((msgs (mew-smtp-get-messages pnm))
105
(qfld (mew-smtp-get-qfld pnm))
106
(case (mew-smtp-get-case pnm))
107
msg)
108
(if msgs
109
(progn
110
(setq msg (car msgs))
111
(setq msgs (cdr msgs))
112
(mew-queue-insert-file pnm mew-smtp-info-list-save-length qfld msg)
113
(mew-set-buffer-multibyte nil)
114
(mew-info-clean-up pnm mew-smtp-info-list-clean-length)
115
(mew-smtp-set-case pnm case) ;; override
116
(mew-smtp-set-messages pnm msgs)
117
(set-process-buffer pro (current-buffer))
118
(mew-smtp-set-status pnm "mail-from")
119
(mew-smtp-command-mail-from pro pnm))
120
(mew-smtp-set-status pnm "quit")
121
(mew-smtp-command-quit pro pnm))))
122
123
(defun mew-smtp-command-mail-from (pro pnm)
124
(widen)
125
(clear-visited-file-modtime)
126
;;
127
(let* ((case (mew-smtp-get-case pnm))
128
(resentp (mew-header-existp mew-resent-from:))
129
(sender: (if resentp mew-resent-sender: mew-sender:))
130
(from: (if resentp mew-resent-from: mew-from:))
131
(from (mew-header-get-value from:))
132
(froms (mew-addrstr-parse-address-list from))
133
(nfrom (length froms))
134
(mail-from (mew-smtp-mail-from case)))
135
(mew-smtp-set-from pnm from) ;; for Bcc:
136
(unless mail-from
137
;; Which address is suitable for MAIL FROM if multiple?
138
(setq mail-from (car froms)))
139
(unless (mew-header-existp sender:)
140
(if (= nfrom 1)
141
(if (and mew-use-sender (not (string= mail-from (car froms))))
142
(mew-smtp-set-sender pnm (cons sender: mail-from)))
143
(mew-smtp-set-sender pnm (cons sender: mail-from))))
144
;;
145
(mew-smtp-process-send-string pro "MAIL FROM:<%s>" mail-from)))
146
147
(defun mew-smtp-command-rcpt-to (pro pnm)
148
(let* ((recipients (mew-smtp-get-recipients pnm))
149
(recipient (car recipients)))
150
(setq recipients (cdr recipients))
151
(mew-smtp-set-recipients pnm recipients)
152
(if recipients (mew-smtp-set-status pnm "mail-from"))
153
(mew-smtp-process-send-string pro "RCPT TO:<%s>" recipient)))
154
155
(defun mew-smtp-command-data (pro pnm)
156
(goto-char (point-max))
157
(unless (bolp) (insert "\n"))
158
(mew-dot-insert)
159
(mew-eol-fix-for-write)
160
(set-buffer-modified-p nil)
161
(mew-smtp-set-cont pnm (point-min))
162
(mew-smtp-set-timer pnm nil)
163
(mew-smtp-process-send-string pro "DATA"))
164
165
(defun mew-smtp-command-content (pro pnm)
166
(save-excursion
167
(let ((cont (mew-smtp-get-cont pnm))
168
(sender (mew-smtp-get-sender pnm))
169
(inc 1000) (i 0) (N 10))
170
(set-buffer (process-buffer pro))
171
;; Sender:
172
(when sender
173
(mew-smtp-process-send-string pro "%s %s" (car sender) (cdr sender))
174
(mew-smtp-set-sender pnm nil))
175
;;
176
(while (and (< cont (point-max)) (not (input-pending-p)) (< i N))
177
(let ((next (min (point-max) (+ cont inc))))
178
(if (and (processp pro) (eq (process-status pro) 'open))
179
(process-send-region pro cont next))
180
(setq cont next)
181
(setq i (1+ i))))
182
(mew-smtp-set-cont pnm cont)
183
(if (< cont (point-max))
184
(let ((timer
185
(if (input-pending-p)
186
(run-with-idle-timer
187
0.01 nil 'mew-smtp-command-content pro pnm)
188
(run-at-time 0.05 nil 'mew-smtp-command-content pro pnm))))
189
(mew-smtp-set-timer pnm timer))
190
(mew-smtp-set-cont pnm nil)
191
(mew-smtp-set-timer pnm nil)
192
(mew-smtp-process-send-string pro ".")))))
193
194
(defun mew-smtp-command-done (pro pnm)
195
(let ((fcc (mew-smtp-get-fcc pnm))
196
(case (mew-smtp-get-case pnm))
197
(back (mew-queue-backup (buffer-file-name) mew-queue-info-suffix))
198
(buf (process-buffer pro))
199
imapp)
200
;; mew-folder-new-message may be slow if the folder contains
201
;; a lot of messages. So, let's Fcc in background.
202
(setq imapp (mew-net-fcc-message case fcc back))
203
(mew-smtp-set-imapp pnm imapp)
204
(mew-smtp-log pnm)
205
(if (mew-smtp-get-bcc pnm)
206
(mew-smtp-bcc pro pnm back)
207
(set-process-buffer pro nil)
208
(mew-remove-buffer buf)
209
(mew-smtp-set-status pro "next")
210
(mew-smtp-command-next pro pnm))))
211
212
(defun mew-smtp-command-quit (pro pnm)
213
(mew-smtp-set-done pnm t)
214
(mew-smtp-process-send-string pro "QUIT"))
215
216
(defun mew-smtp-command-quit2 (pro pnm)
217
;; error is set
218
(mew-smtp-set-done pnm t)
219
(when (and (processp pro) (eq (process-status pro) 'open))
220
(mew-smtp-set-status pnm "quit")
221
(mew-smtp-process-send-string pro "QUIT")))
222
223
(defun mew-smtp-command-noop (pro pnm)
224
())
225
226
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
227
;;;
228
;;; AUTH
229
;;;
230
231
(defvar mew-smtp-auth-alist
232
'(("CRAM-MD5" mew-smtp-command-auth-cram-md5)
233
("PLAIN" mew-smtp-command-auth-plain)
234
("LOGIN" mew-smtp-command-auth-login)))
235
236
(defsubst mew-smtp-auth-get-func (auth)
237
(nth 1 (mew-assoc-case-equal auth mew-smtp-auth-alist 0)))
238
239
;;
240
241
(defun mew-smtp-command-auth-cram-md5 (pro pnm)
242
(mew-smtp-process-send-string pro "AUTH CRAM-MD5")
243
(mew-smtp-set-status pnm "auth-cram-md5"))
244
245
(defun mew-smtp-command-pwd-cram-md5 (pro pnm)
246
(let ((str (mew-smtp-get-string pnm))
247
(user (mew-smtp-get-user pnm))
248
(prompt (format "SMTP CRAM-MD5 password (%s): "
249
(mew-smtp-get-account pnm)))
250
challenge passwd cram-md5)
251
(if (string-match " \\([a-zA-Z0-9+/]+=*\\)" str) ;; xxx
252
(setq challenge (match-string 1 str)))
253
(setq passwd (mew-smtp-input-passwd prompt pnm))
254
(setq cram-md5 (mew-cram-md5 user passwd challenge))
255
(mew-smtp-process-send-string pro cram-md5)))
256
257
(defun mew-smtp-command-auth-login (pro pnm)
258
(let* ((user (mew-smtp-get-user pnm))
259
(euser (mew-base64-encode-string user)))
260
(mew-smtp-process-send-string pro "AUTH LOGIN %s" euser)
261
(mew-smtp-set-status pnm "auth-login")))
262
263
(defun mew-smtp-command-pwd-login (pro pnm)
264
(let* ((prompt (format "SMTP LOGIN password (%s): "
265
(mew-smtp-get-account pnm)))
266
(passwd (mew-smtp-input-passwd prompt pnm))
267
(epasswd (mew-base64-encode-string passwd)))
268
(mew-smtp-process-send-string pro epasswd)))
269
270
(defun mew-smtp-command-auth-plain (pro pnm)
271
(let* ((prompt (format "SMTP PLAIN password (%s): "
272
(mew-smtp-get-account pnm)))
273
(passwd (mew-smtp-input-passwd prompt pnm))
274
(user (mew-smtp-get-user pnm))
275
(plain (mew-base64-encode-string (format "\0%s\0%s" user passwd))))
276
(mew-smtp-process-send-string pro "AUTH PLAIN %s" plain)
277
(mew-smtp-set-status pnm "auth-plain")))
278
279
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
280
;;;
281
;;; Sub functions
282
;;;
283
284
(defconst mew-smtp-info-prefix "mew-smtp-info-")
285
286
(defsubst mew-smtp-info-name (case)
287
(let ((server (mew-smtp-server case))
288
(port (mew-smtp-port case))
289
(user (mew-smtp-user case))
290
(sshsrv (mew-smtp-ssh-server case))
291
(name mew-smtp-info-prefix))
292
(if user
293
(setq name (concat name user "@" server))
294
(setq name (concat name server)))
295
(unless (string= port mew-smtp-port)
296
(setq name (concat name ":" port)))
297
(if sshsrv
298
(concat name "%" sshsrv)
299
name)))
300
301
(defun mew-smtp-process-send-string (pro &rest args)
302
(let ((str (apply 'format args)))
303
(mew-smtp-debug "=SEND=" str)
304
(if (and (processp pro) (eq (process-status pro) 'open))
305
(process-send-string pro (concat str mew-cs-eol))
306
(message "SMTP time out"))))
307
308
(defun mew-smtp-passtag (pnm)
309
(concat (mew-smtp-get-user pnm)
310
"@" (mew-smtp-get-server pnm)
311
":" (mew-smtp-get-port pnm)))
312
313
(defun mew-smtp-input-passwd (prompt pnm)
314
(let ((tag (mew-smtp-passtag pnm))
315
(pro (mew-smtp-get-process pnm))
316
pass)
317
(setq pass (mew-input-passwd prompt tag))
318
(unless (and (processp pro) (eq (process-status pro) 'open))
319
(mew-passwd-set-passwd tag nil))
320
pass))
321
322
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
323
;;;
324
;;; Opening SMTP
325
;;;
326
327
(defun mew-smtp-open (pnm server port)
328
(let ((sprt (mew-port-sanity-check port))
329
pro tm)
330
(condition-case emsg
331
(progn
332
(setq tm (mew-timer mew-smtp-timeout-time 'mew-smtp-timeout))
333
(message "Connecting to the SMTP server...")
334
(setq pro (open-network-stream pnm nil server sprt))
335
(process-kill-without-query pro)
336
(mew-set-process-cs pro mew-cs-text-for-net mew-cs-text-for-net)
337
(message "Connecting to the SMTP server...done"))
338
(quit
339
(setq pro nil)
340
(message "Cannot connect to the SMTP server"))
341
(error
342
(setq pro nil)
343
(message "%s, %s" (nth 1 emsg) (nth 2 emsg))))
344
(if tm (cancel-timer tm))
345
pro))
346
347
(defun mew-smtp-timeout ()
348
(signal 'quit nil))
349
350
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
351
;;;
352
;;; Launcher
353
;;;
354
355
(defun mew-smtp-send-message (case qfld msgs)
356
(let ((server (mew-smtp-server case))
357
(user (mew-smtp-user case))
358
(port (mew-smtp-port case))
359
(pnm (mew-smtp-info-name case))
360
(sshsrv (mew-smtp-ssh-server case))
361
(sslp (mew-smtp-ssl case))
362
(sslport (mew-smtp-ssl-port case))
363
process sshname sshpro sslname sslpro lport)
364
(cond
365
(sshsrv
366
(setq sshpro (mew-open-ssh-stream case server port sshsrv))
367
(when sshpro
368
(setq sshname (process-name sshpro))
369
(setq lport (mew-ssh-pnm-to-lport sshname))
370
(when lport
371
(setq process (mew-smtp-open pnm "localhost" lport)))))
372
(sslp
373
(setq sslpro (mew-open-ssl-stream server sslport))
374
(when sslpro
375
(setq sslname (process-name sslpro))
376
(setq lport (mew-ssl-pnm-to-lport sslname))
377
(when lport
378
(setq process (mew-smtp-open pnm "localhost" lport)))))
379
(t
380
(setq process (mew-smtp-open pnm server port))))
381
(if (null process)
382
(cond
383
((and sshsrv (null sshpro))
384
(message "Cannot create to the SSH connection"))
385
((and sslp (null sslpro))
386
(message "Cannot create to the SSL connection"))
387
(t
388
(message "Cannot connect to the SMTP server")))
389
(mew-info-clean-up pnm mew-smtp-info-list-clean-length)
390
(mew-smtp-set-case pnm case)
391
(mew-smtp-set-qfld pnm qfld)
392
(mew-smtp-set-messages pnm msgs)
393
(mew-smtp-set-server pnm server)
394
(mew-smtp-set-port pnm port)
395
(mew-smtp-set-process pnm process)
396
(mew-smtp-set-ssh-server pnm sshsrv)
397
(mew-smtp-set-ssh-process pnm sshpro)
398
(mew-smtp-set-ssl-process pnm sslpro)
399
(mew-smtp-set-helo-domain pnm (mew-smtp-helo-domain case))
400
(mew-smtp-set-user pnm user)
401
(mew-smtp-set-account pnm (format "%s@%s" user server))
402
(mew-smtp-set-auth-list pnm (mew-smtp-auth-list case))
403
(mew-smtp-set-status pnm "greeting")
404
;;
405
(set-process-buffer process nil)
406
(set-process-sentinel process 'mew-smtp-sentinel)
407
(set-process-filter process 'mew-smtp-filter)
408
(message "Sending in background..."))))
409
410
(defun mew-smtp-flush-queue (case &optional qfld)
411
(let (msgs)
412
(unless qfld (setq qfld (mew-queue-folder case)))
413
(setq msgs (mew-folder-messages qfld))
414
(when msgs
415
(mew-summary-folder-cache-clean qfld)
416
(run-hooks 'mew-smtp-flush-hook)
417
(message "Flushing %s..." qfld)
418
(mew-smtp-send-message case qfld msgs))))
419
420
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
421
;;;
422
;;; Filter and sentinel
423
;;;
424
425
(defun mew-smtp-debug (label string)
426
(when (mew-debug 'net)
427
(save-excursion
428
(set-buffer (get-buffer-create mew-buffer-debug))
429
(goto-char (point-max))
430
(insert (format "\n<%s>\n%s\n" label string)))))
431
432
(defun mew-smtp-filter (process string)
433
(let* ((pnm (process-name process))
434
(case (mew-smtp-get-case pnm))
435
(status (mew-smtp-get-status pnm))
436
(str (concat (mew-smtp-get-string pnm) string))
437
(buf (process-buffer process))
438
next func code)
439
(mew-smtp-debug (upcase status) string)
440
(if (and buf (get-buffer buf)) (set-buffer buf))
441
;; SMTP server's strings should be short enough.
442
(mew-smtp-set-string pnm str)
443
(cond
444
((and (string-match "\n$" str)
445
(string-match "^\\([1-5][0-7][0-9]\\) " str))
446
(setq code (match-string 1 str))
447
(setq next (mew-smtp-fsm-next status code))
448
(cond
449
(next
450
(mew-smtp-set-status pnm next)
451
(setq func (intern-soft (concat "mew-smtp-command-" next)))
452
(and func (funcall func process pnm))
453
(mew-smtp-set-string pnm nil))
454
(t
455
(if (string-match "^pwd-" status)
456
(mew-smtp-set-error pnm "SMTP password is wrong!")
457
(if (string-match "\n$" str)
458
(setq str (substring str 0 (1- (length str)))))
459
(unless (string-match "[.!]$" str)
460
(setq str (concat str "."))))
461
(mew-smtp-queue case str)
462
(mew-smtp-set-error pnm str)
463
(mew-smtp-command-quit2 process pnm))))
464
(t ())))) ;; stay
465
466
(defun mew-smtp-sentinel (process event)
467
(let* ((pnm (process-name process))
468
(buf (process-buffer process))
469
(qfld (mew-smtp-get-qfld pnm))
470
(case (mew-smtp-get-case pnm))
471
(done (mew-smtp-get-done pnm))
472
(imapp (mew-smtp-get-imapp pnm))
473
(error (mew-smtp-get-error pnm))
474
(sshpro (mew-smtp-get-ssh-process pnm))
475
(sslpro (mew-smtp-get-ssl-process pnm)))
476
(mew-smtp-debug "SMTP SENTINEL" event)
477
(cond
478
(error
479
(message "%s This mail has been queued to %s" error qfld)
480
(mew-smtp-log pnm error))
481
(done
482
(message "Sending in background...done"))
483
(t
484
(if (null buf)
485
(message "SMTP connection is lost")
486
(set-buffer buf)
487
(mew-smtp-queue case "SMTP connection is lost"))))
488
(mew-info-clean-up pnm)
489
(if (and (processp sshpro) (not mew-ssh-keep-connection))
490
(process-send-string sshpro "exit\n"))
491
(if (and (processp sslpro) (not mew-ssl-keep-connection))
492
(delete-process sslpro))
493
(run-hooks 'mew-smtp-sentinel-hook)
494
(if imapp (mew-imap2-fcc case))))
495
496
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
497
;;;
498
;;; Queuing
499
;;;
500
501
(defun mew-smtp-queue (case err)
502
;; Must be in a buffer where a message is contained.
503
(let* ((pnm (mew-smtp-info-name case))
504
(qfld (mew-queue-folder case))
505
(oname (buffer-name))
506
(work (buffer-file-name))
507
file-info file info nname)
508
(mew-local-folder-check qfld)
509
(setq file-info (mew-queue-enqueue work qfld))
510
(setq file (nth 0 file-info) info (nth 1 file-info))
511
(setq file (file-name-nondirectory file))
512
(setq nname (mew-concat-folder qfld file))
513
(if (mew-draft-p)
514
(mew-smtp-set-case pnm (mew-tinfo-get-case)))
515
;;
516
(mew-smtp-set-recipients pnm (mew-smtp-get-orig-recipients pnm))
517
(let* ((n mew-smtp-info-list-save-length)
518
(data (make-vector n nil))
519
(i 0))
520
(while (< i n)
521
(aset data i (aref (mew-info pnm) i))
522
(setq i (1+ i)))
523
(mew-lisp-save info data))
524
;;
525
(mew-remove-buffer (current-buffer))
526
(message "%s has been queued to %s (%s)" oname nname err)
527
(mew-touch-folder qfld)
528
file))
529
530
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
531
;;;
532
;;; Bcc:
533
;;;
534
535
(defun mew-smtp-bcc (pro pnm back)
536
(let* ((dir (file-name-directory back))
537
(msg (file-name-nondirectory back))
538
(case (mew-smtp-get-case pnm)))
539
(mew-elet
540
(mew-erase-buffer)
541
(mew-set-buffer-multibyte t)
542
(mew-smtp-set-recipients pnm (mew-smtp-get-bcc pnm))
543
(mew-smtp-set-orig-recipients pnm (mew-smtp-get-bcc pnm))
544
(mew-smtp-set-bcc pnm nil)
545
;;
546
(mew-encode-id-date pnm (mew-smtp-message-id case)) ;; save-excursion
547
(goto-char (point-max))
548
(mew-draft-header-insert mew-to: "Bcc-Receiver:;")
549
(mew-draft-header-insert mew-subj: mew-bcc-subject)
550
(mew-draft-header-insert mew-from: (mew-smtp-get-from pnm))
551
(mew-draft-header-insert mew-organization: (mew-organization case))
552
(mew-draft-header-insert-alist (mew-header-alist case))
553
;; X-Mailer: must be the last
554
(mew-draft-header-insert mew-x-mailer: mew-x-mailer)
555
(mew-header-set "\n")
556
(insert mew-bcc-body)
557
(goto-char (mew-header-end))
558
(forward-line)
559
(setq mew-encode-syntax (mew-encode-syntax-initial dir))
560
(setq mew-encode-syntax
561
(mew-syntax-insert-entry
562
mew-encode-syntax
563
'(2)
564
(mew-encode-syntax-single msg mew-type-msg nil nil nil)))
565
(mew-encode-multipart mew-encode-syntax dir 0 'buffered)
566
(mew-encode-make-header)
567
(mew-encode-save-draft)
568
(mew-overlay-delete-buffer)
569
(mew-set-buffer-multibyte nil)
570
(mew-info-clean-up pnm mew-smtp-info-list-clean-length)
571
(set-process-buffer pro (current-buffer))
572
(mew-smtp-set-status pnm "mail-from")
573
(mew-smtp-command-mail-from pro pnm))))
574
575
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
576
;;;
577
;;; Logging
578
;;;
579
580
(defun mew-smtp-log (pnm &optional err)
581
(let ((logtime (mew-smtp-get-logtime pnm))
582
(msgid (mew-smtp-get-msgid pnm))
583
(recipients (mew-smtp-get-orig-recipients pnm))
584
(server (mew-smtp-get-server pnm))
585
(sshsrv (mew-smtp-get-ssh-server pnm))
586
(sslp (mew-smtp-get-ssl-process pnm)))
587
(with-temp-buffer
588
(and logtime (insert logtime))
589
(and msgid (insert " id=" msgid))
590
(and server (insert " server=" server))
591
(and sshsrv (insert " sshsrv=" sshsrv))
592
(and sslp (insert " SSL"))
593
(and recipients
594
(setq recipients (mapconcat 'identity recipients ",")))
595
(and recipients (insert " recipients=" recipients))
596
(if err
597
(insert " status=" "("
598
(substring err 0 (string-match "\n+$" err))
599
")")
600
(insert " status=sent"))
601
(insert "\n")
602
(write-region (point-min) (point-max)
603
(expand-file-name mew-smtp-log-file mew-conf-path)
604
'append 'no-msg))))
605
606
(provide 'mew-smtp)
607
608
;;; Copyright Notice:
609
610
;; Copyright (C) 1999-2003 Mew developing team.
611
;; All rights reserved.
612
613
;; Redistribution and use in source and binary forms, with or without
614
;; modification, are permitted provided that the following conditions
615
;; are met:
616
;;
617
;; 1. Redistributions of source code must retain the above copyright
618
;; notice, this list of conditions and the following disclaimer.
619
;; 2. Redistributions in binary form must reproduce the above copyright
620
;; notice, this list of conditions and the following disclaimer in the
621
;; documentation and/or other materials provided with the distribution.
622
;; 3. Neither the name of the team nor the names of its contributors
623
;; may be used to endorse or promote products derived from this software
624
;; without specific prior written permission.
625
;;
626
;; THIS SOFTWARE IS PROVIDED BY THE TEAM AND CONTRIBUTORS ``AS IS'' AND
627
;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
628
;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
629
;; PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE TEAM OR CONTRIBUTORS BE
630
;; LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
631
;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
632
;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
633
;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
634
;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
635
;; OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
636
;; IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
637
638
;;; mew-smtp.el ends here
Loggerhead is a web-based interface for Breezy
Version: 2.0.1