Merge from gnus--rel--5.10

[gnus] / contrib / smtpmail.el

diff --git a/contrib/smtpmail.el b/contrib/smtpmail.el
index 9557844..e1e742a 100644 (file)
--- a/contrib/smtpmail.el
+++ b/contrib/smtpmail.el
@@ -1,7 +1,7 @@
 ;;; smtpmail.el --- simple SMTP protocol (RFC 821) for sending mail
 
 ;; Copyright (C) 1995, 1996, 2001, 2002, 2003, 2004, 2005,
-;;   2006 Free Software Foundation, Inc.
+;;   2006, 2007 Free Software Foundation, Inc.
 
 ;; Author: Tomoji Kagatani <kagatani@rbc.ncl.omron.co.jp>
 ;; Maintainer: Simon Josefsson <simon@josefsson.org>
@@ -99,13 +99,13 @@ This only has effect if you specify it before loading the smtpmail library."
 
 (defcustom smtpmail-smtp-service 25
   "*SMTP service port number.
-The default value would be \"smtp\" or 25 ."
+The default value would be \"smtp\" or 25."
   :type '(choice (integer :tag "Port") (string :tag "Service"))
   :group 'smtpmail)
 
 (defcustom smtpmail-local-domain nil
   "*Local domain name without a host name.
-If the function (system-name) returns the full internet address,
+If the function `system-name' returns the full internet address,
 don't define this value."
   :type '(choice (const nil) string)
   :group 'smtpmail)
@@ -145,7 +145,7 @@ The commands enables verbose information from the SMTP server."
   :group 'smtpmail)
 
 (defcustom smtpmail-queue-mail nil
-  "*Specify if mail is queued (if t) or sent immediately (if nil).
+  "*If set, mail is queued; otherwise it is sent immediately.
 If queued, it is stored in the directory `smtpmail-queue-dir'
 and sent with `smtpmail-send-queued-mail'."
   :type 'boolean
@@ -198,7 +198,7 @@ new SMTP extensions that might be useful to support."
   :group 'smtpmail)
 
 (defvar smtpmail-queue-index-file "index"
-  "File name of queued mail index,
+  "File name of queued mail index.
 This is relative to `smtpmail-queue-dir'.")
 
 (defvar smtpmail-address-buffer)
@@ -244,6 +244,11 @@ This is relative to `smtpmail-queue-dir'.")
        (save-excursion
          (set-buffer tembuf)
          (erase-buffer)
+         ;; Use the same buffer-file-coding-system as in the mail
+         ;; buffer, otherwise any write-region invocations (e.g., in
+         ;; mail-do-fcc below) will annoy with asking for a suitable
+         ;; encoding.
+         (set-buffer-file-coding-system smtpmail-code-conv-from nil t)
          (insert-buffer-substring mailbuf)
          (goto-char (point-max))
          ;; require one newline at the end.
@@ -326,6 +331,22 @@ This is relative to `smtpmail-queue-dir'.")
            (goto-char (point-min))
            (unless (re-search-forward "^Date:" delimline t)
              (insert "Date: " (message-make-date) "\n"))
+           ;; Possibly add a MIME header for the current coding system
+           (let (charset)
+             (goto-char (point-min))
+             (and (eq mail-send-nonascii 'mime)
+                  (not (re-search-forward "^MIME-version:" delimline t))
+                  (progn (skip-chars-forward "\0-\177")
+                         (/= (point) (point-max)))
+                  smtpmail-code-conv-from
+                  (setq charset
+                        (coding-system-get smtpmail-code-conv-from
+                                           'mime-charset))
+                  (goto-char delimline)
+                  (insert "MIME-version: 1.0\n"
+                          "Content-type: text/plain; charset="
+                          (symbol-name charset)
+                          "\nContent-Transfer-Encoding: 8bit\n")))
            ;; Insert an extra newline if we need it to work around
            ;; Sun's bug that swallows newlines.
            (goto-char (1+ delimline))
@@ -334,7 +355,10 @@ This is relative to `smtpmail-queue-dir'.")
            ;; Find and handle any FCC fields.
            (goto-char (point-min))
            (if (re-search-forward "^FCC:" delimline t)
-               (mail-do-fcc delimline))
+               ;; Force mail-do-fcc to use the encoding of the mail
+               ;; buffer to encode outgoing messages on FCC files.
+               (let ((coding-system-for-write smtpmail-code-conv-from))
+                 (mail-do-fcc delimline)))
            (if mail-interactive
                (with-current-buffer errbuf
                  (erase-buffer))))
@@ -370,6 +394,7 @@ This is relative to `smtpmail-queue-dir'.")
                (make-directory smtpmail-queue-dir t))
              (with-current-buffer buffer-data
                (erase-buffer)
+               (set-buffer-file-coding-system smtpmail-code-conv-from nil t)
                (insert-buffer-substring tembuf)
                (write-file file-data)
                (set-buffer buffer-elisp)
@@ -541,6 +566,17 @@ This is relative to `smtpmail-queue-dir'.")
                 (decoded (base64-decode-string challenge))
                 (hash (rfc2104-hash 'md5 64 16 passwd decoded))
                 (response (concat (smtpmail-cred-user cred) " " hash))
+                ;; Osamu Yamane <yamane@green.ocn.ne.jp>:
+                ;; SMTP auth fails because the SMTP server identifies
+                ;; only the first part of the string (delimited by
+                ;; new line characters) as a response from the
+                ;; client, and the rest as distinct commands.
+
+                ;; In my case, the response string is 80 characters
+                ;; long.  Without the no-line-break option for
+                ;; base64-encode-sting, only the first 76 characters
+                ;; are taken as a response to the server, and the
+                ;; authentication fails.
                 (encoded (base64-encode-string response t)))
            (smtpmail-send-command process (format "%s" encoded))
            (if (or (null (car (setq ret (smtpmail-read-response process))))