From: ueno <ueno>
Date: Thu, 2 Nov 2000 15:43:36 +0000 (+0000)
Subject: * sasl.el (sasl-mechanisms): Add `LOGIN' and `ANONYMOUS'.
X-Git-Tag: deisui-1_14_0-1~17
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=c4b8e304272c29d93a726b638c77e3d1f01327c8;p=elisp%2Fflim.git

* sasl.el (sasl-mechanisms): Add `LOGIN' and `ANONYMOUS'.
(sasl-mechanism-alist): Likewise.
(sasl-error): Define.
(sasl-login-continuations): New variable.
(sasl-login-response-1): New function.
(sasl-login-response-2): New function.
(sasl-anonymous-continuations): New variable.
(sasl-anonymous-response): New function.

* smtp.el (smtp-error): Define.
(smtp-via-smtp): Use it.
---

diff --git a/ChangeLog b/ChangeLog
index 9dcf1b9..e7d1e8b 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,19 @@
 2000-11-02   Daiki Ueno  <ueno@unixuser.org>
 
+	* sasl.el (sasl-mechanisms): Add `LOGIN' and `ANONYMOUS'.
+	(sasl-mechanism-alist): Likewise.
+	(sasl-error): Define.
+	(sasl-login-continuations): New variable.
+	(sasl-login-response-1): New function.
+	(sasl-login-response-2): New function.
+	(sasl-anonymous-continuations): New variable.
+	(sasl-anonymous-response): New function.
+
+	* smtp.el (smtp-error): Define.
+	(smtp-via-smtp): Use it.
+
+2000-11-02   Daiki Ueno  <ueno@unixuser.org>
+
 	* smtp.el (smtp-via-smtp): Mark as obsolete.
 	(smtp-send-buffer): Rename from `smtp-via-smtp'.
 
diff --git a/sasl.el b/sasl.el
index cbd7b5d..370ff7a 100644
--- a/sasl.el
+++ b/sasl.el
@@ -30,12 +30,14 @@
 (require 'poe)
 
 (defvar sasl-mechanisms
-  '("CRAM-MD5" "DIGEST-MD5" "PLAIN"))
+  '("CRAM-MD5" "DIGEST-MD5" "PLAIN" "LOGIN" "ANONYMOUS"))
 
 (defvar sasl-mechanism-alist
   '(("CRAM-MD5" sasl-cram)
     ("DIGEST-MD5" sasl-digest)
-    ("PLAIN" sasl-plain)))
+    ("PLAIN" sasl-plain)
+    ("LOGIN" sasl-login)
+    ("ANONYMOUS" sasl-anonymous)))
 
 (defvar sasl-unique-id-function #'sasl-unique-id-function)
 
@@ -60,6 +62,12 @@
 (defmacro sasl-principal-server (principal)
   `(aref ,principal 3))
 
+(put 'sasl-error 'error-message "SASL error")
+(put 'sasl-error 'error-conditions '(sasl-error error))
+
+(defun sasl-error (datum)
+  (signal 'sasl-error (list datum)))
+
 (defun sasl-make-authenticator (mechanism continuations)
   "Make an authenticator.
 MECHANISM is a IANA registered SASL mechanism name.
@@ -148,7 +156,7 @@ It contain at least 64 bits of entropy."
 	    (char-to-string (aref "zyxwvutsrqponmlkjihgfedcba9876543210"
 				  (% num 36))))))
 
-;;; PLAIN SASL mechanism (RFC2595 Section 6)
+;;; PLAIN (RFC2595 Section 6)
 (defconst sasl-plain-continuations
   '(sasl-plain-response))
 
@@ -165,6 +173,41 @@ It contain at least 64 bits of entropy."
 
 (provide 'sasl-plain)
 
+;;; LOGIN (No specification exists)
+(defconst sasl-login-continuations
+  '(ignore				;no initial response
+    sasl-login-response-1
+    sasl-login-response-2))
+
+(defun sasl-login-response-1 (principal challenge)
+  (unless (string= (nth 1 challenge) "Username:")
+    (sasl-error (format "Unexpected response: %s" (nth 1 challenge))))
+  (sasl-principal-name principal))
+
+(defun sasl-login-response-2 (principal challenge)
+  (unless (string= (nth 1 challenge) "Password:")
+    (sasl-error (format "Unexpected response: %s" (nth 1 challenge))))
+  (sasl-read-passphrase
+   (format "LOGIN passphrase for %s: " (sasl-principal-name principal))))
+
+(put 'sasl-login 'sasl-authenticator
+     (sasl-make-authenticator "LOGIN" sasl-login-continuations))
+
+(provide 'sasl-login)
+
+;;; ANONYMOUS (RFC2245)
+(defconst sasl-anonymous-continuations
+  '(identity				;no initial response
+    sasl-anonymous-response))
+
+(defun sasl-anonymous-response (principal challenge)
+  (concat (sasl-principal-name principal)))
+
+(put 'sasl-anonymous 'sasl-authenticator
+     (sasl-make-authenticator "ANONYMOUS" sasl-anonymous-continuations))
+
+(provide 'sasl-anonymous)
+
 (provide 'sasl)
 
 ;;; sasl.el ends here
diff --git a/smtp.el b/smtp.el
index 1a0c49c..929a222 100644
--- a/smtp.el
+++ b/smtp.el
@@ -262,7 +262,7 @@ of the host to connect to.  SERVICE is name of the service desired."
       (progn
 	(smtp-send-buffer sender recipients buffer)
 	t)
-    (smtp-response-error)))
+    (smtp-error)))
 
 (make-obsolete 'smtp-via-smtp "It's old API.")
 
@@ -505,8 +505,11 @@ of the host to connect to.  SERVICE is name of the service desired."
     (goto-char (point-max))
     (insert output)))
 
+(put 'smtp-error 'error-message "SMTP error")
+(put 'smtp-error 'error-conditions '(smtp-error error))
+
 (put 'smtp-response-error 'error-message "SMTP response error")
-(put 'smtp-response-error 'error-conditions '(smtp-response-error error))
+(put 'smtp-response-error 'error-conditions '(smtp-response-error smtp-error error))
 
 (defun smtp-response-error (response)
   (signal 'smtp-response-error response))