fix
authorokada <okada>
Sun, 19 Nov 2000 15:15:46 +0000 (15:15 +0000)
committerokada <okada>
Sun, 19 Nov 2000 15:15:46 +0000 (15:15 +0000)
elmo/elmo-imap4.el
elmo/elmo-pop3.el
elmo/elmo-util.el
wl/wl-draft.el

index 450c68b..48c702c 100644 (file)
@@ -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,7 +1213,23 @@ 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)
@@ -1259,34 +1275,108 @@ 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))
-   (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)))))
+  (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)
+                        ""))))))))))
 
 (luna-define-method elmo-network-setup-session ((session
                                                 elmo-imap4-session))
index f39a37c..892862a 100644 (file)
        (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
          (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 (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)))
+  (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)
+                  ""))))))
 
 (luna-define-method elmo-network-setup-session ((session
                                                 elmo-pop3-session))
index c493d00..713601a 100644 (file)
@@ -899,6 +899,31 @@ 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
index 9edf607..41d0993 100644 (file)
 (defvar x-face-add-x-face-version-header)
 (defvar mail-reply-buffer)
 (defvar mail-from-style)
-(defvar smtp-authenticate-type)
-(defvar smtp-authenticate-user)
-(defvar smtp-authenticate-passphrase)
-(defvar smtp-connection-type)
+;(defvar smtp-sasl-mechanisms)
+;(defvar smtp-sasl-user-name)
+;(defvar smtp-use-starttls)
 
 (eval-when-compile
   (require 'elmo-pop3)
 (make-variable-buffer-local 'wl-draft-reply-buffer)
 
 ;;; SMTP binding by Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-(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)))
+;;;(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))))
 
 (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))
+  (` (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)))))
        (,@ body))))
 
 (defun wl-draft-insert-date-field ()