![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to mailpost.el CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / lisp|
Return to mailpost.el CVS log | Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / lisp |
1.1 root 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)))))
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.