From: ueno Date: Thu, 2 Nov 2000 08:38:08 +0000 (+0000) Subject: * sasl-digest.el (sasl-digest-md5-response-1): Rename from X-Git-Tag: deisui-1_14_0-1~21 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=807be0914e7615490581f7415cc43f0708b90e6f;p=elisp%2Fflim.git * sasl-digest.el (sasl-digest-md5-response-1): Rename from `sasl-digest-md5-digest-response'. (sasl-digest-md5-response-2): New alias. (sasl-digest-md5-parse-digest-challenge): Save excursion. * sasl.el (sasl-mechanism-alist): Rename from `sasl-mechanisms'. (sasl-mechanisms): New variable. (sasl-find-authenticator): Check `sasl-mechanisms' rather than `sasl-mechanism-alist'. * smtp.el (smtp-submit-package): Use `smtp-primitive-ehlo'. (smtp-primitive-auth): Check authenticator. --- diff --git a/ChangeLog b/ChangeLog index 3611e9f..e1e6469 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,20 @@ 2000-11-02 Daiki Ueno + * sasl-digest.el (sasl-digest-md5-response-1): Rename from + `sasl-digest-md5-digest-response'. + (sasl-digest-md5-response-2): New alias. + (sasl-digest-md5-parse-digest-challenge): Save excursion. + + * sasl.el (sasl-mechanism-alist): Rename from `sasl-mechanisms'. + (sasl-mechanisms): New variable. + (sasl-find-authenticator): Check `sasl-mechanisms' rather than + `sasl-mechanism-alist'. + + * smtp.el (smtp-submit-package): Use `smtp-primitive-ehlo'. + (smtp-primitive-auth): Check authenticator. + +2000-11-02 Daiki Ueno + * FLIM-ELS (hmac-modules): New variable. (flim-modules): Move HMAC modules to `hmac-modules' - Add `sasl-digest'. diff --git a/sasl-digest.el b/sasl-digest.el index eee6f96..f625acd 100644 --- a/sasl-digest.el +++ b/sasl-digest.el @@ -51,8 +51,8 @@ (defconst sasl-digest-md5-continuations '(ignore ;no initial response - sasl-digest-md5-response - ignore)) ;"" + sasl-digest-md5-response-1 + sasl-digest-md5-response-2)) ;"" (unless (get 'sasl-digest 'sasl-authenticator) (put 'sasl-digest 'sasl-authenticator @@ -74,20 +74,21 @@ (defun sasl-digest-md5-parse-digest-challenge (digest-challenge) "Return a property list parsed DIGEST-CHALLENGE. The value is a cons cell of the form \(realm nonce qop-options stale maxbuf -charset algorithm cipher-opts auth-param)". - (with-temp-buffer - (set-syntax-table sasl-digest-md5-parse-digest-challenge-syntax-table) - (insert digest-challenge) - (goto-char (point-min)) - (insert "(") - (while (progn (forward-sexp) (not (eobp))) - (delete-char 1) - (insert " ")) - (insert ")") - (condition-case nil - (setplist 'sasl-digest-md5-challenge (read (point-min-marker))) - (end-of-file - (error "Parse error in digest-challenge."))))) +charset algorithm cipher-opts auth-param)." + (save-excursion + (with-temp-buffer + (set-syntax-table sasl-digest-md5-parse-digest-challenge-syntax-table) + (insert digest-challenge) + (goto-char (point-min)) + (insert "(") + (while (progn (forward-sexp) (not (eobp))) + (delete-char 1) + (insert " ")) + (insert ")") + (condition-case nil + (setplist 'sasl-digest-md5-challenge (read (point-min-marker))) + (end-of-file + (error "Parse error in digest-challenge.")))))) (defun sasl-digest-md5-digest-uri (serv-type host &optional serv-name) (concat serv-type "/" host @@ -136,7 +137,7 @@ charset algorithm cipher-opts auth-param)". "cnonce=\"" cnonce "\"," "digest-uri=\"" digest-uri "\"," "response=" - (sasl-digest-md5-build-response-value + (sasl-digest-md5-build-response-value-1 username realm passwd nonce cnonce nonce-count digest-uri (or qop "auth")) "," @@ -150,7 +151,7 @@ charset algorithm cipher-opts auth-param)". '(charset qop maxbuf cipher authzid))) ","))) -(defun sasl-digest-md5-digest-response (principal challenge) +(defun sasl-digest-md5-response-1 (principal challenge) (sasl-digest-md5-parse-digest-challenge (nth 1 challenge)) (let ((passphrase (sasl-read-passphrase @@ -170,6 +171,8 @@ charset algorithm cipher-opts auth-param)". (sasl-principal-server-internal principal))) (fillarray passphrase 0)))) +(defalias 'sasl-digest-md5-response-2 'ignore) + (provide 'sasl-digest) ;;; sasl-digest.el ends here diff --git a/sasl.el b/sasl.el index dc42358..eb46668 100644 --- a/sasl.el +++ b/sasl.el @@ -27,6 +27,9 @@ (require 'poe) (defvar sasl-mechanisms + '("CRAM-MD5" "DIGEST-MD5" "PLAIN")) + +(defvar sasl-mechanism-alist '(("CRAM-MD5" sasl-cram) ("DIGEST-MD5" sasl-digest) ("PLAIN" sasl-plain))) @@ -59,12 +62,14 @@ (defun sasl-find-authenticator (mechanisms) "Retrieve an apropriate authenticator object from MECHANISMS hints." - (let (mechanism) - (while mechanisms - (if (setq mechanism (assoc (car mechanisms) sasl-mechanisms)) - (setq mechanism (nth 1 mechanism) - mechanisms nil)) - (setq mechanisms (cdr mechanisms))) + (let* ((sasl-mechanisms sasl-mechanisms) + (mechanism + (catch 'done + (while sasl-mechanisms + (if (member (car sasl-mechanisms) mechanisms) + (throw 'done (nth 1 (assoc (car sasl-mechanisms) + sasl-mechanism-alist)))) + (setq sasl-mechanisms (cdr sasl-mechanisms)))))) (when mechanism (require mechanism) (get mechanism 'sasl-authenticator)))) diff --git a/smtp.el b/smtp.el index c2fa2dd..fc97404 100644 --- a/smtp.el +++ b/smtp.el @@ -260,7 +260,10 @@ or `smtp-local-domain' correctly.")))))) (unwind-protect (progn (smtp-primitive-greeting package) - (smtp-primitive-helo package) + (condition-case nil + (smtp-primitive-ehlo package) + (smtp-response-error + (smtp-primitive-helo package))) (if smtp-use-starttls (smtp-primitive-starttls package)) (if smtp-use-sasl @@ -336,13 +339,14 @@ or `smtp-local-domain' correctly.")))))) "smtp" (smtp-connection-server-internal connection) smtp-sasl-principal-realm)) (authenticator - (sasl-find-authenticator mechanisms)) - (mechanism - (sasl-authenticator-mechanism-internal authenticator)) - ;; Retrieve the initial response - (sasl-response - (sasl-evaluate-challenge authenticator principal)) - response) + (let ((sasl-mechanisms smtp-sasl-mechanisms)) + (sasl-find-authenticator mechanisms))) + mechanism sasl-response response) + (unless authenticator + (error "No authentication mechanism available.")) + (setq mechanism (sasl-authenticator-mechanism-internal authenticator) + ;; Retrieve the initial response + sasl-response (sasl-evaluate-challenge authenticator principal)) (smtp-send-command process (if (nth 1 sasl-response) @@ -365,8 +369,10 @@ or `smtp-local-domain' correctly.")))))) (setq sasl-response (sasl-evaluate-challenge authenticator principal sasl-response)) - (smtp-send-command process (base64-encode-string - (nth 1 sasl-response) t)))))) + (smtp-send-command + process (if (nth 1 sasl-response) + (base64-encode-string (nth 1 sasl-response) t) + "")))))) (defun smtp-primitive-starttls (package) (let* ((connection