/[emacs]/emacs/lisp/mail/smtpmail.el
ViewVC logotype

Diff of /emacs/lisp/mail/smtpmail.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.44.2.1 by miles, Fri Apr 4 06:20:27 2003 UTC revision 1.44.2.2 by miles, Tue Oct 14 23:39:25 2003 UTC
# Line 1  Line 1 
1  ;;; smtpmail.el --- simple SMTP protocol (RFC 821) for sending mail  ;;; smtpmail.el --- simple SMTP protocol (RFC 821) for sending mail
2    
3  ;; Copyright (C) 1995, 1996, 2001, 2002 Free Software Foundation, Inc.  ;; Copyright (C) 1995, 1996, 2001, 2002, 2003 Free Software Foundation, Inc.
4    
5  ;; Author: Tomoji Kagatani <kagatani@rbc.ncl.omron.co.jp>  ;; Author: Tomoji Kagatani <kagatani@rbc.ncl.omron.co.jp>
6  ;; Maintainer: Simon Josefsson <simon@josefsson.org>  ;; Maintainer: Simon Josefsson <simon@josefsson.org>
# Line 212  This is relative to `smtpmail-queue-dir' Line 212  This is relative to `smtpmail-queue-dir'
212  ;;;  ;;;
213    
214  (defvar smtpmail-mail-address nil  (defvar smtpmail-mail-address nil
215    "Value of `user-mail-address' in ambient buffer.")    "Value to use for envelope-from address for mail from ambient buffer.")
216    
217  ;;;###autoload  ;;;###autoload
218  (defun smtpmail-send-it ()  (defun smtpmail-send-it ()
# Line 223  This is relative to `smtpmail-queue-dir' Line 223  This is relative to `smtpmail-queue-dir'
223          (case-fold-search nil)          (case-fold-search nil)
224          delimline          delimline
225          (mailbuf (current-buffer))          (mailbuf (current-buffer))
226          (smtpmail-mail-address user-mail-address)          ;; Examine this variable now, so that
227            ;; local binding in the mail buffer will take effect.
228            (smtpmail-mail-address
229             (or (and mail-specify-envelope-from (mail-envelope-from))
230                 user-mail-address))
231          (smtpmail-code-conv-from          (smtpmail-code-conv-from
232           (if enable-multibyte-characters           (if enable-multibyte-characters
233               (let ((sendmail-coding-system smtpmail-code-conv-from))               (let ((sendmail-coding-system smtpmail-code-conv-from))
# Line 354  This is relative to `smtpmail-queue-dir' Line 358  This is relative to `smtpmail-queue-dir'
358                     (buffer-data (create-file-buffer file-data))                     (buffer-data (create-file-buffer file-data))
359                     (buffer-elisp (create-file-buffer file-elisp))                     (buffer-elisp (create-file-buffer file-elisp))
360                     (buffer-scratch "*queue-mail*"))                     (buffer-scratch "*queue-mail*"))
361                  (unless (file-exists-p smtpmail-queue-dir)
362                    (make-directory smtpmail-queue-dir t))
363                (with-current-buffer buffer-data                (with-current-buffer buffer-data
364                  (erase-buffer)                  (erase-buffer)
365                  (insert-buffer tembuf)                  (insert-buffer tembuf)
# Line 397  This is relative to `smtpmail-queue-dir' Line 403  This is relative to `smtpmail-queue-dir'
403          (with-temp-buffer          (with-temp-buffer
404            (let ((coding-system-for-read 'no-conversion))            (let ((coding-system-for-read 'no-conversion))
405              (insert-file-contents file-msg))              (insert-file-contents file-msg))
406            (if (not (null smtpmail-recipient-address-list))            (let ((smtpmail-mail-address
407                (if (not (smtpmail-via-smtp smtpmail-recipient-address-list                   (or (and mail-specify-envelope-from (mail-envelope-from))
408                                            (current-buffer)))                       user-mail-address)))
409                    (error "Sending failed; SMTP protocol error"))              (if (not (null smtpmail-recipient-address-list))
410              (error "Sending failed; no recipients")))                  (if (not (smtpmail-via-smtp smtpmail-recipient-address-list
411                                                (current-buffer)))
412                        (error "Sending failed; SMTP protocol error"))
413                  (error "Sending failed; no recipients"))))
414          (delete-file file-msg)          (delete-file file-msg)
415          (delete-file (concat file-msg ".el"))          (delete-file (concat file-msg ".el"))
416          (kill-line 1))          (delete-region (point-at-bol) (point-at-bol 2)))
417        (write-region (point-min) (point-max) smtpmail-queue-index))))        (write-region (point-min) (point-max) smtpmail-queue-index))))
418    
419  ;(defun smtpmail-via-smtp (host,port,sender,destination,smtpmail-text-buffer)  ;(defun smtpmail-via-smtp (host,port,sender,destination,smtpmail-text-buffer)
# Line 457  This is relative to `smtpmail-queue-dir' Line 466  This is relative to `smtpmail-queue-dir'
466    (let ((cred (smtpmail-find-credentials    (let ((cred (smtpmail-find-credentials
467                 smtpmail-starttls-credentials host port)))                 smtpmail-starttls-credentials host port)))
468      (if (null (and cred (condition-case ()      (if (null (and cred (condition-case ()
469                              (call-process "starttls")                              (progn
470                                  (require 'starttls)
471                                  (call-process starttls-program))
472                            (error nil))))                            (error nil))))
473          ;; The normal case.          ;; The normal case.
474          (open-network-stream "SMTP" process-buffer host port)          (open-network-stream "SMTP" process-buffer host port)
# Line 541  This is relative to `smtpmail-queue-dir' Line 552  This is relative to `smtpmail-queue-dir'
552          (host (or smtpmail-smtp-server          (host (or smtpmail-smtp-server
553                    (error "`smtpmail-smtp-server' not defined")))                    (error "`smtpmail-smtp-server' not defined")))
554          (port smtpmail-smtp-service)          (port smtpmail-smtp-service)
555          (envelope-from (or (mail-envelope-from)          ;; smtpmail-mail-address should be set to the appropriate
556                             smtpmail-mail-address          ;; buffer-local value by the caller, but in case not:
557                             user-mail-address))          (envelope-from (or smtpmail-mail-address
558                               (and mail-specify-envelope-from
559                                    (mail-envelope-from))
560                               user-mail-address))
561          response-code          response-code
562          greeting          greeting
563          process-buffer          process-buffer
# Line 657  This is relative to `smtpmail-queue-dir' Line 671  This is relative to `smtpmail-queue-dir'
671                            (>= (car response-code) 400))                            (>= (car response-code) 400))
672                        (throw 'done nil))))                        (throw 'done nil))))
673    
674              ;; MAIL FROM: <sender>              ;; MAIL FROM:<sender>
675              (let ((size-part              (let ((size-part
676                     (if (or (member 'size supported-extensions)                     (if (or (member 'size supported-extensions)
677                             (assoc 'size supported-extensions))                             (assoc 'size supported-extensions))
# Line 692  This is relative to `smtpmail-queue-dir' Line 706  This is relative to `smtpmail-queue-dir'
706                           "")                           "")
707                       "")))                       "")))
708  ;             (smtpmail-send-command process (format "MAIL FROM:%s@%s" (user-login-name) (smtpmail-fqdn)))  ;             (smtpmail-send-command process (format "MAIL FROM:%s@%s" (user-login-name) (smtpmail-fqdn)))
709                (smtpmail-send-command process (format "MAIL FROM: <%s>%s%s"                (smtpmail-send-command process (format "MAIL FROM:<%s>%s%s"
710                                                       envelope-from                                                       envelope-from
711                                                       size-part                                                       size-part
712                                                       body-part))                                                       body-part))
713    
# Line 703  This is relative to `smtpmail-queue-dir' Line 717  This is relative to `smtpmail-queue-dir'
717                    (throw 'done nil)                    (throw 'done nil)
718                  ))                  ))
719    
720              ;; RCPT TO: <recipient>              ;; RCPT TO:<recipient>
721              (let ((n 0))              (let ((n 0))
722                (while (not (null (nth n recipient)))                (while (not (null (nth n recipient)))
723                  (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))))
724                  (setq n (1+ n))                  (setq n (1+ n))
725    
726                  (setq response-code (smtpmail-read-response process))                  (setq response-code (smtpmail-read-response process))
# Line 946  many continuation lines." Line 960  many continuation lines."
960    
961  (provide 'smtpmail)  (provide 'smtpmail)
962    
963    ;;; arch-tag: a76992df-6d71-43b7-9e72-4bacc6c05466
964  ;;; smtpmail.el ends here  ;;; smtpmail.el ends here

Legend:
Removed from v.1.44.2.1  
changed lines
  Added in v.1.44.2.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26