X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/1a8e727bc0b369c983dbf61a48a61c47d648e3af..ac84042c630254697a5244b11bef4375579bbf3f:/lisp/mail/smtpmail.el diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el index 59bbd7fbc8..e516133c6a 100644 --- a/lisp/mail/smtpmail.el +++ b/lisp/mail/smtpmail.el @@ -1,6 +1,6 @@ ;;; smtpmail.el --- simple SMTP protocol (RFC 821) for sending mail -;; Copyright (C) 1995, 1996, 2001 Free Software Foundation, Inc. +;; Copyright (C) 1995, 1996, 2001, 2002, 2003 Free Software Foundation, Inc. ;; Author: Tomoji Kagatani ;; Maintainer: Simon Josefsson @@ -66,7 +66,6 @@ ;;; Code: (require 'sendmail) -(require 'time-stamp) (autoload 'starttls-open-stream "starttls") (autoload 'starttls-negotiate "starttls") (autoload 'mail-strip-quoted-names "mail-utils") @@ -84,7 +83,8 @@ (defcustom smtpmail-default-smtp-server nil - "*Specify default SMTP server." + "*Specify default SMTP server. +This only has effect if you specify it before loading the smtpmail library." :type '(choice (const nil) string) :group 'smtpmail) @@ -211,6 +211,9 @@ This is relative to `smtpmail-queue-dir'.") ;;; ;;; +(defvar smtpmail-mail-address nil + "Value to use for envelope-from address for mail from ambient buffer.") + ;;;###autoload (defun smtpmail-send-it () (let ((errbuf (if mail-interactive @@ -220,7 +223,11 @@ This is relative to `smtpmail-queue-dir'.") (case-fold-search nil) delimline (mailbuf (current-buffer)) - (mail-address user-mail-address) + ;; Examine this variable now, so that + ;; local binding in the mail buffer will take effect. + (smtpmail-mail-address + (or (and mail-specify-envelope-from (mail-envelope-from)) + user-mail-address)) (smtpmail-code-conv-from (if enable-multibyte-characters (let ((sendmail-coding-system smtpmail-code-conv-from)) @@ -261,7 +268,7 @@ This is relative to `smtpmail-queue-dir'.") ;; they put one in themselves. (goto-char (point-min)) (if (not (re-search-forward "^From:" delimline t)) - (let* ((login mail-address) + (let* ((login smtpmail-mail-address) (fullname (user-full-name))) (cond ((eq mail-from-style 'angles) (insert "From: " fullname) @@ -339,17 +346,20 @@ This is relative to `smtpmail-queue-dir'.") smtpmail-recipient-address-list tembuf)) (error "Sending failed; SMTP protocol error")) (error "Sending failed; no recipients")) - (let* ((file-data (concat - smtpmail-queue-dir - (concat (time-stamp-yyyy-mm-dd) - "_" (time-stamp-hh:mm:ss) - "_" - (setq smtpmail-queue-counter - (1+ smtpmail-queue-counter))))) - (file-elisp (concat file-data ".el")) + (let* ((file-data + (expand-file-name + (format "%s_%i" + (format-time-string "%Y-%m-%d_%H:%M:%S") + (setq smtpmail-queue-counter + (1+ smtpmail-queue-counter))) + smtpmail-queue-dir)) + (file-data (convert-standard-filename file-data)) + (file-elisp (concat file-data ".el")) (buffer-data (create-file-buffer file-data)) (buffer-elisp (create-file-buffer file-elisp)) (buffer-scratch "*queue-mail*")) + (unless (file-exists-p smtpmail-queue-dir) + (make-directory smtpmail-queue-dir t)) (with-current-buffer buffer-data (erase-buffer) (insert-buffer tembuf) @@ -374,6 +384,7 @@ This is relative to `smtpmail-queue-dir'.") (if (bufferp errbuf) (kill-buffer errbuf))))) +;;;###autoload (defun smtpmail-send-queued-mail () "Send mail that was queued as a result of setting `smtpmail-queue-mail'." (interactive) @@ -392,14 +403,17 @@ This is relative to `smtpmail-queue-dir'.") (with-temp-buffer (let ((coding-system-for-read 'no-conversion)) (insert-file-contents file-msg)) - (if (not (null smtpmail-recipient-address-list)) - (if (not (smtpmail-via-smtp smtpmail-recipient-address-list - (current-buffer))) - (error "Sending failed; SMTP protocol error")) - (error "Sending failed; no recipients"))) + (let ((smtpmail-mail-address + (or (and mail-specify-envelope-from (mail-envelope-from)) + user-mail-address))) + (if (not (null smtpmail-recipient-address-list)) + (if (not (smtpmail-via-smtp smtpmail-recipient-address-list + (current-buffer))) + (error "Sending failed; SMTP protocol error")) + (error "Sending failed; no recipients")))) (delete-file file-msg) (delete-file (concat file-msg ".el")) - (kill-line 1)) + (delete-region (point-at-bol) (point-at-bol 2))) (write-region (point-min) (point-max) smtpmail-queue-index)))) ;(defun smtpmail-via-smtp (host,port,sender,destination,smtpmail-text-buffer) @@ -452,7 +466,9 @@ This is relative to `smtpmail-queue-dir'.") (let ((cred (smtpmail-find-credentials smtpmail-starttls-credentials host port))) (if (null (and cred (condition-case () - (call-process "starttls") + (progn + (require 'starttls) + (call-process starttls-program)) (error nil)))) ;; The normal case. (open-network-stream "SMTP" process-buffer host port) @@ -472,9 +488,9 @@ This is relative to `smtpmail-queue-dir'.") (mech (car (smtpmail-intersection smtpmail-auth-supported mechs))) (cred (if (stringp smtpmail-auth-credentials) (let* ((netrc (netrc-parse smtpmail-auth-credentials)) - (hostentry (netrc-machine - netrc host (format "%s" (or port "smtp")) - "smtp"))) + (port-name (format "%s" (or port "smtp"))) + (hostentry (netrc-machine netrc host port-name + port-name))) (when hostentry (list host port (netrc-get hostentry "login") @@ -488,7 +504,7 @@ This is relative to `smtpmail-queue-dir'.") (smtpmail-cred-server cred) (smtpmail-cred-port cred)))))) ret) - (when cred + (when (and cred mech) (cond ((eq mech 'cram-md5) (smtpmail-send-command process (format "AUTH %s" mech)) @@ -536,6 +552,12 @@ This is relative to `smtpmail-queue-dir'.") (host (or smtpmail-smtp-server (error "`smtpmail-smtp-server' not defined"))) (port smtpmail-smtp-service) + ;; smtpmail-mail-address should be set to the appropriate + ;; buffer-local value by the caller, but in case not: + (envelope-from (or smtpmail-mail-address + (and mail-specify-envelope-from + (mail-envelope-from)) + user-mail-address)) response-code greeting process-buffer @@ -609,7 +631,7 @@ This is relative to `smtpmail-queue-dir'.") (if (and do-starttls (smtpmail-find-credentials smtpmail-starttls-credentials host port) (member 'starttls supported-extensions) - (process-id process)) + (numberp (process-id process))) (progn (smtpmail-send-command process (format "STARTTLS")) (if (or (null (car (setq response-code (smtpmail-read-response process)))) @@ -649,7 +671,7 @@ This is relative to `smtpmail-queue-dir'.") (>= (car response-code) 400)) (throw 'done nil)))) - ;; MAIL FROM: + ;; MAIL FROM: (let ((size-part (if (or (member 'size supported-extensions) (assoc 'size supported-extensions)) @@ -658,13 +680,8 @@ This is relative to `smtpmail-queue-dir'.") ;; size estimate: (+ (- (point-max) (point-min)) ;; Add one byte for each change-of-line - ;; because or CR-LF representation: - (count-lines (point-min) (point-max)) - ;; For some reason, an empty line is - ;; added to the message. Maybe this - ;; is a bug, but it can't hurt to add - ;; those two bytes anyway: - 2))) + ;; because of CR-LF representation: + (count-lines (point-min) (point-max))))) "")) (body-part (if (member '8bitmime supported-extensions) @@ -684,9 +701,8 @@ This is relative to `smtpmail-queue-dir'.") "") ""))) ; (smtpmail-send-command process (format "MAIL FROM:%s@%s" (user-login-name) (smtpmail-fqdn))) - (smtpmail-send-command process (format "MAIL FROM: <%s>%s%s" - (or mail-envelope-from - mail-address) + (smtpmail-send-command process (format "MAIL FROM:<%s>%s%s" + envelope-from size-part body-part)) @@ -696,10 +712,10 @@ This is relative to `smtpmail-queue-dir'.") (throw 'done nil) )) - ;; RCPT TO: + ;; RCPT TO: (let ((n 0)) (while (not (null (nth n recipient))) - (smtpmail-send-command process (format "RCPT TO: <%s>" (smtpmail-maybe-append-domain (nth n recipient)))) + (smtpmail-send-command process (format "RCPT TO:<%s>" (smtpmail-maybe-append-domain (nth n recipient)))) (setq n (1+ n)) (setq response-code (smtpmail-read-response process)) @@ -746,7 +762,9 @@ This is relative to `smtpmail-queue-dir'.") ; (>= (car response-code) 400)) ; (throw 'done nil) ; ) - (delete-process process)))))) + (delete-process process) + (unless smtpmail-debug-info + (kill-buffer process-buffer))))))) (defun smtpmail-process-filter (process output) @@ -835,31 +853,15 @@ This is relative to `smtpmail-queue-dir'.") ) (defun smtpmail-send-data (process buffer) - (let - ((data-continue t) - (sending-data nil) - this-line - this-line-end) - + (let ((data-continue t) sending-data) (with-current-buffer buffer (goto-char (point-min))) - (while data-continue (with-current-buffer buffer - (beginning-of-line) - (setq this-line (point)) - (end-of-line) - (setq this-line-end (point)) - (setq sending-data nil) - (setq sending-data (buffer-substring this-line this-line-end)) - (if (/= (forward-line 1) 0) - (setq data-continue nil))) - - (smtpmail-send-data-1 process sending-data) - ) - ) - ) - + (setq sending-data (buffer-substring (point-at-bol) (point-at-eol))) + (end-of-line 2) + (setq data-continue (not (eobp)))) + (smtpmail-send-data-1 process sending-data)))) (defun smtpmail-deduce-address-list (smtpmail-text-buffer header-start header-end) "Get address list suitable for smtp RCPT TO:
." @@ -937,4 +939,5 @@ many continuation lines." (provide 'smtpmail) +;;; arch-tag: a76992df-6d71-43b7-9e72-4bacc6c05466 ;;; smtpmail.el ends here