Function: sendmail-send-it
sendmail-send-it is a byte-compiled function defined in
sendmail.el.gz.
Signature
(sendmail-send-it)
Documentation
Send the current mail buffer using the Sendmail package.
This is a suitable value for send-mail-function. It sends using the
external program defined by sendmail-program.
Probably introduced at or before Emacs version 24.1.
Source Code
;; Defined in /usr/src/emacs/lisp/mail/sendmail.el.gz
(defun sendmail-send-it ()
"Send the current mail buffer using the Sendmail package.
This is a suitable value for `send-mail-function'. It sends using the
external program defined by `sendmail-program'."
(require 'mail-utils)
;; FIXME: A lot of the work done here seems out-of-place (e.g. it should
;; happen regardless of the method used to send, whether via SMTP of
;; /usr/bin/sendmail or anything else).
(let ((errbuf (if mail-interactive
(generate-new-buffer " sendmail errors")
0))
(error nil)
(tembuf (generate-new-buffer " sendmail temp"))
(multibyte enable-multibyte-characters)
(case-fold-search nil)
(selected-coding (select-message-coding-system))
resend-to-addresses
delimline
fcc-was-found
(mailbuf (current-buffer))
;; Examine these variables now, so that
;; local binding in the mail buffer will take effect.
(envelope-from
(and mail-specify-envelope-from
(or (save-restriction
;; Only look at the headers when fetching the
;; envelope address.
(message-narrow-to-headers)
(mail-envelope-from))
user-mail-address))))
(unwind-protect
(with-current-buffer tembuf
(erase-buffer)
(unless multibyte
(set-buffer-multibyte nil))
(insert-buffer-substring mailbuf)
(set-buffer-file-coding-system selected-coding)
(goto-char (point-max))
;; require one newline at the end.
(or (= (preceding-char) ?\n)
(insert ?\n))
;; Change header-delimiter to be what sendmail expects.
(goto-char (mail-header-end))
(delete-region (point) (progn (end-of-line) (point)))
(setq delimline (point-marker))
(sendmail-sync-aliases)
(if mail-aliases
(expand-mail-aliases (point-min) delimline))
(goto-char (point-min))
;; Ignore any blank lines in the header
;; FIXME: mail-header-end should have stopped at an empty line,
;; so the regexp below should never match before delimline!
(while (and (re-search-forward "\n\n\n*" delimline t)
(< (point) delimline))
(replace-match "\n"))
(goto-char (point-min))
;; Look for Resent- headers. They require sending
;; the message specially.
(let ((case-fold-search t))
(goto-char (point-min))
(while (re-search-forward "^Resent-\\(To\\|Cc\\|Bcc\\):" delimline t)
;; Put a list of such addresses in resend-to-addresses.
(setq resend-to-addresses
(save-restriction
(narrow-to-region (point)
(save-excursion
(forward-line 1)
(while (looking-at "^[ \t]")
(forward-line 1))
(point)))
(append (mail-parse-comma-list)
resend-to-addresses)))
;; Delete Resent-Bcc ourselves
(if (save-excursion (beginning-of-line)
(looking-at "resent-bcc"))
(delete-region (line-beginning-position)
(line-beginning-position 2))))
;; Apparently this causes a duplicate Sender.
;; ;; If the From is different from current user, insert Sender.
;; (goto-char (point-min))
;; (and (re-search-forward "^From:" delimline t)
;; (progn
;; (require 'mail-utils)
;; (not (string-equal
;; (mail-strip-quoted-names
;; (save-restriction
;; (narrow-to-region (point-min) delimline)
;; (mail-fetch-field "From")))
;; (user-login-name))))
;; (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\\)+\\b" delimline t)
(replace-match "")
;; This one matches a Subject just before the header delimiter.
(if (and (re-search-forward "^Subject:\\([ \t]*\n\\)+" delimline t)
(= (match-end 0) delimline))
(replace-match "")))
;; Put the "From:" field in unless for some odd reason
;; they put one in themselves.
(goto-char (point-min))
(if (not (re-search-forward "^From:" delimline t))
(mail-insert-from-field))
;; Possibly add a MIME header for the current coding system
(let (charset where-content-type)
(goto-char (point-min))
(setq where-content-type
(re-search-forward "^Content-type:" delimline t))
(goto-char (point-min))
(and (eq mail-send-nonascii 'mime)
(not (re-search-forward "^MIME-version:" delimline t))
(progn (skip-chars-forward "\0-\177")
(/= (point) (point-max)))
selected-coding
(setq charset
(coding-system-get selected-coding :mime-charset))
(progn
(goto-char delimline)
(insert "MIME-version: 1.0\n"
"Content-type: text/plain; charset="
(symbol-name charset)
"\nContent-Transfer-Encoding: 8bit\n")
;; The character set we will actually use
;; should override any specified in the message itself.
(when where-content-type
(goto-char where-content-type)
(delete-region (line-beginning-position)
(progn (forward-line 1) (point)))))))
;; Insert an extra newline if we need it to work around
;; Sun's bug that swallows newlines.
(goto-char (1+ delimline))
;; Find and handle any Fcc fields.
(goto-char (point-min))
(if (re-search-forward "^Fcc:" delimline t)
(progn
(setq fcc-was-found t)
(mail-do-fcc delimline)))
(if mail-interactive
(with-current-buffer errbuf
(erase-buffer))))
;; Encode the header according to RFC2047.
(mail-encode-header (point-min) delimline)
(goto-char (point-min))
(if (let ((case-fold-search t))
(or resend-to-addresses
(re-search-forward "^To:\\|^cc:\\|^bcc:"
delimline t)))
(let* ((default-directory "/")
(coding-system-for-write selected-coding)
(args
(append (list (point-min) (point-max)
sendmail-program
nil errbuf nil "-oi")
(and envelope-from
(list "-f" envelope-from))
;; ;; Don't say "from root" if running under su.
;; (and (equal (user-real-login-name) "root")
;; (list "-f" (user-login-name)))
(and mail-alias-file
(list (concat "-oA" mail-alias-file)))
(if mail-interactive
sendmail-error-reporting-interactive
sendmail-error-reporting-non-interactive)
;; Get the addresses from the message
;; unless this is a resend.
;; We must not do that for a resend
;; because we would find the original addresses.
;; For a resend, include the specific addresses.
(or resend-to-addresses
'("-t")
)
(if mail-use-dsn
(list "-N" (mapconcat #'symbol-name
mail-use-dsn ",")))
)
)
(exit-value (apply #'call-process-region args)))
(cond ((or (null exit-value) (eq 0 exit-value)))
((numberp exit-value)
(setq error t)
(error "Sending...failed with exit value %d" exit-value))
((stringp exit-value)
(setq error t)
(error "Sending...terminated by signal: %s" exit-value))
(t
(setq error t)
(error "SENDMAIL-SEND-IT -- fall through: %S" exit-value))))
(or fcc-was-found
(error "No recipients")))
(if mail-interactive
(with-current-buffer errbuf
(goto-char (point-min))
(while (re-search-forward "\n\n* *" nil t)
(replace-match "; "))
(unless (zerop (buffer-size))
(setq error t)
(error "Sending...failed to %s"
(buffer-substring (point-min) (point-max)))))))
(kill-buffer tembuf)
(when (buffer-live-p errbuf)
(if error
(switch-to-buffer-other-window errbuf)
(kill-buffer errbuf))))))