From 1a3c31052aa37cdf0789a338977d9dd4c10878eb Mon Sep 17 00:00:00 2001 From: okada Date: Sun, 19 Nov 2000 15:14:56 +0000 Subject: [PATCH] fix --- elmo/elmo-imap4.el | 154 +++++++++++----------------------------------------- elmo/elmo-pop3.el | 138 ++++------------------------------------------ elmo/elmo-util.el | 25 --------- wl/wl-draft.el | 118 ++++++++++++++++------------------------ 4 files changed, 88 insertions(+), 347 deletions(-) diff --git a/elmo/elmo-imap4.el b/elmo/elmo-imap4.el index 48c702c..450c68b 100644 --- a/elmo/elmo-imap4.el +++ b/elmo/elmo-imap4.el @@ -59,9 +59,9 @@ (require 'starttls) (require 'sasl)) (error)) -; (defun-maybe sasl-cram-md5 (username passphrase challenge)) -; (defun-maybe sasl-digest-md5-digest-response -; (digest-challenge username passwd serv-type host &optional realm)) + (defun-maybe sasl-cram-md5 (username passphrase challenge)) + (defun-maybe sasl-digest-md5-digest-response + (digest-challenge username passwd serv-type host &optional realm)) (defun-maybe starttls-negotiate (a)) (defun-maybe elmo-generic-list-folder-unread (spec number-alist mark-alist unread-marks)) (defun-maybe elmo-generic-folder-diff (spec folder number-list)) @@ -1213,23 +1213,7 @@ If optional argument UNMARK is non-nil, unmark." (elmo-imap4-password (elmo-get-passwd (elmo-network-session-password-key session)))))) (signal 'elmo-authenticate-error '(login))))) - -;;; dirty hack -(defconst sasl-imap4-login-steps - '(sasl-imap4-login-response)) - -(defun sasl-imap4-login-response (client step) - (concat - (sasl-client-name client) - " " - (sasl-read-passphrase - (format "LOGIN passphrase for %s: " (sasl-client-name client))))) - -(put 'sasl-imap4-login 'sasl-mechanism - (sasl-make-mechanism "IMAP4-LOGIN" sasl-imap4-login-steps)) - -(provide 'sasl-imap4-login) - + (luna-define-method elmo-network-initialize-session-buffer :after ((session elmo-imap4-session) buffer) @@ -1275,108 +1259,34 @@ If optional argument UNMARK is non-nil, unmark." (luna-define-method elmo-network-authenticate-session ((session elmo-imap4-session)) - (with-current-buffer (process-buffer - (elmo-network-session-process-internal session)) - (let* ((auth (elmo-network-session-auth-internal session)) - (auth (mapcar '(lambda (a) - (if (eq a 'plain) - 'imap4-login - a)) - (if (listp auth) auth (list auth))))) - (unless (or (eq elmo-imap4-status 'auth) - (null auth)) - (let* ((elmo-imap4-debug-inhibit-logging t) - (sasl-mechanism-alist - (append - sasl-mechanism-alist - (list '("IMAP4-LOGIN" sasl-imap4-login)))) - (sasl-mechanisms - (append - (delq nil - (mapcar '(lambda (cap) - (if (string-match "^auth=\\(.*\\)$" - (symbol-name cap)) - (match-string 1 (upcase (symbol-name cap))))) - (elmo-imap4-session-capability-internal session))) - (list "IMAP4-LOGIN"))) - (mechanism - (if (eq auth 'any) - (sasl-find-mechanism sasl-mechanisms) - (sasl-find-mechanism - (delq nil - (mapcar '(lambda (cap) (upcase (symbol-name cap))) - (if (listp auth) - auth - (list auth))))))) - client name step response tag - sasl-read-passphrase) - (unless mechanism - (if (or elmo-imap4-force-login - (y-or-n-p - (format - "There's no %s capability in server. continue?" - (elmo-list-to-string - (elmo-network-session-auth-internal session))))) - (setq mechanism (sasl-find-mechanism - sasl-mechanisms)) - (signal 'elmo-authenticate-error '(elmo-imap4-auth-no-mechanisms)))) - (setq client - (sasl-make-client - mechanism - (elmo-network-session-user-internal session) - "imap" - (elmo-network-session-host-internal session))) -;;; (if elmo-imap4-auth-user-realm -;;; (sasl-client-set-property client 'realm elmo-imap4-auth-user-realm)) - (setq name (sasl-mechanism-name mechanism) - step (sasl-next-step client nil)) - (elmo-network-session-set-auth-internal session - (intern (downcase name))) - (setq sasl-read-passphrase - (function - (lambda (prompt) - (elmo-get-passwd - (elmo-network-session-password-key session))))) - (if (string= name "IMAP4-LOGIN") - (setq tag - (elmo-imap4-send-command - session - (concat "LOGIN " (sasl-step-data step)))) - (setq tag - (elmo-imap4-send-command - session - (concat "AUTHENTICATE " name - (and (sasl-step-data step) - (concat - " " - (elmo-base64-encode-string - (sasl-step-data step) - 'no-lin-break))))))) - (catch 'done - (while t - (setq response (elmo-imap4-read-untagged - (elmo-network-session-process-internal session))) - (if (and - (null (elmo-imap4-response-continue-req-p response)) - (elmo-imap4-response-ok-p response) - (or (sasl-next-step client step) - (throw 'done nil))) - (signal 'elmo-authenticate-error - (list (intern - (concat "elmo-imap4-auth-" - (downcase name)))))) - (sasl-step-set-data - step - (elmo-base64-decode-string - (elmo-imap4-response-value response 'continue-req))) - (setq step (sasl-next-step client step)) - (setq tag - (elmo-imap4-send-string - session - (if (sasl-step-data step) - (elmo-base64-encode-string (sasl-step-data step) - 'no-line-break) - "")))))))))) + (with-current-buffer (process-buffer + (elmo-network-session-process-internal session)) + (unless (eq elmo-imap4-status 'auth) + (unless (or (not (elmo-network-session-auth-internal session)) + (eq (elmo-network-session-auth-internal session) 'plain) + (and (memq (intern + (format "auth=%s" + (elmo-network-session-auth-internal + session))) + (elmo-imap4-session-capability-internal session)) + (assq + (elmo-network-session-auth-internal session) + elmo-imap4-authenticator-alist))) + (if (or elmo-imap4-force-login + (y-or-n-p + (format + "There's no %s capability in server. continue?" + (elmo-network-session-auth-internal session)))) + (elmo-network-session-set-auth-internal session nil) + (signal 'elmo-open-error + '(elmo-network-initialize-session)))) + (let ((authenticator + (if (elmo-network-session-auth-internal session) + (nth 1 (assq + (elmo-network-session-auth-internal session) + elmo-imap4-authenticator-alist)) + 'elmo-imap4-login))) + (funcall authenticator session))))) (luna-define-method elmo-network-setup-session ((session elmo-imap4-session)) diff --git a/elmo/elmo-pop3.el b/elmo/elmo-pop3.el index 892862a..f39a37c 100644 --- a/elmo/elmo-pop3.el +++ b/elmo/elmo-pop3.el @@ -297,45 +297,6 @@ (signal 'elmo-open-error '(elmo-pop-auth-digest-md5))))) -;;; dirty hack -(defconst sasl-pop3-user-steps - '(sasl-pop3-user-response-1 - sasl-pop3-user-response-2)) - -(defun sasl-pop3-user-response-1 (client step) - (sasl-client-name client)) - -(defun sasl-pop3-user-response-2 (client step) - (format "PASS %s" - (sasl-read-passphrase - (format "LOGIN passphrase for %s: " - (sasl-client-name client))))) - -(put 'sasl-pop3-user 'sasl-mechanism - (sasl-make-mechanism "USER" sasl-pop3-user-steps)) - -(provide 'sasl-pop3-user) - -(defconst sasl-pop3-apop-steps - '(sasl-pop3-apop-response)) - -(defun sasl-pop3-apop-response (client step) - (require 'md5) - (format "%s %s" - (sasl-client-name client) - (md5 - (concat (match-string - 1 - (elmo-network-session-greeting-internal session)) - (sasl-read-passphrase - (format "LOGIN passphrase for %s: " - (sasl-client-name client))))))) - -(put 'sasl-pop3-apop 'sasl-mechanism - (sasl-make-mechanism "APOP" sasl-pop3-apop-steps)) - -(provide 'sasl-pop3-apop) - (luna-define-method elmo-network-initialize-session-buffer :after ((session elmo-pop3-session) buffer) (with-current-buffer buffer @@ -363,97 +324,18 @@ (signal 'elmo-open-error '(elmo-pop3-starttls-error))))))) -;(luna-define-method elmo-network-authenticate-session ((session -; elmo-pop3-session)) -; (let (authenticator) -; ;; defaults to 'user. -; (unless (elmo-network-session-auth-internal session) -; (elmo-network-session-set-auth-internal session 'user)) -; (setq authenticator -; (nth 1 (assq (elmo-network-session-auth-internal session) -; elmo-pop3-authenticator-alist))) -; (unless authenticator (error "There's no authenticator for %s" -; (elmo-network-session-auth-internal session))) -; (funcall authenticator session))) - (luna-define-method elmo-network-authenticate-session ((session elmo-pop3-session)) - (let* ((process (elmo-network-session-process-internal session)) - (auth (elmo-network-session-auth-internal session)) - (auth (mapcar '(lambda (mechanism) (upcase (symbol-name mechanism))) - (if (listp auth) auth (list auth)))) - (sasl-mechanism-alist - (append - sasl-mechanism-alist - (list '("USER" sasl-pop3-user) - '("APOP" sasl-pop3-apop)))) - (mechanism - (if (eq auth 'any) - (sasl-find-mechanism sasl-mechanisms) - (sasl-find-mechanism auth))) - client name step response - sasl-read-passphrase) - (unless mechanism - (if (or elmo-pop3-force-login - (y-or-n-p - (format - "There's no %s capability in server. continue?" - (elmo-list-to-string - (elmo-network-session-auth-internal session))))) - (setq mechanism (sasl-find-mechanism - sasl-mechanisms)) - (signal 'elmo-authenticate-error '(elmo-pop3-auth-no-mechanisms)))) - (setq client - (sasl-make-client - mechanism - (elmo-network-session-user-internal session) - "pop" - (elmo-network-session-host-internal session))) -;;; (if elmo-pop3-auth-user-realm -;;; (sasl-client-set-property client 'realm elmo-pop3-auth-user-realm)) - (setq name (sasl-mechanism-name mechanism) - step (sasl-next-step client nil)) - (elmo-network-session-set-auth-internal session - (intern (downcase name))) - (setq sasl-read-passphrase - (function - (lambda (prompt) - (elmo-get-passwd - (elmo-network-session-password-key session))))) - (if (or (string= name "USER") - (string= name "APOP")) - (elmo-pop3-send-command - process - (format "%s %s" name - (sasl-step-data step))) - (elmo-pop3-send-command - process - (concat "AUTH " name - (and (sasl-step-data step) - (concat - " " - (elmo-base64-encode-string - (sasl-step-data step) 'no-line-break)))))) - (catch 'done - (while t - (setq response (elmo-pop3-read-response process t)) - (if (string-match "^\+OK" response) - (if (sasl-next-step client step) - (signal 'elmo-authenticate-error - (list (intern - (concat "elmo-pop3-auth-" - (downcase name))))) - (throw 'done nil))) - (sasl-step-set-data - step - (elmo-base64-decode-string response)) - (setq step (sasl-next-step client step)) - (elmo-pop3-send-string - process - (if (sasl-step-data step) - (elmo-base64-encode-string (sasl-step-data step) - 'no-line-break) - "")))))) + (let (authenticator) + ;; defaults to 'user. + (unless (elmo-network-session-auth-internal session) + (elmo-network-session-set-auth-internal session 'user)) + (setq authenticator + (nth 1 (assq (elmo-network-session-auth-internal session) + elmo-pop3-authenticator-alist))) + (unless authenticator (error "There's no authenticator for %s" + (elmo-network-session-auth-internal session))) + (funcall authenticator session))) (luna-define-method elmo-network-setup-session ((session elmo-pop3-session)) diff --git a/elmo/elmo-util.el b/elmo/elmo-util.el index 713601a..c493d00 100644 --- a/elmo/elmo-util.el +++ b/elmo/elmo-util.el @@ -899,31 +899,6 @@ Otherwise treat \\ in NEWTEXT string as special: (goto-char (point-min)) (read (current-buffer)))) -(defun elmo-list-to-string (list) - (let ((tlist list) - str) - (if (listp tlist) - (progn - (setq str "(") - (while (car tlist) - (setq str - (concat str - (if (symbolp (car tlist)) - (symbol-name (car tlist)) - (car tlist)))) - (if (cdr tlist) - (setq str - (concat str " "))) - (setq tlist (cdr tlist))) - (setq str - (concat str ")"))) - (setq str - (if (symbolp tlist) - (symbol-name tlist) - tlist))) - str)) - - (defun elmo-plug-on-by-servers (alist &optional servers) (let ((server-list (or servers elmo-plug-on-servers))) (catch 'plugged diff --git a/wl/wl-draft.el b/wl/wl-draft.el index 41d0993..9edf607 100644 --- a/wl/wl-draft.el +++ b/wl/wl-draft.el @@ -41,9 +41,10 @@ (defvar x-face-add-x-face-version-header) (defvar mail-reply-buffer) (defvar mail-from-style) -;(defvar smtp-sasl-mechanisms) -;(defvar smtp-sasl-user-name) -;(defvar smtp-use-starttls) +(defvar smtp-authenticate-type) +(defvar smtp-authenticate-user) +(defvar smtp-authenticate-passphrase) +(defvar smtp-connection-type) (eval-when-compile (require 'elmo-pop3) @@ -96,77 +97,50 @@ (make-variable-buffer-local 'wl-draft-reply-buffer) ;;; SMTP binding by Daiki Ueno -;;;(defvar wl-smtp-features -;;; '(((smtp-authenticate-type -;;; (if wl-smtp-authenticate-type -;;; (intern (downcase (format "%s" wl-smtp-authenticate-type))))) -;;; ((smtp-authenticate-user wl-smtp-posting-user) -;;; ((smtp-authenticate-passphrase -;;; (elmo-get-passwd -;;; (format "%s@%s" -;;; smtp-authenticate-user -;;; smtp-server)))))) -;;; (smtp-connection-type)) -;;; "Additional SMTP features.") - -;;;(eval-when-compile -;;; (defun wl-smtp-parse-extension (exts parents) -;;; (let (bindings binding feature) -;;; (dolist (ext exts) -;;; (setq feature (if (listp (car ext)) (caar ext) (car ext)) -;;; binding -;;; (` ((, feature) -;;; (or (, (if (listp (car ext)) -;;; (cadar ext) -;;; (let ((wl-feature -;;; (intern -;;; (concat "wl-" (symbol-name feature))))) -;;; (if (boundp wl-feature) -;;; wl-feature)))) -;;; (and (boundp '(, feature)) (, feature)))))) -;;; (when parents -;;; (setcdr binding (list (append '(and) parents (cdr binding))))) -;;; (setq bindings -;;; (nconc bindings (list binding) -;;; (wl-smtp-parse-extension -;;; (cdr ext) (cons feature parents))))) -;;; bindings))) - -;;;(defmacro wl-smtp-extension-bind (&rest body) -;;; "Return a `let' form that binds all variables of SMTP extension. -;;;After this is done, BODY will be executed in the scope -;;;of the `let' form. -;;; -;;;The variables bound and their default values are described by -;;;the `wl-smtp-features' variable." -;;; (` (let* (, (wl-smtp-parse-extension wl-smtp-features nil)) -;;; (,@ body)))) +(defvar wl-smtp-features + '(((smtp-authenticate-type + (if wl-smtp-authenticate-type + (intern (downcase (format "%s" wl-smtp-authenticate-type))))) + ((smtp-authenticate-user wl-smtp-posting-user) + ((smtp-authenticate-passphrase + (elmo-get-passwd + (format "%s@%s" + smtp-authenticate-user + smtp-server)))))) + (smtp-connection-type)) + "Additional SMTP features.") + +(eval-when-compile + (defun wl-smtp-parse-extension (exts parents) + (let (bindings binding feature) + (dolist (ext exts) + (setq feature (if (listp (car ext)) (caar ext) (car ext)) + binding + (` ((, feature) + (or (, (if (listp (car ext)) + (cadar ext) + (let ((wl-feature + (intern + (concat "wl-" (symbol-name feature))))) + (if (boundp wl-feature) + wl-feature)))) + (and (boundp '(, feature)) (, feature)))))) + (when parents + (setcdr binding (list (append '(and) parents (cdr binding))))) + (setq bindings + (nconc bindings (list binding) + (wl-smtp-parse-extension + (cdr ext) (cons feature parents))))) + bindings))) (defmacro wl-smtp-extension-bind (&rest body) - (` (let* ((smtp-sasl-mechanisms - (if wl-smtp-authenticate-type - (mapcar 'upcase - (if (listp wl-smtp-authenticate-type) - wl-smtp-authenticate-type - (list wl-smtp-authenticate-type))))) - (smtp-use-sasl (and smtp-sasl-mechanisms t)) - (smtp-use-starttls wl-smtp-connection-type) - smtp-sasl-user-name smtp-sasl-user-realm sasl-read-passphrase) - (if (and (string= (car smtp-sasl-mechanisms) "DIGEST-MD5") - ;; sendmail bug? - (string-match "^\\([^@]*\\)@\\([^@]*\\)" - wl-smtp-posting-user)) - (setq smtp-sasl-user-name (match-string 1 wl-smtp-posting-user) - smtp-sasl-user-realm (match-string 2 wl-smtp-posting-user)) - (setq smtp-sasl-user-name wl-smtp-posting-user - smtp-sasl-user-realm nil)) - (setq sasl-read-passphrase - (function - (lambda (prompt) - (elmo-get-passwd - (format "%s@%s" - smtp-sasl-user-name - smtp-server))))) + "Return a `let' form that binds all variables of SMTP extension. +After this is done, BODY will be executed in the scope +of the `let' form. + +The variables bound and their default values are described by +the `wl-smtp-features' variable." + (` (let* (, (wl-smtp-parse-extension wl-smtp-features nil)) (,@ body)))) (defun wl-draft-insert-date-field () -- 1.7.10.4