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