| 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. |
| 28 | To use it, include \"(setq send-mail-function 'post-mail-send-it)\" in |
| 29 | site-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 |