X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;ds=sidebyside;f=elmo%2Felmo-pop3.el;h=e82ee979bf0873179688a8c9b09145b6c040a3fd;hb=d531b07417d60be775fddb1beffb9562d6b733f2;hp=26a84261a2d58b5a7945a4fa9169db21ee5103ad;hpb=6ee2df2d9ba35b5961d631bee2d6133cf6c3746e;p=elisp%2Fwanderlust.git diff --git a/elmo/elmo-pop3.el b/elmo/elmo-pop3.el index 26a8426..e82ee97 100644 --- a/elmo/elmo-pop3.el +++ b/elmo/elmo-pop3.el @@ -56,7 +56,11 @@ If server doesn't accept asynchronous commands, this variable should be set as non-nil.") -(defvar elmo-pop3-exists-exactly t) +(defcustom elmo-pop3-exists-exactly nil + "If non-nil, POP3 folder existence is checked everytime before the session." + :type 'boolean + :group 'elmo) + (defvar sasl-mechanism-alist) (defvar elmo-pop3-total-size nil) @@ -152,25 +156,39 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") (elmo-pop3-send-command (elmo-network-session-process-internal session) "quit") ;; process is dead. - (or (elmo-pop3-read-response - (elmo-network-session-process-internal session) - t) + (or (cdr (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 (folder &optional if-exists) + "Get POP3 session for FOLDER. +If IF-EXISTS is non-nil, don't get new session. +If IF-EXISTS is `any-exists', get BIFF session or normal session if exists." (let ((elmo-pop3-use-uidl-internal (if elmo-inhibit-number-mapping nil (elmo-pop3-folder-use-uidl-internal folder)))) - (elmo-network-get-session 'elmo-pop3-session - (concat - (if (elmo-folder-biff-internal folder) - "BIFF-") - "POP3") - folder if-exists))) + (prog1 + (if (eq if-exists 'any-exists) + (or (elmo-network-get-session 'elmo-pop3-session + "POP3" + folder if-exists) + (elmo-network-get-session 'elmo-pop3-session + "BIFF-POP3" + folder if-exists)) + (elmo-network-get-session 'elmo-pop3-session + (concat + (if (elmo-folder-biff-internal folder) + "BIFF-") + "POP3") + folder if-exists)) + ;; For saving existency. + (unless (file-exists-p (elmo-folder-msgdb-path folder)) + (elmo-make-directory (elmo-folder-msgdb-path folder)))))) (defun elmo-pop3-send-command (process command &optional no-erase no-log) (with-current-buffer (process-buffer process) @@ -179,16 +197,25 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") (goto-char (point-min)) (setq elmo-pop3-read-point (point)) (elmo-pop3-debug "SEND: %s\n" (if no-log "" command)) - (process-send-string process command) - (process-send-string process "\r\n"))) + (process-send-string process (concat command "\r\n")))) (defun elmo-pop3-read-response (process &optional not-command) + "Read response and return a cons cell of \(CODE . BODY\). +PROCESS is the process to read response from. +If optional NOT-COMMAND is non-nil, read only the first line. +CODE is one of the following: +'ok ... response is OK. +'err ... response is ERROR. +'login-delay ... user is not allowed to login until the login delay + period has expired. +'in-use ... authentication was successful but the mailbox is in use." ;; buffer is in case for process is dead. (with-current-buffer (process-buffer process) (let ((case-fold-search nil) (response-string nil) (response-continue t) (return-value nil) + (err nil) match-end) (while response-continue (goto-char elmo-pop3-read-point) @@ -209,9 +236,16 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") response-string))) (if (looking-at "\\-.*$") (progn - (setq response-continue nil) - (setq elmo-pop3-read-point match-end) - (setq return-value nil)) + (when (looking-at "[^ ]+ \\[\\([^]]+\\)\\]") + (setq return-value + (intern + (downcase + (buffer-substring (match-beginning 1) + (match-end 1)))))) + (setq err t + response-continue nil + elmo-pop3-read-point match-end + return-value (cons (or return-value 'err) nil))) (setq elmo-pop3-read-point match-end) (if not-command (setq response-continue nil)) @@ -220,46 +254,58 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") (concat return-value "\n" response-string) response-string))) (setq elmo-pop3-read-point match-end))) - return-value))) + (if err + return-value + (cons 'ok return-value))))) (defun elmo-pop3-process-filter (process output) - (with-current-buffer (process-buffer process) - (goto-char (point-max)) - (insert output) - (elmo-pop3-debug "RECEIVED: %s\n" output) - (if (and elmo-pop3-total-size - (> elmo-pop3-total-size - (min elmo-display-retrieval-progress-threshold 100))) - (elmo-display-progress - 'elmo-display-retrieval-progress - (format "Retrieving (%d/%d bytes)..." - (buffer-size) - elmo-pop3-total-size) - (/ (buffer-size) (/ elmo-pop3-total-size 100)))))) + (when (buffer-live-p (process-buffer process)) + (with-current-buffer (process-buffer process) + (goto-char (point-max)) + (insert output) + (elmo-pop3-debug "RECEIVED: %s\n" output) + (if (and elmo-pop3-total-size + (> elmo-pop3-total-size + (min elmo-display-retrieval-progress-threshold 100))) + (elmo-display-progress + 'elmo-display-retrieval-progress + (format "Retrieving (%d/%d bytes)..." + (buffer-size) + elmo-pop3-total-size) + (/ (buffer-size) (/ elmo-pop3-total-size 100))))))) (defun elmo-pop3-auth-user (session) - (let ((process (elmo-network-session-process-internal session))) + (let ((process (elmo-network-session-process-internal session)) + response) ;; try USER/PASS (elmo-pop3-send-command process (format "user %s" (elmo-network-session-user-internal session)) nil 'no-log) - (or (elmo-pop3-read-response process t) - (progn - (delete-process process) - (signal 'elmo-authenticate-error - '(elmo-pop-auth-user)))) + (setq response (elmo-pop3-read-response process t)) + (unless (eq (car response) 'ok) + (delete-process process) + (signal 'elmo-open-error '(elmo-pop-auth-user))) (elmo-pop3-send-command process (format "pass %s" (elmo-get-passwd (elmo-network-session-password-key session))) nil 'no-log) - (or (elmo-pop3-read-response process t) - (progn - (delete-process process) + (setq response (elmo-pop3-read-response process t)) + (unless (eq (car response) 'ok) + (delete-process process) + (unless (eq 'ok (car response)) + (if (or (eq (car response) 'in-use) + (eq (car response) 'login-delay)) + (error (cond ((eq (car response) 'in-use) + "Maildrop is currently in use") + ((eq (car response) 'login-delay) + "Not allowed to login \ +until the login delay period has expired"))) (signal 'elmo-authenticate-error - '(elmo-pop-auth-user)))))) + '(elmo-pop-auth-user))))) + (car response))) (defun elmo-pop3-auth-apop (session) (if (string-match "^\+OK .*\\(<[^\>]+>\\)" @@ -277,13 +323,22 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") (elmo-get-passwd (elmo-network-session-password-key session))))) nil 'no-log) - (or (elmo-pop3-read-response - (elmo-network-session-process-internal session) - t) - (progn - (delete-process (elmo-network-session-process-internal session)) - (signal 'elmo-authenticate-error - '(elmo-pop3-auth-apop))))) + (let ((response (elmo-pop3-read-response + (elmo-network-session-process-internal session) + t))) + (unless (eq (car response) 'ok) + (delete-process (elmo-network-session-process-internal session)) + (unless (eq 'ok (car response)) + (if (or (eq (car response) 'in-use) + (eq (car response) 'login-delay)) + (error (cond ((eq (car response) 'in-use) + "Maildrop is currently in use") + ((eq (car response) 'login-delay) + "Not allowed to login \ +until the login delay period has expired"))) + (signal 'elmo-authenticate-error + '(elmo-pop-auth-apop))))) + (car response))) (signal 'elmo-open-error '(elmo-pop3-auth-apop)))) (luna-define-method elmo-network-initialize-session-buffer :after @@ -307,18 +362,16 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") (setq elmo-pop3-read-point (point)) (or (elmo-network-session-set-greeting-internal session - (elmo-pop3-read-response process t)) + (cdr (elmo-pop3-read-response process t))) ; if ok, cdr is non-nil. (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)) + (if (eq 'ok (car (elmo-pop3-read-response process))) (starttls-negotiate process) - (signal 'elmo-open-error - '(elmo-pop3-starttls-error))))))) + (signal 'elmo-open-error '(elmo-pop3-starttls-error))))))) (luna-define-method elmo-network-authenticate-session ((session elmo-pop3-session)) @@ -369,21 +422,26 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") nil 'no-log) (catch 'done (while t - (unless (setq response (elmo-pop3-read-response process t)) - ;; response is NO or BAD. - (signal 'elmo-authenticate-error - (list (intern - (concat "elmo-pop3-auth-" - (downcase name)))))) - (if (string-match "^\+OK" response) - (if (sasl-next-step client step) - ;; Bogus server? - (signal 'elmo-authenticate-error - (list (intern - (concat "elmo-pop3-auth-" - (downcase name))))) - ;; The authentication process is finished. - (throw 'done nil))) + (setq response (elmo-pop3-read-response process t)) + (unless (eq 'ok (car response)) + (if (or (eq (car response) 'in-use) + (eq (car response) 'login-delay)) + (error (cond ((eq (car response) 'in-use) + "Maildrop is currently in use") + ((eq (car response) 'login-delay) + "Not allowed to login \ +until the login delay period has expired"))) + (signal 'elmo-authenticate-error + (list (intern (concat "elmo-pop3-auth-" + (downcase name))))))) + (if (sasl-next-step client step) + ;; Bogus server? + (signal 'elmo-authenticate-error + (list (intern + (concat "elmo-pop3-auth-" + (downcase name))))) + ;; The authentication process is finished. + (throw 'done nil)) (sasl-step-set-data step (elmo-base64-decode-string @@ -404,11 +462,10 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") (setq elmo-pop3-size-hash (elmo-make-hash 31)) ;; To get obarray of uidl and size (elmo-pop3-send-command process "list") - (if (null (elmo-pop3-read-response process)) + (if (null (cdr (elmo-pop3-read-response process))) (error "POP LIST command failed")) (if (null (setq response - (elmo-pop3-read-contents - (current-buffer) process))) + (elmo-pop3-read-contents process))) (error "POP LIST command failed")) ;; POP server always returns a sequence of serial numbers. (setq count (elmo-pop3-parse-list-response response)) @@ -418,15 +475,14 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") (setq elmo-pop3-number-uidl-hash (elmo-make-hash (* count 2))) ;; UIDL (elmo-pop3-send-command process "uidl") - (unless (elmo-pop3-read-response process) + (unless (cdr (elmo-pop3-read-response process)) (error "POP UIDL failed")) - (unless (setq response (elmo-pop3-read-contents - (current-buffer) process)) + (unless (setq response (elmo-pop3-read-contents process)) (error "POP UIDL failed")) (elmo-pop3-parse-uidl-response response))))) -(defun elmo-pop3-read-contents (buffer process) - (with-current-buffer buffer +(defun elmo-pop3-read-contents (process) + (with-current-buffer (process-buffer process) (let ((case-fold-search nil) match-end) (goto-char elmo-pop3-read-point) @@ -458,7 +514,11 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") (setq session (elmo-pop3-get-session folder)) (if session (elmo-network-close-session session))))) - nil)) + (or (file-directory-p (elmo-folder-msgdb-path folder)) + ;; First time. + (when (elmo-folder-plugged-p folder) + (let ((elmo-pop3-exists-exactly t)) + (elmo-folder-exists-p folder)))))) (defun elmo-pop3-parse-uidl-response (string) (let ((buffer (current-buffer)) @@ -594,7 +654,7 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") response) (with-current-buffer (process-buffer process) (elmo-pop3-send-command process "STAT") - (setq response (elmo-pop3-read-response process)) + (setq response (cdr (elmo-pop3-read-response process))) ;; response: "^\+OK 2 7570$" (if (not (string-match "^\+OK[ \t]*\\([0-9]*\\)" response)) (error "POP STAT command failed") @@ -619,9 +679,9 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") (t nil))) -(defun elmo-pop3-retrieve-headers (buffer tobuffer process articles) +(defun elmo-pop3-retrieve-headers (process tobuffer articles) (save-excursion - (set-buffer buffer) + (set-buffer (process-buffer process)) (erase-buffer) (let ((number (length articles)) (count 0) @@ -644,7 +704,6 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") (accept-process-output process 1)) (discard-input) (while (progn - (set-buffer buffer) (goto-char last-point) ;; Count replies. (while (elmo-pop3-next-result-arrived-p) @@ -659,49 +718,39 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") (accept-process-output process 1) ;;; (accept-process-output process) (discard-input)))) - ;; Remove all "\r"'s. - (goto-char (point-min)) - (while (search-forward "\r\n" nil t) - (replace-match "\n")) + ;; Replace all CRLF with LF. + (elmo-delete-cr-buffer) (copy-to-buffer tobuffer (point-min) (point-max))))) (luna-define-method elmo-folder-msgdb-create ((folder elmo-pop3-folder) - numlist new-mark - already-mark seen-mark - important-mark seen-list) + numlist flag-table) (let ((process (elmo-network-session-process-internal (elmo-pop3-get-session folder)))) (with-current-buffer (process-buffer process) (elmo-pop3-sort-msgdb-by-original-number folder (elmo-pop3-msgdb-create-by-header + folder process numlist - new-mark already-mark - seen-mark seen-list + flag-table (if (elmo-pop3-folder-use-uidl-internal folder) (elmo-pop3-folder-location-alist-internal folder))))))) -(defun elmo-pop3-sort-overview-by-original-number (overview loc-alist) - (if loc-alist - (sort overview - (lambda (ent1 ent2) - (< (elmo-pop3-uidl-to-number - (cdr (assq (elmo-msgdb-overview-entity-get-number ent1) - loc-alist))) - (elmo-pop3-uidl-to-number - (cdr (assq (elmo-msgdb-overview-entity-get-number ent2) - loc-alist)))))) - overview)) - (defun elmo-pop3-sort-msgdb-by-original-number (folder msgdb) - (message "Sorting...") - (let ((overview (elmo-msgdb-get-overview msgdb))) - (setq overview (elmo-pop3-sort-overview-by-original-number - overview - (elmo-pop3-folder-location-alist-internal folder))) - (message "Sorting...done") - (list overview (nth 1 msgdb)(nth 2 msgdb)(nth 3 msgdb)))) + (let ((location-alist (elmo-pop3-folder-location-alist-internal folder))) + (when location-alist + (elmo-msgdb-sort-entities + msgdb + (lambda (ent1 ent2 loc-alist) + (< (elmo-pop3-uidl-to-number + (cdr (assq (elmo-message-entity-number ent1) + loc-alist))) + (elmo-pop3-uidl-to-number + (cdr (assq (elmo-message-entity-number ent2) + loc-alist))))) + location-alist)) + msgdb)) (defun elmo-pop3-uidl-to-number (uidl) (string-to-number (elmo-get-hash-val uidl @@ -715,11 +764,9 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") (elmo-get-hash-val (format "#%d" number) elmo-pop3-size-hash)) -(defun elmo-pop3-msgdb-create-by-header (process numlist - new-mark already-mark - seen-mark - seen-list - loc-alist) +(defun elmo-pop3-msgdb-create-by-header (folder process numlist + flag-table + loc-alist) (let ((tmp-buffer (get-buffer-create " *ELMO Overview TMP*"))) (with-current-buffer (process-buffer process) (if loc-alist ; use uidl. @@ -730,29 +777,29 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") (lambda (number) (elmo-pop3-uidl-to-number (cdr (assq number loc-alist)))) numlist)))) - (elmo-pop3-retrieve-headers (process-buffer process) - tmp-buffer process numlist) + (elmo-pop3-retrieve-headers process tmp-buffer numlist) (prog1 (elmo-pop3-msgdb-create-message + folder tmp-buffer process (length numlist) numlist - new-mark already-mark seen-mark seen-list loc-alist) + flag-table loc-alist) (kill-buffer tmp-buffer))))) -(defun elmo-pop3-msgdb-create-message (buffer +(defun elmo-pop3-msgdb-create-message (folder + buffer process num - numlist new-mark already-mark - seen-mark - seen-list + numlist + flag-table loc-alist) (save-excursion - (let (beg overview number-alist mark-alist - entity i number message-id gmark seen size) + (let ((new-msgdb (elmo-make-msgdb)) + beg entity i number message-id flags) (set-buffer buffer) - (elmo-set-buffer-multibyte default-enable-multibyte-characters) + (set-buffer-multibyte default-enable-multibyte-characters) (goto-char (point-min)) (setq i 0) (message "Creating msgdb...") @@ -764,55 +811,36 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") (save-restriction (narrow-to-region beg (point)) (setq entity - (elmo-msgdb-create-overview-from-buffer + (elmo-msgdb-create-message-entity-from-buffer + (elmo-msgdb-message-entity-handler new-msgdb) (car numlist))) (setq numlist (cdr numlist)) (when entity - (setq overview - (elmo-msgdb-append-element - overview entity)) (with-current-buffer (process-buffer process) - (elmo-msgdb-overview-entity-set-size + (elmo-message-entity-set-field entity + 'size (string-to-number (elmo-pop3-number-to-size - (elmo-msgdb-overview-entity-get-number entity)))) + (elmo-message-entity-number entity)))) (if (setq number (car (rassoc (elmo-pop3-number-to-uidl - (elmo-msgdb-overview-entity-get-number entity)) + (elmo-message-entity-number entity)) loc-alist))) - (elmo-msgdb-overview-entity-set-number entity number))) - (setq number-alist - (elmo-msgdb-number-add - number-alist - (elmo-msgdb-overview-entity-get-number entity) - (car entity))) - (setq message-id (car entity)) - (setq seen (member message-id seen-list)) - (if (setq gmark (or (elmo-msgdb-global-mark-get message-id) - (if (elmo-file-cache-status - (elmo-file-cache-get message-id)) - (if seen - nil - already-mark) - (if seen - (if elmo-pop3-use-cache - seen-mark) - new-mark)))) - (setq mark-alist - (elmo-msgdb-mark-append - mark-alist - (elmo-msgdb-overview-entity-get-number entity) - gmark)))))) + (elmo-message-entity-set-number entity number))) + (setq message-id (elmo-message-entity-field entity 'message-id) + flags (elmo-flag-table-get flag-table message-id)) + (elmo-global-flags-set flags folder number message-id) + (elmo-msgdb-append-entity new-msgdb entity flags)))) (when (> num elmo-display-progress-threshold) (setq i (1+ i)) (if (or (zerop (% i 5)) (= i num)) (elmo-display-progress 'elmo-pop3-msgdb-create-message "Creating msgdb..." (/ (* i 100) num))))) - (list overview number-alist mark-alist)))) + new-msgdb))) (defun elmo-pop3-read-body (process outbuf) (with-current-buffer (process-buffer process) @@ -870,8 +898,8 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") 0)) (unwind-protect (progn - (when (null (setq response (elmo-pop3-read-response - process t))) + (when (null (setq response (cdr (elmo-pop3-read-response + process t)))) (error "Fetching message failed")) (setq response (elmo-pop3-read-body process outbuf))) (setq elmo-pop3-total-size nil)) @@ -879,12 +907,13 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") (elmo-display-progress 'elmo-display-retrieval-progress "Retrieving..." 100) ; remove progress bar. - (message "Retrieving...done.")) + (message "Retrieving...done")) (set-buffer outbuf) (goto-char (point-min)) (while (re-search-forward "^\\." nil t) (replace-match "") (forward-line)) + (elmo-delete-cr-buffer) response)))) (defun elmo-pop3-delete-msg (process number loc-alist) @@ -897,18 +926,18 @@ Debug information is inserted in the buffer \"*POP3 DEBUG*\"") (progn (elmo-pop3-send-command process (format "dele %s" number)) - (when (null (setq response (elmo-pop3-read-response - process t))) + (when (null (setq response (cdr (elmo-pop3-read-response + process t)))) (error "Deleting message failed"))) (error "Deleting message failed"))))) -(luna-define-method elmo-folder-delete-messages-plugged - ((folder elmo-pop3-folder) msgs) +(luna-define-method elmo-folder-delete-messages-plugged ((folder + elmo-pop3-folder) + msgs) (let ((loc-alist (elmo-pop3-folder-location-alist-internal folder)) (process (elmo-network-session-process-internal (elmo-pop3-get-session folder)))) - (mapcar '(lambda (msg) (elmo-pop3-delete-msg - process msg loc-alist)) + (mapcar '(lambda (msg) (elmo-pop3-delete-msg process msg loc-alist)) msgs))) (luna-define-method elmo-message-use-cache-p ((folder elmo-pop3-folder) number)