;;; 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
: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
(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-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.
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.
:stream-type stream-type
:process nil
:greeting nil
- :last-accessed (current-time)
- ))
- (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
+ :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)
(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)
projects / elisp / wanderlust.git / blobdiff