diff options
Diffstat (limited to 'lisp/mail')
| -rw-r--r-- | lisp/mail/smtpmail.el | 53 |
1 files changed, 27 insertions, 26 deletions
diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el index b23970d441b..2e5b722de0b 100644 --- a/lisp/mail/smtpmail.el +++ b/lisp/mail/smtpmail.el | |||
| @@ -45,7 +45,7 @@ | |||
| 45 | ;;(setq smtpmail-starttls-credentials | 45 | ;;(setq smtpmail-starttls-credentials |
| 46 | ;; '(("YOUR SMTP HOST" 25 "~/.my_smtp_tls.key" "~/.my_smtp_tls.cert"))) | 46 | ;; '(("YOUR SMTP HOST" 25 "~/.my_smtp_tls.key" "~/.my_smtp_tls.cert"))) |
| 47 | 47 | ||
| 48 | ;; To queue mail, set smtpmail-queue-mail to t and use | 48 | ;; To queue mail, set smtpmail-queue-mail to t and use |
| 49 | ;; smtpmail-send-queued-mail to send. | 49 | ;; smtpmail-send-queued-mail to send. |
| 50 | 50 | ||
| 51 | ;; Modified by Stephen Cranefield <scranefield@infoscience.otago.ac.nz>, | 51 | ;; Modified by Stephen Cranefield <scranefield@infoscience.otago.ac.nz>, |
| @@ -86,7 +86,7 @@ | |||
| 86 | :type '(choice (const nil) string) | 86 | :type '(choice (const nil) string) |
| 87 | :group 'smtpmail) | 87 | :group 'smtpmail) |
| 88 | 88 | ||
| 89 | (defcustom smtpmail-smtp-server | 89 | (defcustom smtpmail-smtp-server |
| 90 | (or (getenv "SMTPSERVER") smtpmail-default-smtp-server) | 90 | (or (getenv "SMTPSERVER") smtpmail-default-smtp-server) |
| 91 | "*The name of the host running SMTP server." | 91 | "*The name of the host running SMTP server." |
| 92 | :type '(choice (const nil) string) | 92 | :type '(choice (const nil) string) |
| @@ -139,7 +139,7 @@ The commands enables verbose information from the SMTP server." | |||
| 139 | :type 'boolean | 139 | :type 'boolean |
| 140 | :group 'smtpmail) | 140 | :group 'smtpmail) |
| 141 | 141 | ||
| 142 | (defcustom smtpmail-queue-mail nil | 142 | (defcustom smtpmail-queue-mail nil |
| 143 | "*Specify if mail is queued (if t) or sent immediately (if nil). | 143 | "*Specify if mail is queued (if t) or sent immediately (if nil). |
| 144 | If queued, it is stored in the directory `smtpmail-queue-dir' | 144 | If queued, it is stored in the directory `smtpmail-queue-dir' |
| 145 | and sent with `smtpmail-send-queued-mail'." | 145 | and sent with `smtpmail-send-queued-mail'." |
| @@ -292,7 +292,7 @@ This is relative to `smtpmail-queue-dir'.") | |||
| 292 | ;; ... then undo escaping of matching parentheses, | 292 | ;; ... then undo escaping of matching parentheses, |
| 293 | ;; including matching nested parentheses. | 293 | ;; including matching nested parentheses. |
| 294 | (goto-char fullname-start) | 294 | (goto-char fullname-start) |
| 295 | (while (re-search-forward | 295 | (while (re-search-forward |
| 296 | "\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)" | 296 | "\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)" |
| 297 | fullname-end 1) | 297 | fullname-end 1) |
| 298 | (replace-match "\\1(\\3)" t) | 298 | (replace-match "\\1(\\3)" t) |
| @@ -327,16 +327,16 @@ This is relative to `smtpmail-queue-dir'.") | |||
| 327 | (setq smtpmail-recipient-address-list | 327 | (setq smtpmail-recipient-address-list |
| 328 | (smtpmail-deduce-address-list tembuf (point-min) delimline)) | 328 | (smtpmail-deduce-address-list tembuf (point-min) delimline)) |
| 329 | (kill-buffer smtpmail-address-buffer) | 329 | (kill-buffer smtpmail-address-buffer) |
| 330 | 330 | ||
| 331 | (smtpmail-do-bcc delimline) | 331 | (smtpmail-do-bcc delimline) |
| 332 | ; Send or queue | 332 | ; Send or queue |
| 333 | (if (not smtpmail-queue-mail) | 333 | (if (not smtpmail-queue-mail) |
| 334 | (if (not (null smtpmail-recipient-address-list)) | 334 | (if (not (null smtpmail-recipient-address-list)) |
| 335 | (if (not (smtpmail-via-smtp | 335 | (if (not (smtpmail-via-smtp |
| 336 | smtpmail-recipient-address-list tembuf)) | 336 | smtpmail-recipient-address-list tembuf)) |
| 337 | (error "Sending failed; SMTP protocol error")) | 337 | (error "Sending failed; SMTP protocol error")) |
| 338 | (error "Sending failed; no recipients")) | 338 | (error "Sending failed; no recipients")) |
| 339 | (let* ((file-data (concat | 339 | (let* ((file-data (concat |
| 340 | smtpmail-queue-dir | 340 | smtpmail-queue-dir |
| 341 | (concat (time-stamp-yyyy-mm-dd) | 341 | (concat (time-stamp-yyyy-mm-dd) |
| 342 | "_" (time-stamp-hh:mm:ss) | 342 | "_" (time-stamp-hh:mm:ss) |
| @@ -356,12 +356,12 @@ This is relative to `smtpmail-queue-dir'.") | |||
| 356 | (insert (concat | 356 | (insert (concat |
| 357 | "(setq smtpmail-recipient-address-list '" | 357 | "(setq smtpmail-recipient-address-list '" |
| 358 | (prin1-to-string smtpmail-recipient-address-list) | 358 | (prin1-to-string smtpmail-recipient-address-list) |
| 359 | ")\n")) | 359 | ")\n")) |
| 360 | (write-file file-elisp) | 360 | (write-file file-elisp) |
| 361 | (set-buffer (generate-new-buffer buffer-scratch)) | 361 | (set-buffer (generate-new-buffer buffer-scratch)) |
| 362 | (insert (concat file-data "\n")) | 362 | (insert (concat file-data "\n")) |
| 363 | (append-to-file (point-min) | 363 | (append-to-file (point-min) |
| 364 | (point-max) | 364 | (point-max) |
| 365 | smtpmail-queue-index) | 365 | smtpmail-queue-index) |
| 366 | ) | 366 | ) |
| 367 | (kill-buffer buffer-scratch) | 367 | (kill-buffer buffer-scratch) |
| @@ -469,12 +469,13 @@ This is relative to `smtpmail-queue-dir'.") | |||
| 469 | (mech (car (smtpmail-intersection smtpmail-auth-supported mechs))) | 469 | (mech (car (smtpmail-intersection smtpmail-auth-supported mechs))) |
| 470 | (cred (if (stringp smtpmail-auth-credentials) | 470 | (cred (if (stringp smtpmail-auth-credentials) |
| 471 | (let* ((netrc (netrc-parse smtpmail-auth-credentials)) | 471 | (let* ((netrc (netrc-parse smtpmail-auth-credentials)) |
| 472 | (hostentry (netrc-machine | 472 | (hostentry (netrc-machine |
| 473 | netrc host (format "%s" (or port "smtp")) | 473 | netrc host (format "%s" (or port "smtp")) |
| 474 | "smtp"))) | 474 | "smtp"))) |
| 475 | (list host port | 475 | (when hostentry |
| 476 | (netrc-get hostentry "login") | 476 | (list host port |
| 477 | (netrc-get hostentry "password"))) | 477 | (netrc-get hostentry "login") |
| 478 | (netrc-get hostentry "password")))) | ||
| 478 | (smtpmail-find-credentials | 479 | (smtpmail-find-credentials |
| 479 | smtpmail-auth-credentials host port))) | 480 | smtpmail-auth-credentials host port))) |
| 480 | (passwd (when cred | 481 | (passwd (when cred |
| @@ -521,7 +522,7 @@ This is relative to `smtpmail-queue-dir'.") | |||
| 521 | (>= (car ret) 400)) | 522 | (>= (car ret) 400)) |
| 522 | (throw 'done nil))) | 523 | (throw 'done nil))) |
| 523 | (t | 524 | (t |
| 524 | (error "Mechanism %s not implemented" mech))) | 525 | (error "Mechanism %s not implemented" mech))) |
| 525 | ;; Remember the password. | 526 | ;; Remember the password. |
| 526 | (when (and (not (stringp smtpmail-auth-credentials)) | 527 | (when (and (not (stringp smtpmail-auth-credentials)) |
| 527 | (null (smtpmail-cred-passwd cred))) | 528 | (null (smtpmail-cred-passwd cred))) |
| @@ -558,7 +559,7 @@ This is relative to `smtpmail-queue-dir'.") | |||
| 558 | (make-local-variable 'smtpmail-read-point) | 559 | (make-local-variable 'smtpmail-read-point) |
| 559 | (setq smtpmail-read-point (point-min)) | 560 | (setq smtpmail-read-point (point-min)) |
| 560 | 561 | ||
| 561 | 562 | ||
| 562 | (if (or (null (car (setq greeting (smtpmail-read-response process)))) | 563 | (if (or (null (car (setq greeting (smtpmail-read-response process)))) |
| 563 | (not (integerp (car greeting))) | 564 | (not (integerp (car greeting))) |
| 564 | (>= (car greeting) 400)) | 565 | (>= (car greeting) 400)) |
| @@ -615,7 +616,7 @@ This is relative to `smtpmail-queue-dir'.") | |||
| 615 | (starttls-negotiate process) | 616 | (starttls-negotiate process) |
| 616 | (setq do-starttls nil)) | 617 | (setq do-starttls nil)) |
| 617 | (setq do-ehlo nil)))) | 618 | (setq do-ehlo nil)))) |
| 618 | 619 | ||
| 619 | (smtpmail-try-auth-methods process supported-extensions host port) | 620 | (smtpmail-try-auth-methods process supported-extensions host port) |
| 620 | 621 | ||
| 621 | (if (or (member 'onex supported-extensions) | 622 | (if (or (member 'onex supported-extensions) |
| @@ -691,7 +692,7 @@ This is relative to `smtpmail-queue-dir'.") | |||
| 691 | (>= (car response-code) 400)) | 692 | (>= (car response-code) 400)) |
| 692 | (throw 'done nil) | 693 | (throw 'done nil) |
| 693 | )) | 694 | )) |
| 694 | 695 | ||
| 695 | ;; RCPT TO: <recipient> | 696 | ;; RCPT TO: <recipient> |
| 696 | (let ((n 0)) | 697 | (let ((n 0)) |
| 697 | (while (not (null (nth n recipient))) | 698 | (while (not (null (nth n recipient))) |
| @@ -705,7 +706,7 @@ This is relative to `smtpmail-queue-dir'.") | |||
| 705 | (throw 'done nil) | 706 | (throw 'done nil) |
| 706 | ) | 707 | ) |
| 707 | )) | 708 | )) |
| 708 | 709 | ||
| 709 | ;; DATA | 710 | ;; DATA |
| 710 | (smtpmail-send-command process "DATA") | 711 | (smtpmail-send-command process "DATA") |
| 711 | 712 | ||
| @@ -767,7 +768,7 @@ This is relative to `smtpmail-queue-dir'.") | |||
| 767 | (setq response-strings | 768 | (setq response-strings |
| 768 | (cons (buffer-substring smtpmail-read-point (- match-end 2)) | 769 | (cons (buffer-substring smtpmail-read-point (- match-end 2)) |
| 769 | response-strings)) | 770 | response-strings)) |
| 770 | 771 | ||
| 771 | (goto-char smtpmail-read-point) | 772 | (goto-char smtpmail-read-point) |
| 772 | (if (looking-at "[0-9]+ ") | 773 | (if (looking-at "[0-9]+ ") |
| 773 | (let ((begin (match-beginning 0)) | 774 | (let ((begin (match-beginning 0)) |
| @@ -782,10 +783,10 @@ This is relative to `smtpmail-queue-dir'.") | |||
| 782 | nil | 783 | nil |
| 783 | (setq response-continue nil) | 784 | (setq response-continue nil) |
| 784 | (setq return-value | 785 | (setq return-value |
| 785 | (cons (string-to-int | 786 | (cons (string-to-int |
| 786 | (buffer-substring begin end)) | 787 | (buffer-substring begin end)) |
| 787 | (nreverse response-strings))))) | 788 | (nreverse response-strings))))) |
| 788 | 789 | ||
| 789 | (if (looking-at "[0-9]+-") | 790 | (if (looking-at "[0-9]+-") |
| 790 | (progn (if smtpmail-debug-info | 791 | (progn (if smtpmail-debug-info |
| 791 | (message "%s" (car response-strings))) | 792 | (message "%s" (car response-strings))) |
| @@ -794,7 +795,7 @@ This is relative to `smtpmail-queue-dir'.") | |||
| 794 | (progn | 795 | (progn |
| 795 | (setq smtpmail-read-point match-end) | 796 | (setq smtpmail-read-point match-end) |
| 796 | (setq response-continue nil) | 797 | (setq response-continue nil) |
| 797 | (setq return-value | 798 | (setq return-value |
| 798 | (cons nil (nreverse response-strings))) | 799 | (cons nil (nreverse response-strings))) |
| 799 | ) | 800 | ) |
| 800 | ))) | 801 | ))) |
| @@ -818,7 +819,7 @@ This is relative to `smtpmail-queue-dir'.") | |||
| 818 | smtpmail-code-conv-from) | 819 | smtpmail-code-conv-from) |
| 819 | (setq data (string-as-multibyte | 820 | (setq data (string-as-multibyte |
| 820 | (encode-coding-string data smtpmail-code-conv-from)))) | 821 | (encode-coding-string data smtpmail-code-conv-from)))) |
| 821 | 822 | ||
| 822 | (if smtpmail-debug-info | 823 | (if smtpmail-debug-info |
| 823 | (insert data "\r\n")) | 824 | (insert data "\r\n")) |
| 824 | 825 | ||
| @@ -855,7 +856,7 @@ This is relative to `smtpmail-queue-dir'.") | |||
| 855 | ) | 856 | ) |
| 856 | ) | 857 | ) |
| 857 | ) | 858 | ) |
| 858 | 859 | ||
| 859 | 860 | ||
| 860 | (defun smtpmail-deduce-address-list (smtpmail-text-buffer header-start header-end) | 861 | (defun smtpmail-deduce-address-list (smtpmail-text-buffer header-start header-end) |
| 861 | "Get address list suitable for smtp RCPT TO: <address>." | 862 | "Get address list suitable for smtp RCPT TO: <address>." |