;; Simple SMTP protocol (RFC 821) for sending mail
-;; Copyright (C) 1995 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1996 Free Software Foundation, Inc.
;; Author: Tomoji Kagatani <kagatani@rbc.ncl.omron.co.jp>
+;; Maintainer: Brian D. Carlstrom <bdc@ai.mit.edu>
;; Keywords: mail
;; This file is part of GNU Emacs.
;;; Commentary:
;; Send Mail to smtp host from smtpmail temp buffer.
-;; alfa release
;; Please add these lines in your .emacs(_emacs).
;;
;;(setq smtpmail-debug-info t)
;;(load-library "smtpmail")
;;(setq smtpmail-code-conv-from nil)
+;;(setq user-full-name "YOUR NAME HERE")
;;; Code:
(defvar smtpmail-default-smtp-server nil
"*Specify default SMTP server.")
-(defvar smtpmail-smtp-server (or (getenv "SMTPSERVER")
- smtpmail-default-smtp-server)
+(defvar smtpmail-smtp-server
+ (or (getenv "SMTPSERVER") smtpmail-default-smtp-server)
"*The name of the host running SMTP server.")
-(defvar smtpmail-smtp-service "smtp"
+(defvar smtpmail-smtp-service 25
"*SMTP service port number. smtp or 25 .")
(defvar smtpmail-local-domain nil
;;;
(defun smtpmail-send-it ()
+ (require 'mail-utils)
(let ((errbuf (if mail-interactive
(generate-new-buffer " smtpmail errors")
0))
(replace-match "\n")
(backward-char 1)
(setq delimline (point-marker))
+;; (sendmail-synch-aliases)
(if mail-aliases
(expand-mail-aliases (point-min) delimline))
(goto-char (point-min))
(replace-match "\n"))
(let ((case-fold-search t))
(goto-char (point-min))
- ;; Find and handle any FCC fields.
- (goto-char (point-min))
- (if (re-search-forward "^FCC:" delimline t)
- (mail-do-fcc delimline))
(goto-char (point-min))
- (require 'mail-utils)
(while (re-search-forward "^Resent-to:" delimline t)
(setq resend-to-addresses
(save-restriction
;;; (progn
;;; (forward-line 1)
;;; (insert "Sender: " (user-login-name) "\n")))
- ;; "S:" is an abbreviation for "Subject:".
- (goto-char (point-min))
- (if (re-search-forward "^S:" delimline t)
- (replace-match "Subject:"))
;; Don't send out a blank subject line
(goto-char (point-min))
(if (re-search-forward "^Subject:[ \t]*\n" delimline t)
(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))
+ (let* ((login user-mail-address)
+ (fullname (user-full-name)))
+ (cond ((eq mail-from-style 'angles)
+ (insert "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 (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]"
+ fullname-end 1)
+ (progn
+ ;; Quote fullname, escaping specials.
+ (goto-char fullname-start)
+ (insert "\"")
+ (while (re-search-forward "[\"\\]"
+ fullname-end 1)
+ (replace-match "\\\\\\&" t))
+ (insert "\""))))
+ (insert " <" login ">\n"))
+ ((eq mail-from-style 'parens)
+ (insert "From: " login " (")
+ (let ((fullname-start (point)))
+ (insert fullname)
+ (let ((fullname-end (point-marker)))
+ (goto-char fullname-start)
+ ;; RFC 822 says \ and nonmatching parentheses
+ ;; must be escaped in comments.
+ ;; Escape every instance of ()\ ...
+ (while (re-search-forward "[()\\]" fullname-end 1)
+ (replace-match "\\\\\\&" t))
+ ;; ... then undo escaping of matching parentheses,
+ ;; including matching nested parentheses.
+ (goto-char fullname-start)
+ (while (re-search-forward
+ "\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)"
+ fullname-end 1)
+ (replace-match "\\1(\\3)" t)
+ (goto-char fullname-start))))
+ (insert ")\n"))
+ ((null mail-from-style)
+ (insert "From: " login "\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)
+ (mail-do-fcc delimline))
(if mail-interactive
(save-excursion
(set-buffer errbuf)
;;
(setq smtpmail-address-buffer (generate-new-buffer "*smtp-mail*"))
(setq smtpmail-recipient-address-list
- (smtpmail-deduce-address-list tembuf (point-min) delimline))
+ (or resend-to-addresses
+ (smtpmail-deduce-address-list tembuf (point-min) delimline)))
(kill-buffer smtpmail-address-buffer)
(smtpmail-do-bcc delimline)
(if (not (null smtpmail-recipient-address-list))
(if (not (smtpmail-via-smtp smtpmail-recipient-address-list tembuf))
- (error "Sending... Failed. SMTP Protocol Error."))
- (error "Sending... failed. No recipients."))
+ (error "Sending failed; SMTP protocol error"))
+ (error "Sending failed; no recipients"))
)
(kill-buffer tembuf)
(if (bufferp errbuf)
(defun smtpmail-via-smtp (recipient smtpmail-text-buffer)
(let ((process nil)
- host
- port
+ (host smtpmail-smtp-server)
+ (port smtpmail-smtp-service)
response-code
- )
- (setq host smtpmail-smtp-server)
- (setq port smtpmail-smtp-service)
-
+ greeting
+ process-buffer)
(unwind-protect
(catch 'done
;; get or create the trace buffer
;; MAIL FROM: <sender>
; (smtpmail-send-command process (format "MAIL FROM:%s@%s" (user-login-name) (smtpmail-fqdn)))
- (smtpmail-send-command process (format "MAIL FROM:%s" user-mail-address))
+ (smtpmail-send-command process (format "MAIL FROM: <%s>" user-mail-address))
(if (or (null (car (setq response-code (smtpmail-read-response process))))
(not (integerp (car response-code)))
)
;; RCPT TO: <recipient>
- (setq n 0)
- (while (not (null (nth n recipient)))
- (smtpmail-send-command process (format "RCPT TO: %s" (nth n recipient)))
- (setq n (1+ n))
-
- (if (or (null (car (setq response-code (smtpmail-read-response process))))
- (not (integerp (car response-code)))
- (>= (car response-code) 400))
- (throw 'done nil)
- )
- )
+ (let ((n 0))
+ (while (not (null (nth n recipient)))
+ (smtpmail-send-command process (format "RCPT TO: <%s>" (nth n recipient)))
+ (setq n (1+ n))
+
+ (if (or (null (car (setq response-code (smtpmail-read-response process))))
+ (not (integerp (car response-code)))
+ (>= (car response-code) 400))
+ (throw 'done nil)
+ )
+ ))
;; DATA
(smtpmail-send-command process "DATA")
(delete-process process))))))
-;; check completely by T.Kagatani
(defun smtpmail-process-filter (process output)
(save-excursion
(set-buffer (process-buffer process))
(goto-char (point-max))
(insert output)))
-;; check completely by T.Kagatani
(defun smtpmail-read-response (process)
(let ((case-fold-search nil)
(response-string nil)
; (setq response-continue t)
; (setq return-value '(nil ""))
- (goto-char smtpmail-read-point)
(while response-continue
+ (goto-char smtpmail-read-point)
(while (not (search-forward "\r\n" nil t))
(accept-process-output process)
(goto-char smtpmail-read-point))
return-value))
-;; check completely by T.Kagatani
(defun smtpmail-send-command (process command)
(goto-char (point-max))
(if (= (aref command 0) ?P)
(process-send-string process command)
(process-send-string process "\r\n"))
-;; check completely by T.Kagatani
(defun smtpmail-send-data-1 (process data)
(goto-char (point-max))
(insert data "\r\n"))
(setq smtpmail-read-point (point))
- (process-send-string process data)
- ;; . -> ..
- (if (string-equal data ".")
+ ;; Escape "." at start of a line
+ (if (eq (string-to-char data) ?.)
(process-send-string process "."))
+ (process-send-string process data)
(process-send-string process "\r\n")
)
((case-fold-search t)
(simple-address-list "")
this-line
- this-line-end)
+ this-line-end
+ addr-regexp)
(unwind-protect
(save-excursion
(set-buffer smtpmail-address-buffer) (erase-buffer)
(insert-buffer-substring smtpmail-text-buffer header-start header-end)
(goto-char (point-min))
- (while (re-search-forward "^\\(TO:\\|CC:\\|BCC:\\)" header-end t)
+ ;; RESENT-* fields should stop processing of regular fields.
+ (save-excursion
+ (if (re-search-forward "^RESENT-TO:" header-end t)
+ (setq addr-regexp "^\\(RESENT-TO:\\|RESENT-CC:\\|RESENT-BCC:\\)")
+ (setq addr-regexp "^\\(TO:\\|CC:\\|BCC:\\)")))
+
+ (while (re-search-forward addr-regexp header-end t)
(replace-match "")
(setq this-line (match-beginning 0))
(forward-line 1)
(while (re-search-forward "[ \t]+" header-end t) (replace-match " "))
(goto-char (point-min))
- (setq recipient-address-list nil)
- (while (re-search-forward " [^ ]+ " (point-max) t)
- (backward-char 1)
- (setq recipient-address-list(cons (buffer-substring (match-beginning 0) (match-end 0))
- recipient-address-list))
- )
- (setq smtpmail-recipient-address-list recipient-address-list)
+ (let (recipient-address-list)
+ (while (re-search-forward " \\([^ ]+\\) " (point-max) t)
+ (backward-char 1)
+ (setq recipient-address-list (cons (buffer-substring (match-beginning 1) (match-end 1))
+ recipient-address-list))
+ )
+ (setq smtpmail-recipient-address-list recipient-address-list))
)
)