sync up to latest slim-1_13

[elisp/flim.git] / smtp.el

diff --git a/smtp.el b/smtp.el
index 02e9d38..ee09fd2 100644 (file)
--- a/smtp.el
+++ b/smtp.el
@@ -34,6 +34,7 @@
 (require 'pcustom)
 (require 'mail-utils)                  ; mail-strip-quoted-names
 
+(eval-when-compile (require 'sasl))
 (eval-and-compile
   (autoload 'starttls-open-stream "starttls")
   (autoload 'starttls-negotiate "starttls")
@@ -41,7 +42,8 @@
   (autoload 'sasl-plain "sasl")
   (autoload 'sasl-scram-md5-client-msg-1 "sasl")
   (autoload 'sasl-scram-md5-client-msg-2 "sasl")
-  (autoload 'sasl-scram-md5-authenticate-server "sasl"))
+  (autoload 'sasl-scram-md5-authenticate-server "sasl")
+  (autoload 'sasl-digest-md5-digest-response "sasl"))
                       
 (eval-when-compile (require 'cl))      ; push
 
@@ -104,14 +106,13 @@ don't define this value."
     (login smtp-auth-login)
     (anonymous smtp-auth-anonymous)
     (scram-md5 smtp-auth-scram-md5)
-    (digest-md5 smtp-auth-digest-md5)
-    ))
+    (digest-md5 smtp-auth-digest-md5)))
 
 (defcustom smtp-connection-type nil
   "*SMTP connection type."
   :type '(choice (const nil) (const :tag "TLS" starttls))
   :group 'smtp)
- 
+
 (defvar smtp-read-point nil)
 
 (defun smtp-make-fqdn ()
@@ -202,12 +203,12 @@ don't define this value."
 
            ;; AUTH --- SMTP Service Extension for Authentication (RFC2554)
            (when smtp-authenticate-type
-             (let ((auth (intern smtp-authenticate-type)) method)
+             (let ((auth smtp-authenticate-type) method)
                (if (and 
                     (memq auth extensions)
                     (setq method (nth 1 (assq auth smtp-authenticate-method-alist))))
                    (funcall method process)
-                 (throw 'smtp-error
+                 (throw 'done
                         (format "AUTH mechanism %s not available" auth)))))
 
            ;; ONEX --- One message transaction only (sendmail extension?)
@@ -311,7 +312,7 @@ don't define this value."
            t)
 
        (if (and process
-                (eq (process-status process) 'open))
+                (memq (process-status process) '(open run)))
        (progn
          ;; QUIT
          (smtp-send-command process "QUIT")
@@ -419,8 +420,7 @@ don't define this value."
 
 (defun smtp-deduce-address-list (smtp-text-buffer header-start header-end)
   "Get address list suitable for smtp RCPT TO:<address>."
-  (let ((case-fold-search t)
-       (simple-address-list "")
+  (let ((simple-address-list "")
        this-line
        this-line-end
        addr-regexp
@@ -429,6 +429,7 @@ don't define this value."
        (save-excursion
          ;;
          (set-buffer smtp-address-buffer)
+         (setq case-fold-search t)
          (erase-buffer)
          (insert (save-excursion
                    (set-buffer smtp-text-buffer)
@@ -659,29 +660,34 @@ don't define this value."
 
 (defun smtp-auth-digest-md5 (process)
   "Login to server using the AUTH DIGEST-MD5 method."
-  (let (responce)
+  (let (user realm response)
     (smtp-send-command process "AUTH DIGEST-MD5")
     (setq response (smtp-read-response process))
     (if (or (null (car response))
            (not (integerp (car response)))
            (>= (car response) 400))
        (throw 'done (car (cdr response))))
-    (digest-md5-parse-digest-challenge
-     (base64-decode-string
-      (substring (car (cdr response)) 4)))
+    (if (string-match "^\\([^@]*\\)@\\([^@]*\\)"
+                     smtp-authenticate-user)
+       (setq user (match-string 1 smtp-authenticate-user)
+             realm (match-string 2 smtp-authenticate-user))
+      (setq user smtp-authenticate-user
+           realm nil))
     (smtp-send-command process
-     (base64-encode-string 
-      (digest-md5-digest-response
-       smtp-authenticate-user
-       smtp-authenticate-passphrase
-       (digest-md5-digest-uri
-       "smtp" (digest-md5-challenge 'realm)))
-      'no-line-break))
+                      (base64-encode-string
+                       (sasl-digest-md5-digest-response
+                        (base64-decode-string
+                         (substring (car (cdr response)) 4))
+                        user
+                        smtp-authenticate-passphrase
+                        "smtp" smtp-server realm)
+                       'no-line-break) t)
     (setq response (smtp-read-response process))
     (if (or (null (car response))
            (not (integerp (car response)))
            (>= (car response) 400))
-       (throw 'done (car (cdr response))))))
+       (throw 'done (car (cdr response))))
+    (smtp-send-command process "")))
     
 (provide 'smtp)