From: " fullname) (let ((fullname-start (+ (point-min) 6)) (fullname-end (point-marker))) (goto-char fullname- start) ;; Look for a character that cannot appear unquoted ;; according to RFC 822. (if (or (re-search- forward "[A- !#-'*+/-9=?A-ZA--1" fullname-end I) quote-fullname) (progn ;; Quote fullname, escaping specials. (goto-char fullname-start) (insert "V") (while (re-search-forward "[VA" fullname-end 1) (replace-match "111111&" t)) (insert "1"")))) (insert " <" login ">\n")) ((eq mail-from-style 'parens) (insert "From: " login " (") (let ((fullname-start (point))) (if quote-fullname (insert "V")) (insert fullname) (if quote-fullname (insert "1"")) (let ((fullname-end (point-marker))) (goto-char fullname-start) ;; RFC 822 says 1 and nonmatching parentheses ;; must be escaped in comments. ;; Escape every instance of ()I ... (while (re-search-forward "[OA" fullname-end 1) (replace-match "111111&" t)) ;; ... then undo escaping of matching parentheses, ;; including matching nested parentheses. (goto-char fullname-start) (while (re-search-forward "1101=111[A11]11(1111111111)*11)1111(11(11([A111111111111111)*I1)1111)" fullname-end 1) (replace- match "111(1\3)" t) (goto-char fullname-start)))) (insert ")\n")) ((null mail-from-style) (insert "From: " login "In")) ((eq mail-from-style 'system-default) nil) (t (error "Invalid value for 'mail-from-style'"))))) (defun sendmail-send-it 0 "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) (let ((errbuf (if mail-interactive (generate -new-buffer " sendmail errors") 0)) (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)) (program (if (boundp 'sendmail-program) sendmail-program "/usr/lib/sendmail")) ;; Examine these variables now, so that ;; local binding in the mail buffer will take effect. (envelope -from (and mail-specify -envelope -from (or (mail -envelope -from) user-mail -address)))) (unwind -protect (with -current -buffer tembuf (erase -buffer) (unless multibyte (set-buffer-multibyte nil)) (insert-buffer-substring mailbuf) (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) (prog n (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 (while (and (re-search -forward "\n\n\n*" delimline t) (< (point) delimline)) EFTA00504397 (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\\Icc\\Ibcc\\) :" 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 "A[ \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 (save -excursion (beginning -of-line) (point)) (save -excursion (end-of-line) (1+ (point)))))) ;;; Apparently this causes a duplicate Sender. ;;; ;; If the From is different than 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 "ASubject:\\(( \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) (goto-char (point -min)) (and (eq mail-send-nonascii 'mime) (not (re-search -forward ""MIME -version:" delimline t)) (progn (skip -chars -forward "\O-\177") (1= (point) (point -max))) selected -coding (setq charset (coding -system -get selected -coding 'mime-charset)) (goto-char delimline) (insert "MIME -version: 1.0\n" "Content -type: text/plain; charset=" (symbol -name charset) EFTA00504398 "\nContent-Transfer-Encoding: 8bit\n"))) ;; 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)))) (goto-char (point -min)) (if (let ((case -fold -search t)) (or resend-to-addresses (re-search -forward "*To:\\I Acc:\\I abcc:" delimline t))) (let* ((default -directory "/") (coding -system -for-write selected -coding) (args (append (list (point -min) (point -max) 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 ;; These mean "report errors to terminal" ;; and "deliver interactively" '("-oep" "-odi") ;; These mean "report errors by mail" and "deliver in background". '("-oem" "-odb")) ;; 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))) (or (null exit-value) (eq 0 exit-value) (error "Sending...failed with exit value %d" 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 "; ")) (if (not (zerop (buffer -size))) (error "Sending...failed to %s" EFTA00504399 (buffer-substring (point -min) (point -max))))))) (kill -buffer tembuf) (if (bufferp errbuf) (kill -buffer errbuf))))) EFTA00504400