X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Felmo-imap4.el;h=022048ec89784754cac797b677d4474899a05b1e;hb=10518221da70c6e7ffc66352ee6a3e1036bd5133;hp=48c702c02b6eed2b6d899f35a20bcc87c3ee6e18;hpb=d5b30dbc0d8ad66b629cf38de7df94bf92b09c11;p=elisp%2Fwanderlust.git

diff --git a/elmo/elmo-imap4.el b/elmo/elmo-imap4.el
index 48c702c..022048e 100644
--- a/elmo/elmo-imap4.el
+++ b/elmo/elmo-imap4.el
@@ -47,25 +47,7 @@
 (require 'utf7)
 
 ;;; Code:
-(condition-case nil
-    (progn
-      (require 'sasl))
-  (error))
-;; silence byte compiler.
-(eval-when-compile
-  (require 'cl)
-  (condition-case nil
-      (progn
-	(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 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))
-  (defsubst-maybe utf7-decode-string (string &optional imap) string))
+(eval-when-compile (require 'cl))
 
 (defvar elmo-imap4-use-lock t
   "USE IMAP4 with locking process.")
@@ -124,13 +106,6 @@
     elmo-imap4-status-callback-data
     elmo-imap4-current-msgdb))
 
-(defvar elmo-imap4-authenticator-alist
-  '((login	elmo-imap4-auth-login)
-    (cram-md5	elmo-imap4-auth-cram-md5)
-    (digest-md5 elmo-imap4-auth-digest-md5)
-    (plain      elmo-imap4-login))
-  "Definition of authenticators.")
-
 ;;;;
 
 (defconst elmo-imap4-quoted-specials-list '(?\\ ?\"))
@@ -387,6 +362,9 @@ If response is not `OK' response, causes error with IMAP response text."
 ;;;
 
 (defun elmo-imap4-session-check (session)
+  (with-current-buffer (elmo-network-session-buffer session)
+    (setq elmo-imap4-fetch-callback nil)
+    (setq elmo-imap4-fetch-callback-data nil))
   (elmo-imap4-send-command-wait session "check"))
 
 (defun elmo-imap4-atom-p (string)
@@ -552,7 +530,7 @@ BUFFER must be a single-byte buffer."
 		     elmo-default-imap4-user)
       (setq append-serv (concat ":" (elmo-imap4-spec-username spec))))
     (unless (eq (elmo-imap4-spec-auth spec)
-		     elmo-default-imap4-authenticate-type)
+		elmo-default-imap4-authenticate-type)
       (setq append-serv 
 	    (concat append-serv "/" (symbol-name (elmo-imap4-spec-auth spec)))))
     (unless (string= (elmo-imap4-spec-hostname spec)
@@ -636,23 +614,24 @@ BUFFER must be a single-byte buffer."
     (when (elmo-imap4-spec-mailbox spec)
       (when (setq msgs (elmo-imap4-list-folder spec))
 	(elmo-imap4-delete-msgs spec msgs))
-      ;; (elmo-imap4-send-command-wait session "close")
+      (elmo-imap4-send-command-wait session "close")
       (elmo-imap4-send-command-wait
        session
        (list "delete "
 	     (elmo-imap4-mailbox (elmo-imap4-spec-mailbox spec)))))))
 
 (defun elmo-imap4-rename-folder (old-spec new-spec)
-;;;(elmo-imap4-send-command-wait session "close")
-  (elmo-imap4-send-command-wait
-   (elmo-imap4-get-session old-spec)
-   (list "rename "
-	 (elmo-imap4-mailbox
-	  (elmo-imap4-spec-mailbox old-spec))
-	 " "
-	 (elmo-imap4-mailbox
-	  (elmo-imap4-spec-mailbox new-spec)))))
-
+  (let ((session (elmo-imap4-get-session old-spec)))
+    (elmo-imap4-send-command-wait session "close")
+    (elmo-imap4-send-command-wait
+     session
+     (list "rename "
+	   (elmo-imap4-mailbox
+	    (elmo-imap4-spec-mailbox old-spec))
+	   " "
+	   (elmo-imap4-mailbox
+	    (elmo-imap4-spec-mailbox new-spec))))))
+  
 (defun elmo-imap4-max-of-folder (spec)
   (let ((session (elmo-imap4-get-session spec))
 	 (killed (and elmo-use-killed-list
@@ -682,7 +661,7 @@ BUFFER must be a single-byte buffer."
   (if elmo-use-server-diff
       (elmo-imap4-server-diff spec)
     (elmo-generic-folder-diff spec folder number-list)))
-    
+
 (defun elmo-imap4-get-session (spec &optional if-exists)
   (elmo-network-get-session
    'elmo-imap4-session
@@ -1064,20 +1043,28 @@ If optional argument UNMARK is non-nil, unmark."
 
 ;;
 ;; app-data:
+;; cons of list
 ;; 0: new-mark 1: already-mark 2: seen-mark 3: important-mark
-;; 4: seen-list 5: as-number
+;; 4: seen-list
+;; and result of use-flag-p.
 (defun elmo-imap4-fetch-callback-1 (entity flags app-data)
   "A msgdb entity callback function."
-  (let ((seen (member (car entity) (nth 4 app-data)))
-	mark)
+  (let* ((use-flag (cdr app-data))
+	 (app-data (car app-data))
+	 (seen (member (car entity) (nth 4 app-data)))
+	 mark)
     (if (member "\\Flagged" flags)
 	(elmo-msgdb-global-mark-set (car entity) (nth 3 app-data)))
     (setq mark (or (elmo-msgdb-global-mark-get (car entity))
 		   (if (elmo-cache-exists-p (car entity)) ;; XXX
-		       (if (or (member "\\Seen" flags) seen)
+		       (if (or seen
+			       (and use-flag
+				    (member "\\Seen" flags)))
 			   nil
 			 (nth 1 app-data))
-		     (if (or (member "\\Seen" flags) seen)
+		     (if (or seen
+			     (and use-flag
+				  (member "\\Seen" flags)))
 			 (if elmo-imap4-use-cache
 			     (nth 2 app-data))
 		       (nth 0 app-data)))))
@@ -1117,7 +1104,9 @@ If optional argument UNMARK is non-nil, unmark."
       (with-current-buffer (elmo-network-session-buffer session)
 	(setq elmo-imap4-current-msgdb nil
 	      elmo-imap4-fetch-callback 'elmo-imap4-fetch-callback-1
-	      elmo-imap4-fetch-callback-data args)
+	      elmo-imap4-fetch-callback-data (cons args
+						   (elmo-imap4-use-flag-p
+						    spec)))
 	(while set-list
 	  (elmo-imap4-send-command-wait
 	   session
@@ -1142,7 +1131,20 @@ If optional argument UNMARK is non-nil, unmark."
       (elmo-read
        (concat "(" (downcase (elmo-match-string 1 string)) ")"))))
 
-;; Current buffer is process buffer.
+(defun elmo-imap4-clear-login (session)
+  (let ((elmo-imap4-debug-inhibit-logging t))
+    (or
+     (elmo-imap4-read-ok
+      session
+      (elmo-imap4-send-command
+       session
+       (list "login "
+	     (elmo-imap4-userid (elmo-network-session-user-internal session))
+	     " "
+	     (elmo-imap4-password
+	      (elmo-get-passwd (elmo-network-session-password-key session))))))
+     (signal 'elmo-authenticate-error '(elmo-imap4-clear-login)))))
+
 (defun elmo-imap4-auth-login (session)
   (let ((tag (elmo-imap4-send-command session "authenticate login"))
 	(elmo-imap4-debug-inhibit-logging t))
@@ -1160,76 +1162,7 @@ If optional argument UNMARK is non-nil, unmark."
     (or (elmo-imap4-read-ok session tag)
 	(signal 'elmo-authenticate-error '(elmo-imap4-auth-login)))
     (setq elmo-imap4-status 'auth)))
-
-(defun elmo-imap4-auth-cram-md5 (session)
-  (let ((tag (elmo-imap4-send-command session "authenticate cram-md5"))
-	(elmo-imap4-debug-inhibit-logging t)
-	response)
-    (or (setq response (elmo-imap4-read-continue-req session))
-	(signal 'elmo-authenticate-error
-		'(elmo-imap4-auth-cram-md5)))
-    (elmo-imap4-send-string
-     session
-     (elmo-base64-encode-string
-      (sasl-cram-md5 (elmo-network-session-user-internal session)
-		     (elmo-get-passwd
-		      (elmo-network-session-password-key session))
-		     (elmo-base64-decode-string response))))
-    (or (elmo-imap4-read-ok session tag)
-	(signal 'elmo-authenticate-error '(elmo-imap4-auth-cram-md5)))))
-
-(defun elmo-imap4-auth-digest-md5 (session)
-  (let ((tag (elmo-imap4-send-command session "authenticate digest-md5"))
-	(elmo-imap4-debug-inhibit-logging t)
-	response)
-    (or (setq response (elmo-imap4-read-continue-req session))
-	(signal 'elmo-authenticate-error '(elmo-imap4-auth-digest-md5)))
-    (elmo-imap4-send-string
-     session
-     (elmo-base64-encode-string
-      (sasl-digest-md5-digest-response
-       (elmo-base64-decode-string response)
-       (elmo-network-session-user-internal session)
-       (elmo-get-passwd (elmo-network-session-password-key session))
-       "imap"
-       (elmo-network-session-password-key session))
-      'no-line-break))
-    (or (setq response (elmo-imap4-read-continue-req session))
-	(signal 'elmo-authenticate-error '(elmo-imap4-auth-digest-md5)))
-    (elmo-imap4-send-string session "")
-    (or (elmo-imap4-read-ok session tag)
-	(signal 'elmo-authenticate-error '(elmo-imap4-auth-digest-md5)))))
-
-(defun elmo-imap4-login (session)
-  (let ((elmo-imap4-debug-inhibit-logging t))
-    (or
-     (elmo-imap4-read-ok
-      session
-      (elmo-imap4-send-command
-       session
-       (list "login "
-	     (elmo-imap4-userid (elmo-network-session-user-internal session))
-	     " "
-	     (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)
@@ -1274,43 +1207,38 @@ If optional argument UNMARK is non-nil, unmark."
 	(starttls-negotiate process)))))
 
 (luna-define-method elmo-network-authenticate-session ((session
-							elmo-imap4-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)))))
+	   (auth (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)
+	(cond
+	 ((eq 'clear (car auth))
+	  (elmo-imap4-clear-login session))
+	 ((eq 'login (car auth))
+	  (elmo-imap4-auth-login session))
+	 (t
+	  (let* ((elmo-imap4-debug-inhibit-logging t)
+		 (sasl-mechanisms
+		  (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))))
+		 (mechanism
 		  (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
+				   (list auth)))))) ;)
+		 client name step response tag
+		 sasl-read-passphrase)
+	    (unless mechanism
 	      (if (or elmo-imap4-force-login
 		      (y-or-n-p
 		       (format
@@ -1319,7 +1247,8 @@ If optional argument UNMARK is non-nil, unmark."
 			 (elmo-network-session-auth-internal session)))))
 		  (setq mechanism (sasl-find-mechanism
 				   sasl-mechanisms))
-		(signal 'elmo-authenticate-error '(elmo-imap4-auth-no-mechanisms))))
+		(signal 'elmo-authenticate-error
+			'(elmo-imap4-auth-no-mechanisms))))
 	    (setq client
 		  (sasl-make-client
 		   mechanism
@@ -1330,41 +1259,44 @@ If optional argument UNMARK is non-nil, unmark."
 ;;;		(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)))
+	    (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)))))))
+	    (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)))
+		(setq response
+		      (elmo-imap4-read-untagged
+		       (elmo-network-session-process-internal session)))
+		(if (elmo-imap4-response-continue-req-p response)
+		    (unless (sasl-next-step client step)
+		      ;; response is '+' but there's no next step.
+		      (signal 'elmo-authenticate-error
+			      (list (intern
+				     (concat "elmo-imap4-auth-"
+					     (downcase name))))))
+		  ;; response is OK.
+		  (if (elmo-imap4-response-ok-p response)
+		      (throw 'done nil) ; finished.
+		    ;; response is NO or BAD.
 		    (signal 'elmo-authenticate-error
 			    (list (intern
 				   (concat "elmo-imap4-auth-"
-					   (downcase name))))))
+					   (downcase name)))))))
 		(sasl-step-set-data
 		 step
 		 (elmo-base64-decode-string
@@ -1376,7 +1308,7 @@ If optional argument UNMARK is non-nil, unmark."
 		       (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))
@@ -1427,7 +1359,7 @@ If optional argument UNMARK is non-nil, unmark."
   (elmo-imap4-read-msg spec msg outbuf 'unseen))
 
 (defun elmo-imap4-read-msg (spec msg outbuf
-				 &optional leave-seen-flag-untouched)
+				 &optional msgdb leave-seen-flag-untouched)
   (let ((session (elmo-imap4-get-session spec))
 	response)
     (elmo-imap4-session-select-mailbox session
@@ -1439,15 +1371,14 @@ If optional argument UNMARK is non-nil, unmark."
 	  (elmo-imap4-send-command-wait session
 					(format
 					 (if elmo-imap4-use-uid
-					     "uid fetch %s rfc822%s"
-					   "fetch %s rfc822%s")
+					     "uid fetch %s body%s[]"
+					   "fetch %s body%s[]")
 					 msg
 					 (if leave-seen-flag-untouched
 					     ".peek" ""))))
-    (and (setq response (elmo-imap4-response-value
+    (and (setq response (elmo-imap4-response-bodydetail-text
 			 (elmo-imap4-response-value-all
-			  response 'fetch )
-			 'rfc822))
+			  response 'fetch )))
 	 (with-current-buffer outbuf
 	   (erase-buffer)
 	   (insert response)
@@ -1651,6 +1582,7 @@ Return nil if no complete line has arrived."
 
 (defun elmo-imap4-arrival-filter (proc string)
   "IMAP process filter."
+  (when (buffer-live-p (process-buffer proc))
   (with-current-buffer (process-buffer proc)
     (elmo-imap4-debug "-> %s" string)
     (goto-char (point-max))
@@ -1678,7 +1610,7 @@ Return nil if no complete line has arrived."
 		    (t
 		     (message "Unknown state %s in arrival filter"
 			      elmo-imap4-status))))
-	  (delete-region (point-min) (point-max)))))))
+	  (delete-region (point-min) (point-max))))))))
 
 ;; IMAP parser.