update.
[elisp/flim.git] / smtp.el
diff --git a/smtp.el b/smtp.el
index 4706bff..fe511e9 100644 (file)
--- a/smtp.el
+++ b/smtp.el
@@ -1,6 +1,7 @@
 ;;; smtp.el --- basic functions to send mail with SMTP server
 
-;; Copyright (C) 1995, 1996, 1998, 1999, 2000 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1996, 1998, 1999, 2000, 2001 ,2002, 2004
+;; Free Software Foundation, Inc.
 
 ;; Author: Tomoji Kagatani <kagatani@rbc.ncl.omron.co.jp>
 ;;     Simon Leinen <simon@switch.ch> (ESMTP support)
@@ -22,8 +23,8 @@
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with this program; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 
 ;;; Commentary:
@@ -102,6 +103,14 @@ don't define this value."
   :type 'boolean
   :group 'smtp-extensions)
 
+(defcustom smtp-starttls-program "starttls"
+  "The program to run in a subprocess to open an TLSv1 connection."
+  :group 'smtp-extensions)
+
+(defcustom smtp-starttls-extra-args nil
+  "Extra arguments to `starttls-program'"
+  :group 'smtp-extensions)
+
 (defcustom smtp-use-sasl nil
   "If non-nil, use SMTP Authentication (RFC2554) if available."
   :type 'boolean
@@ -122,6 +131,11 @@ don't define this value."
   :type '(repeat string)
   :group 'smtp-extensions)
 
+(defcustom smtp-debug nil
+  "*If non-nil, smtp debug info printout into messages."
+  :type 'boolean
+  :group 'smtp)
+
 (defvar sasl-mechanisms)
 
 ;;;###autoload
@@ -140,8 +154,7 @@ Here is an example:
 It connects to a SMTP server using \"ssh\" before actually connecting
 to the SMTP port.  Where the command \"nc\" is the netcat executable;
 see http://www.atstake.com/research/tools/index.html#network_utilities
-for details.  In addition, you will have to modify the value for
-`smtp-end-of-line' to \"\\n\" if you use \"telnet\" instead of \"nc\".")
+for details.")
 
 (defvar smtp-read-point nil)
 
@@ -149,11 +162,6 @@ for details.  In addition, you will have to modify the value for
 
 (defvar smtp-submit-package-function #'smtp-submit-package)
 
-(defvar smtp-end-of-line "\r\n"
-  "*String to use as end-of-line marker when talking to a SMTP server.
-This is \"\\r\\n\" by default, but it may have to be \"\\n\" when using a non
-native connection function.  See also `smtp-open-connection-function'.")
-
 ;;; @ SMTP package
 ;;; A package contains a mail message, an envelope sender address,
 ;;; and one or more envelope recipient addresses.  In ESMTP model
@@ -343,16 +351,19 @@ RECIPIENTS is a list of envelope recipient addresses.
 BUFFER may be a buffer or a buffer name which contains mail message."
   (if smtp-send-by-myself
       (smtp-send-buffer-by-myself sender recipients buffer)
-    (let ((server
-          (if (functionp smtp-server)
-              (funcall smtp-server sender recipients)
-            smtp-server))
-         (package
-          (smtp-make-package sender recipients buffer))
-         (smtp-open-connection-function
-          (if smtp-use-starttls
-              #'starttls-open-stream
-            smtp-open-connection-function)))
+    (let* ((server
+           (if (functionp smtp-server)
+               (funcall smtp-server sender recipients)
+             (or smtp-server
+                 (error "`smtp-server' not defined"))))
+          (package
+           (smtp-make-package sender recipients buffer))
+          (starttls-program smtp-starttls-program)
+          (starttls-extra-args smtp-starttls-extra-args)
+          (smtp-open-connection-function
+           (if smtp-use-starttls
+               #'starttls-open-stream
+             smtp-open-connection-function)))
       (save-excursion
        (set-buffer
         (get-buffer-create
@@ -388,8 +399,10 @@ BUFFER may be a buffer or a buffer name which contains mail message."
        (smtp-primitive-rcptto package)
        (smtp-primitive-data package))
     (let ((connection (smtp-find-connection (current-buffer))))
-      (when (smtp-connection-opened connection)
-       (smtp-primitive-quit package)
+      (when (and connection (smtp-connection-opened connection))
+       (condition-case nil
+           (smtp-primitive-quit package)
+         (smtp-error))
        (smtp-close-connection connection)))))
 
 (defun smtp-send-buffer-by-myself (sender recipients buffer)
@@ -426,7 +439,7 @@ BUFFER may be a buffer or a buffer name which contains mail message."
          (let ((smtp-use-sasl nil)
                (smtp-use-starttls-ignore-error t))
            (funcall smtp-submit-package-function package)))
-      (setq servers (cdr servers)))))
+       (setq servers (cdr servers)))))
 
 ;;; @ hook methods for `smtp-submit-package'
 ;;;
@@ -542,7 +555,7 @@ BUFFER may be a buffer or a buffer name which contains mail message."
     ;; SIZE --- Message Size Declaration (RFC1870)
     (if (and smtp-use-size
             (assq 'size extensions))
-       (setq extension (format "SIZE=%d" (smtp-package-buffer-internal-size package))))
+       (setq extension (format " SIZE=%d" (smtp-package-buffer-internal-size package))))
     ;; 8BITMIME --- 8bit-MIMEtransport (RFC1652)
     (if (and smtp-use-8bitmime
             (assq '8bitmime extensions))
@@ -550,7 +563,7 @@ BUFFER may be a buffer or a buffer name which contains mail message."
     (smtp-send-command
      connection
      (if extension
-        (format "MAIL FROM:<%s> %s" sender extension)
+        (format "MAIL FROM:<%s>%s" sender extension)
        (format "MAIL FROM:<%s>" sender)))
     (setq response (smtp-read-response connection))
     (if (/= (car response) 250)
@@ -622,24 +635,31 @@ BUFFER may be a buffer or a buffer name which contains mail message."
        response)
     (while response-continue
       (goto-char smtp-read-point)
-      (while (not (search-forward smtp-end-of-line nil t))
+      (while (not (re-search-forward "\r?\n" nil t))
+       (unless (smtp-connection-opened connection)
+         (signal 'smtp-error "Connection closed"))
        (accept-process-output (smtp-connection-process-internal connection))
        (goto-char smtp-read-point))
-      (if decoder
-         (let ((string (buffer-substring smtp-read-point (- (point) 2))))
-           (delete-region smtp-read-point (point))
-           (insert (funcall decoder string) smtp-end-of-line)))
-      (setq response
-           (nconc response
-                  (list (buffer-substring
-                         (+ 4 smtp-read-point)
-                         (- (point) 2)))))
-      (goto-char
-       (prog1 smtp-read-point
-        (setq smtp-read-point (point))))
-      (if (looking-at "[1-5][0-9][0-9] ")
-         (setq response (cons (read (point-marker)) response)
-               response-continue nil)))
+      (let ((bol smtp-read-point)
+           (eol (match-beginning 0)))
+       (when decoder
+         (let ((string (buffer-substring bol eol)))
+           (delete-region bol (point))
+           (insert (funcall decoder string))
+           (setq eol (point))
+           (insert "\r\n")))
+       (setq smtp-read-point (point))
+       (goto-char bol)
+       (cond
+        ((looking-at "[1-5][0-9][0-9]\\([ -]\\)")
+         (setq response
+               (nconc response
+                      (list (buffer-substring (match-end 0) eol))))
+         (when (string= (match-string 1) " ")
+           (setq response (cons (read (point-marker)) response)
+                 response-continue nil)))
+        (smtp-debug
+         (message "Invalid response: %s" (buffer-substring bol eol))))))
     response))
 
 (defun smtp-send-command (connection command)
@@ -650,7 +670,7 @@ BUFFER may be a buffer or a buffer name which contains mail message."
           (smtp-connection-encoder-internal connection)))
       (set-buffer (process-buffer process))
       (goto-char (point-max))
-      (setq command (concat command smtp-end-of-line))
+      (setq command (concat command "\r\n"))
       (insert command)
       (setq smtp-read-point (point))
       (if encoder
@@ -664,8 +684,8 @@ BUFFER may be a buffer or a buffer name which contains mail message."
         (smtp-connection-encoder-internal connection)))
     ;; Escape "." at start of a line.
     (if (eq (string-to-char data) ?.)
-       (setq data (concat "." data smtp-end-of-line))
-      (setq data (concat data smtp-end-of-line)))
+       (setq data (concat "." data "\r\n"))
+      (setq data (concat data "\r\n")))
     (if encoder
        (setq data (funcall encoder data)))
     (process-send-string process data)))
@@ -707,9 +727,7 @@ BUFFER may be a buffer or a buffer name which contains mail message."
                          (mail-strip-quoted-names
                           (buffer-substring this-line this-line-end)))))
          (erase-buffer)
-         (insert-string " ")
-         (insert-string simple-address-list)
-         (insert-string "\n")
+         (insert " " simple-address-list "\n")
          ;; newline --> blank
          (subst-char-in-region (point-min) (point-max) 10 ?  t)
          ;; comma   --> blank