|
4
|
1 ;;
|
|
|
2 ;; P O S T . E L
|
|
|
3 ;;
|
|
|
4 ;; Yet another mail interface. this for the rmail system to provide
|
|
|
5 ;; the missing sendmail interface on systems without /usr/lib/sendmail,
|
|
|
6 ;; but with /usr/uci/post.
|
|
|
7 ;;
|
|
|
8 ;; created by: Gary Delp <delp at huey.Udel.Edu>
|
|
|
9 ;; Mon Jan 13 14:45:12 1986
|
|
|
10 ;;
|
|
|
11 ;;
|
|
|
12
|
|
|
13 ;; (setq send-mail-function 'post-mail-send-it)
|
|
|
14
|
|
|
15 (defun post-mail-send-it ()
|
|
|
16 "\
|
|
|
17 the MH -post interface for rmail-mail to call.
|
|
|
18 to use it, include (setq send-mail-function 'post-mail-send-it) in site-init."
|
|
|
19 (let ((errbuf (if mail-interactive
|
|
|
20 (generate-new-buffer " post-mail errors")
|
|
|
21 0))
|
|
|
22 (temfile "/tmp/,rpost")
|
|
|
23 (tembuf (generate-new-buffer " post-mail temp"))
|
|
|
24 (case-fold-search nil)
|
|
|
25 delimline
|
|
|
26 (mailbuf (current-buffer)))
|
|
|
27 (unwind-protect
|
|
|
28 (save-excursion
|
|
|
29 (set-buffer tembuf)
|
|
|
30 (erase-buffer)
|
|
|
31 (insert-buffer-substring mailbuf)
|
|
|
32 (goto-char (point-max))
|
|
|
33 ;; require one newline at the end.
|
|
|
34 (or (= (preceding-char) ?\n)
|
|
|
35 (insert ?\n))
|
|
|
36 ;; Change header-delimiter to be what post-mail expects.
|
|
|
37 (goto-char (point-min))
|
|
|
38 (search-forward (concat "\n" mail-header-separator "\n"))
|
|
|
39 (replace-match "\n\n")
|
|
|
40 (backward-char 1)
|
|
|
41 (setq delimline (point-marker))
|
|
|
42 (if mail-aliases
|
|
|
43 (expand-mail-aliases (point-min) delimline))
|
|
|
44 (goto-char (point-min))
|
|
|
45 ;; ignore any blank lines in the header
|
|
|
46 (while (and (re-search-forward "\n\n\n*" delimline t)
|
|
|
47 (< (point) delimline))
|
|
|
48 (replace-match "\n"))
|
|
|
49 ;; Find and handle any FCC fields.
|
|
|
50 (let ((case-fold-search t))
|
|
|
51 (goto-char (point-min))
|
|
|
52 (if (re-search-forward "^FCC:" delimline t)
|
|
|
53 (mail-do-fcc delimline))
|
|
|
54 ;; If there is a From and no Sender, put it a Sender.
|
|
|
55 (goto-char (point-min))
|
|
|
56 (and (re-search-forward "^From:" delimline t)
|
|
|
57 (not (save-excursion
|
|
|
58 (goto-char (point-min))
|
|
|
59 (re-search-forward "^Sender:" delimline t)))
|
|
|
60 (progn
|
|
|
61 (forward-line 1)
|
|
|
62 (insert "Sender: " (user-login-name) "\n")))
|
|
|
63 ;; don't send out a blank subject line
|
|
|
64 (goto-char (point-min))
|
|
|
65 (if (re-search-forward "^Subject:[ \t]*\n" delimline t)
|
|
|
66 (replace-match ""))
|
|
|
67 (if mail-interactive
|
|
|
68 (save-excursion
|
|
|
69 (set-buffer errbuf)
|
|
|
70 (erase-buffer))))
|
|
|
71 (write-file (setq temfile (make-temp-name temfile)))
|
|
|
72 (set-file-modes temfile 384)
|
|
|
73 (apply 'call-process
|
|
|
74 (append (list (if (boundp 'post-mail-program)
|
|
|
75 post-mail-program
|
|
|
76 "/usr/uci/lib/mh/post")
|
|
|
77 nil errbuf nil
|
|
|
78 "-nofilter" "-msgid")
|
|
|
79 (if mail-interactive '("-watch") '("-nowatch"))
|
|
|
80 (list temfile)))
|
|
|
81 (if mail-interactive
|
|
|
82 (save-excursion
|
|
|
83 (set-buffer errbuf)
|
|
|
84 (goto-char (point-min))
|
|
|
85 (while (re-search-forward "\n\n* *" nil t)
|
|
|
86 (replace-match "; "))
|
|
|
87 (if (not (zerop (buffer-size)))
|
|
|
88 (error "Sending...failed to %s"
|
|
|
89 (buffer-substring (point-min) (point-max)))))))
|
|
|
90 (kill-buffer tembuf)
|
|
|
91 (if (bufferp errbuf)
|
|
|
92 (switch-to-buffer errbuf)))))
|
