From bd8bab3adfaedd5c16462e8cf6e32827649aae42 Mon Sep 17 00:00:00 2001 From: teranisi Date: Wed, 23 Aug 2000 01:38:12 +0000 Subject: [PATCH] * 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. --- elmo/ChangeLog | 70 ++++ elmo/elmo-imap4.el | 1005 ++++++++++++++++++++---------------------------- elmo/elmo-net.el | 211 ++++++++++ elmo/elmo-pop3.el | 617 ++++++++++++++--------------- elmo/elmo-util.el | 164 +------- elmo/elmo-vars.el | 4 +- elmo/elmo2.el | 6 +- elmo/mmelmo-imap4-2.el | 46 +-- 8 files changed, 1032 insertions(+), 1091 deletions(-) create mode 100644 elmo/elmo-net.el diff --git a/elmo/ChangeLog b/elmo/ChangeLog index 662d749..7a1a767 100644 --- a/elmo/ChangeLog +++ b/elmo/ChangeLog @@ -1,3 +1,73 @@ +2000-08-23 Yuuichi Teranishi + + * 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 * elmo-util.el (elmo-define-error): New function. diff --git a/elmo/elmo-imap4.el b/elmo/elmo-imap4.el index b56c3a3..167db28 100644 --- a/elmo/elmo-imap4.el +++ b/elmo/elmo-imap4.el @@ -25,12 +25,12 @@ ;;; Commentary: ;; - (require 'elmo-vars) (require 'elmo-util) (require 'elmo-msgdb) (require 'elmo-date) (require 'elmo-cache) +(require 'elmo-net) (require 'utf7) ;;; Code: @@ -60,8 +60,6 @@ ;; (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.") @@ -71,6 +69,11 @@ (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 @@ -93,8 +96,6 @@ '(("^{.*/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) @@ -238,21 +239,6 @@ BUFFER must be a single-byte buffer." (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) @@ -294,11 +280,9 @@ BUFFER must be a single-byte buffer." "\\'") 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) @@ -325,14 +309,18 @@ BUFFER must be a single-byte buffer." (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) @@ -349,11 +337,9 @@ BUFFER must be a single-byte buffer." ;;; 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)))) @@ -363,25 +349,22 @@ BUFFER must be a single-byte buffer." (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)) @@ -389,7 +372,7 @@ BUFFER must be a single-byte buffer." (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)) @@ -399,60 +382,27 @@ BUFFER must be a single-byte buffer." (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 @@ -472,9 +422,9 @@ BUFFER must be a single-byte buffer." (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) @@ -514,10 +464,9 @@ BUFFER must be a single-byte buffer." (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) @@ -537,8 +486,7 @@ BUFFER must be a single-byte buffer." 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 @@ -563,83 +511,62 @@ BUFFER must be a single-byte buffer." (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)) @@ -650,14 +577,12 @@ BUFFER must be a single-byte buffer." (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 @@ -668,33 +593,15 @@ BUFFER must be a single-byte buffer." (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))) @@ -729,14 +636,14 @@ BUFFER must be a single-byte buffer." (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" @@ -748,7 +655,7 @@ BUFFER must be a single-byte buffer." (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 " @@ -760,7 +667,7 @@ BUFFER must be a single-byte buffer." (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) ")")) @@ -768,18 +675,13 @@ BUFFER must be a single-byte buffer." (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))) @@ -1072,20 +974,15 @@ If CHOP-LENGTH is not specified, message set is not chopped." "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)" @@ -1093,12 +990,11 @@ If optional argument UNMARK is non-nil, unmark." (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))) @@ -1137,8 +1033,8 @@ If optional argument UNMARK is non-nil, unmark." "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 @@ -1148,9 +1044,13 @@ If optional argument UNMARK is non-nil, unmark." "")) 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) @@ -1159,16 +1059,10 @@ If optional argument UNMARK is non-nil, unmark." 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 @@ -1194,8 +1088,7 @@ If optional argument UNMARK is non-nil, unmark." 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..." @@ -1255,171 +1148,176 @@ If optional argument UNMARK is non-nil, unmark." (> (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))) @@ -1440,11 +1338,9 @@ Return nil if connection failed." (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) @@ -1480,7 +1376,7 @@ Return nil if connection failed." (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))) @@ -1506,99 +1402,77 @@ Return nil if connection failed." )) (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 @@ -1628,154 +1502,117 @@ Return nil if connection failed." (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) diff --git a/elmo/elmo-net.el b/elmo/elmo-net.el new file mode 100644 index 0000000..16e4a9c --- /dev/null +++ b/elmo/elmo-net.el @@ -0,0 +1,211 @@ +;;; elmo-net.el -- Network module for ELMO. + +;; Copyright 1998,1999,2000 Yuuichi Teranishi + +;; Author: Yuuichi Teranishi +;; 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 diff --git a/elmo/elmo-pop3.el b/elmo/elmo-pop3.el index 628799e..b636c0e 100644 --- a/elmo/elmo-pop3.el +++ b/elmo/elmo-pop3.el @@ -30,6 +30,7 @@ ;; (require 'elmo-msgdb) +(require 'elmo-net) (eval-when-compile (require 'elmo-util) (condition-case nil @@ -46,6 +47,7 @@ (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))) @@ -59,8 +61,17 @@ (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 @@ -69,124 +80,31 @@ (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)) @@ -194,9 +112,8 @@ (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) @@ -240,149 +157,207 @@ (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 @@ -408,12 +383,13 @@ Return nil if connection failed." (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)) @@ -455,8 +431,9 @@ Return nil if connection failed." (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 @@ -476,8 +453,9 @@ Return nil if connection failed." (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 @@ -510,14 +488,14 @@ Return nil if connection failed." (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") @@ -551,8 +529,8 @@ Return nil if connection 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)) @@ -594,15 +572,14 @@ Return nil if connection failed." 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)))) @@ -619,13 +596,13 @@ Return nil if connection failed." (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 @@ -634,7 +611,8 @@ Return nil if connection failed." (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 @@ -717,8 +695,8 @@ Return nil if connection failed." (/ (* 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) @@ -728,7 +706,7 @@ Return nil if connection failed." (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) @@ -737,21 +715,20 @@ Return nil if connection failed." (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) @@ -759,33 +736,31 @@ Return nil if connection failed." (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) @@ -827,8 +802,10 @@ Return nil if connection failed." (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) diff --git a/elmo/elmo-util.el b/elmo/elmo-util.el index f8e1ee4..84d335d 100644 --- a/elmo/elmo-util.el +++ b/elmo/elmo-util.el @@ -72,109 +72,6 @@ (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) @@ -277,6 +174,16 @@ File content is encoded with MIME-CHARSET." (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) @@ -497,7 +404,7 @@ File content is encoded with MIME-CHARSET." (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))))) @@ -1519,55 +1426,6 @@ Otherwise treat \\ in NEWTEXT string as special: (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)) diff --git a/elmo/elmo-vars.el b/elmo/elmo-vars.el index cf86d48..a38d540 100644 --- a/elmo/elmo-vars.el +++ b/elmo/elmo-vars.el @@ -66,8 +66,8 @@ Any symbol value of `elmo-network-stream-type-alist'.") "*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 diff --git a/elmo/elmo2.el b/elmo/elmo2.el index 2461b42..f4da8d1 100644 --- a/elmo/elmo2.el +++ b/elmo/elmo2.el @@ -60,12 +60,10 @@ (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)) ) diff --git a/elmo/mmelmo-imap4-2.el b/elmo/mmelmo-imap4-2.el index 60f843d..55c7032 100644 --- a/elmo/mmelmo-imap4-2.el +++ b/elmo/mmelmo-imap4-2.el @@ -159,34 +159,24 @@ (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) -- 1.7.10.4