Mercurial > emacs
comparison lisp/mail/smtpmail.el @ 41716:e467d0e8f243
Use with-current-buffer.
(message-make-date, message-make-message-id): Autoload when needed.
(smtpmail-send-it): Use them to add `Date:' and `Message-Id:'
headers when missing.
author | Stefan Monnier <monnier@iro.umontreal.ca> |
---|---|
date | Sat, 01 Dec 2001 00:36:12 +0000 |
parents | 608d7b92d289 |
children | de4a90cd0a5f |
comparison
equal
deleted
inserted
replaced
41715:3fb1c54eb631 | 41716:e467d0e8f243 |
---|---|
68 (require 'sendmail) | 68 (require 'sendmail) |
69 (require 'time-stamp) | 69 (require 'time-stamp) |
70 (autoload 'starttls-open-stream "starttls") | 70 (autoload 'starttls-open-stream "starttls") |
71 (autoload 'starttls-negotiate "starttls") | 71 (autoload 'starttls-negotiate "starttls") |
72 (autoload 'mail-strip-quoted-names "mail-utils") | 72 (autoload 'mail-strip-quoted-names "mail-utils") |
73 (autoload 'message-make-date "message") | |
74 (autoload 'message-make-message-id "message") | |
73 (autoload 'rfc2104-hash "rfc2104") | 75 (autoload 'rfc2104-hash "rfc2104") |
74 | 76 |
75 ;;; | 77 ;;; |
76 (defgroup smtpmail nil | 78 (defgroup smtpmail nil |
77 "SMTP protocol for sending mail." | 79 "SMTP protocol for sending mail." |
291 (replace-match "\\1(\\3)" t) | 293 (replace-match "\\1(\\3)" t) |
292 (goto-char fullname-start)))) | 294 (goto-char fullname-start)))) |
293 (insert ")\n")) | 295 (insert ")\n")) |
294 ((null mail-from-style) | 296 ((null mail-from-style) |
295 (insert "From: " login "\n"))))) | 297 (insert "From: " login "\n"))))) |
298 ;; Insert a `Message-Id:' field if there isn't one yet. | |
299 (goto-char (point-min)) | |
300 (unless (re-search-forward "^Message-Id:" delimline t) | |
301 (insert "Message-Id: " (message-make-message-id) "\n")) | |
302 ;; Insert a `Date:' field if there isn't one yet. | |
303 (goto-char (point-min)) | |
304 (unless (re-search-forward "^Date:" delimline t) | |
305 (insert "Date: " (message-make-date) "\n")) | |
296 ;; Insert an extra newline if we need it to work around | 306 ;; Insert an extra newline if we need it to work around |
297 ;; Sun's bug that swallows newlines. | 307 ;; Sun's bug that swallows newlines. |
298 (goto-char (1+ delimline)) | 308 (goto-char (1+ delimline)) |
299 (if (eval mail-mailer-swallows-blank-line) | 309 (if (eval mail-mailer-swallows-blank-line) |
300 (newline)) | 310 (newline)) |
301 ;; Find and handle any FCC fields. | 311 ;; Find and handle any FCC fields. |
302 (goto-char (point-min)) | 312 (goto-char (point-min)) |
303 (if (re-search-forward "^FCC:" delimline t) | 313 (if (re-search-forward "^FCC:" delimline t) |
304 (mail-do-fcc delimline)) | 314 (mail-do-fcc delimline)) |
305 (if mail-interactive | 315 (if mail-interactive |
306 (save-excursion | 316 (with-current-buffer errbuf |
307 (set-buffer errbuf) | |
308 (erase-buffer)))) | 317 (erase-buffer)))) |
309 ;; | 318 ;; |
310 ;; | 319 ;; |
311 ;; | 320 ;; |
312 (setq smtpmail-address-buffer (generate-new-buffer "*smtp-mail*")) | 321 (setq smtpmail-address-buffer (generate-new-buffer "*smtp-mail*")) |
329 (file-data (convert-standard-filename file-data)) | 338 (file-data (convert-standard-filename file-data)) |
330 (file-elisp (concat file-data ".el")) | 339 (file-elisp (concat file-data ".el")) |
331 (buffer-data (create-file-buffer file-data)) | 340 (buffer-data (create-file-buffer file-data)) |
332 (buffer-elisp (create-file-buffer file-elisp)) | 341 (buffer-elisp (create-file-buffer file-elisp)) |
333 (buffer-scratch "*queue-mail*")) | 342 (buffer-scratch "*queue-mail*")) |
334 (save-excursion | 343 (with-current-buffer buffer-data |
335 (set-buffer buffer-data) | |
336 (erase-buffer) | 344 (erase-buffer) |
337 (insert-buffer tembuf) | 345 (insert-buffer tembuf) |
338 (write-file file-data) | 346 (write-file file-data) |
339 (set-buffer buffer-elisp) | 347 (set-buffer buffer-elisp) |
340 (erase-buffer) | 348 (erase-buffer) |
361 (interactive) | 369 (interactive) |
362 ;;; Get index, get first mail, send it, get second mail, etc... | 370 ;;; Get index, get first mail, send it, get second mail, etc... |
363 (let ((buffer-index (find-file-noselect smtpmail-queue-index)) | 371 (let ((buffer-index (find-file-noselect smtpmail-queue-index)) |
364 (file-msg "") | 372 (file-msg "") |
365 (tembuf nil)) | 373 (tembuf nil)) |
366 (save-excursion | 374 (with-current-buffer buffer-index |
367 (set-buffer buffer-index) | |
368 (beginning-of-buffer) | 375 (beginning-of-buffer) |
369 (while (not (eobp)) | 376 (while (not (eobp)) |
370 (setq file-msg (buffer-substring (point) (save-excursion | 377 (setq file-msg (buffer-substring (point) (line-end-position))) |
371 (end-of-line) | |
372 (point)))) | |
373 (load file-msg) | 378 (load file-msg) |
374 (setq tembuf (find-file-noselect file-msg)) | 379 (setq tembuf (find-file-noselect file-msg)) |
375 (if (not (null smtpmail-recipient-address-list)) | 380 (if (not (null smtpmail-recipient-address-list)) |
376 (if (not (smtpmail-via-smtp smtpmail-recipient-address-list | 381 (if (not (smtpmail-via-smtp smtpmail-recipient-address-list |
377 tembuf)) | 382 tembuf)) |
518 ;; get or create the trace buffer | 523 ;; get or create the trace buffer |
519 (setq process-buffer | 524 (setq process-buffer |
520 (get-buffer-create (format "*trace of SMTP session to %s*" host))) | 525 (get-buffer-create (format "*trace of SMTP session to %s*" host))) |
521 | 526 |
522 ;; clear the trace buffer of old output | 527 ;; clear the trace buffer of old output |
523 (save-excursion | 528 (with-current-buffer process-buffer |
524 (set-buffer process-buffer) | |
525 (erase-buffer)) | 529 (erase-buffer)) |
526 | 530 |
527 ;; open the connection to the server | 531 ;; open the connection to the server |
528 (setq process (smtpmail-open-stream process-buffer host port)) | 532 (setq process (smtpmail-open-stream process-buffer host port)) |
529 (and (null process) (throw 'done nil)) | 533 (and (null process) (throw 'done nil)) |
530 | 534 |
531 ;; set the send-filter | 535 ;; set the send-filter |
532 (set-process-filter process 'smtpmail-process-filter) | 536 (set-process-filter process 'smtpmail-process-filter) |
533 | 537 |
534 (save-excursion | 538 (with-current-buffer process-buffer |
535 (set-buffer process-buffer) | |
536 (set-buffer-process-coding-system 'raw-text-unix 'raw-text-unix) | 539 (set-buffer-process-coding-system 'raw-text-unix 'raw-text-unix) |
537 (make-local-variable 'smtpmail-read-point) | 540 (make-local-variable 'smtpmail-read-point) |
538 (setq smtpmail-read-point (point-min)) | 541 (setq smtpmail-read-point (point-min)) |
539 | 542 |
540 | 543 |
627 ;; MAIL FROM: <sender> | 630 ;; MAIL FROM: <sender> |
628 (let ((size-part | 631 (let ((size-part |
629 (if (or (member 'size supported-extensions) | 632 (if (or (member 'size supported-extensions) |
630 (assoc 'size supported-extensions)) | 633 (assoc 'size supported-extensions)) |
631 (format " SIZE=%d" | 634 (format " SIZE=%d" |
632 (save-excursion | 635 (with-current-buffer smtpmail-text-buffer |
633 (set-buffer smtpmail-text-buffer) | |
634 ;; size estimate: | 636 ;; size estimate: |
635 (+ (- (point-max) (point-min)) | 637 (+ (- (point-max) (point-min)) |
636 ;; Add one byte for each change-of-line | 638 ;; Add one byte for each change-of-line |
637 ;; because or CR-LF representation: | 639 ;; because or CR-LF representation: |
638 (count-lines (point-min) (point-max)) | 640 (count-lines (point-min) (point-max)) |
711 ; (smtpmail-send-command process "QUIT") | 713 ; (smtpmail-send-command process "QUIT") |
712 ; (and (null (car (smtpmail-read-response process))) | 714 ; (and (null (car (smtpmail-read-response process))) |
713 ; (throw 'done nil)) | 715 ; (throw 'done nil)) |
714 t )) | 716 t )) |
715 (if process | 717 (if process |
716 (save-excursion | 718 (with-current-buffer (process-buffer process) |
717 (set-buffer (process-buffer process)) | |
718 (smtpmail-send-command process "QUIT") | 719 (smtpmail-send-command process "QUIT") |
719 (smtpmail-read-response process) | 720 (smtpmail-read-response process) |
720 | 721 |
721 ; (if (or (null (car (setq response-code (smtpmail-read-response process)))) | 722 ; (if (or (null (car (setq response-code (smtpmail-read-response process)))) |
722 ; (not (integerp (car response-code))) | 723 ; (not (integerp (car response-code))) |
725 ; ) | 726 ; ) |
726 (delete-process process)))))) | 727 (delete-process process)))))) |
727 | 728 |
728 | 729 |
729 (defun smtpmail-process-filter (process output) | 730 (defun smtpmail-process-filter (process output) |
730 (save-excursion | 731 (with-current-buffer (process-buffer process) |
731 (set-buffer (process-buffer process)) | |
732 (goto-char (point-max)) | 732 (goto-char (point-max)) |
733 (insert output))) | 733 (insert output))) |
734 | 734 |
735 (defun smtpmail-read-response (process) | 735 (defun smtpmail-read-response (process) |
736 (let ((case-fold-search nil) | 736 (let ((case-fold-search nil) |
817 ((data-continue t) | 817 ((data-continue t) |
818 (sending-data nil) | 818 (sending-data nil) |
819 this-line | 819 this-line |
820 this-line-end) | 820 this-line-end) |
821 | 821 |
822 (save-excursion | 822 (with-current-buffer buffer |
823 (set-buffer buffer) | |
824 (goto-char (point-min))) | 823 (goto-char (point-min))) |
825 | 824 |
826 (while data-continue | 825 (while data-continue |
827 (save-excursion | 826 (with-current-buffer buffer |
828 (set-buffer buffer) | |
829 (beginning-of-line) | 827 (beginning-of-line) |
830 (setq this-line (point)) | 828 (setq this-line (point)) |
831 (end-of-line) | 829 (end-of-line) |
832 (setq this-line-end (point)) | 830 (setq this-line-end (point)) |
833 (setq sending-data nil) | 831 (setq sending-data nil) |
842 | 840 |
843 | 841 |
844 (defun smtpmail-deduce-address-list (smtpmail-text-buffer header-start header-end) | 842 (defun smtpmail-deduce-address-list (smtpmail-text-buffer header-start header-end) |
845 "Get address list suitable for smtp RCPT TO: <address>." | 843 "Get address list suitable for smtp RCPT TO: <address>." |
846 (unwind-protect | 844 (unwind-protect |
847 (save-excursion | 845 (with-current-buffer smtpmail-address-buffer |
848 (set-buffer smtpmail-address-buffer) (erase-buffer) | 846 (erase-buffer) |
849 (let | 847 (let |
850 ((case-fold-search t) | 848 ((case-fold-search t) |
851 (simple-address-list "") | 849 (simple-address-list "") |
852 this-line | 850 this-line |
853 this-line-end | 851 this-line-end |
854 addr-regexp) | 852 addr-regexp) |
855 (insert-buffer-substring smtpmail-text-buffer header-start header-end) | 853 (insert-buffer-substring smtpmail-text-buffer header-start header-end) |
856 (goto-char (point-min)) | 854 (goto-char (point-min)) |
857 ;; RESENT-* fields should stop processing of regular fields. | 855 ;; RESENT-* fields should stop processing of regular fields. |
858 (save-excursion | 856 (save-excursion |
859 (if (re-search-forward "^Resent-\\(to\\|cc\\|bcc\\):" header-end t) | 857 (setq addr-regexp |
860 (setq addr-regexp "^Resent-\\(to\\|cc\\|bcc\\):") | 858 (if (re-search-forward "^Resent-\\(to\\|cc\\|bcc\\):" |
861 (setq addr-regexp "^\\(To:\\|Cc:\\|Bcc:\\)"))) | 859 header-end t) |
860 "^Resent-\\(to\\|cc\\|bcc\\):" | |
861 "^\\(To:\\|Cc:\\|Bcc:\\)"))) | |
862 | 862 |
863 (while (re-search-forward addr-regexp header-end t) | 863 (while (re-search-forward addr-regexp header-end t) |
864 (replace-match "") | 864 (replace-match "") |
865 (setq this-line (match-beginning 0)) | 865 (setq this-line (match-beginning 0)) |
866 (forward-line 1) | 866 (forward-line 1) |