X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;ds=sidebyside;f=elmo%2Felmo-net.el;h=c1f1bdb57e1ad7bf930a80245557ff612147ebaa;hb=44a57cc09a5b8df1f493a0ac9fdae8041a76f44b;hp=0fe45a3cfdd9f07f1152bd419f1acafa91acc55f;hpb=3c569cdabc17804bf00b8a738e12f0664ca520e7;p=elisp%2Fwanderlust.git diff --git a/elmo/elmo-net.el b/elmo/elmo-net.el index 0fe45a3..c1f1bdb 100644 --- a/elmo/elmo-net.el +++ b/elmo/elmo-net.el @@ -37,6 +37,10 @@ ;;; Code: ;; +(defconst elmo-net-folder-name-syntax '((?@ [server ".+"]) + (?: [port "^[0-9]+$"]) + (?! stream-type))) + ;;; ELMO net folder (eval-and-compile (luna-define-class elmo-net-folder @@ -56,6 +60,22 @@ (defvar sasl-mechanisms) +(defcustom elmo-network-session-idle-timeout nil + "Idle timeout of the network cache. Specified in seconds. +If elapsed time since last access is larger than this value, +cached session is not reused. +If nil, network cache is reused." + :type '(choice number (const nil)) + :group 'elmo) + +(defcustom elmo-network-session-retry-count nil + "Retry count for authentication when open network session. +If nil, just once. If t, until success." + :type '(choice (integer :tag "Times") + (const :tag "Just once" nil) + (const :tag "Until success" t)) + :group 'elmo) + ;;; Code: ;; (eval-and-compile @@ -66,7 +86,8 @@ auth stream-type process - greeting)) + greeting + last-accessed)) (luna-define-internal-accessors 'elmo-network-session)) (luna-define-generic elmo-network-initialize-session (session) @@ -88,7 +109,7 @@ elmo-network-initialize-session-buffer ((session elmo-network-session) buffer) (with-current-buffer buffer - (elmo-set-buffer-multibyte nil) + (set-buffer-multibyte nil) (buffer-disable-undo (current-buffer)))) (luna-define-method elmo-network-close-session ((session elmo-network-session)) @@ -142,6 +163,16 @@ (elmo-network-close-session (cdr pair))) (setq elmo-network-session-cache nil)) +(defsubst elmo-network-session-buffer-name (session) + (format " *%s session for %s@%s:%d%s" + (elmo-network-session-name-internal session) + (elmo-network-session-user-internal session) + (elmo-network-session-server-internal session) + (elmo-network-session-port-internal session) + (or (elmo-network-stream-type-spec-string + (elmo-network-session-stream-type-internal session)) + ""))) + (defmacro elmo-network-session-buffer (session) "Get buffer for SESSION." (` (process-buffer (elmo-network-session-process-internal @@ -166,16 +197,26 @@ if making session failed, returns nil." (setq pair (assoc (setq key (elmo-network-session-cache-key name folder)) elmo-network-session-cache)) (when (and pair - (not (memq (process-status - (elmo-network-session-process-internal - (cdr pair))) - '(open run)))) + (or (not (memq (process-status + (elmo-network-session-process-internal + (cdr pair))) + '(open run))) + (and elmo-network-session-idle-timeout + (elmo-network-session-last-accessed-internal + (cdr pair)) + (elmo-time-expire + (elmo-network-session-last-accessed-internal + (cdr pair)) + elmo-network-session-idle-timeout)))) (setq elmo-network-session-cache (delq pair elmo-network-session-cache)) (elmo-network-close-session (cdr pair)) (setq pair nil)) (if pair - (cdr pair) ; connection cache exists. + (progn + (elmo-network-session-set-last-accessed-internal + (cdr pair) (current-time)) + (cdr pair)) ; connection cache exists. (unless if-exists (setq session (elmo-network-open-session @@ -191,6 +232,15 @@ if making session failed, returns nil." elmo-network-session-cache)) session)))) +(defun elmo-network-session-buffer-create (session) + (let ((buffer-name (elmo-network-session-buffer-name session)) + buffer) + (when (get-buffer buffer-name) + (kill-buffer buffer-name)) + (setq buffer (get-buffer-create buffer-name)) + (elmo-network-initialize-session-buffer session buffer) + buffer)) + (defun elmo-network-open-session (class name server port user auth stream-type) "Open an authenticated network session. @@ -211,40 +261,42 @@ Returns a process object. if making session failed, returns nil." :auth auth :stream-type stream-type :process nil - :greeting nil)) - (buffer (format " *%s session for %s@%s:%d%s" - name - user - server - port - (or (elmo-network-stream-type-spec-string stream-type) - ""))) - process) - (condition-case error - (progn - (if (get-buffer buffer) (kill-buffer buffer)) - (setq buffer (get-buffer-create buffer)) - (elmo-network-initialize-session-buffer session buffer) - (elmo-network-session-set-process-internal - session - (setq process (elmo-open-network-stream - (elmo-network-session-name-internal session) - buffer server port stream-type))) - (when process + :greeting nil + :last-accessed (current-time))) + (retry elmo-network-session-retry-count) + success) + (while (not success) + (condition-case error + (when (elmo-network-session-set-process-internal + session + (elmo-open-network-stream + (elmo-network-session-name-internal session) + (elmo-network-session-buffer-create session) + server port stream-type)) (elmo-network-initialize-session session) (elmo-network-authenticate-session session) - (elmo-network-setup-session session))) - (error - (when (eq (car error) 'elmo-open-error) + (elmo-network-setup-session session) + (setq success t)) + (elmo-authenticate-error + (elmo-remove-passwd (elmo-network-session-password-key session)) + (message "Authetication is failed") + (sit-for 1) + (elmo-network-close-session session) + (unless (if (numberp retry) + (> (setq retry (1- retry)) 0) + retry) + (signal (car error) (cdr error)))) + (elmo-open-error (elmo-set-plugged nil server port (elmo-network-stream-type-symbol stream-type) (current-time)) (message "Auto plugged off at %s:%d :%s" server port (cadr error)) - (sit-for 1)) - (when (eq (car error) 'elmo-authenticate-error) - (elmo-remove-passwd (elmo-network-session-password-key session))) - (elmo-network-close-session session) - (signal (car error)(cdr error)))) + (sit-for 1) + (elmo-network-close-session session) + (signal (car error) (cdr error))) + (error + (elmo-network-close-session session) + (signal (car error) (cdr error))))) session)) (defun elmo-open-network-stream (name buffer server service stream-type) @@ -289,25 +341,35 @@ Returned value is searched from `elmo-network-stream-type-alist'." (setq alist (cdr alist))) spec)) -(luna-define-method elmo-folder-initialize ((folder - elmo-net-folder) - name) +(defun elmo-net-folder-set-parameters (folder params &optional defaults) + (let ((port (cdr (assq 'port params))) + (stream-type (cdr (assq 'stream-type params)))) + ;; server + (elmo-net-folder-set-server-internal + folder + (or (cdr (assq 'server params)) + (plist-get defaults :server))) + ;; port + (elmo-net-folder-set-port-internal + folder + (or (and port (string-to-int port)) + (plist-get defaults :port))) + ;; stream-type + (elmo-net-folder-set-stream-type-internal + folder + (or (and stream-type + (assoc (concat "!" stream-type) elmo-network-stream-type-alist)) + (plist-get defaults :stream-type))))) + +(luna-define-method elmo-folder-initialize ((folder elmo-net-folder) name) ;; user and auth should be set in subclass. (when (string-match "\\(@[^@:/!]+\\)?\\(:[0-9]+\\)?\\(!.*\\)?$" name) - (if (match-beginning 1) - (elmo-net-folder-set-server-internal - folder - (elmo-match-substring 1 name 1))) - (if (match-beginning 2) - (elmo-net-folder-set-port-internal - folder - (string-to-int (elmo-match-substring 2 name 1)))) - (if (match-beginning 3) - (elmo-net-folder-set-stream-type-internal - folder - (assoc (elmo-match-string 3 name) - elmo-network-stream-type-alist))) - (substring name 0 (match-beginning 0)))) + (elmo-net-folder-set-parameters + folder + (car (elmo-parse-separated-tokens + (substring name (match-beginning 0)) + elmo-net-folder-name-syntax)))) + folder) (luna-define-method elmo-net-port-info ((folder elmo-net-folder)) (list (elmo-net-folder-server-internal folder) @@ -335,10 +397,21 @@ Returned value is searched from `elmo-network-stream-type-alist'." (append (elmo-net-port-info folder) (list nil nil (quote (elmo-net-port-label folder)) add)))) +(luna-define-method elmo-folder-create ((folder elmo-net-folder)) + (if (elmo-folder-plugged-p folder) + (elmo-folder-send folder 'elmo-folder-create-plugged) + (elmo-folder-send folder 'elmo-folder-create-unplugged))) + +(luna-define-method elmo-folder-create-unplugged ((folder elmo-net-folder)) + (if elmo-enable-disconnected-operation + (elmo-folder-create-dop folder) + (error "Unplugged"))) + (luna-define-method elmo-folder-exists-p ((folder elmo-net-folder)) (if (elmo-folder-plugged-p folder) (elmo-folder-send folder 'elmo-folder-exists-p-plugged) - t)) ; If unplugged, assume the folder exists. + ;; If unplugged, guess by msgdb. + (file-directory-p (elmo-folder-msgdb-path folder)))) (luna-define-method elmo-folder-status ((folder elmo-net-folder)) (if (elmo-folder-plugged-p folder) @@ -351,6 +424,17 @@ Returned value is searched from `elmo-network-stream-type-alist'." (elmo-folder-status-dop folder) (error "Unplugged"))) +(luna-define-method elmo-folder-next-message-number ((folder elmo-net-folder)) + (if (elmo-folder-plugged-p folder) + (elmo-folder-send folder 'elmo-folder-next-message-number-plugged) + (elmo-folder-send folder 'elmo-folder-next-message-number-unplugged))) + +(luna-define-method elmo-folder-next-message-number-unplugged + ((folder elmo-net-folder)) + (if elmo-enable-disconnected-operation + (elmo-folder-next-message-number-dop folder) + (error "Unplugged"))) + (luna-define-method elmo-folder-list-messages-internal ((folder elmo-net-folder) &optional nohide) (elmo-net-folder-list-messages-internal folder nohide)) @@ -362,7 +446,7 @@ Returned value is searched from `elmo-network-stream-type-alist'." (luna-define-method elmo-folder-list-messages-plugged ((folder elmo-net-folder)) - t) + nil) ;; Should consider offline append and removal. (luna-define-method elmo-folder-list-messages-unplugged ((folder @@ -374,41 +458,30 @@ Returned value is searched from `elmo-network-stream-type-alist'." (elmo-delete-if (lambda (number) (memq number deleting)) ;; current number-list. - (mapcar - 'car - (elmo-msgdb-get-number-alist (elmo-folder-msgdb folder)))) + (elmo-folder-list-messages folder nil 'in-msgdb)) ;; append appending messages (mapcar (lambda (x) (* -1 x)) (elmo-dop-spool-folder-list-messages folder)))) - (error "Unplugged"))) - -(luna-define-method elmo-folder-list-unreads-internal - ((folder elmo-net-folder) unread-marks &optional mark-alist) - (if (and (elmo-folder-plugged-p folder) - (elmo-folder-use-flag-p folder)) - (elmo-folder-send folder 'elmo-folder-list-unreads-plugged) t)) -(luna-define-method elmo-folder-list-importants-internal - ((folder elmo-net-folder) important-mark) +(luna-define-method elmo-folder-list-flagged-internal ((folder elmo-net-folder) + flag) (if (and (elmo-folder-plugged-p folder) (elmo-folder-use-flag-p folder)) - (elmo-folder-send folder 'elmo-folder-list-importants-plugged) + (elmo-folder-send folder 'elmo-folder-list-flagged-plugged flag) + ;; Should consider offline append and removal? t)) -(luna-define-method elmo-folder-list-unreads-plugged - ((folder elmo-net-folder)) - t) - -(luna-define-method elmo-folder-list-importants-plugged - ((folder elmo-net-folder)) +(luna-define-method elmo-folder-list-flagged-plugged ((folder elmo-net-folder) + flag) t) -(luna-define-method elmo-folder-delete-messages ((folder elmo-net-folder) - numbers) - (if (elmo-folder-plugged-p folder) - (elmo-folder-send folder 'elmo-folder-delete-messages-plugged numbers) - (elmo-folder-send folder 'elmo-folder-delete-messages-unplugged numbers))) +(luna-define-method elmo-folder-delete-messages-internal ((folder + elmo-net-folder) + numbers) + (if (elmo-folder-plugged-p folder) + (elmo-folder-send folder 'elmo-folder-delete-messages-plugged numbers) + (elmo-folder-send folder 'elmo-folder-delete-messages-unplugged numbers))) (luna-define-method elmo-folder-delete-messages-unplugged ((folder elmo-net-folder) @@ -416,91 +489,56 @@ Returned value is searched from `elmo-network-stream-type-alist'." (elmo-folder-delete-messages-dop folder numbers)) (luna-define-method elmo-folder-msgdb-create ((folder elmo-net-folder) - numbers new-mark - already-mark seen-mark - important-mark seen-list) + numbers flag-table) (if (elmo-folder-plugged-p folder) (elmo-folder-send folder 'elmo-folder-msgdb-create-plugged - numbers - new-mark - already-mark seen-mark - important-mark seen-list) + numbers flag-table) (elmo-folder-send folder 'elmo-folder-msgdb-create-unplugged - numbers - new-mark already-mark seen-mark - important-mark seen-list))) + numbers flag-table))) (luna-define-method elmo-folder-msgdb-create-unplugged ((folder elmo-net-folder) numbers - new-mark already-mark - seen-mark - important-mark - seen-list) + flag-table) ;; XXXX should be appended to already existing msgdb. (elmo-dop-msgdb (elmo-folder-msgdb-create (elmo-dop-spool-folder folder) (mapcar 'abs numbers) - new-mark already-mark - seen-mark - important-mark - seen-list))) - -(luna-define-method elmo-folder-unmark-important ((folder elmo-net-folder) - numbers) - (if (elmo-folder-use-flag-p folder) - (if (elmo-folder-plugged-p folder) - (elmo-folder-send folder 'elmo-folder-unmark-important-plugged - numbers) - (elmo-folder-send folder - 'elmo-folder-unmark-important-unplugged numbers)) - t)) - -(luna-define-method elmo-folder-mark-as-important ((folder elmo-net-folder) - numbers) - (if (elmo-folder-use-flag-p folder) - (if (elmo-folder-plugged-p folder) - (elmo-folder-send folder 'elmo-folder-mark-as-important-plugged - numbers) - (elmo-folder-send folder 'elmo-folder-mark-as-important-unplugged - numbers)) - t)) - -(luna-define-method elmo-folder-unmark-read ((folder elmo-net-folder) - numbers) - (if (elmo-folder-use-flag-p folder) - (if (elmo-folder-plugged-p folder) - (elmo-folder-send folder 'elmo-folder-unmark-read-plugged numbers) - (elmo-folder-send folder 'elmo-folder-unmark-read-unplugged numbers)) - t)) - -(luna-define-method elmo-folder-mark-as-read ((folder elmo-net-folder) - numbers) - (if (elmo-folder-use-flag-p folder) - (if (elmo-folder-plugged-p folder) - (elmo-folder-send folder 'elmo-folder-mark-as-read-plugged numbers) - (elmo-folder-send - folder 'elmo-folder-mark-as-read-unplugged numbers)) - t)) - -(luna-define-method elmo-folder-mark-as-read-unplugged ((folder - elmo-net-folder) - numbers) - (elmo-folder-mark-as-read-dop folder numbers)) - -(luna-define-method elmo-folder-unmark-read-unplugged ((folder elmo-net-folder) - numbers) - (elmo-folder-unmark-read-dop folder numbers)) + flag-table))) + +(luna-define-method elmo-folder-set-flag :before ((folder elmo-net-folder) + numbers + flag + &optional is-local) + (when (and (not is-local) + (elmo-folder-use-flag-p folder)) + (elmo-folder-send folder + (if (elmo-folder-plugged-p folder) + 'elmo-folder-set-flag-plugged + 'elmo-folder-set-flag-unplugged) + numbers + flag))) + +(luna-define-method elmo-folder-unset-flag :before ((folder elmo-net-folder) + numbers + flag + &optional is-local) + (when (and (not is-local) + (elmo-folder-use-flag-p folder)) + (elmo-folder-send folder + (if (elmo-folder-plugged-p folder) + 'elmo-folder-unset-flag-plugged + 'elmo-folder-unset-flag-unplugged) + numbers + flag))) -(luna-define-method elmo-folder-mark-as-important-unplugged ((folder - elmo-net-folder) - numbers) - (elmo-folder-mark-as-important-dop folder numbers)) +(luna-define-method elmo-folder-set-flag-unplugged ((folder elmo-net-folder) + numbers flag) + (elmo-folder-set-flag-dop folder numbers flag)) -(luna-define-method elmo-folder-unmark-important-unplugged ((folder - elmo-net-folder) - numbers) - (elmo-folder-unmark-important-dop folder numbers)) +(luna-define-method elmo-folder-unset-flag-unplugged ((folder elmo-net-folder) + numbers flag) + (elmo-folder-unset-flag-dop folder numbers flag)) (luna-define-method elmo-message-encache :around ((folder elmo-net-folder) number &optional read) @@ -552,8 +590,7 @@ Returned value is searched from `elmo-network-stream-type-alist'." (if (elmo-folder-plugged-p folder) (elmo-folder-send folder 'elmo-folder-check-plugged))) -(luna-define-method elmo-folder-diff :around ((folder elmo-net-folder) - &optional numbers) +(luna-define-method elmo-folder-diff :around ((folder elmo-net-folder)) (if (and (elmo-folder-use-flag-p folder) (elmo-folder-plugged-p folder)) (elmo-folder-send folder 'elmo-folder-diff-plugged)