Set default as 'user.
* mmelmo-imap4-2.el (mmelmo-imap4-get-mime-entity): Rewrite.
* elmo2.el (elmo-quit): Don't use `elmo-pop3-flush-connection'
and `elmo-imap4-flush-connection'.
* elmo-util.el (toplevel): Removed workaround for timezone y2k.
(elmo-pop3-get-spec): Assume auth as symbol.
(elmo-open-network-stream): Moved to `elmo-net'.
* elmo-pop3.el (toplevel): Require 'elmo-net.
Define `sasl-cram-md5' to silence byte compilier.
(elmo-pop3-connection-cache) Abolished.
(elmo-pop3-authenticator-alist) New variable.
(elmo-pop3-session): Define.
(elmo-pop3-connection-get-process): Abolished.
(elmo-pop3-connection-get-buffer): Ditto.
(elmo-pop3-close-connection): Ditto.
(elmo-pop3-flush-connection): Ditto.
(elmo-pop3-get-connection): Ditto.
(elmo-pop3-get-session): New function.
(Replacement for `elmo-pop3-get-connection').
All other related modules are changed.
(elmo-network-close-session): Define.
(elmo-pop3-send-command): Abolished argument `buffer'.
All other related modules are changed.
(elmo-pop3-read-response): Likewise.
(elmo-pop3-open-connection): Abolished.
(elmo-pop3-auth-user): New function.
(elmo-pop3-auth-apop): Ditto.
(elmo-pop3-auth-cram-md5): Ditto.
(elmo-pop3-auth-scram-md5): Ditto.
(elmo-pop3-auth-digest-md5): Ditto.
(elmo-network-initialize-session): Define.
(elmo-network-authenticate-session): Ditto.
(elmo-network-setup-session): Ditto.
* elmo-imap4.el (toplevel): Require 'elmo-net.
(elmo-imap4-session): Define.
(elmo-imap4-connection-cache): Abolished.
(elmo-imap4-password-key): Ditto.
(elmo-imap4-flush-connection): Ditto.
(elmo-imap4-get-connection): Ditto.
All other related modules are changed.
(elmo-imap4-get-session): New function
(Replacement for `elmo-imap4-get-connection').
(elmo-imap4-read-response): Abolished argument `buffer'.
All other related modules are changed.
(elmo-imap4-send-command): Likewise.
(elmo-imap4-select-folder): Abolished.
All other related modules are changed.
(elmo-imap4-select-mailbox): New function.
(Replacement for `elmo-imap4-select-folder').
(elmo-imap4-auth-login): Simplify.
(Assume current buffer as process buffer)
(elmo-imap4-auth-cram-md5): Ditto.
(elmo-imap4-auth-digest-md5): Ditto.
(elmo-imap4-login): Ditto.
(elmo-imap4-open-connection): Abolished.
(elmo-imap4-open-connection-1): Abolished.
(elmo-network-initialize-sessoin): Define.
(elmo-network-authenticate-session): Ditto.
(elmo-network-setup-session): Ditto.
* elmo-net.el: New module.
+2000-08-23 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * elmo-vars.el (elmo-default-pop3-authenticate-type):
+ Set default as 'user.
+
+ * mmelmo-imap4-2.el (mmelmo-imap4-get-mime-entity): Rewrite.
+
+ * elmo2.el (elmo-quit): Don't use `elmo-pop3-flush-connection'
+ and `elmo-imap4-flush-connection'.
+
+ * elmo-util.el (toplevel): Removed workaround for timezone y2k.
+ (elmo-pop3-get-spec): Assume auth as symbol.
+ (elmo-open-network-stream): Moved to `elmo-net'.
+
+ * elmo-pop3.el (toplevel): Require 'elmo-net.
+ Define `sasl-cram-md5' to silence byte compilier.
+ (elmo-pop3-connection-cache) Abolished.
+ (elmo-pop3-authenticator-alist) New variable.
+ (elmo-pop3-session): Define.
+ (elmo-pop3-connection-get-process): Abolished.
+ (elmo-pop3-connection-get-buffer): Ditto.
+ (elmo-pop3-close-connection): Ditto.
+ (elmo-pop3-flush-connection): Ditto.
+ (elmo-pop3-get-connection): Ditto.
+ (elmo-pop3-get-session): New function.
+ (Replacement for `elmo-pop3-get-connection').
+ All other related modules are changed.
+ (elmo-network-close-session): Define.
+ (elmo-pop3-send-command): Abolished argument `buffer'.
+ All other related modules are changed.
+ (elmo-pop3-read-response): Likewise.
+ (elmo-pop3-open-connection): Abolished.
+ (elmo-pop3-auth-user): New function.
+ (elmo-pop3-auth-apop): Ditto.
+ (elmo-pop3-auth-cram-md5): Ditto.
+ (elmo-pop3-auth-scram-md5): Ditto.
+ (elmo-pop3-auth-digest-md5): Ditto.
+ (elmo-network-initialize-session): Define.
+ (elmo-network-authenticate-session): Ditto.
+ (elmo-network-setup-session): Ditto.
+
+ * elmo-imap4.el (toplevel): Require 'elmo-net.
+ (elmo-imap4-session): Define.
+ (elmo-imap4-connection-cache): Abolished.
+ (elmo-imap4-password-key): Ditto.
+ (elmo-imap4-flush-connection): Ditto.
+ (elmo-imap4-get-connection): Ditto.
+ All other related modules are changed.
+ (elmo-imap4-get-session): New function
+ (Replacement for `elmo-imap4-get-connection').
+ (elmo-imap4-read-response): Abolished argument `buffer'.
+ All other related modules are changed.
+ (elmo-imap4-send-command): Likewise.
+ (elmo-imap4-select-folder): Abolished.
+ All other related modules are changed.
+ (elmo-imap4-select-mailbox): New function.
+ (Replacement for `elmo-imap4-select-folder').
+ (elmo-imap4-auth-login): Simplify.
+ (Assume current buffer as process buffer)
+ (elmo-imap4-auth-cram-md5): Ditto.
+ (elmo-imap4-auth-digest-md5): Ditto.
+ (elmo-imap4-login): Ditto.
+ (elmo-imap4-open-connection): Abolished.
+ (elmo-imap4-open-connection-1): Abolished.
+ (elmo-network-initialize-sessoin): Define.
+ (elmo-network-authenticate-session): Ditto.
+ (elmo-network-setup-session): Ditto.
+
+ * elmo-net.el: New module.
+
2000-08-22 Daiki Ueno <ueno@unixuser.org>
* elmo-util.el (elmo-define-error): New function.
;;; Commentary:
;;
-
(require 'elmo-vars)
(require 'elmo-util)
(require 'elmo-msgdb)
(require 'elmo-date)
(require 'elmo-cache)
+(require 'elmo-net)
(require 'utf7)
;;; Code:
;;
(defvar elmo-imap4-seq-prefix "elmo-imap4")
(defvar elmo-imap4-seqno 0)
-(defvar elmo-imap4-connection-cache nil
- "Cache of imap connection.")
(defvar elmo-imap4-use-uid t
"Use UID as message number.")
(digest-md5 elmo-imap4-auth-digest-md5))
"Definition of authenticators.")
+(eval-and-compile
+ (luna-define-class elmo-imap4-session (elmo-network-session)
+ (capability current-mailbox))
+ (luna-define-internal-accessors 'elmo-imap4-session))
+
(defconst elmo-imap4-quoted-specials-list '(?\\ ?\"))
(defconst elmo-imap4-non-atom-char-regex
'(("^{.*/nntp}.*$" . ".")) ; Default is for UW's remote nntp mailbox...
"Extra namespace alist. A list of cons cell like: (REGEXP . DELIMITER) ")
-(defvar elmo-imap4-password-key nil)
-
;; buffer local variable
(defvar elmo-imap4-server-capability nil)
(defvar elmo-imap4-server-namespace nil)
(std11-wrap-as-quoted-pairs string elmo-imap4-quoted-specials-list)
"\""))
-(defun elmo-imap4-flush-connection ()
- (interactive)
- (let ((cache elmo-imap4-connection-cache)
- buffer process)
- (while cache
- (setq buffer (car (cdr (car cache))))
- (if buffer (kill-buffer buffer))
- (setq process (car (cdr (cdr (car cache)))))
- (if process (delete-process process))
- (setq cache (cdr cache)))
- (setq elmo-imap4-connection-cache nil)))
-
-(defsubst elmo-imap4-get-process (spec)
- (elmo-imap4-connection-get-process (elmo-imap4-get-connection spec)))
-
(defun elmo-imap4-process-folder-list (string)
(with-temp-buffer
(let ((case-fold-search t)
"\\'")
root)))
(setq root (concat root delim)))
- (elmo-imap4-send-command (process-buffer process)
- process
+ (elmo-imap4-send-command process
(list "list " (elmo-imap4-mailbox root) " *"))
- (setq response (elmo-imap4-read-response (process-buffer process)
- process))
+ (setq response (elmo-imap4-read-response process))
(setq result (elmo-imap4-process-folder-list response))
(unless (string= (elmo-imap4-spec-username spec)
elmo-default-imap4-user)
(eval append-serv))))
result))))
+(defun elmo-imap4-get-process (spec)
+ (elmo-network-session-process-internal
+ (elmo-imap4-get-session spec)))
+
(defun elmo-imap4-folder-exists-p (spec)
(let ((process (elmo-imap4-get-process spec)))
- (elmo-imap4-send-command (process-buffer process)
- process
+ (elmo-imap4-send-command process
(list "status "
- (elmo-imap4-mailbox (elmo-imap4-spec-mailbox spec))
+ (elmo-imap4-mailbox
+ (elmo-imap4-spec-mailbox spec))
" (messages)"))
- (elmo-imap4-read-response (process-buffer process) process)))
+ (elmo-imap4-read-response process)))
(defun elmo-imap4-folder-creatable-p (spec)
t)
;;; For UW imapd 4.6, this workaround is needed to create #mh mailbox.
;;; (if (string-match "^\\(#mh/\\).*[^/]$" folder)
;;; (setq folder (concat folder "/"))) ;; make directory
- (elmo-imap4-send-command (process-buffer process)
- process
+ (elmo-imap4-send-command process
(list "create " (elmo-imap4-mailbox folder)))
- (if (null (elmo-imap4-read-response (process-buffer process)
- process))
+ (if (null (elmo-imap4-read-response process))
(error "Create folder %s failed" folder)
t))))
(when (elmo-imap4-spec-mailbox spec)
(when (setq msgs (elmo-imap4-list-folder spec))
(elmo-imap4-delete-msgs spec msgs))
- (elmo-imap4-send-command (process-buffer process) process "close")
- (elmo-imap4-read-response (process-buffer process) process)
- (elmo-imap4-send-command (process-buffer process)
- process
+ (elmo-imap4-send-command process "close")
+ (elmo-imap4-read-response process)
+ (elmo-imap4-send-command process
(list "delete "
(elmo-imap4-mailbox
(elmo-imap4-spec-mailbox spec))))
- (if (null (elmo-imap4-read-response (process-buffer process)
- process))
+ (if (null (elmo-imap4-read-response process))
(error "Delete folder %s failed" (elmo-imap4-spec-mailbox spec))
t))))
(defun elmo-imap4-rename-folder (old-spec new-spec)
(let ((process (elmo-imap4-get-process old-spec)))
(when (elmo-imap4-spec-mailbox old-spec)
- (elmo-imap4-send-command (process-buffer process) process "close")
- (elmo-imap4-read-response (process-buffer process) process)
- (elmo-imap4-send-command (process-buffer process)
- process
+ (elmo-imap4-send-command process "close")
+ (elmo-imap4-read-response process)
+ (elmo-imap4-send-command process
(list "rename "
(elmo-imap4-mailbox
(elmo-imap4-spec-mailbox old-spec))
(elmo-imap4-mailbox
(elmo-imap4-spec-mailbox new-spec))
))
- (if (null (elmo-imap4-read-response (process-buffer process) process))
+ (if (null (elmo-imap4-read-response process))
(error "Rename folder from %s to %s failed"
(elmo-imap4-spec-mailbox old-spec)
(elmo-imap4-spec-mailbox new-spec))
(save-excursion
(let* ((process (elmo-imap4-get-process spec))
response)
- (elmo-imap4-send-command (process-buffer process)
- process
+ (elmo-imap4-send-command process
(list "status "
(elmo-imap4-mailbox
(elmo-imap4-spec-mailbox spec))
" (uidnext messages)"))
- (setq response (elmo-imap4-read-response (process-buffer process)
- process))
+ (setq response (elmo-imap4-read-response process))
(when (and response (string-match
"\\* STATUS [^(]* \\(([^)]*)\\)" response))
(setq response (read (downcase (elmo-match-string 1 response))))
(cons (- (cadr (memq 'uidnext response)) 1)
(cadr (memq 'messages response)))))))
-(defun elmo-imap4-get-connection (spec)
- "Return opened IMAP connection for SPEC."
- (let* ((user (elmo-imap4-spec-username spec))
- (host (elmo-imap4-spec-hostname spec))
- (port (elmo-imap4-spec-port spec))
- (auth (elmo-imap4-spec-auth spec))
- (type (elmo-imap4-spec-stream-type spec))
- entry connection process
- user-at-host-on-port)
- (if (not (elmo-plugged-p host port))
- (error "Unplugged"))
- (setq user-at-host-on-port
- (format "%s@%s:%d%s" user host port
- (if type
- (elmo-network-stream-type-spec-string type)
- "")))
- (setq entry (assoc user-at-host-on-port elmo-imap4-connection-cache))
- (if (and entry
- (memq (process-status (cadr (cdr entry)))
- '(closed exit)))
- ;; connection is closed...
- (let ((buffer (car (cdr entry))))
- (setq elmo-imap4-connection-cache
- (delq entry elmo-imap4-connection-cache))
- (if buffer (kill-buffer buffer))
- (setq entry nil)))
- (if entry
- (cdr entry) ; connection cache exists.
- (setq process
- (elmo-imap4-open-connection host port user auth type))
- (elmo-imap4-debug "Connected to %s" user-at-host-on-port)
- ;; add a new entry to the top of the cache.
- (setq elmo-imap4-connection-cache
- (cons
- (cons user-at-host-on-port
- (setq connection (list (process-buffer process) process
- "" ; current-folder..
- )))
- elmo-imap4-connection-cache))
- connection)))
+(defun elmo-imap4-get-session (spec)
+ (elmo-network-get-session
+ 'elmo-imap4-session
+ "IMAP4"
+ (elmo-imap4-spec-hostname spec)
+ (elmo-imap4-spec-port spec)
+ (elmo-imap4-spec-username spec)
+ (elmo-imap4-spec-auth spec)
+ (elmo-imap4-spec-stream-type spec)))
(defun elmo-imap4-process-filter (process output)
(save-match-data
(elmo-imap4-debug "continue(%d) %s" elmo-imap4-seqno output))
(goto-char (point-max)))))
-(defun elmo-imap4-read-response (buffer process &optional not-command)
- (save-excursion
- (set-buffer buffer)
+(defun elmo-imap4-read-response (process &optional not-command)
+ "Read response from PROCESS"
+ (with-current-buffer (process-buffer process)
(let ((case-fold-search nil)
(response-string nil)
(response-continue t)
(setq elmo-imap4-read-point match-end)))
return-value)))
-(defun elmo-imap4-read-contents (buffer process)
+(defun elmo-imap4-read-contents (process)
"Read OK response"
- (save-excursion
- (set-buffer buffer)
+ (with-current-buffer (process-buffer process)
(let ((case-fold-search nil)
(response-string nil)
match-end)
response-string))))
(defun elmo-imap4-read-bytes (buffer process bytes)
- (save-excursion
- (set-buffer buffer)
+ (with-current-buffer buffer
(let ((case-fold-search nil)
start gc-message return-value)
(setq start elmo-imap4-read-point) ; starting point
(setq elmo-imap4-read-point (+ start bytes))
ret-val)))
-(defun elmo-imap4-send-string (buffer process string)
+(defun elmo-imap4-send-string (process string)
"Send STRING to server."
- (save-excursion
- (set-buffer buffer)
+ (with-current-buffer (process-buffer process)
(erase-buffer)
(goto-char (point-min))
(setq elmo-imap4-read-point (point))
(process-send-string process string)
(process-send-string process "\r\n")))
-(defun elmo-imap4-noop (connection)
- (let ((buffer (car connection))
- (process (cadr connection)))
- (save-excursion
- (elmo-imap4-send-command buffer
- process "noop")
- (elmo-imap4-read-response buffer process))))
-
(defun elmo-imap4-commit (spec)
(if (elmo-imap4-plugged-p spec)
- (save-excursion
- (let ((connection (elmo-imap4-get-connection spec))
- response ret-val beg end)
- (and (not (null (elmo-imap4-spec-mailbox spec)))
- (if (not (string= (elmo-imap4-connection-get-cwf connection)
- (elmo-imap4-spec-mailbox spec)))
- (if (null (setq response
- (elmo-imap4-select-folder
- (elmo-imap4-spec-mailbox spec)
- connection)))
- (error "Select folder %s failed"
- (elmo-imap4-spec-mailbox spec)))
- (if elmo-imap4-use-select-to-update-status
- (elmo-imap4-select-folder
- (elmo-imap4-spec-mailbox spec)
- connection)
- (elmo-imap4-check connection))))))))
-
-(defun elmo-imap4-check (connection)
- (let ((process (elmo-imap4-connection-get-process connection)))
- (save-excursion
- (elmo-imap4-send-command (process-buffer process)
- process "check")
- (elmo-imap4-read-response (process-buffer process) process))))
-
-(defun elmo-imap4-select-folder (folder connection)
- (let ((process (elmo-imap4-connection-get-process connection))
- response)
- (save-excursion
+ (let ((session (elmo-imap4-get-session spec)))
+ (if elmo-imap4-use-select-to-update-status
+ (elmo-imap4-select-mailbox session
+ (elmo-imap4-spec-mailbox spec)
+ 'force)
+ (elmo-imap4-select-mailbox session
+ (elmo-imap4-spec-mailbox spec))
+ (elmo-imap4-check session)))))
+
+(defun elmo-imap4-check (session)
+ (let ((process (elmo-network-session-process-internal session)))
+ (elmo-imap4-send-command process "check")
+ (elmo-imap4-read-response process)))
+
+(defun elmo-imap4-select-mailbox (session mailbox &optional force)
+ (when (or force
+ (not (string=
+ (elmo-imap4-session-current-mailbox-internal session)
+ mailbox)))
+ (let ((process (elmo-network-session-process-internal session))
+ response)
(unwind-protect
(progn
- (elmo-imap4-send-command (process-buffer process)
- process
- (list "select "
- (elmo-imap4-mailbox folder)))
- (setq response (elmo-imap4-read-response
- (process-buffer process) process)))
- (if (null response)
- (progn
- (setcar (cddr connection) nil)
- (error "Select folder %s failed" folder))
- (setcar (cddr connection) folder))))
- response))
+ (elmo-imap4-send-command process
+ (list
+ "select "
+ (elmo-imap4-mailbox mailbox)))
+ (setq response (elmo-imap4-read-response process)))
+ (if response
+ (elmo-imap4-session-set-current-mailbox-internal
+ session mailbox)
+ (elmo-imap4-session-set-current-mailbox-internal session nil)
+ (error "Select mailbox %s failed" mailbox))))))
(defun elmo-imap4-check-validity (spec validity-file)
"get uidvalidity value from server and compare it with validity-file."
(let* ((process (elmo-imap4-get-process spec))
response)
(save-excursion
- (elmo-imap4-send-command (process-buffer process)
- process
+ (elmo-imap4-send-command process
(list "status "
(elmo-imap4-mailbox
(elmo-imap4-spec-mailbox spec))
" (uidvalidity)"))
- (setq response (elmo-imap4-read-response
- (process-buffer process) process))
+ (setq response (elmo-imap4-read-response process))
(if (string-match "UIDVALIDITY \\([0-9]+\\)" response)
(string= (elmo-get-file-string validity-file)
(elmo-match-string 1 response))
(let* ((process (elmo-imap4-get-process spec))
response)
(save-excursion
- (elmo-imap4-send-command (process-buffer process)
- process
+ (elmo-imap4-send-command process
(list "status "
(elmo-imap4-mailbox
(elmo-imap4-spec-mailbox spec))
" (uidvalidity)"))
- (setq response (elmo-imap4-read-response
- (process-buffer process) process))
+ (setq response (elmo-imap4-read-response process))
(if (string-match "UIDVALIDITY \\([0-9]+\\)" response)
(progn
(elmo-save-string
(defun elmo-imap4-list (spec str)
(save-excursion
- (let* ((connection (elmo-imap4-get-connection spec))
- (process (elmo-imap4-connection-get-process connection))
+ (let* ((session (elmo-imap4-get-session spec))
+ (process (elmo-network-session-process-internal session))
response ret-val beg end)
- (and (elmo-imap4-spec-mailbox spec)
- (if (not (string= (elmo-imap4-connection-get-cwf connection)
- (elmo-imap4-spec-mailbox spec)))
- (if (null (setq response
- (elmo-imap4-select-folder
- (elmo-imap4-spec-mailbox spec)
- connection)))
- (error "Select folder %s failed"
- (elmo-imap4-spec-mailbox spec)))
- ;; for status update.
- (if elmo-imap4-use-select-to-update-status
- (elmo-imap4-select-folder (elmo-imap4-spec-mailbox spec)
- connection)
- (unless (elmo-imap4-check connection)
- ;; Check failed...not selected??
- (elmo-imap4-select-folder (elmo-imap4-spec-mailbox spec)
- connection)))))
- (elmo-imap4-send-command (process-buffer process)
- process
+ (elmo-imap4-commit spec)
+ (elmo-imap4-send-command process
(format (if elmo-imap4-use-uid
"uid search %s"
"search %s") str))
- (setq response (elmo-imap4-read-response (process-buffer process)
- process))
+ (setq response (elmo-imap4-read-response process))
(if (and response (string-match "\\* SEARCH" response))
(progn
(setq response (substring response (match-end 0)))
(and (elmo-imap4-use-flag-p spec)
(elmo-imap4-list spec "flagged")))
-(defun elmo-imap4-search-internal (process buffer filter)
+(defun elmo-imap4-search-internal (process filter)
(let ((search-key (elmo-filter-key filter))
word response)
(cond
((or (string= "since" search-key)
(string= "before" search-key))
(setq search-key (concat "sent" search-key))
- (elmo-imap4-send-command buffer process
+ (elmo-imap4-send-command process
(format
(if elmo-imap4-use-uid
"uid search %s %s"
(t
(setq word (encode-mime-charset-string (elmo-filter-value filter)
elmo-search-mime-charset))
- (elmo-imap4-send-command buffer process
+ (elmo-imap4-send-command process
(list
(if elmo-imap4-use-uid
"uid search CHARSET "
(format "%s "
(elmo-filter-key filter))
(elmo-imap4-astring word)))))
- (if (null (setq response (elmo-imap4-read-response buffer process)))
+ (if (null (setq response (elmo-imap4-read-response process)))
(error "Search failed for %s" (elmo-filter-key filter)))
(if (string-match "^\\* SEARCH\\([^\n]*\\)$" response)
(read (concat "(" (elmo-match-string 1 response) ")"))
(defun elmo-imap4-search (spec condition &optional from-msgs)
(save-excursion
- (let* ((connection (elmo-imap4-get-connection spec))
- (process (elmo-imap4-connection-get-process connection))
+ (let* ((session (elmo-imap4-get-session spec))
+ (process (elmo-network-session-process-internal session))
response ret-val len word)
- (if (and (elmo-imap4-spec-mailbox spec)
- (not (string= (elmo-imap4-connection-get-cwf connection)
- (elmo-imap4-spec-mailbox spec)))
- (null (elmo-imap4-select-folder
- (elmo-imap4-spec-mailbox spec) connection)))
- (error "Select folder %s failed" (elmo-imap4-spec-mailbox spec)))
+ (elmo-imap4-select-mailbox session
+ (elmo-imap4-spec-mailbox spec))
(while condition
(setq response (elmo-imap4-search-internal process
- (process-buffer process)
(car condition)))
(setq ret-val (nconc ret-val response))
(setq condition (cdr condition)))
"SET flag of MSGS as MARK.
If optional argument UNMARK is non-nil, unmark."
(save-excursion
- (let* ((connection (elmo-imap4-get-connection spec))
- (process (elmo-imap4-connection-get-process connection))
+ (let* ((session (elmo-imap4-get-session spec))
+ (process (elmo-network-session-process-internal session))
(msg-list (copy-sequence msgs))
set-list ent)
- (if (and (elmo-imap4-spec-mailbox spec)
- (not (string= (elmo-imap4-connection-get-cwf connection)
- (elmo-imap4-spec-mailbox spec)))
- (null (elmo-imap4-select-folder
- (elmo-imap4-spec-mailbox spec) connection)))
- (error "Select folder %s failed" (elmo-imap4-spec-mailbox spec)))
+ (elmo-imap4-select-mailbox session
+ (elmo-imap4-spec-mailbox spec))
(setq set-list (elmo-imap4-make-number-set-list msg-list))
(when set-list
- (elmo-imap4-send-command (process-buffer process)
- process
+ (elmo-imap4-send-command process
(format
(if elmo-imap4-use-uid
"uid store %s %sflags.silent (%s)"
(cdr (car set-list))
(if unmark "-" "+")
mark))
- (unless (elmo-imap4-read-response (process-buffer process) process)
+ (unless (elmo-imap4-read-response process)
(error "Store %s flag failed" mark))
(unless no-expunge
- (elmo-imap4-send-command
- (process-buffer process) process "expunge")
- (unless (elmo-imap4-read-response (process-buffer process) process)
+ (elmo-imap4-send-command process "expunge")
+ (unless (elmo-imap4-read-response process)
(error "Expunge failed"))))
t)))
"Create msgdb for SPEC."
(when numlist
(save-excursion
- (let* ((connection (elmo-imap4-get-connection spec))
- (process (elmo-imap4-connection-get-process connection))
+ (let* ((session (elmo-imap4-get-session spec))
+ (process (elmo-network-session-process-internal session))
(filter (and as-num numlist))
(case-fold-search t)
(extra-fields (if elmo-msgdb-extra-fields
""))
rfc2060 count ret-val set-list ov-str length)
(setq rfc2060 (with-current-buffer (process-buffer process)
- (if (memq 'imap4rev1 elmo-imap4-server-capability)
+ (if (memq 'imap4rev1
+ (elmo-imap4-session-capability-internal
+ session))
t
- (if (memq 'imap4 elmo-imap4-server-capability)
+ (if (memq 'imap4
+ (elmo-imap4-session-capability-internal
+ session))
nil
(error "No IMAP4 capability!!")))))
(setq count 0)
numlist
elmo-imap4-overview-fetch-chop-length))
(message "Getting overview...")
- (if (and (elmo-imap4-spec-mailbox spec)
- (not (string= (elmo-imap4-connection-get-cwf connection)
- (elmo-imap4-spec-mailbox spec)))
- (null (elmo-imap4-select-folder
- (elmo-imap4-spec-mailbox spec) connection)))
- (error "Select IMAP folder %s failed"
- (elmo-imap4-spec-mailbox spec)))
+ (elmo-imap4-select-mailbox session
+ (elmo-imap4-spec-mailbox spec))
(while set-list
(elmo-imap4-send-command
- (process-buffer process)
process
;; get overview entity from IMAP4
(format
new-mark already-mark seen-mark important-mark
seen-list filter)))))
(setq count (+ count (car (car set-list))))
- (setq ov-str (elmo-imap4-read-contents (process-buffer process)
- process))
+ (setq ov-str (elmo-imap4-read-contents process))
(when (> length elmo-display-progress-threshold)
(elmo-display-progress
'elmo-imap4-msgdb-create "Getting overview..."
(> (length (car x))
(length (car y)))))))))
-(defun elmo-imap4-auth-login (buffer process name)
- (with-current-buffer buffer
- (elmo-imap4-send-command
- (current-buffer) process "authenticate login" 'no-lock)
- (or (elmo-imap4-read-response (current-buffer) process t)
+;; Current buffer is process buffer.
+(defun elmo-imap4-auth-login (session)
+ (elmo-imap4-send-command
+ (elmo-network-session-process-internal session)
+ "authenticate login" 'no-lock)
+ (or (elmo-imap4-read-response
+ (elmo-network-session-process-internal session)
+ t)
+ (signal 'elmo-authenticate-error
+ '(elmo-imap4-auth-login)))
+ (elmo-imap4-send-string
+ (elmo-network-session-process-internal session)
+ (elmo-base64-encode-string
+ (elmo-network-session-user-internal session)))
+ (or (elmo-imap4-read-response
+ (elmo-network-session-process-internal session)
+ t)
(signal 'elmo-authenticate-error
'(elmo-imap4-auth-login)))
- (elmo-imap4-send-string
- (current-buffer) process (elmo-base64-encode-string name))
- (or (elmo-imap4-read-response (current-buffer) process t)
+ (elmo-imap4-send-string
+ (elmo-network-session-process-internal session)
+ (elmo-base64-encode-string
+ (elmo-get-passwd (elmo-network-session-password-key session))))
+ (or (elmo-imap4-read-response
+ (elmo-network-session-process-internal session))
+ (signal 'elmo-authenticate-error
+ '(elmo-imap4-auth-login))))
+
+(defun elmo-imap4-auth-cram-md5 (session)
+ (let ((process (elmo-network-session-process-internal session)) response)
+ (elmo-imap4-send-command
+ process
+ "authenticate cram-md5" 'no-lock)
+ (or (setq response (elmo-imap4-read-response process t))
(signal 'elmo-authenticate-error
- '(elmo-imap4-auth-login)))
+ '(elmo-imap4-auth-cram-md5)))
+ (setq response (cadr (split-string response " ")))
(elmo-imap4-send-string
- (current-buffer) process (elmo-base64-encode-string
- (elmo-get-passwd elmo-imap4-password-key)))
- (or (elmo-imap4-read-response (current-buffer) process)
+ process
+ (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-response process)
(signal 'elmo-authenticate-error
- '(elmo-imap4-auth-login)))))
+ '(elmo-imap4-auth-cram-md5)))))
-(defun elmo-imap4-auth-cram-md5 (buffer process name)
- (save-excursion
- (set-buffer buffer)
- (let (response)
- (elmo-imap4-send-command
- (current-buffer) process "authenticate cram-md5" 'no-lock)
- (setq response (elmo-imap4-read-response (current-buffer) process t))
- (or response
- (signal 'elmo-authenticate-error
- '(elmo-imap4-auth-cram-md5)))
- (setq response (cadr (split-string response " ")))
- (elmo-imap4-send-string
- (current-buffer) process
- (elmo-base64-encode-string
- (sasl-cram-md5 name (elmo-get-passwd elmo-imap4-password-key)
- (elmo-base64-decode-string response))))
- (or (elmo-imap4-read-response (current-buffer) process)
- (signal 'elmo-authenticate-error
- '(elmo-imap4-auth-cram-md5))))))
-
-(defun elmo-imap4-auth-digest-md5 (buffer process name)
- (save-excursion
- (set-buffer buffer)
- (let (response)
+(defun elmo-imap4-auth-digest-md5 (session)
+ (let ((process (elmo-network-session-process-internal session))
+ response)
(elmo-imap4-send-command
- (current-buffer) process "authenticate digest-md5" 'no-lock)
- (setq response (elmo-imap4-read-response (current-buffer) process t))
+ process "authenticate digest-md5" 'no-lock)
+ (setq response (elmo-imap4-read-response process t))
(or response
(signal 'elmo-authenticate-error
'(elmo-imap4-auth-digest-md5)))
(setq response (cadr (split-string response " ")))
(elmo-imap4-send-string
- (current-buffer) process
+ process
(elmo-base64-encode-string
(sasl-digest-md5-digest-response
(elmo-base64-decode-string response)
- name (elmo-get-passwd elmo-imap4-password-key)
- "imap" elmo-imap4-password-key);; XXX
+ (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 (elmo-imap4-read-response (current-buffer) process t)
- (signal 'elmo-authenticate-error
- '(elmo-imap4-auth-digest-md5)))
- (elmo-imap4-send-string (current-buffer) process "")
- (or (elmo-imap4-read-response (current-buffer) process)
+ (or (elmo-imap4-read-response process t)
(signal 'elmo-authenticate-error
- '(elmo-imap4-auth-digest-md5))))))
-
-(defun elmo-imap4-login (buffer process name)
- (save-excursion
- (set-buffer buffer)
- (elmo-imap4-send-command
- (current-buffer) process
- (list "login " (elmo-imap4-userid name) " "
- (elmo-imap4-password
- (elmo-get-passwd elmo-imap4-password-key)))
- nil 'no-log)
- (or (elmo-imap4-read-response (current-buffer) process)
- (signal 'elmo-authenticate-error
- '(elmo-imap4-login)))))
-
-(defun elmo-imap4-open-connection (host port user auth type)
- "Open IMAP connection to HOST on PORT for USER.
-Return nil if connection failed."
- (let (process)
- (condition-case error
- (save-excursion
- (as-binary-process
- (setq process
- (elmo-open-network-stream
- "IMAP" (format " *IMAP session to %s:%d" host port)
- host port type)))
- (elmo-imap4-open-connection-1 process host port user auth type))
- (error
- (when (eq (car error) 'elmo-authenticate-error)
- (with-current-buffer (process-buffer process)
- (elmo-remove-passwd elmo-imap4-password-key)))
- (when (and process
- (memq (process-status process) '(open run)))
- (delete-process process))
- (signal (car error)(cdr error))))
- process))
-
-(defun elmo-imap4-open-connection-1 (process host port user auth type)
- (let (response capability mechanism)
- (set-buffer (process-buffer process))
- (elmo-set-buffer-multibyte nil)
- (buffer-disable-undo)
- (erase-buffer)
- (make-variable-buffer-local 'elmo-imap4-server-capability)
- (make-variable-buffer-local 'elmo-imap4-lock)
- (make-local-variable 'elmo-imap4-read-point)
- (setq elmo-imap4-read-point (point-min))
- (make-local-variable 'elmo-imap4-password-key)
- (set-process-filter process 'elmo-imap4-process-filter)
- ;; flush connections when exiting...
- (setq response
- (elmo-imap4-read-response (current-buffer) process t))
- (unless (string-match "^\\* PREAUTH" response)
- (elmo-imap4-send-command (current-buffer) process "capability")
- (setq elmo-imap4-server-capability
- (elmo-imap4-parse-capability
- (elmo-imap4-read-response (current-buffer) process))
- capability elmo-imap4-server-capability)
- (when (eq (elmo-network-stream-type-symbol type) 'starttls)
+ '(elmo-imap4-auth-digest-md5)))
+ (elmo-imap4-send-string process "")
+ (or (elmo-imap4-read-response process)
+ (signal 'elmo-authenticate-error
+ '(elmo-imap4-auth-digest-md5)))))
+
+(defun elmo-imap4-login (session)
+ (elmo-imap4-send-command
+ (elmo-network-session-process-internal session)
+ (list "login " (elmo-imap4-userid
+ (elmo-network-session-user-internal session))
+ " "
+ (elmo-imap4-password
+ (elmo-get-passwd (elmo-network-session-password-key session))))
+ nil 'no-log)
+ (or (elmo-imap4-read-response
+ (elmo-network-session-process-internal session))
+ (signal 'elmo-authenticate-error
+ '(elmo-imap4-auth-digest-md5))))
+
+(luna-define-method elmo-network-initialize-session ((session
+ elmo-imap4-session))
+ (let ((process (elmo-network-session-process-internal session))
+ response greeting capability mechanism)
+ (with-current-buffer (process-buffer process)
+ (elmo-set-buffer-multibyte nil)
+ (buffer-disable-undo)
+ (make-variable-buffer-local 'elmo-imap4-lock)
+ (make-local-variable 'elmo-imap4-read-point)
+ (setq elmo-imap4-read-point (point-min))
+ (set-process-filter process 'elmo-imap4-process-filter)
+ ;; greeting
+ (elmo-network-session-set-greeting-internal
+ session
+ (elmo-imap4-read-response process t))
+ (unless (elmo-network-session-greeting-internal session)
+ (signal 'elmo-open-error
+ '(elmo-network-initialize-session)))
+ (elmo-imap4-send-command process "capability")
+ (elmo-imap4-session-set-capability-internal
+ session
+ (elmo-imap4-parse-capability
+ (elmo-imap4-read-response process)))
+ (when (eq (elmo-network-stream-type-symbol
+ (elmo-network-session-stream-type-internal session))
+ 'starttls)
(or (memq 'starttls capability)
(signal 'elmo-open-error
- '("There's no STARTTLS support in server")))
- (elmo-imap4-send-command (current-buffer) process "starttls")
+ '(elmo-network-initialize-session)))
+ (elmo-imap4-send-command process "starttls")
(setq response
- (elmo-imap4-read-response (current-buffer) process))
+ (elmo-imap4-read-response process))
(if (string-match
(concat "^\\(" elmo-imap4-seq-prefix
(int-to-string elmo-imap4-seqno)
"\\|\\*\\) OK")
response)
- (starttls-negotiate process)))
- (unless (or (not auth)
- (and (memq (intern (format "auth=%s" auth))
- capability)
- (setq mechanism
- (assq auth elmo-imap4-authenticator-alist))))
- (if (or elmo-imap4-force-login
- (y-or-n-p
- (format
- "There's no %s capability in server. continue?"
- auth)))
- (setq auth nil)
- (signal 'elmo-authenticate-error
- '("There's no AUTHENTICATE mechanism")))
- (setq elmo-imap4-password-key
- (format "IMAP4:%s/%s@%s:%d"
- user (or auth 'plain) host port
- (elmo-network-stream-type-spec-string
- type))))
- (if auth
- (funcall (nth 1 mechanism) (current-buffer) process user)
- (elmo-imap4-login (current-buffer) process user)));; try login
- ;; get namespace of server if possible.
- (when (memq 'namespace elmo-imap4-server-capability)
- (elmo-imap4-send-command (current-buffer) process "namespace")
- (setq elmo-imap4-server-namespace
- (elmo-imap4-parse-namespace
- (elmo-imap4-parse-response
- (elmo-imap4-read-response (current-buffer) process)))))
- process))
-
+ (starttls-negotiate process))))))
+
+(luna-define-method elmo-network-authenticate-session ((session
+ elmo-imap4-session))
+ (unless (string-match "^\\* PREAUTH"
+ (elmo-network-session-greeting-internal session))
+ (unless (or (not (elmo-network-session-auth-internal session))
+ (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))))
+
+(luna-define-method elmo-network-setup-session ((session
+ elmo-imap4-session))
+ (let ((process (elmo-network-session-process-internal session)))
+ (with-current-buffer (process-buffer process)
+ ;; get namespace of server if possible.
+ (when (memq 'namespace (elmo-imap4-session-capability-internal session))
+ (elmo-imap4-send-command process "namespace")
+ (setq elmo-imap4-server-namespace
+ (elmo-imap4-parse-namespace
+ (elmo-imap4-parse-response
+ (elmo-imap4-read-response process))))))))
+
(defun elmo-imap4-get-seqno ()
(setq elmo-imap4-seqno (+ 1 elmo-imap4-seqno)))
(replace-match "\r\n"))))
tmp-buf))
-(defun elmo-imap4-send-command (buffer process command &optional no-lock
- no-log)
- "Send COMMAND to server with sequence number."
- (save-excursion
- (set-buffer buffer)
+(defun elmo-imap4-send-command (process command &optional no-lock no-log)
+ "Send COMMAND to the PROCESS."
+ (with-current-buffer (process-buffer process)
(when (and elmo-imap4-use-lock
elmo-imap4-lock)
(elmo-imap4-debug "send: (%d) is still locking." elmo-imap4-seqno)
(process-send-string process cmdstr)
(process-send-string process "\r\n")
(setq cmdstr nil)
- (if (null (elmo-imap4-read-response buffer process t))
+ (if (null (elmo-imap4-read-response process t))
(error "No response from server"))
(cond ((stringp (nth 1 token))
(setq cmdstr (nth 1 token)))
))
(defun elmo-imap4-read-part (folder msg part)
- (save-excursion
- (let* ((spec (elmo-folder-get-spec folder))
- (connection (elmo-imap4-get-connection spec))
- (process (elmo-imap4-connection-get-process connection))
- response ret-val bytes)
- (when (elmo-imap4-spec-mailbox spec)
- (when (not (string= (elmo-imap4-connection-get-cwf connection)
- (elmo-imap4-spec-mailbox spec)))
- (if (null (setq response
- (elmo-imap4-select-folder
- (elmo-imap4-spec-mailbox spec) connection)))
- (error "Select folder %s failed" (elmo-imap4-spec-mailbox spec))))
- (elmo-imap4-send-command (process-buffer process)
- process
- (format
- (if elmo-imap4-use-uid
- "uid fetch %s body.peek[%s]"
- "fetch %s body.peek[%s]")
- msg part))
+ (let* ((spec (elmo-folder-get-spec folder))
+ (session (elmo-imap4-get-session spec))
+ (process (elmo-network-session-process-internal session))
+ response ret-val bytes)
+ (elmo-imap4-select-mailbox session
+ (elmo-imap4-spec-mailbox spec))
+ (elmo-imap4-send-command process
+ (format
+ (if elmo-imap4-use-uid
+ "uid fetch %s body.peek[%s]"
+ "fetch %s body.peek[%s]")
+ msg part))
+ (if (null (setq response (elmo-imap4-read-response
+ process t)))
+ (error "Fetch failed"))
+ (save-match-data
+ (while (string-match "^\\* OK" response)
(if (null (setq response (elmo-imap4-read-response
- (process-buffer process)
process t)))
- (error "Fetch failed"))
- (save-match-data
- (while (string-match "^\\* OK" response)
- (if (null (setq response (elmo-imap4-read-response
- (process-buffer process)
- process t)))
- (error "Fetch failed"))))
- (save-match-data
- (if (string-match ".*{\\([0-9]+\\)}" response)
- (setq bytes
- (string-to-int
- (elmo-match-string 1 response)))
- (error "Fetch failed")))
- (if (null (setq response (elmo-imap4-read-bytes
- (process-buffer process) process bytes)))
- (error "Fetch message failed"))
- (setq ret-val response)
- (elmo-imap4-read-response (process-buffer process)
- process)) ;; ignore remaining..
- ret-val)))
+ (error "Fetch failed"))))
+ (save-match-data
+ (if (string-match ".*{\\([0-9]+\\)}" response)
+ (setq bytes
+ (string-to-int
+ (elmo-match-string 1 response)))
+ (error "Fetch failed")))
+ (if (null (setq response (elmo-imap4-read-bytes
+ (process-buffer process) process bytes)))
+ (error "Fetch message failed"))
+ (setq ret-val response)
+ (elmo-imap4-read-response process) ;; ignore remaining..
+ ret-val))
(defun elmo-imap4-prefetch-msg (spec msg outbuf)
(elmo-imap4-read-msg spec msg outbuf 'unseen))
(defun elmo-imap4-read-msg (spec msg outbuf
&optional leave-seen-flag-untouched)
- (save-excursion
- (let* ((connection (elmo-imap4-get-connection spec))
- (process (elmo-imap4-connection-get-process connection))
- response ret-val bytes)
- (as-binary-process
- (when (elmo-imap4-spec-mailbox spec)
- (when (not (string= (elmo-imap4-connection-get-cwf connection)
- (elmo-imap4-spec-mailbox spec)))
- (if (null (setq response
- (elmo-imap4-select-folder
- (elmo-imap4-spec-mailbox spec)
- connection)))
- (error "Select folder %s failed" (elmo-imap4-spec-mailbox spec))))
- (elmo-imap4-send-command (process-buffer process)
- process
- (format
- (if elmo-imap4-use-uid
- "uid fetch %s body%s[]"
- "fetch %s body%s[]")
- msg
- (if leave-seen-flag-untouched
- ".peek" "")))
+ (let* ((session (elmo-imap4-get-session spec))
+ (process (elmo-network-session-process-internal session))
+ response ret-val bytes)
+ (as-binary-process
+ (elmo-imap4-select-mailbox session
+ (elmo-imap4-spec-mailbox spec))
+ (elmo-imap4-send-command process
+ (format
+ (if elmo-imap4-use-uid
+ "uid fetch %s body%s[]"
+ "fetch %s body%s[]")
+ msg
+ (if leave-seen-flag-untouched
+ ".peek" "")))
+ (if (null (setq response (elmo-imap4-read-response
+ process t)))
+ (error "Fetch failed"))
+ (save-match-data
+ (while (string-match "^\\* OK" response)
(if (null (setq response (elmo-imap4-read-response
- (process-buffer process)
process t)))
- (error "Fetch failed"))
- (save-match-data
- (while (string-match "^\\* OK" response)
- (if (null (setq response (elmo-imap4-read-response
- (process-buffer process)
- process t)))
- (error "Fetch failed"))))
- (save-match-data
- (if (string-match ".*{\\([0-9]+\\)}" response)
- (setq bytes
- (string-to-int
- (elmo-match-string 1 response)))
- (error "Fetch failed")))
- (setq ret-val (elmo-imap4-read-body
- (process-buffer process)
- process bytes outbuf))
- (elmo-imap4-read-response (process-buffer process)
- process)) ;; ignore remaining..
- )
- ret-val)))
+ (error "Fetch failed"))))
+ (save-match-data
+ (if (string-match ".*{\\([0-9]+\\)}" response)
+ (setq bytes
+ (string-to-int
+ (elmo-match-string 1 response)))
+ (error "Fetch failed")))
+ (setq ret-val (elmo-imap4-read-body
+ (process-buffer process)
+ process bytes outbuf))
+ (elmo-imap4-read-response process)) ;; ignore remaining..
+ ret-val))
(defun elmo-imap4-setup-send-buffer-from-file (file)
(let ((tmp-buf (get-buffer-create
(message "Deleting message...%d/%d" i num)
(elmo-imap4-delete-msg-by-id spec (car message-ids))
(setq message-ids (cdr message-ids)))
- (let* ((connection (elmo-imap4-get-connection spec))
- (process (elmo-imap4-connection-get-process connection)))
- (elmo-imap4-send-command (process-buffer process)
- process "expunge")
- (if (null (elmo-imap4-read-response (process-buffer process)
- process))
+ (let* ((session (elmo-imap4-get-session spec))
+ (process (elmo-network-session-process-internal session)))
+ (elmo-imap4-send-command process "expunge")
+ (if (null (elmo-imap4-read-response process))
(error "Expunge failed")))))
(defun elmo-imap4-delete-msg-by-id (spec msgid)
- (save-excursion
- (let* ((connection (elmo-imap4-get-connection spec))
- (process (elmo-imap4-connection-get-process connection))
- ;;(size (length string))
- response msgs)
- (if (and (elmo-imap4-spec-mailbox spec)
- (not (string= (elmo-imap4-connection-get-cwf connection)
- (elmo-imap4-spec-mailbox spec)))
- (null (elmo-imap4-select-folder
- (elmo-imap4-spec-mailbox spec)
- connection)))
- (error "Select folder %s failed" (elmo-imap4-spec-mailbox spec)))
- (save-excursion
- (elmo-imap4-send-command (process-buffer process)
- process
- (list
- (if elmo-imap4-use-uid
- "uid search header message-id "
- "search header message-id ")
- (elmo-imap4-field-body msgid)))
- (setq response (elmo-imap4-read-response
- (process-buffer process) process))
- (if (and response
- (string-match "^\\* SEARCH\\([^\n]*\\)$" response))
- (setq msgs (read (concat "(" (elmo-match-string 1 response) ")")))
- (error "SEARCH failed"))
- (elmo-imap4-delete-msgs-no-expunge spec msgs)))))
+ (let* ((session (elmo-imap4-get-session spec))
+ (process (elmo-network-session-process-internal session))
+ response msgs)
+ (elmo-imap4-select-mailbox session
+ (elmo-imap4-spec-mailbox spec))
+ (elmo-imap4-send-command process
+ (list
+ (if elmo-imap4-use-uid
+ "uid search header message-id "
+ "search header message-id ")
+ (elmo-imap4-field-body msgid)))
+ (setq response (elmo-imap4-read-response process))
+ (if (and response
+ (string-match "^\\* SEARCH\\([^\n]*\\)$" response))
+ (setq msgs (read (concat "(" (elmo-match-string 1 response) ")")))
+ (error "SEARCH failed"))
+ (elmo-imap4-delete-msgs-no-expunge spec msgs)))
(defun elmo-imap4-append-msg-by-id (spec msgid)
- (save-excursion
- (let* ((connection (elmo-imap4-get-connection spec))
- (process (elmo-imap4-connection-get-process connection))
- send-buf)
- (if (and (elmo-imap4-spec-mailbox spec)
- (not (string= (elmo-imap4-connection-get-cwf connection)
- (elmo-imap4-spec-mailbox spec)))
- (null (elmo-imap4-select-folder
- (elmo-imap4-spec-mailbox spec) connection)))
- (error "Select folder %s failed" (elmo-imap4-spec-mailbox spec)))
- (setq send-buf (elmo-imap4-setup-send-buffer-from-file
- (elmo-cache-get-path msgid)))
- (elmo-imap4-send-command (process-buffer process)
- process
- (list
- "append "
- (elmo-imap4-mailbox (elmo-imap4-spec-mailbox spec))
- " (\\Seen) "
- (elmo-imap4-buffer-literal send-buf)))
- (kill-buffer send-buf)
- (if (null (elmo-imap4-read-response (process-buffer process)
- process))
- (error "Append failed")))
- t))
+ (let* ((session (elmo-imap4-get-session spec))
+ (process (elmo-network-session-process-internal session))
+ send-buf)
+ (elmo-imap4-select-mailbox session
+ (elmo-imap4-spec-mailbox spec))
+ (setq send-buf (elmo-imap4-setup-send-buffer-from-file
+ (elmo-cache-get-path msgid)))
+ (elmo-imap4-send-command
+ process
+ (list
+ "append "
+ (elmo-imap4-mailbox (elmo-imap4-spec-mailbox spec))
+ " (\\Seen) "
+ (elmo-imap4-buffer-literal send-buf)))
+ (kill-buffer send-buf)
+ (if (null (elmo-imap4-read-response process))
+ (error "Append failed")))
+ t)
(defun elmo-imap4-append-msg (spec string &optional msg no-see)
- (save-excursion
- (let* ((connection (elmo-imap4-get-connection spec))
- (process (elmo-imap4-connection-get-process connection))
- send-buf)
- (if (and (elmo-imap4-spec-mailbox spec)
- (not (string= (elmo-imap4-connection-get-cwf connection)
- (elmo-imap4-spec-mailbox spec)))
- (null (elmo-imap4-select-folder (elmo-imap4-spec-mailbox spec)
- connection)))
- (error "Select folder %s failed" (elmo-imap4-spec-mailbox spec)))
- (setq send-buf (elmo-imap4-setup-send-buffer string))
- (elmo-imap4-send-command (process-buffer process)
- process
- (list
- "append "
- (elmo-imap4-mailbox (elmo-imap4-spec-mailbox spec))
- (if no-see " " " (\\Seen) ")
- (elmo-imap4-buffer-literal send-buf)))
- (kill-buffer send-buf)
- ;;(current-buffer)
- (if (null (elmo-imap4-read-response (process-buffer process)
- process))
- (error "Append failed")))
- t))
+ (let* ((session (elmo-imap4-get-session spec))
+ (process (elmo-network-session-process-internal session))
+ send-buf)
+ (elmo-imap4-select-mailbox session
+ (elmo-imap4-spec-mailbox spec))
+ (setq send-buf (elmo-imap4-setup-send-buffer string))
+ (elmo-imap4-send-command
+ process
+ (list
+ "append "
+ (elmo-imap4-mailbox (elmo-imap4-spec-mailbox spec))
+ (if no-see " " " (\\Seen) ")
+ (elmo-imap4-buffer-literal send-buf)))
+ (kill-buffer send-buf)
+ ;;(current-buffer)
+ (if (null (elmo-imap4-read-response process))
+ (error "Append failed")))
+ t)
-(defun elmo-imap4-copy-msgs (dst-spec msgs src-spec &optional expunge-it same-number)
+(defun elmo-imap4-copy-msgs (dst-spec
+ msgs src-spec &optional expunge-it same-number)
"Equivalence of hostname, username is assumed."
- (save-excursion
- (let* ((src-folder (elmo-imap4-spec-mailbox src-spec))
- (dst-folder (elmo-imap4-spec-mailbox dst-spec))
- (connection (elmo-imap4-get-connection src-spec))
- (process (elmo-imap4-connection-get-process connection))
- (mlist msgs))
- (if (and src-folder
- (not (string= (elmo-imap4-connection-get-cwf connection)
- src-folder))
- (null (elmo-imap4-select-folder
- src-folder connection)))
- (error "Select folder %s failed" src-folder))
- (while mlist
- (elmo-imap4-send-command (process-buffer process)
- process
- (list
- (format
- (if elmo-imap4-use-uid
- "uid copy %s "
- "copy %s ")
- (car mlist))
- (elmo-imap4-mailbox dst-folder)))
- (if (null (elmo-imap4-read-response (process-buffer process)
- process))
- (error "Copy failed")
- (setq mlist (cdr mlist))))
- (when expunge-it
- (elmo-imap4-send-command (process-buffer process)
- process "expunge")
- (if (null (elmo-imap4-read-response (process-buffer process)
- process))
- (error "Expunge failed")))
- t)))
+ (let* ((src-folder (elmo-imap4-spec-mailbox src-spec))
+ (dst-folder (elmo-imap4-spec-mailbox dst-spec))
+ (session (elmo-imap4-get-session src-spec))
+ (process (elmo-network-session-process-internal session))
+ (mlist msgs))
+ (elmo-imap4-select-mailbox session
+ (elmo-imap4-spec-mailbox src-spec))
+ (while mlist
+ (elmo-imap4-send-command process
+ (list
+ (format
+ (if elmo-imap4-use-uid
+ "uid copy %s "
+ "copy %s ")
+ (car mlist))
+ (elmo-imap4-mailbox dst-folder)))
+ (if (null (elmo-imap4-read-response process))
+ (error "Copy failed")
+ (setq mlist (cdr mlist))))
+ (when expunge-it
+ (elmo-imap4-send-command process "expunge")
+ (if (null (elmo-imap4-read-response process))
+ (error "Expunge failed")))
+ t))
(defun elmo-imap4-server-diff (spec)
"get server status"
- (save-excursion
- (let* ((connection (elmo-imap4-get-connection spec))
- (process (elmo-imap4-connection-get-process connection))
- response)
- ;; commit when same folder.
- (if (string= (elmo-imap4-connection-get-cwf connection)
- (elmo-imap4-spec-mailbox spec))
- (elmo-imap4-commit spec))
- (elmo-imap4-send-command (process-buffer process)
- process
- (list
- "status "
- (elmo-imap4-mailbox
- (elmo-imap4-spec-mailbox spec))
- " (unseen messages)"))
- (setq response (elmo-imap4-read-response
- (process-buffer process) process))
- (when (string-match "\\* STATUS [^(]* \\(([^)]*)\\)" response)
- (setq response (read (downcase (elmo-match-string 1 response))))
- (cons (cadr (memq 'unseen response))
- (cadr (memq 'messages response)))))))
+ (let* ((session (elmo-imap4-get-session spec))
+ (process (elmo-network-session-process-internal session))
+ response)
+ ;; commit.
+ (elmo-imap4-commit spec)
+ (elmo-imap4-send-command process
+ (list
+ "status "
+ (elmo-imap4-mailbox
+ (elmo-imap4-spec-mailbox spec))
+ " (unseen messages)"))
+ (setq response (elmo-imap4-read-response process))
+ (when (string-match "\\* STATUS [^(]* \\(([^)]*)\\)" response)
+ (setq response (read (downcase (elmo-match-string 1 response))))
+ (cons (cadr (memq 'unseen response))
+ (cadr (memq 'messages response))))))
(defun elmo-imap4-use-cache-p (spec number)
elmo-imap4-use-cache)
--- /dev/null
+;;; elmo-net.el -- Network module for ELMO.
+
+;; Copyright 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
+
+;; Author: Yuuichi Teranishi <teranisi@gohome.org>
+;; Keywords: mail, net news
+
+;; This file is part of ELMO (Elisp Library for Message Orchestration).
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+;;
+
+;;; Commentary:
+;;
+
+(require 'luna)
+(require 'elmo-util)
+(require 'elmo-vars)
+
+(eval-and-compile
+ (luna-define-class elmo-network-session () (name
+ host
+ port
+ user
+ auth
+ stream-type
+ process
+ greeting))
+ (luna-define-internal-accessors 'elmo-network-session))
+
+(luna-define-generic elmo-network-initialize-session (session)
+ "Initialize SESSION (Called before authentication).")
+
+(luna-define-generic elmo-network-authenticate-session (session)
+ "Authenticate SESSION.")
+
+(luna-define-generic elmo-network-setup-session (session)
+ "Setup SESSION. (Called after authentication).")
+
+(luna-define-generic elmo-network-close-session (session)
+ "Close SESSION.")
+
+(luna-define-method elmo-network-close-session ((session elmo-network-session))
+ (and (elmo-network-session-process-internal session)
+; (memq (process-status (elmo-network-session-process-internal session))
+; '(open run))
+ (kill-buffer (process-buffer
+ (elmo-network-session-process-internal session)))
+ (delete-process (elmo-network-session-process-internal session))))
+
+(defmacro elmo-network-stream-type-spec-string (stream-type)
+ (` (nth 0 (, stream-type))))
+
+(defmacro elmo-network-stream-type-symbol (stream-type)
+ (` (nth 1 (, stream-type))))
+
+(defmacro elmo-network-stream-type-feature (stream-type)
+ (` (nth 2 (, stream-type))))
+
+(defmacro elmo-network-stream-type-function (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)
+ (elmo-network-session-user-internal session)
+ (symbol-name (or (elmo-network-session-auth-internal session)
+ 'plain))
+ (elmo-network-session-host-internal session)
+ (elmo-network-session-port-internal session)))
+
+(defvar elmo-network-session-cache nil)
+
+(defsubst elmo-network-session-cache-key (name host port user auth stream-type)
+ "Returns session cache key."
+ (format "%s:%s/%s@%s:%d%s"
+ name user auth host port (or stream-type "")))
+
+(defun elmo-network-clear-session-cache ()
+ "Clear session cache."
+ (interactive)
+ (mapcar (lambda (pair)
+ (elmo-network-close-session (cdr pair)))
+ elmo-network-session-cache)
+ (setq elmo-network-session-cache nil))
+
+(defun elmo-network-get-session (class name host port user auth stream-type
+ &optional if-exists)
+ "Get network session from session cache or a new network session.
+CLASS is the class name of the session.
+NAME is the name of the process.
+HOST is the name of the server host.
+PORT is the port number of the service.
+USER is the user-id for the authenticate.
+AUTH is the authenticate method name (symbol).
+STREAM-TYPE is the stream type (See also `elmo-network-stream-type-alist').
+Returns a `elmo-network-session' instance.
+If optional argument IF-EXISTS is non-nil, it does not return session
+if there is no session cache.
+if making session failed, returns nil."
+ (let (pair session key)
+ (if (not (elmo-plugged-p host port))
+ (error "Unplugged"))
+ (setq pair (assoc (setq key (elmo-network-session-cache-key
+ name host port user auth stream-type))
+ elmo-network-session-cache))
+ (when (and pair
+ (memq (process-status
+ (elmo-network-session-process-internal
+ (cdr pair)))
+ '(closed exit)))
+ (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.
+ (unless if-exists
+ (setq session
+ (elmo-network-open-session class name
+ host port user auth stream-type))
+ (setq elmo-network-session-cache
+ (cons (cons key session)
+ elmo-network-session-cache))
+ session))))
+
+(defun elmo-network-open-session (class name host port user auth
+ stream-type)
+ "Open an authenticated network session.
+CLASS is the class name of the session.
+NAME is the name of the process.
+HOST is the name of the server host.
+PORT is the port number of the service.
+USER is the user-id for the authenticate.
+AUTH is the authenticate method name (symbol).
+STREAM-TYPE is the stream type (See also `elmo-network-stream-type-alist').
+Returns a process object. if making session failed, returns nil."
+ (let ((session
+ (luna-make-entity class
+ :name name
+ :host host
+ :port port
+ :user user
+ :auth auth
+ :stream-type stream-type
+ :process nil
+ :greeting nil)))
+ (condition-case error
+ (progn
+ (elmo-network-session-set-process-internal
+ session
+ (elmo-open-network-stream
+ (elmo-network-session-name-internal session)
+ (format " *%s session to %s:%d"
+ (elmo-network-session-name-internal session)
+ host port)
+ host port stream-type))
+ (when (elmo-network-session-process-internal session)
+ (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))))
+ session))
+
+(defun elmo-open-network-stream (name buffer host service stream-type)
+ (let ((auto-plugged (and elmo-auto-change-plugged
+ (> elmo-auto-change-plugged 0)))
+ process)
+ (if (and stream-type
+ (elmo-network-stream-type-feature stream-type))
+ (require (elmo-network-stream-type-feature stream-type)))
+ (condition-case err
+ (let (process-connection-type)
+ (as-binary-process
+ (setq process
+ (if stream-type
+ (funcall (elmo-network-stream-type-function stream-type)
+ name buffer host service)
+ (open-network-stream name buffer host service)))))
+ (error
+ (when auto-plugged
+ (elmo-set-plugged nil host service (current-time))
+ (message "Auto plugged off at %s:%d" host service)
+ (sit-for 1))
+ (signal (car err) (cdr err))))
+ (when process
+ (process-kill-without-query process)
+ (when auto-plugged
+ (elmo-set-plugged t host service))
+ process)))
+
+(provide 'elmo-net)
+
+;;; elmo-net.el ends here
;;
(require 'elmo-msgdb)
+(require 'elmo-net)
(eval-when-compile
(require 'elmo-util)
(condition-case nil
(server-msg-1 client-msg-1 salted-pass))
(defun-maybe sasl-scram-md5-make-salted-pass
(server-msg-1 passphrase))
+ (defun-maybe sasl-cram-md5 (username passphrase challenge))
(defun-maybe sasl-scram-md5-authenticate-server
(server-msg-1 server-msg-2 client-msg-1 salted-pass))
(defun-maybe starttls-negotiate (a)))
(defvar elmo-pop3-exists-exactly t)
(defvar elmo-pop3-read-point nil)
-(defvar elmo-pop3-connection-cache nil
- "Cache of pop3 connection.")
+
+(defvar elmo-pop3-authenticator-alist
+ '((user elmo-pop3-auth-user)
+ (apop elmo-pop3-auth-apop)
+ (cram-md5 elmo-pop3-auth-cram-md5)
+ (scram-md5 elmo-pop3-auth-scram-md5)
+ (digest-md5 elmo-pop3-auth-digest-md5))
+ "Definition of authenticators.")
+
+(eval-and-compile
+ (luna-define-class elmo-pop3-session (elmo-network-session) ()))
;; buffer-local
(defvar elmo-pop3-number-uidl-hash nil) ; number -> uidl
(defvar elmo-pop3-uidl-done nil)
(defvar elmo-pop3-list-done nil)
-(defmacro elmo-pop3-connection-get-process (connection)
- (` (nth 1 (, connection))))
-
-(defmacro elmo-pop3-connection-get-buffer (connection)
- (` (nth 0 (, connection))))
-
-(defun elmo-pop3-close-connection (connection &optional process buffer)
- (and (or connection process)
- (save-excursion
- (let ((buffer (or buffer
- (elmo-pop3-connection-get-buffer connection)))
- (process (or process
- (elmo-pop3-connection-get-process connection))))
- (elmo-pop3-send-command buffer process "quit")
- (when (null (elmo-pop3-read-response buffer process t))
- (error "POP error: QUIT failed"))
- (if buffer (kill-buffer buffer))
- (if process (delete-process process))))))
-
-(defun elmo-pop3-flush-connection ()
- (interactive)
- (let ((cache elmo-pop3-connection-cache)
- buffer process proc-stat)
- (while cache
- (setq buffer (car (cdr (car cache))))
- (setq process (car (cdr (cdr (car cache)))))
- (if (and process
- (not (or (eq (setq proc-stat
- (process-status process))
- 'closed)
- (eq proc-stat 'exit))))
- (condition-case ()
- (elmo-pop3-close-connection nil process buffer)
- (error)))
- (setq cache (cdr cache)))
- (setq elmo-pop3-connection-cache nil)))
-
-(defun elmo-pop3-get-connection (spec &optional if-exists)
- "Return opened POP3 connection for SPEC."
- (let* ((user (elmo-pop3-spec-username spec))
- (server (elmo-pop3-spec-hostname spec))
- (port (elmo-pop3-spec-port spec))
- (auth (elmo-pop3-spec-auth spec))
- (type (elmo-pop3-spec-stream-type spec))
- (user-at-host (format "%s@%s" user server))
- entry connection result buffer process proc-stat response
- user-at-host-on-port)
- (if (not (elmo-plugged-p server port))
- (error "Unplugged"))
- (setq user-at-host-on-port
- (concat user-at-host ":" (int-to-string port)
- (elmo-network-stream-type-spec-string type)))
- (setq entry (assoc user-at-host-on-port elmo-pop3-connection-cache))
- (if (and entry
- (memq (setq proc-stat
- (process-status (cadr (cdr entry))))
- '(closed exit signal)))
- ;; connection is closed...
- (let ((buffer (car (cdr entry))))
- (if buffer (kill-buffer buffer))
- (setq elmo-pop3-connection-cache
- (delete entry elmo-pop3-connection-cache))
- (setq entry nil)))
- (if entry
- (cdr entry)
- (unless if-exists
- (setq result
- (elmo-pop3-open-connection
- server user port auth
- (elmo-get-passwd user-at-host) type))
- (if (null result)
- (error "Connection failed"))
- (setq buffer (car result))
- (setq process (cdr result))
- (when (and process (null buffer))
- (elmo-remove-passwd user-at-host)
- (delete-process process)
- (error "Login failed"))
- ;; add a new entry to the top of the cache.
- (setq elmo-pop3-connection-cache
- (cons
- (cons user-at-host-on-port
- (setq connection (list buffer process)))
- elmo-pop3-connection-cache))
- ;; initialization of list
- (with-current-buffer buffer
- (make-variable-buffer-local 'elmo-pop3-uidl-number-hash)
- (make-variable-buffer-local 'elmo-pop3-number-uidl-hash)
- (make-variable-buffer-local 'elmo-pop3-uidl-done)
- (make-variable-buffer-local 'elmo-pop3-size-hash)
- (make-variable-buffer-local 'elmo-pop3-list-done)
- (setq elmo-pop3-size-hash (make-vector 31 0))
- ;; To get obarray of uidl and size
- ;; List
- (elmo-pop3-send-command buffer process "list")
- (if (null (elmo-pop3-read-response buffer process))
- (error "POP List folder failed"))
- (if (null (setq response
- (elmo-pop3-read-contents buffer process)))
- (error "POP List folder failed"))
- ;; POP server always returns a sequence of serial numbers.
- (elmo-pop3-parse-list-response response)
- ;; UIDL
- (when elmo-pop3-use-uidl
- (setq elmo-pop3-uidl-number-hash (make-vector 31 0))
- (setq elmo-pop3-number-uidl-hash (make-vector 31 0))
- ;; UIDL
- (elmo-pop3-send-command buffer process "uidl")
- (unless (elmo-pop3-read-response buffer process)
- (error "UIDL failed."))
- (unless (setq response (elmo-pop3-read-contents buffer process))
- (error "UIDL failed."))
- (elmo-pop3-parse-uidl-response response)
- elmo-pop3-uidl-done))
- connection))))
-
-(defun elmo-pop3-send-command (buffer process command &optional no-erase)
- (with-current-buffer buffer
+(luna-define-method elmo-network-close-session ((session elmo-pop3-session))
+ (when (process-live-p
+ (elmo-network-session-process-internal session))
+ (elmo-pop3-send-command (elmo-network-session-process-internal session)
+ "quit")
+ (or (elmo-pop3-read-response
+ (elmo-network-session-process-internal session) t)
+ (error "POP error: QUIT failed"))
+ (kill-buffer (process-buffer
+ (elmo-network-session-process-internal session))))
+ (delete-process (elmo-network-session-process-internal session)))
+
+(defun elmo-pop3-get-session (spec &optional if-exists)
+ (elmo-network-get-session
+ 'elmo-pop3-session
+ "POP3"
+ (elmo-pop3-spec-hostname spec)
+ (elmo-pop3-spec-port spec)
+ (elmo-pop3-spec-username spec)
+ (elmo-pop3-spec-auth spec)
+ (elmo-pop3-spec-stream-type spec)
+ if-exists))
+
+(defun elmo-pop3-send-command (process command &optional no-erase)
+ (with-current-buffer (process-buffer process)
(unless no-erase
(erase-buffer))
(goto-char (point-min))
(process-send-string process command)
(process-send-string process "\r\n")))
-(defun elmo-pop3-read-response (buffer process &optional not-command)
- (save-excursion
- (set-buffer buffer)
+(defun elmo-pop3-read-response (process &optional not-command)
+ (with-current-buffer (process-buffer process)
(let ((case-fold-search nil)
(response-string nil)
(response-continue t)
(goto-char (point-max))
(insert output)))
-(defun elmo-pop3-open-connection (server user port auth passphrase type)
- "Open POP3 connection to SERVER on PORT for USER.
-Return a cons cell of (session-buffer . process).
-Return nil if connection failed."
- (let ((process nil)
- (host server)
- process-buffer ret-val response capability)
- (catch 'done
- (as-binary-process
- (setq process-buffer
- (get-buffer-create (format " *POP session to %s:%d" host port)))
- (save-excursion
- (set-buffer process-buffer)
- (elmo-set-buffer-multibyte nil)
- (erase-buffer))
- (setq process
- (elmo-open-network-stream "POP" process-buffer host port type))
- (and (null process) (throw 'done nil))
- (set-process-filter process 'elmo-pop3-process-filter)
- ;; flush connections when exiting...
- (save-excursion
- (set-buffer process-buffer)
- (make-local-variable 'elmo-pop3-read-point)
- (setq elmo-pop3-read-point (point-min))
- (when (null (setq response
- (elmo-pop3-read-response process-buffer process t)))
- (setq ret-val (cons nil process))
- (throw 'done nil))
- (when (eq (elmo-network-stream-type-symbol type) 'starttls)
- (elmo-pop3-send-command process-buffer process "stls")
- (string-match "^\+OK"
- (elmo-pop3-read-response
- process-buffer process))
- (starttls-negotiate process))
- (cond ((string= auth "apop")
- ;; try only APOP
- (if (string-match "^\+OK .*\\(<[^\>]+>\\)" response)
- ;; good, APOP ready server
- (progn
- (require 'md5)
- (elmo-pop3-send-command
- process-buffer process
- (format "apop %s %s"
- user
- (md5
- (concat (match-string 1 response)
- passphrase)))))
- ;; otherwise, fail (only APOP authentication)
- (setq ret-val (cons nil process))
- (throw 'done nil)))
- ((string= auth "cram-md5")
- (elmo-pop3-send-command
- process-buffer process "auth cram-md5")
- (when (null (setq response
- (elmo-pop3-read-response
- process-buffer process t)))
- (setq ret-val (cons nil process))
- (throw 'done nil))
- (elmo-pop3-send-command
- process-buffer process
- (elmo-base64-encode-string
- (sasl-cram-md5 user passphrase
- (elmo-base64-decode-string
- (cadr (split-string response " ")))))))
- ((string= auth "digest-md5")
- (elmo-pop3-send-command
- process-buffer process "auth digest-md5")
- (when (null (setq response
- (elmo-pop3-read-response
- process-buffer process t)))
- (setq ret-val (cons nil process))
- (throw 'done nil))
- (elmo-pop3-send-command
- process-buffer process
- (elmo-base64-encode-string
- (sasl-digest-md5-digest-response
- (elmo-base64-decode-string
- (cadr (split-string response " ")))
- user passphrase "pop" host)
- 'no-line-break))
- (when (null (setq response
- (elmo-pop3-read-response
- process-buffer process t)))
- (setq ret-val (cons nil process))
- (throw 'done nil))
- (elmo-pop3-send-command process-buffer process ""))
- ((string= auth "scram-md5")
- (let (server-msg-1 server-msg-2 client-msg-1 client-msg-2
- salted-pass)
- (elmo-pop3-send-command
- process-buffer process
- (format "auth scram-md5 %s"
- (elmo-base64-encode-string
- (setq client-msg-1
- (sasl-scram-md5-client-msg-1 user)))))
- (when (null (setq response
- (elmo-pop3-read-response
- process-buffer process t)))
- (setq ret-val (cons nil process))
- (throw 'done nil))
- (setq server-msg-1
- (elmo-base64-decode-string
- (cadr (split-string response " "))))
- (elmo-pop3-send-command
- process-buffer process
- (elmo-base64-encode-string
- (sasl-scram-md5-client-msg-2
- server-msg-1
- client-msg-1
- (setq salted-pass
- (sasl-scram-md5-make-salted-pass
- server-msg-1 passphrase)))))
- (when (null (setq response
- (elmo-pop3-read-response
- process-buffer process t)))
- (setq ret-val (cons nil process))
- (throw 'done nil))
- (setq server-msg-2
- (elmo-base64-decode-string
- (cadr (split-string response " "))))
- (if (null (sasl-scram-md5-authenticate-server
- server-msg-1
- server-msg-2
- client-msg-1
- salted-pass))
- (throw 'done nil))
- (elmo-pop3-send-command
- process-buffer process "")))
- (t
- ;; try USER/PASS
- (elmo-pop3-send-command process-buffer process
- (format "user %s" user))
- (when (null (elmo-pop3-read-response process-buffer process t))
- (setq ret-val (cons nil process))
- (throw 'done nil))
- (elmo-pop3-send-command process-buffer process
- (format "pass %s" passphrase))))
- ;; read PASS or APOP response
- (when (null (elmo-pop3-read-response process-buffer process t))
- (setq ret-val (cons nil process))
- (throw 'done nil))
- (setq ret-val (cons process-buffer process)))))
- ret-val))
+(defun elmo-pop3-auth-user (session)
+ (let ((process (elmo-network-session-process-internal session)))
+ ;; try USER/PASS
+ (elmo-pop3-send-command
+ process
+ (format "user %s" (elmo-network-session-user-internal session)))
+ (or (elmo-pop3-read-response process t)
+ (signal 'elmo-authenticate-error
+ '(elmo-pop-auth-user)))
+ (elmo-pop3-send-command process
+ (format
+ "pass %s"
+ (elmo-get-passwd
+ (elmo-network-session-password-key session))))
+ (or (elmo-pop3-read-response process t)
+ (signal 'elmo-authenticate-error
+ '(elmo-pop-auth-user)))))
+
+(defun elmo-pop3-auth-apop (session)
+ (if (string-match "^\+OK .*\\(<[^\>]+>\\)"
+ (elmo-network-session-greeting-internal session))
+ ;; good, APOP ready server
+ (progn
+ (require 'md5)
+ (elmo-pop3-send-command
+ (elmo-network-session-process-internal session)
+ (format "apop %s %s"
+ (elmo-network-session-user-internal session)
+ (md5
+ (concat (match-string
+ 1
+ (elmo-network-session-greeting-internal session))
+ (elmo-get-passwd
+ (elmo-network-session-password-key session))))))
+ (or (elmo-pop3-read-response
+ (elmo-network-session-process-internal session)
+ t)
+ (signal 'elmo-authenticate-error
+ '(elmo-pop3-auth-apop))))
+ (signal 'elmo-open-error '(elmo-pop-auth-user))))
+
+(defun elmo-pop3-auth-cram-md5 (session)
+ (let ((process (elmo-network-session-process-internal session))
+ response)
+ (elmo-pop3-send-command process "auth cram-md5")
+ (or (setq response
+ (elmo-pop3-read-response process t))
+ (signal 'elmo-open-error '(elmo-pop-auth-cram-md5)))
+ (elmo-pop3-send-command
+ process
+ (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
+ (cadr (split-string response " "))))))
+ (or (elmo-pop3-read-response process t)
+ (signal 'elmo-authenticate-error
+ '(elmo-pop-auth-cram-md5)))))
+
+(defun elmo-pop3-auth-scram-md5 (session)
+ (let ((process (elmo-network-session-process-internal session))
+ server-msg-1 server-msg-2 client-msg-1 client-msg-2
+ salted-pass response)
+ (elmo-pop3-send-command
+ process
+ (format "auth scram-md5 %s"
+ (elmo-base64-encode-string
+ (setq client-msg-1
+ (sasl-scram-md5-client-msg-1
+ (elmo-network-session-user-internal session))))))
+ (or (elmo-pop3-read-response process t)
+ (signal 'elmo-open-error '(elmo-pop-auth-scram-md5)))
+ (setq server-msg-1
+ (elmo-base64-decode-string (cadr (split-string response " "))))
+ (elmo-pop3-send-command
+ process
+ (elmo-base64-encode-string
+ (sasl-scram-md5-client-msg-2
+ server-msg-1
+ client-msg-1
+ (setq salted-pass
+ (sasl-scram-md5-make-salted-pass
+ server-msg-1
+ (elmo-get-passwd
+ (elmo-network-session-password-key session)))))))
+ (or (setq response (elmo-pop3-read-response process t))
+ (signal 'elmo-authenticate-error
+ '(elmo-pop-auth-scram-md5)))
+ (setq server-msg-2 (elmo-base64-decode-string
+ (cadr (split-string response " "))))
+ (or (sasl-scram-md5-authenticate-server server-msg-1
+ server-msg-2
+ client-msg-1
+ salted-pass)
+ (signal 'elmo-authenticate-error
+ '(elmo-pop-auth-scram-md5)))
+ (elmo-pop3-send-command process "")
+ (or (setq response (elmo-pop3-read-response process t))
+ (signal 'elmo-authenticate-error
+ '(elmo-pop-auth-scram-md5)))))
+
+(defun elmo-pop3-auth-digest-md5 (session)
+ (let ((process (elmo-network-session-process-internal session))
+ response)
+ (elmo-pop3-send-command process "auth digest-md5")
+ (or (setq response
+ (elmo-pop3-read-response process t))
+ (signal 'elmo-open-error
+ '(elmo-pop-auth-digest-md5)))
+ (elmo-pop3-send-command
+ process
+ (elmo-base64-encode-string
+ (sasl-digest-md5-digest-response
+ (elmo-base64-decode-string
+ (cadr (split-string response " ")))
+ (elmo-network-session-user-internal session)
+ (elmo-get-passwd
+ (elmo-network-session-password-key session))
+ "pop"
+ (elmo-network-session-host-internal session))
+ 'no-line-break))
+ (or (elmo-pop3-read-response process t)
+ (signal 'elmo-authenticate-error
+ '(elmo-pop-auth-digest-md5)))
+ (elmo-pop3-send-command process "")
+ (or (elmo-pop3-read-response process t)
+ (signal 'elmo-open-error
+ '(elmo-pop-auth-digest-md5)))))
+
+(luna-define-method elmo-network-initialize-session ((session
+ elmo-pop3-session))
+ (let ((process (elmo-network-session-process-internal session))
+ response capability mechanism)
+ (with-current-buffer (process-buffer process)
+ (elmo-set-buffer-multibyte nil)
+ (set-process-filter process 'elmo-pop3-process-filter)
+ (make-local-variable 'elmo-pop3-read-point)
+ (setq elmo-pop3-read-point (point-min))
+ (or (elmo-network-session-set-greeting-internal
+ session
+ (elmo-pop3-read-response process t))
+ (signal 'elmo-open-error
+ '(elmo-network-intialize-session)))
+ (when (eq (elmo-network-stream-type-symbol
+ (elmo-network-session-stream-type-internal session))
+ 'starttls)
+ (elmo-pop3-send-command process "stls")
+ (if (string-match "^\+OK"
+ (elmo-pop3-read-response process))
+ (starttls-negotiate process)
+ (signal 'elmo-open-error
+ '(elmo-network-intialize-session)))))))
+
+(luna-define-method elmo-network-authenticate-session ((session
+ elmo-pop3-session))
+ (let (authenticator)
+ ;; defaults to 'user.
+ (unless (elmo-network-session-auth-internal session)
+ (elmo-network-session-set-auth-internal session 'user))
+ (setq authenticator
+ (nth 1 (assq (elmo-network-session-auth-internal session)
+ elmo-pop3-authenticator-alist)))
+ (unless authenticator (error "There's no authenticator for %s"
+ (elmo-network-session-auth-internal session)))
+ (funcall authenticator session)))
+
+(luna-define-method elmo-network-setup-session ((session
+ elmo-pop3-session))
+ (let ((process (elmo-network-session-process-internal session))
+ response)
+ (with-current-buffer (process-buffer process)
+ ;; Initialize list
+ (make-variable-buffer-local 'elmo-pop3-uidl-number-hash)
+ (make-variable-buffer-local 'elmo-pop3-number-uidl-hash)
+ (make-variable-buffer-local 'elmo-pop3-uidl-done)
+ (make-variable-buffer-local 'elmo-pop3-size-hash)
+ (make-variable-buffer-local 'elmo-pop3-list-done)
+ (setq elmo-pop3-size-hash (make-vector 31 0))
+ ;; To get obarray of uidl and size
+ (elmo-pop3-send-command process "list")
+ (if (null (elmo-pop3-read-response process))
+ (error "POP List folder failed"))
+ (if (null (setq response
+ (elmo-pop3-read-contents
+ (current-buffer) process)))
+ (error "POP List folder failed"))
+ ;; POP server always returns a sequence of serial numbers.
+ (elmo-pop3-parse-list-response response)
+ ;; UIDL
+ (when elmo-pop3-use-uidl
+ (setq elmo-pop3-uidl-number-hash (make-vector 31 0))
+ (setq elmo-pop3-number-uidl-hash (make-vector 31 0))
+ ;; UIDL
+ (elmo-pop3-send-command process "uidl")
+ (unless (elmo-pop3-read-response process)
+ (error "UIDL failed."))
+ (unless (setq response (elmo-pop3-read-contents
+ (current-buffer) process))
+ (error "UIDL failed."))
+ (elmo-pop3-parse-uidl-response response)))))
(defun elmo-pop3-read-contents (buffer process)
(save-excursion
(if (and elmo-pop3-exists-exactly
(elmo-pop3-plugged-p spec))
(save-excursion
- (let (elmo-auto-change-plugged) ;;don't change plug status.
+ (let (elmo-auto-change-plugged ; don't change plug status.
+ session)
(condition-case nil
(prog1
- (elmo-pop3-get-connection spec)
- (elmo-pop3-close-connection
- (elmo-pop3-get-connection spec 'if-exists)))
+ (setq session (elmo-pop3-get-session spec))
+ (if session
+ (elmo-network-close-session session)))
(error nil))))
t))
(nreverse list))))
(defun elmo-pop3-list-location (spec)
- (with-current-buffer (elmo-pop3-connection-get-buffer
- (elmo-pop3-get-connection spec))
+ (with-current-buffer (process-buffer
+ (elmo-network-session-process-internal
+ (elmo-pop3-get-session spec)))
(let (list)
(if elmo-pop3-uidl-done
(progn
(sort flist '<))))
(defun elmo-pop3-list-by-list (spec)
- (with-current-buffer (elmo-pop3-connection-get-buffer
- (elmo-pop3-get-connection spec))
+ (with-current-buffer (process-buffer
+ (elmo-network-session-process-internal
+ (elmo-pop3-get-session spec)))
(let (list)
(if elmo-pop3-list-done
(progn
(elmo-pop3-commit spec)
(if elmo-pop3-use-uidl
(elmo-pop3-list-by-uidl-subr spec 'nonsort)
- (let* ((connection (elmo-pop3-get-connection spec))
- (buffer (nth 0 connection))
- (process (nth 1 connection))
+ (let* ((process
+ (elmo-network-session-process-internal
+ (elmo-pop3-get-session spec)))
(total 0)
response)
- (with-current-buffer buffer
- (elmo-pop3-send-command buffer process "STAT")
- (setq response (elmo-pop3-read-response buffer process))
+ (with-current-buffer (process-buffer process)
+ (elmo-pop3-send-command process "STAT")
+ (setq response (elmo-pop3-read-response process))
;; response: "^\+OK 2 7570$"
(if (not (string-match "^\+OK[ \t]*\\([0-9]*\\)" response))
(error "POP STAT command failed")
(last-point (point-min)))
;; Send HEAD commands.
(while articles
- (elmo-pop3-send-command buffer process (format
- "top %s 0" (car articles))
+ (elmo-pop3-send-command process (format
+ "top %s 0" (car articles))
'no-erase)
;; (accept-process-output process 1)
(setq articles (cdr articles))
important-mark seen-list
&optional msgdb)
(when numlist
- (let* ((connection (elmo-pop3-get-connection spec))
- (buffer (elmo-pop3-connection-get-buffer connection))
- (process (elmo-pop3-connection-get-process connection))
- loc-alist)
+ (let ((process (elmo-network-session-process-internal
+ (elmo-pop3-get-session spec)))
+ loc-alist)
(if elmo-pop3-use-uidl
(setq loc-alist (if msgdb (elmo-msgdb-get-location msgdb)
(elmo-msgdb-location-load
(elmo-msgdb-expand-path nil spec)))))
- (elmo-pop3-msgdb-create-by-header buffer process numlist
+ (elmo-pop3-msgdb-create-by-header process numlist
new-mark already-mark
seen-mark seen-list
loc-alist))))
(elmo-get-hash-val (format "#%d" number)
elmo-pop3-size-hash))
-(defun elmo-pop3-msgdb-create-by-header (buffer process numlist
- new-mark already-mark
- seen-mark
- seen-list
- loc-alist)
+(defun elmo-pop3-msgdb-create-by-header (process numlist
+ new-mark already-mark
+ seen-mark
+ seen-list
+ loc-alist)
(let ((tmp-buffer (get-buffer-create " *ELMO Overview TMP*")))
- (with-current-buffer buffer
+ (with-current-buffer (process-buffer process)
(if loc-alist ; use uidl.
(setq numlist
(delq
(lambda (number)
(elmo-pop3-uidl-to-number (cdr (assq number loc-alist))))
numlist))))
- (elmo-pop3-retrieve-headers buffer tmp-buffer process numlist)
+ (elmo-pop3-retrieve-headers (process-buffer process)
+ tmp-buffer process numlist)
(prog1
(elmo-pop3-msgdb-create-message
tmp-buffer
(/ (* i 100) num)))))
(list overview number-alist mark-alist loc-alist))))
-(defun elmo-pop3-read-body (buffer process outbuf)
- (with-current-buffer buffer
+(defun elmo-pop3-read-body (process outbuf)
+ (with-current-buffer (process-buffer process)
(let ((start elmo-pop3-read-point)
end)
(goto-char start)
(setq end (point))
(with-current-buffer outbuf
(erase-buffer)
- (insert-buffer-substring buffer start (- end 3))
+ (insert-buffer-substring (process-buffer process) start (- end 3))
(elmo-delete-cr-get-content-type)))))
(defun elmo-pop3-read-msg (spec number outbuf &optional msgdb)
(elmo-msgdb-get-location msgdb)
(elmo-msgdb-location-load
(elmo-msgdb-expand-path nil spec)))))
- (connection (elmo-pop3-get-connection spec))
- (buffer (elmo-pop3-connection-get-buffer connection))
- (process (elmo-pop3-connection-get-process connection))
+ (process (elmo-network-session-process-internal
+ (elmo-pop3-get-session spec)))
response errmsg msg)
- (with-current-buffer buffer
+ (with-current-buffer (process-buffer process)
(if loc-alist
(setq number (elmo-pop3-uidl-to-number
(cdr (assq number loc-alist)))))
(when number
- (elmo-pop3-send-command buffer process
+ (elmo-pop3-send-command process
(format "retr %s" number))
(when (null (setq response (elmo-pop3-read-response
- buffer process t)))
+ process t)))
(error "Fetching message failed"))
- (setq response (elmo-pop3-read-body buffer process outbuf))
+ (setq response (elmo-pop3-read-body process outbuf))
(set-buffer outbuf)
(goto-char (point-min))
(while (re-search-forward "^\\." nil t)
(forward-line))
response))))
-(defun elmo-pop3-delete-msg (buffer process number loc-alist)
- (with-current-buffer buffer
+(defun elmo-pop3-delete-msg (process number loc-alist)
+ (with-current-buffer (process-buffer process)
(let (response errmsg msg)
(if loc-alist
(setq number (elmo-pop3-uidl-to-number
(cdr (assq number loc-alist)))))
(if number
(progn
- (elmo-pop3-send-command buffer process
+ (elmo-pop3-send-command process
(format "dele %s" number))
(when (null (setq response (elmo-pop3-read-response
- buffer process t)))
+ process t)))
(error "Deleting message failed")))
(error "Deleting message failed")))))
-
(defun elmo-pop3-delete-msgs (spec msgs &optional msgdb)
- (let* ((loc-alist (if elmo-pop3-use-uidl
- (if msgdb
- (elmo-msgdb-get-location msgdb)
- (elmo-msgdb-location-load
- (elmo-msgdb-expand-path nil spec)))))
- (connection (elmo-pop3-get-connection spec))
- (buffer (elmo-pop3-connection-get-buffer connection))
- (process (elmo-pop3-connection-get-process connection)))
+ (let ((loc-alist (if elmo-pop3-use-uidl
+ (if msgdb
+ (elmo-msgdb-get-location msgdb)
+ (elmo-msgdb-location-load
+ (elmo-msgdb-expand-path nil spec)))))
+ (process (elmo-network-session-process-internal
+ (elmo-pop3-get-session spec))))
(mapcar '(lambda (msg) (elmo-pop3-delete-msg
- buffer process msg loc-alist))
+ process msg loc-alist))
msgs)))
(defun elmo-pop3-search (spec condition &optional numlist)
(defun elmo-pop3-commit (spec)
(if (elmo-pop3-plugged-p spec)
- (elmo-pop3-close-connection
- (elmo-pop3-get-connection spec 'if-exists))))
+ (let ((session (elmo-pop3-get-session spec 'if-exists)))
+ (and session
+ (elmo-network-close-session session)))))
+
(provide 'elmo-pop3)
(filename newname &optional ok-if-already-exists)
(copy-file filename newname ok-if-already-exists t)))
-(require 'broken)
-(broken-facility timezone-y2k
- "timezone.el does not clear Y2K."
- (or (not (featurep 'timezone))
- (string= (aref (timezone-parse-date "Sat, 1 Jan 00 07:00:00 JST") 0)
- "2000")))
-
-(when-broken timezone-y2k
- (defun timezone-parse-date (date)
- "Parse DATE and return a vector [YEAR MONTH DAY TIME TIMEZONE].
-19 is prepended to year if necessary. Timezone may be nil if nothing.
-Understands the following styles:
- (1) 14 Apr 89 03:20[:12] [GMT]
- (2) Fri, 17 Mar 89 4:01[:33] [GMT]
- (3) Mon Jan 16 16:12[:37] [GMT] 1989
- (4) 6 May 1992 1641-JST (Wednesday)
- (5) 22-AUG-1993 10:59:12.82
- (6) Thu, 11 Apr 16:17:12 91 [MET]
- (7) Mon, 6 Jul 16:47:20 T 1992 [MET]"
- (condition-case nil
- (progn
- ;; Get rid of any text properties.
- (and (stringp date)
- (or (text-properties-at 0 date)
- (next-property-change 0 date))
- (setq date (copy-sequence date))
- (set-text-properties 0 (length date) nil date))
- (let ((date (or date ""))
- (year nil)
- (month nil)
- (day nil)
- (time nil)
- (zone nil)) ;This may be nil.
- (cond ((string-match
- "\\([^ \t,]+\\),[ \t]+\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]+\\(T[ \t]+\\|\\)\\([0-9]+\\)[ \t]*\\'" date)
- ;; Styles: (6) and (7) without timezone
- (setq year 6 month 3 day 2 time 4 zone nil))
- ((string-match
- "\\([^ \t,]+\\),[ \t]+\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]+\\(T[ \t]+\\|\\)\\([0-9]+\\)[ \t]*\\([-+a-zA-Z0-9]+\\)" date)
- ;; Styles: (6) and (7) with timezone and buggy timezone
- (setq year 6 month 3 day 2 time 4 zone 7))
- ((string-match
- "\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]*\\'" date)
- ;; Styles: (1) and (2) without timezone
- (setq year 3 month 2 day 1 time 4 zone nil))
- ((string-match
- "\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]*\\([-+a-zA-Z0-9]+\\)" date)
- ;; Styles: (1) and (2) with timezone and buggy timezone
- (setq year 3 month 2 day 1 time 4 zone 5))
- ((string-match
- "\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]+\\([0-9]+\\)" date)
- ;; Styles: (3) without timezone
- (setq year 4 month 1 day 2 time 3 zone nil))
- ((string-match
- "\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]+\\([-+a-zA-Z0-9]+\\)[ \t]+\\([0-9]+\\)" date)
- ;; Styles: (3) with timezone
- (setq year 5 month 1 day 2 time 3 zone 4))
- ((string-match
- "\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)[ \t]*\\([-+a-zA-Z0-9]+\\)" date)
- ;; Styles: (4) with timezone
- (setq year 3 month 2 day 1 time 4 zone 5))
- ((string-match
- "\\([0-9]+\\)-\\([A-Za-z]+\\)-\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9]+:[0-9]+\\)\\.[0-9]+" date)
- ;; Styles: (5) without timezone.
- (setq year 3 month 2 day 1 time 4 zone nil))
- )
- (if year
- (progn
- (setq year
- (substring date (match-beginning year)
- (match-end year)))
- (if (< (length year) 4)
- (let ((yr (string-to-int year)))
- (when (>= yr 100)
- (setq yr (- yr 100)))
- (setq year (format "%d%02d"
- (if (< yr 70)
- 20
- 19)
- yr))))
- (let ((string (substring date
- (match-beginning month)
- (+ (match-beginning month) 3))))
- (setq month
- (int-to-string
- (cdr (assoc (upcase string)
- timezone-months-assoc)))))
- (setq day
- (substring date (match-beginning day) (match-end day)))
- (setq time
- (substring date (match-beginning time)
- (match-end time)))))
- (if zone
- (setq zone
- (substring date (match-beginning zone)
- (match-end zone))))
- (if year
- (vector year month day time zone)
- (vector "0" "0" "0" "0" nil))
- )
- )
- (t (signal 'invalid-date (list date))))))
-
(defsubst elmo-call-func (folder func-name &rest args)
(let* ((spec (if (stringp folder)
(elmo-folder-get-spec folder)
(utf7-encode-string string 'imap)
string))
+(defun elmo-get-network-stream-type (stream-type)
+ (let ((ali elmo-network-stream-type-alist)
+ entry)
+ (while ali
+ (when (eq (car (cdr (car ali))) stream-type)
+ (setq entry (car ali)
+ ali nil))
+ (setq ali (cdr ali)))
+ entry))
+
(defun elmo-network-get-spec (folder default-server default-port
default-stream-type)
(let (server port type)
(if (eq (length user) 0)
(setq user elmo-default-pop3-user))
(setq auth (if (match-beginning 3)
- (elmo-match-substring 3 folder 1)
+ (intern (elmo-match-substring 3 folder 1))
elmo-default-pop3-authenticate-type))
(append (list 'pop3 user auth)
(cdr spec)))))
(and (eq (car diff) 0)
(< diff-time (nth 1 diff)))))
-
-(defun elmo-get-network-stream-type (stream-type)
- (let ((ali elmo-network-stream-type-alist)
- entry)
- (while ali
- (when (eq (car (cdr (car ali))) stream-type)
- (setq entry (car ali)
- ali nil))
- (setq ali (cdr ali)))
- entry))
-
-(defmacro elmo-network-stream-type-spec-string (stream-type)
- (` (nth 0 (, stream-type))))
-
-(defmacro elmo-network-stream-type-symbol (stream-type)
- (` (nth 1 (, stream-type))))
-
-(defmacro elmo-network-stream-type-feature (stream-type)
- (` (nth 2 (, stream-type))))
-
-(defmacro elmo-network-stream-type-function (stream-type)
- (` (nth 3 (, stream-type))))
-
-(defun elmo-open-network-stream (name buffer host service stream-type)
- (let ((auto-plugged (and elmo-auto-change-plugged
- (> elmo-auto-change-plugged 0)))
- process)
- (if (and stream-type
- (elmo-network-stream-type-feature stream-type))
- (require (elmo-network-stream-type-feature stream-type)))
- (condition-case err
- (let (process-connection-type)
- (setq process
- (if stream-type
- (funcall (elmo-network-stream-type-function stream-type)
- name buffer host service)
- (open-network-stream name buffer host service))))
- (error
- (when auto-plugged
- (elmo-set-plugged nil host service (current-time))
- (message "Auto plugged off at %s:%d" host service)
- (sit-for 1))
- (signal (car err) (cdr err))))
- (when process
- (process-kill-without-query process)
- (when auto-plugged
- (elmo-set-plugged t host service))
- process)))
-
(if (fboundp 'std11-fetch-field)
(defalias 'elmo-field-body 'std11-fetch-field) ;;no narrow-to-region
(defalias 'elmo-field-body 'std11-field-body))
"*Default username for POP3.")
(defvar elmo-default-pop3-server "localhost"
"*Default POP3 server.")
-(defvar elmo-default-pop3-authenticate-type "user"
- "*Default Authentication type for POP3.") ; "apop" or "user"
+(defvar elmo-default-pop3-authenticate-type 'user
+ "*Default Authentication type for POP3.")
(defvar elmo-default-pop3-port 110
"*Default POP3 port.")
(defvar elmo-default-pop3-stream-type nil
(defun elmo-quit ()
(interactive)
- (if (featurep 'elmo-imap4)
- (elmo-imap4-flush-connection))
+ (if (featurep 'elmo-net)
+ (elmo-network-clear-session-cache))
(if (featurep 'elmo-nntp)
(elmo-nntp-flush-connection))
- (if (featurep 'elmo-pop3)
- (elmo-pop3-flush-connection))
(if (get-buffer elmo-work-buf-name)
(kill-buffer elmo-work-buf-name))
)
(eq (cdr (assq 'type (mime-entity-content-type entity))) 'text))
(defun mmelmo-imap4-get-mime-entity (folder number msgdb)
- (save-excursion
- (let* ((spec (elmo-folder-get-spec folder))
- (connection (elmo-imap4-get-connection spec))
- (mailbox (elmo-imap4-spec-mailbox spec))
- response)
- (when mailbox
- (save-excursion
- (when (not (string= (elmo-imap4-connection-get-cwf connection)
- mailbox))
- (if (null (elmo-imap4-select-folder mailbox connection))
- (error "Select folder failed")))
- (elmo-imap4-send-command (elmo-imap4-connection-get-buffer
- connection)
- (elmo-imap4-connection-get-process
- connection)
- (format
- (if elmo-imap4-use-uid
- "uid fetch %s bodystructure"
- "fetch %s bodystructure")
- number))
- (if (null (setq response (elmo-imap4-read-contents
- (elmo-imap4-connection-get-buffer
- connection)
- (elmo-imap4-connection-get-process
- connection))))
- (error "Fetching body structure failed")))
- (mmelmo-imap4-parse-bodystructure-string folder number msgdb
- response)))))
+ (let* ((spec (elmo-folder-get-spec folder))
+ (session (elmo-imap4-get-session spec))
+ (mailbox (elmo-imap4-spec-mailbox spec))
+ response)
+ (when mailbox
+ (elmo-imap4-select-mailbox session mailbox)
+ (elmo-imap4-send-command
+ (elmo-network-session-process-internal session)
+ (format
+ (if elmo-imap4-use-uid
+ "uid fetch %s bodystructure"
+ "fetch %s bodystructure")
+ number))
+ (or (setq response (elmo-imap4-read-contents
+ (elmo-network-session-process-internal session)))
+ (error "Fetching body structure failed"))
+ (mmelmo-imap4-parse-bodystructure-string folder number msgdb
+ response))))
(defun mmelmo-imap4-read-part (entity)
(if (or (not mmelmo-imap4-threshold)
projects / elisp / wanderlust.git / commitdiff