/[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 by rms, Sun May 12 17:00:52 2002 UTC revision 1.44.2.1 by miles, Fri Apr 4 06:20:27 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 Free Software Foundation, Inc.  ;; Copyright (C) 1995, 1996, 2001, 2002 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 66  Line 66 
66  ;;; Code:  ;;; Code:
67    
68  (require 'sendmail)  (require 'sendmail)
 (require 'time-stamp)  
69  (autoload 'starttls-open-stream "starttls")  (autoload 'starttls-open-stream "starttls")
70  (autoload 'starttls-negotiate "starttls")  (autoload 'starttls-negotiate "starttls")
71  (autoload 'mail-strip-quoted-names "mail-utils")  (autoload 'mail-strip-quoted-names "mail-utils")
# Line 84  Line 83 
83    
84    
85  (defcustom smtpmail-default-smtp-server nil  (defcustom smtpmail-default-smtp-server nil
86    "*Specify default SMTP server."    "*Specify default SMTP server.
87    This only has effect if you specify it before loading the smtpmail library."
88    :type '(choice (const nil) string)    :type '(choice (const nil) string)
89    :group 'smtpmail)    :group 'smtpmail)
90    
# Line 342  This is relative to `smtpmail-queue-dir' Line 342  This is relative to `smtpmail-queue-dir'
342                              smtpmail-recipient-address-list tembuf))                              smtpmail-recipient-address-list tembuf))
343                        (error "Sending failed; SMTP protocol error"))                        (error "Sending failed; SMTP protocol error"))
344                  (error "Sending failed; no recipients"))                  (error "Sending failed; no recipients"))
345              (let* ((file-data (concat              (let* ((file-data
346                                 smtpmail-queue-dir                      (expand-file-name
347                                 (concat (time-stamp-yyyy-mm-dd)                       (format "%s_%i"
348                                         "_" (time-stamp-hh:mm:ss)                               (format-time-string "%Y-%m-%d_%H:%M:%S")
349                                         "_"                               (setq smtpmail-queue-counter
350                                         (setq smtpmail-queue-counter                                     (1+ smtpmail-queue-counter)))
351                                               (1+ smtpmail-queue-counter)))))                       smtpmail-queue-dir))
352                        (file-elisp (concat file-data ".el"))                     (file-data (convert-standard-filename file-data))
353                       (file-elisp (concat file-data ".el"))
354                     (buffer-data (create-file-buffer file-data))                     (buffer-data (create-file-buffer file-data))
355                     (buffer-elisp (create-file-buffer file-elisp))                     (buffer-elisp (create-file-buffer file-elisp))
356                     (buffer-scratch "*queue-mail*"))                     (buffer-scratch "*queue-mail*"))
# Line 377  This is relative to `smtpmail-queue-dir' Line 378  This is relative to `smtpmail-queue-dir'
378        (if (bufferp errbuf)        (if (bufferp errbuf)
379            (kill-buffer errbuf)))))            (kill-buffer errbuf)))))
380    
381    ;;;###autoload
382  (defun smtpmail-send-queued-mail ()  (defun smtpmail-send-queued-mail ()
383    "Send mail that was queued as a result of setting `smtpmail-queue-mail'."    "Send mail that was queued as a result of setting `smtpmail-queue-mail'."
384    (interactive)    (interactive)
# Line 539  This is relative to `smtpmail-queue-dir' Line 541  This is relative to `smtpmail-queue-dir'
541          (host (or smtpmail-smtp-server          (host (or smtpmail-smtp-server
542                    (error "`smtpmail-smtp-server' not defined")))                    (error "`smtpmail-smtp-server' not defined")))
543          (port smtpmail-smtp-service)          (port smtpmail-smtp-service)
544            (envelope-from (or (mail-envelope-from)
545                               smtpmail-mail-address
546                               user-mail-address))
547          response-code          response-code
548          greeting          greeting
549          process-buffer          process-buffer
# Line 612  This is relative to `smtpmail-queue-dir' Line 617  This is relative to `smtpmail-queue-dir'
617              (if (and do-starttls              (if (and do-starttls
618                       (smtpmail-find-credentials smtpmail-starttls-credentials host port)                       (smtpmail-find-credentials smtpmail-starttls-credentials host port)
619                       (member 'starttls supported-extensions)                       (member 'starttls supported-extensions)
620                       (process-id process))                       (numberp (process-id process)))
621                  (progn                  (progn
622                    (smtpmail-send-command process (format "STARTTLS"))                    (smtpmail-send-command process (format "STARTTLS"))
623                    (if (or (null (car (setq response-code (smtpmail-read-response process))))                    (if (or (null (car (setq response-code (smtpmail-read-response process))))
# Line 688  This is relative to `smtpmail-queue-dir' Line 693  This is relative to `smtpmail-queue-dir'
693                       "")))                       "")))
694  ;             (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)))
695                (smtpmail-send-command process (format "MAIL FROM: <%s>%s%s"                (smtpmail-send-command process (format "MAIL FROM: <%s>%s%s"
696                                                       (or mail-envelope-from                                                       envelope-from
                                                          smtpmail-mail-address)  
697                                                       size-part                                                       size-part
698                                                       body-part))                                                       body-part))
699    
# Line 749  This is relative to `smtpmail-queue-dir' Line 753  This is relative to `smtpmail-queue-dir'
753  ;                   (>= (car response-code) 400))  ;                   (>= (car response-code) 400))
754  ;               (throw 'done nil)  ;               (throw 'done nil)
755  ;             )  ;             )
756              (delete-process process))))))              (delete-process process)
757                (unless smtpmail-debug-info
758                  (kill-buffer process-buffer)))))))
759    
760    
761  (defun smtpmail-process-filter (process output)  (defun smtpmail-process-filter (process output)

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

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