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