(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)
- (defun-maybe sasl-find-mechanism (mechanisms))
- (defun-maybe sasl-make-client (mechanism name service server))
- (defun-maybe sasl-mechanism-name (client))
- (defun-maybe sasl-next-step (client step))
- (defun-maybe sasl-step-data (step))
- (defun-maybe sasl-step-set-data (step data)))
+(eval-when-compile (require 'cl))
(defvar elmo-imap4-use-lock t
"USE IMAP4 with locking process.")
elmo-imap4-status-callback-data
elmo-imap4-current-msgdb))
+(defvar elmo-imap4-display-literal-progress nil)
;;;;
(defconst elmo-imap4-quoted-specials-list '(?\\ ?\"))
;;;
(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)
+ (or elmo-default-imap4-authenticate-type 'clear))
(setq append-serv
(concat append-serv "/" (symbol-name (elmo-imap4-spec-auth spec)))))
(unless (string= (elmo-imap4-spec-hostname spec)
(mapcar '(lambda (fld)
(unless
(string-match
- (concat "^" (regexp-quote folder))
+ (concat "^" (regexp-quote folder) delim)
fld)
fld))
result))))
(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-session-select-mailbox session
+ (elmo-imap4-spec-mailbox 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
"search %s") flag))
'search)))
-(defun elmo-imap4-list-folder (spec)
- (let ((killed (and elmo-use-killed-list
- (elmo-msgdb-killed-list-load
- (elmo-msgdb-expand-path spec))))
- numbers)
- (setq numbers (elmo-imap4-list spec "all"))
+(defun elmo-imap4-list-folder (spec &optional nohide)
+ (let* ((killed (and elmo-use-killed-list
+ (elmo-msgdb-killed-list-load
+ (elmo-msgdb-expand-path spec))))
+ (max (elmo-msgdb-max-of-killed killed))
+ numbers)
+ (setq numbers (elmo-imap4-list spec
+ (if (or nohide
+ (null (eq max 0)))
+ (format "uid %d:*" (1+ max))
+ "all")))
(elmo-living-messages numbers killed)))
(defun elmo-imap4-list-folder-unread (spec number-alist mark-alist
;;
;; 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))
- (if (eq 'plain (car auth))
- (elmo-imap4-login session)
+ (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-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-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)))
- (signal 'elmo-authenticate-error
- (list (intern
- (concat "elmo-imap4-auth-"
- (downcase name))))))
+ (setq response
+ (elmo-imap4-read-untagged
+ (elmo-network-session-process-internal session)))
+ (if (elmo-imap4-response-ok-p response)
+ (if (sasl-next-step client step)
+ ;; Bogus server?
+ (signal 'elmo-authenticate-error
+ (list (intern
+ (concat "elmo-imap4-auth-"
+ (downcase name)))))
+ ;; The authentication process is finished.
+ (throw 'done nil)))
+ (unless (elmo-imap4-response-continue-req-p response)
+ ;; response is NO or BAD.
+ (signal 'elmo-authenticate-error
+ (list (intern
+ (concat "elmo-imap4-auth-"
+ (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))
(with-current-buffer (elmo-network-session-buffer session)
(setq elmo-imap4-fetch-callback nil)
(setq elmo-imap4-fetch-callback-data nil))
- (elmo-delete-cr
- (elmo-imap4-response-bodydetail-text
- (elmo-imap4-response-value-all
- (elmo-imap4-send-command-wait session
- (format
- (if elmo-imap4-use-uid
- "uid fetch %s body.peek[%s]"
- "fetch %s body.peek[%s]")
- msg part))
- 'fetch)))))
+ (unless elmo-inhibit-display-retrieval-progress
+ (setq elmo-imap4-display-literal-progress t))
+ (prog1
+ (unwind-protect
+ (elmo-delete-cr
+ (elmo-imap4-response-bodydetail-text
+ (elmo-imap4-response-value-all
+ (elmo-imap4-send-command-wait session
+ (format
+ (if elmo-imap4-use-uid
+ "uid fetch %s body.peek[%s]"
+ "fetch %s body.peek[%s]")
+ msg part))
+ 'fetch)))
+ (setq elmo-imap4-display-literal-progress nil))
+ (unless elmo-inhibit-display-retrieval-progress
+ (elmo-display-progress 'elmo-imap4-display-literal-progress
+ "" 100) ; remove progress bar.
+ (message "Retrieving...done.")))))
(defun elmo-imap4-prefetch-msg (spec msg outbuf)
- (elmo-imap4-read-msg spec msg outbuf 'unseen))
+ (elmo-imap4-read-msg spec msg outbuf nil '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
(with-current-buffer (elmo-network-session-buffer session)
(setq elmo-imap4-fetch-callback nil)
(setq elmo-imap4-fetch-callback-data nil))
- (setq response
- (elmo-imap4-send-command-wait session
- (format
- (if elmo-imap4-use-uid
- "uid fetch %s rfc822%s"
- "fetch %s rfc822%s")
- msg
- (if leave-seen-flag-untouched
- ".peek" ""))))
- (and (setq response (elmo-imap4-response-value
+ (unless elmo-inhibit-display-retrieval-progress
+ (setq elmo-imap4-display-literal-progress t))
+ (unwind-protect
+ (setq response
+ (elmo-imap4-send-command-wait session
+ (format
+ (if elmo-imap4-use-uid
+ "uid fetch %s body%s[]"
+ "fetch %s body%s[]")
+ msg
+ (if leave-seen-flag-untouched
+ ".peek" ""))))
+ (setq elmo-imap4-display-literal-progress nil))
+ (unless elmo-inhibit-display-retrieval-progress
+ (elmo-display-progress 'elmo-imap4-display-literal-progress
+ "" 100) ; remove progress bar.
+ (message "Retrieving...done."))
+ (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-append-msg (spec string &optional msg no-see)
(let ((session (elmo-imap4-get-session spec))
- send-buf)
+ send-buf result)
(elmo-imap4-session-select-mailbox session
(elmo-imap4-spec-mailbox spec))
(setq send-buf (elmo-imap4-setup-send-buffer string))
(unwind-protect
- (elmo-imap4-send-command-wait
- session
- (list
- "append "
- (elmo-imap4-mailbox (elmo-imap4-spec-mailbox spec))
- (if no-see " " " (\\Seen) ")
- (elmo-imap4-buffer-literal send-buf)))
- (kill-buffer send-buf)))
- t)
+ (setq result (elmo-imap4-send-command-wait
+ session
+ (list
+ "append "
+ (elmo-imap4-mailbox (elmo-imap4-spec-mailbox spec))
+ (if no-see " " " (\\Seen) ")
+ (elmo-imap4-buffer-literal send-buf))))
+ (kill-buffer send-buf))
+ result))
(defun elmo-imap4-copy-msgs (dst-spec
msgs src-spec &optional expunge-it same-number)
nil t)
(if (match-string 1)
(if (< (point-max) (+ (point) (string-to-number (match-string 1))))
- nil
+ (progn
+ (if (and elmo-imap4-display-literal-progress
+ (> (string-to-number (match-string 1))
+ (min elmo-display-retrieval-progress-threshold 100)))
+ (elmo-display-progress
+ 'elmo-imap4-display-literal-progress
+ (format "Retrieving (%d/%d bytes)..."
+ (- (point-max) (point))
+ (string-to-number (match-string 1)))
+ (/ (- (point-max) (point))
+ (/ (string-to-number (match-string 1)) 100))))
+ nil)
(goto-char (+ (point) (string-to-number (match-string 1))))
(elmo-imap4-find-next-line))
(point))))
(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.