通过ssh而不是smtp远程发送邮件……

这个帖子只是一个“留档”,希望能为将来可能的,有一些奇奇怪怪的特殊需求的同学提供一些帮助……

就是因为某些奇奇怪怪的原因,我现在有一个邮件服务器,但这个服务器没有提供SMTP,只能用服务器上的程序发送邮件。

于是我就简单捣鼓了一下sendmail-send-it函数,使用ssh执行远程服务器上的sendmail程序,从而实现“远程发件”……

思来想去觉得这玩意可能还是有那么一点点价值的(因为我脑子不好走过一点弯路),大家不要笑我 :see_no_evil:

下面是代码,把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编码时不会出错。

嗯,就这样,大家虎年快乐!

3 个赞

为啥不写个 shell script:

#!/bin/sh
ssh hostname sendmail "$@"

然後设成 sendmail-program

想要改 hostname 也完全可以用环境变量來做

2 个赞

谢谢!受教啦!