;;; elmo-imap4.el -- IMAP4 Interface for ELMO.
-;; Copyright 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
+;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
+;; Copyright (C) 1999,2000 Kenichi OKADA <okada@opaopa.org>
+;; Copyright (C) 2000 OKAZAKI Tetsurou <okazaki@be.to>
+;; Copyright (C) 2000 Daiki Ueno <ueno@unixuser.org>
;; Author: Yuuichi Teranishi <teranisi@gohome.org>
+;; Kenichi OKADA <okada@opaopa.org>
+;; OKAZAKI Tetsurou <okazaki@be.to>
+;; Daiki Ueno <ueno@unixuser.org>
;; Keywords: mail, net news
;; This file is part of ELMO (Elisp Library for Message Orchestration).
(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.")
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 '(?\\ ?\"))
;;;
(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)
(unless (string= (elmo-imap4-spec-username spec)
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)
+ (setq append-serv
+ (concat append-serv "/" (symbol-name (elmo-imap4-spec-auth spec)))))
(unless (string= (elmo-imap4-spec-hostname spec)
elmo-default-imap4-server)
(setq append-serv (concat append-serv "@" (elmo-imap4-spec-hostname
(setq append-serv (concat append-serv
(elmo-network-stream-type-spec-string
type)))))
- (mapcar (lambda (fld)
- (concat "%" (elmo-imap4-decode-folder-string fld)
- (and append-serv
- (eval append-serv))))
- result)))
+ (if hierarchy
+ (let (folder folders ret)
+ (while (setq folders (car result))
+ (if (prog1
+ (string-match
+ (concat "^\\(" root "[^" delim "]" "+\\)" delim)
+ folders)
+ (setq folder (match-string 1 folders)))
+ (progn
+ (setq ret
+ (append ret (list (list
+ (concat "%" (elmo-imap4-decode-folder-string folder)
+ (and append-serv
+ (eval append-serv)))))))
+ (setq result
+ (delq nil
+ (mapcar '(lambda (fld)
+ (unless
+ (string-match
+ (concat "^" (regexp-quote folder))
+ fld)
+ fld))
+ result))))
+ (setq ret (append ret (list
+ (concat "%" (elmo-imap4-decode-folder-string folders)
+ (and append-serv
+ (eval append-serv))))))
+ (setq result (cdr result))))
+ ret)
+ (mapcar (lambda (fld)
+ (concat "%" (elmo-imap4-decode-folder-string fld)
+ (and append-serv
+ (eval append-serv))))
+ result))))
(defun elmo-imap4-folder-exists-p (spec)
(let ((session (elmo-imap4-get-session 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
is same as MAILBOX.
If second optional argument NO-ERROR is non-nil, don't cause an error when
selecting folder was failed.
-Returns t if selecting folder succeed. Otherwise, nil is returned."
+Returns response value if selecting folder succeed. "
(when (or force
(not (string=
(elmo-imap4-session-current-mailbox-internal session)
(error (or
(elmo-imap4-response-error-text response)
(format "Select %s failed" mailbox))))))
- result)))
+ (and result response))))
(defun elmo-imap4-check-validity (spec validity-file)
;;; Not used.
;;
;; 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)) ")"))))
-;; 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))
(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)))))
(luna-define-method
elmo-network-initialize-session-buffer :after ((session
(luna-define-method elmo-network-initialize-session ((session
elmo-imap4-session))
- (let ((process (elmo-network-session-process-internal session))
- capability)
+ (let ((process (elmo-network-session-process-internal session)))
(with-current-buffer (process-buffer process)
;; Skip garbage output from process before greeting.
(while (and (memq (process-status process) '(open run))
(when (eq (elmo-network-stream-type-symbol
(elmo-network-session-stream-type-internal session))
'starttls)
- (or (memq 'starttls capability)
+ (or (memq 'starttls
+ (elmo-imap4-session-capability-internal session))
(signal 'elmo-open-error
- '(elmo-network-initialize-session)))
+ '(elmo-imap4-starttls-error)))
(elmo-imap4-send-command-wait session "starttls")
(starttls-negotiate process)))))
(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)))))
+ elmo-imap4-session))
+ (with-current-buffer (process-buffer
+ (elmo-network-session-process-internal session))
+ (let* ((auth (elmo-network-session-auth-internal session))
+ (auth (if (listp auth) auth (list auth))))
+ (unless (or (eq elmo-imap4-status 'auth)
+ (null auth))
+ (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
+ (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)))))
+ (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 (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
+ (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))
'fetch)))))
(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
(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