-;;; elmo-net.el -- Network module for ELMO.
+;;; elmo-net.el --- Network module for ELMO.
;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
;;
;;; Commentary:
-;;
+;;
+;;; Code:
+;;
(eval-when-compile (require 'cl))
(require 'elmo-util)
(require 'elmo-cache)
(require 'elmo)
-;;; Code:
-;;
+(defconst elmo-net-folder-name-syntax '((?@ [server ".+"])
+ (?: [port "^[0-9]+$"])
+ (?! stream-type)))
;;; ELMO net folder
(eval-and-compile
(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
auth
stream-type
process
- greeting))
+ greeting
+ last-accessed))
(luna-define-internal-accessors 'elmo-network-session))
(luna-define-generic elmo-network-initialize-session (session)
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))
(delete-process (elmo-network-session-process-internal session))))
(defmacro elmo-network-stream-type-spec-string (stream-type)
- (` (nth 0 (, stream-type))))
+ `(nth 0 ,stream-type))
(defmacro elmo-network-stream-type-symbol (stream-type)
- (` (nth 1 (, stream-type))))
+ `(nth 1 ,stream-type))
(defmacro elmo-network-stream-type-feature (stream-type)
- (` (nth 2 (, stream-type))))
+ `(nth 2 ,stream-type))
(defmacro elmo-network-stream-type-function (stream-type)
- (` (nth 3 (, stream-type))))
+ `(nth 3 ,stream-type))
(defsubst elmo-network-session-password-key (session)
(format "%s:%s/%s@%s:%d"
- (elmo-network-session-name-internal session)
+ (upcase
+ (nth 1 (split-string (symbol-name
+ (luna-class-name session)) "[4-]")))
(elmo-network-session-user-internal session)
(elmo-network-session-auth-internal session)
(elmo-network-session-server-internal session)
(elmo-network-session-port-internal session)))
(defvar elmo-network-session-cache nil)
-(defvar elmo-network-session-name-prefix nil)
(defsubst elmo-network-session-cache-key (name folder)
"Returns session cache key for NAME and FOLDER."
(format "%s:%s/%s@%s:%d%s"
- (concat elmo-network-session-name-prefix name)
+ name
(elmo-net-folder-user-internal folder)
(elmo-net-folder-auth-internal folder)
(elmo-net-folder-server-internal folder)
(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
- (, session)))))
+ `(process-buffer (elmo-network-session-process-internal ,session)))
(defun elmo-network-get-session (class name folder &optional if-exists)
"Get network session from session cache or a new network session.
(let (pair session key)
(if (not (elmo-plugged-p
(elmo-net-folder-server-internal folder)
- (elmo-net-folder-port-internal folder)))
+ (elmo-net-folder-port-internal folder)
+ (elmo-network-stream-type-symbol
+ (elmo-net-folder-stream-type-internal folder))))
(error "Unplugged"))
(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
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.
:auth auth
:stream-type stream-type
:process nil
- :greeting nil))
- (buffer (format " *%s session for %s@%s:%d%s"
- (concat elmo-network-session-name-prefix 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-authenticate-error)
- (elmo-remove-passwd (elmo-network-session-password-key session)))
- (elmo-network-close-session session)
- (signal (car error)(cdr 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)
+ (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)
(elmo-network-stream-type-feature stream-type))
(require (elmo-network-stream-type-feature stream-type)))
(condition-case err
- (let (process-connection-type)
+ (let (process-connection-type)
(as-binary-process
(setq process
(if stream-type
(open-network-stream name buffer server service)))))
(error
(when auto-plugged
- (elmo-set-plugged nil server service stream-type (current-time))
+ (elmo-set-plugged nil server service
+ (elmo-network-stream-type-symbol stream-type)
+ (current-time))
(message "Auto plugged off at %s:%d" server service)
(sit-for 1))
(signal (car err) (cdr err))))
(when process
(process-kill-without-query process)
(when auto-plugged
- (elmo-set-plugged t server service stream-type))
+ (elmo-set-plugged t server service
+ (elmo-network-stream-type-symbol stream-type)))
process)))
(defun elmo-get-network-stream-type (symbol)
(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-number 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)
(apply 'elmo-plugged-p
(append (elmo-net-port-info folder)
(list nil (quote (elmo-net-port-label folder))))))
-
+
(luna-define-method elmo-folder-set-plugged ((folder elmo-net-folder)
plugged &optional add)
(apply 'elmo-set-plugged plugged
(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)
(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))
(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
(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)
(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
+(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)
+ number &optional read)
(if (elmo-folder-plugged-p folder)
(luna-call-next-method)
(if elmo-enable-disconnected-operation
- (elmo-message-encache-dop folder number)
+ (elmo-message-encache-dop folder number read)
(error "Unplugged"))))
(luna-define-generic elmo-message-fetch-plugged (folder number strategy
(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)
projects / elisp / wanderlust.git / blobdiff