aboutsummaryrefslogtreecommitdiffstats
path: root/lisp/mail
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/mail')
-rw-r--r--lisp/mail/smtpmail.el53
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).
144If queued, it is stored in the directory `smtpmail-queue-dir' 144If queued, it is stored in the directory `smtpmail-queue-dir'
145and sent with `smtpmail-send-queued-mail'." 145and 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>."