From: okada <okada>
Date: Sat, 11 Dec 1999 16:00:34 +0000 (+0000)
Subject: * smtp.el (smtp-auth-scram-md5): New function.
X-Git-Tag: slim-1_13_5~26
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=e13fba0df6f5bb3cda16f522bbc36586ffecdf45;p=elisp%2Fflim.git

* smtp.el (smtp-auth-scram-md5): New function.
(smtp-authentication-method-alist): Add `scram-md5'.
---

diff --git a/ChangeLog b/ChangeLog
index 337c768..461f8f6 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+1999-12-01  Kenichi OKADA <okada@opaopa.org>
+
+	* smtp.el (smtp-auth-scram-md5): New function.
+	(smtp-authentication-method-alist): Add `scram-md5'.
+
 1999-12-12  Kenichi OKADA <okada@opaopa.org>
 
 	* sasl.el (TopLevel): Require `scram-md5'.
@@ -70,7 +75,7 @@
 1999-12-01  Kenichi OKADA <okada@opaopa.org>
 
 	* smtp.el (smtp-auth-anonymous): New function.
-	(smtp-authentication-method-alist): Add anonymous.
+	(smtp-authentication-method-alist): Add `anonymous'.
 
 1999-12-01  Kenichi OKADA <okada@opaopa.org>
 
diff --git a/smtp.el b/smtp.el
index 9089d49..80bef9c 100644
--- a/smtp.el
+++ b/smtp.el
@@ -100,6 +100,7 @@ don't define this value."
     (plain smtp-auth-plain)
     (login smtp-auth-login)
     (anonymous smtp-auth-anonymous)
+    (scram-md5 smtp-auth-scram-md5)
     ))
 
 (defcustom smtp-connection-type nil
@@ -564,6 +565,72 @@ don't define this value."
 	    (>= (car response) 400))
 	(throw 'done (car (cdr response))))))
  
+(defun smtp-auth-scram-md5 (process)
+  ;; now tesing
+  (let ((secure-word (copy-sequence smtp-authentication-passphrase))
+	server-msg-1 server-msg-2 client-msg-1
+	response)
+    (smtp-send-command process "AUTH SCRAM-MD5")
+    (setq response (smtp-read-response process))
+    (if (or (null (car response))
+	    (not (integerp (car response)))
+	    (>= (car response) 400))
+	(progn
+	  (fillarray secure-word 0)
+	  (throw 'done (car (cdr response)))))
+    (smtp-send-command
+     process
+     (base64-encode-string
+      (setq client-msg-1
+	    (sasl-scram-md5-client-msg-1 user))) t)
+    (setq response (smtp-read-response process))
+    (if (or (null (car response))
+	    (not (integerp (car response)))
+	    (>= (car response) 400))
+	(progn 
+	  (fillarray secure-word 0)
+	  (fillarray client-msg-1 0)
+	  (throw 'done (car (cdr response)))))
+    (setq server-msg-1
+	  (base64-decode-string
+	   (substring (car (cdr response)) 4)))
+    (smtp-send-command
+     process
+     (base64-encode-string
+      (sasl-scram-md5-client-msg-2
+       server-msg-1
+       client-msg-1
+       secure-word)) t)
+    (setq response (smtp-read-response process))
+    (if (or (null (car response))
+	    (not (integerp (car response)))
+	    (>= (car response) 400))
+	(progn 
+	  (fillarray secure-word 0)
+	  (fillarray server-msg-1 0)
+	  (fillarray client-msg-1 0)
+	  (throw 'done (car (cdr response)))))
+    (setq server-msg-2
+	  (base64-decode-string
+	   (substring (car (cdr response)) 4)))
+    (if (null (prog1
+		  (sasl-scram-md5-authenticate-server
+		   server-msg-1
+		   server-msg-2
+		   client-msg-1
+		   secure-word)
+		(fillarray secure-word 0)
+		(fillarray server-msg-1 0)
+		(fillarray server-msg-2 0)
+		(fillarray client-msg-1 0)))
+	(throw 'done nil))
+    (smtp-send-command process "")
+    (setq response (smtp-read-response process))
+    (if (or (null (car response))
+	    (not (integerp (car response)))
+	    (>= (car response) 400))
+	(throw 'done (car (cdr response)))) ))
+    
 (provide 'smtp)
 
 ;;; smtp.el ends here