(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 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.")
;;;
(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)
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)
(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
(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
;;
;; 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)))))
(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
(elmo-read
(concat "(" (downcase (elmo-match-string 1 string)) ")"))))
-(defun elmo-imap4-login (session)
+(defun elmo-imap4-clear-login (session)
(let ((elmo-imap4-debug-inhibit-logging t))
(or
(elmo-imap4-read-ok
" "
(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)
-
+ (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))
+ (or (elmo-imap4-read-continue-req session)
+ (signal 'elmo-authenticate-error '(elmo-imap4-auth-login)))
+ (elmo-imap4-send-string session
+ (elmo-base64-encode-string
+ (elmo-network-session-user-internal session)))
+ (or (elmo-imap4-read-continue-req session)
+ (signal 'elmo-authenticate-error '(elmo-imap4-auth-login)))
+ (elmo-imap4-send-string session
+ (elmo-base64-encode-string
+ (elmo-get-passwd
+ (elmo-network-session-password-key session))))
+ (or (elmo-imap4-read-ok session tag)
+ (signal 'elmo-authenticate-error '(elmo-imap4-auth-login)))
+ (setq elmo-imap4-status 'auth)))
+
(luna-define-method
elmo-network-initialize-session-buffer :after ((session
elmo-imap4-session) buffer)
(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
(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
;;; (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
(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))
(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
(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)
(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))
(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.
projects / elisp / wanderlust.git / blobdiff