lisp/mail/mailpost.el

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