这个帖子只是一个“留档”,希望能为将来可能的,有一些奇奇怪怪的特殊需求的同学提供一些帮助……
就是因为某些奇奇怪怪的原因,我现在有一个邮件服务器,但这个服务器没有提供SMTP,只能用服务器上的程序发送邮件。
于是我就简单捣鼓了一下sendmail-send-it
函数,使用ssh执行远程服务器上的sendmail
程序,从而实现“远程发件”……
思来想去觉得这玩意可能还是有那么一点点价值的(因为我脑子不好走过一点弯路),大家不要笑我
下面是代码,把rosa/my-ssh
的值改成自己的hostname就可以了
(defvar rosa/my-ssh "hostname")
(defun rosa/my-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'."
(interactive)
(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 (point-at-bol)
(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))
(if (eval mail-mailer-swallows-blank-line)
(newline))
;; 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)
"ssh"
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 ",")))
)
)
(new-args (append (seq-subseq args 0 6) `(,rosa/my-ssh) (list (apply #'concat (append '("/usr/sbin/sendmail ") (mapcar #'(lambda (str) (concat str " ")) (cddr (cddddr args))))))))
(exit-value (apply #'call-process-region new-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))))))
在添加MIME附件的时候可能会有小问题,我用base64编码时不会出错。
嗯,就这样,大家虎年快乐!