X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Felmo-pop3.el;h=730c1a37b34360459415d73494a38e08dfc47f97;hb=08fe50f15e7aed9643f87a7cbb552690c6908318;hp=494784a3d220365163caa5e411d8fbb510558fb8;hpb=2e9f5d2e3f003da464c20fe9924d1e80849265e6;p=elisp%2Fwanderlust.git diff --git a/elmo/elmo-pop3.el b/elmo/elmo-pop3.el index 494784a..730c1a3 100644 --- a/elmo/elmo-pop3.el +++ b/elmo/elmo-pop3.el @@ -1,8 +1,10 @@ -;;; elmo-pop3.el -- POP3 Interface for ELMO. +;;; elmo-pop3.el --- POP3 Interface for ELMO. -;; Copyright 1998,1999,2000 Yuuichi Teranishi +;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi +;; Copyright (C) 1999,2000 Kenichi OKADA ;; Author: Yuuichi Teranishi +;; Kenichi OKADA ;; Keywords: mail, net news ;; This file is part of ELMO (Elisp Library for Message Orchestration). @@ -24,140 +26,165 @@ ;; ;;; Commentary: -;; +;; ;;; Code: -;; +;; (require 'elmo-msgdb) +(require 'elmo-net) + (eval-when-compile - (require 'elmo-util) - (condition-case nil - (progn - (require 'starttls) - (require 'sasl)) - (error)) - (defun-maybe md5 (a)) - (defun-maybe sasl-digest-md5-digest-response - (digest-challenge username passwd serv-type host &optional realm)) - (defun-maybe sasl-scram-md5-client-msg-1 - (authenticate-id &optional authorize-id)) - (defun-maybe sasl-scram-md5-client-msg-2 - (server-msg-1 client-msg-1 salted-pass)) - (defun-maybe sasl-scram-md5-make-salted-pass - (server-msg-1 passphrase)) - (defun-maybe sasl-scram-md5-authenticate-server - (server-msg-1 server-msg-2 client-msg-1 salted-pass)) - (defun-maybe starttls-negotiate (a))) -(condition-case nil - (progn - (require 'sasl)) - (error)) + (require 'elmo-util)) -(defvar elmo-pop3-exists-exactly t) -(defvar elmo-pop3-read-point nil) -(defvar elmo-pop3-connection-cache nil - "Cache of pop3 connection.") +(eval-and-compile + (autoload 'md5 "md5")) -(defun elmo-pop3-close-connection (connection &optional process buffer) - (save-excursion - (let* ((buffer (or buffer (nth 0 connection))) - (process (or process (nth 1 connection)))) - (elmo-pop3-send-command buffer process "quit") - (when (null (elmo-pop3-read-response buffer process t)) - (error "POP error: QUIT failed"))))) - -(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))) - (if buffer (kill-buffer buffer)) - ;;(setq process (car (cdr (cdr (car cache))))) - (if process (delete-process process)) - (setq cache (cdr cache))) - (setq elmo-pop3-connection-cache nil))) - -(defun elmo-pop3-get-connection (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)) - (ssl (elmo-pop3-spec-ssl spec)) - (user-at-host (format "%s@%s" user server)) - ret-val result buffer process errmsg proc-stat - 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) - (if (eq ssl 'starttls) "!!" (if ssl "!")))) - (setq ret-val (assoc user-at-host-on-port elmo-pop3-connection-cache)) - (if (and ret-val - (or (eq (setq proc-stat - (process-status (cadr (cdr ret-val)))) - 'closed) - (eq proc-stat 'exit))) - ;; connection is closed... - (progn - (kill-buffer (car (cdr ret-val))) - (setq elmo-pop3-connection-cache - (delete ret-val elmo-pop3-connection-cache)) - (setq ret-val nil) - )) - (if ret-val - (cdr ret-val) - (setq result - (elmo-pop3-open-connection - server user port auth - (elmo-get-passwd user-at-host) ssl)) - (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") - ) - (setq elmo-pop3-connection-cache - (append elmo-pop3-connection-cache - (list - (cons user-at-host-on-port - (setq ret-val (list buffer process)))))) - ret-val))) - -(defun elmo-pop3-send-command (buffer process command) - (save-excursion - (set-buffer buffer) - (erase-buffer) - (goto-char (point-min)) - (setq elmo-pop3-read-point (point)) - (process-send-string process command) - (process-send-string process "\r\n"))) +(defcustom elmo-pop3-default-use-uidl t + "If non-nil, use UIDL on POP3." + :type 'boolean + :group 'elmo) -(defun elmo-pop3-send-command-no-erase (buffer process command) - (save-excursion - (set-buffer buffer) - ;(erase-buffer) +(defvar elmo-pop3-use-uidl-internal t + "(Internal switch for using UIDL on POP3).") + +(defvar elmo-pop3-use-cache t + "Use cache in pop3 folder.") + +(defvar elmo-pop3-send-command-synchronously nil + "If non-nil, commands are send synchronously. +If server doesn't accept asynchronous commands, this variable should be +set as non-nil.") + +(defvar elmo-pop3-exists-exactly t) +(defvar sasl-mechanism-alist) + +(defvar elmo-pop3-total-size nil) + +;; For debugging. +(defvar elmo-pop3-debug nil + "Non-nil forces POP3 folder as debug mode. +Debug information is inserted in the buffer \"*POP3 DEBUG*\"") + +;;; Debug +(defsubst elmo-pop3-debug (message &rest args) + (if elmo-pop3-debug + (let ((biff (string-match "BIFF-" (buffer-name))) + pos) + (with-current-buffer (get-buffer-create (concat "*POP3 DEBUG*" + (if biff "BIFF"))) + (goto-char (point-max)) + (setq pos (point)) + (insert (apply 'format message args) "\n"))))) + +;;; ELMO POP3 folder +(eval-and-compile + (luna-define-class elmo-pop3-folder (elmo-net-folder) + (use-uidl location-alist)) + (luna-define-internal-accessors 'elmo-pop3-folder)) + +(luna-define-method elmo-folder-initialize :around ((folder + elmo-pop3-folder) + name) + (let ((elmo-network-stream-type-alist + (if elmo-pop3-stream-type-alist + (append elmo-pop3-stream-type-alist + elmo-network-stream-type-alist) + elmo-network-stream-type-alist)) + parse) + (setq name (luna-call-next-method)) + ;; user + (setq parse (elmo-parse-token name "/:")) + (elmo-net-folder-set-user-internal folder + (if (eq (length (car parse)) 0) + elmo-pop3-default-user + (car parse))) + ;; auth + (setq parse (elmo-parse-prefixed-element ?/ (cdr parse) ":")) + (elmo-net-folder-set-auth-internal folder + (if (eq (length (car parse)) 0) + elmo-pop3-default-authenticate-type + (intern (downcase (car parse))))) + ;; uidl + (setq parse (elmo-parse-prefixed-element ?: (cdr parse))) + (elmo-pop3-folder-set-use-uidl-internal folder + (if (eq (length (car parse)) 0) + elmo-pop3-default-use-uidl + (string= (car parse) "uidl"))) + (unless (elmo-net-folder-server-internal folder) + (elmo-net-folder-set-server-internal folder + elmo-pop3-default-server)) + (unless (elmo-net-folder-port-internal folder) + (elmo-net-folder-set-port-internal folder + elmo-pop3-default-port)) + (unless (elmo-net-folder-stream-type-internal folder) + (elmo-net-folder-set-stream-type-internal + folder + (elmo-get-network-stream-type + elmo-pop3-default-stream-type))) + folder)) + +;;; POP3 session +(luna-define-class elmo-pop3-session (elmo-network-session) ()) + +;; buffer-local +(defvar elmo-pop3-read-point nil) +(defvar elmo-pop3-number-uidl-hash nil) ; number -> uidl +(defvar elmo-pop3-uidl-number-hash nil) ; uidl -> number +(defvar elmo-pop3-size-hash nil) ; number -> size +(defvar elmo-pop3-uidl-done nil) +(defvar elmo-pop3-list-done nil) +(defvar elmo-pop3-lock nil) + +(defvar elmo-pop3-local-variables '(elmo-pop3-read-point + elmo-pop3-uidl-number-hash + elmo-pop3-number-uidl-hash + elmo-pop3-uidl-done + elmo-pop3-size-hash + elmo-pop3-list-done + elmo-pop3-lock)) + +(luna-define-method elmo-network-close-session ((session elmo-pop3-session)) + (when (elmo-network-session-process-internal session) + (when (memq (process-status + (elmo-network-session-process-internal session)) + '(open run)) + (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) + (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) + (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))) + +(defun elmo-pop3-send-command (process command &optional no-erase no-log) + (with-current-buffer (process-buffer process) + (unless no-erase + (erase-buffer)) (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"))) -(defun elmo-pop3-read-response (buffer process &optional not-command) - (save-excursion - (set-buffer buffer) +(defun elmo-pop3-read-response (process &optional not-command) + ;; 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) @@ -166,7 +193,7 @@ (while response-continue (goto-char elmo-pop3-read-point) (while (not (re-search-forward "\r?\n" nil t)) - (accept-process-output process) + (accept-process-output process 1) (goto-char elmo-pop3-read-point)) (setq match-end (point)) (setq response-string @@ -179,8 +206,7 @@ (setq return-value (if return-value (concat return-value "\n" response-string) - response-string - ))) + response-string))) (if (looking-at "\\-.*$") (progn (setq response-continue nil) @@ -197,234 +223,386 @@ return-value))) (defun elmo-pop3-process-filter (process output) - (save-excursion - (set-buffer (process-buffer process)) + (with-current-buffer (process-buffer process) (goto-char (point-max)) - (insert output))) - -(defun elmo-pop3-open-connection (server user port auth passphrase ssl) - (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 ssl)) - (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 ssl '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" + (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))) + ;; 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)))) + (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) + (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 + (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))))) + 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))))) + (signal 'elmo-open-error '(elmo-pop3-auth-apop)))) + +(luna-define-method elmo-network-initialize-session-buffer :after + ((session elmo-pop3-session) buffer) + (with-current-buffer buffer + (mapcar 'make-variable-buffer-local elmo-pop3-local-variables))) + +(luna-define-method elmo-network-initialize-session ((session + elmo-pop3-session)) + (let ((process (elmo-network-session-process-internal session)) + response mechanism) + (with-current-buffer (process-buffer process) + (set-process-filter process 'elmo-pop3-process-filter) + (setq elmo-pop3-read-point (point-min)) + ;; Skip garbage output from process before greeting. + (while (and (memq (process-status process) '(open run)) + (goto-char (point-max)) + (forward-line -1) + (not (looking-at "+OK"))) + (accept-process-output process 1)) + (setq elmo-pop3-read-point (point)) + (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-pop3-starttls-error))))))) + +(luna-define-method elmo-network-authenticate-session ((session + elmo-pop3-session)) + (with-current-buffer (process-buffer + (elmo-network-session-process-internal session)) + (let* ((process (elmo-network-session-process-internal session)) + (auth (elmo-network-session-auth-internal session)) + (auth (mapcar '(lambda (mechanism) (upcase (symbol-name mechanism))) + (if (listp auth) auth (list auth)))) + sasl-mechanisms + client name step response mechanism + sasl-read-passphrase) + (or (and (string= "USER" (car auth)) + (elmo-pop3-auth-user session)) + (and (string= "APOP" (car auth)) + (elmo-pop3-auth-apop session)) + (progn + (require 'sasl) + (setq sasl-mechanisms (mapcar 'car sasl-mechanism-alist)) + (setq mechanism (sasl-find-mechanism auth)) + (unless mechanism + (signal 'elmo-authenticate-error '(elmo-pop3-auth-no-mechanisms))) + (setq client + (sasl-make-client + mechanism + (elmo-network-session-user-internal session) + "pop" + (elmo-network-session-server-internal session))) +;;; (if elmo-pop3-auth-user-realm +;;; (sasl-client-set-property client 'realm elmo-pop3-auth-user-realm)) + (setq name (sasl-mechanism-name mechanism)) + (elmo-network-session-set-auth-internal session + (intern (downcase name))) + (setq sasl-read-passphrase + (function + (lambda (prompt) + (elmo-get-passwd + (elmo-network-session-password-key session))))) + (setq step (sasl-next-step client nil)) + (elmo-pop3-send-command + process + (concat "AUTH " name + (and (sasl-step-data step) + (concat + " " (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)) + (sasl-step-data step) 'no-line-break)))) + 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))) + (sasl-step-set-data + step + (elmo-base64-decode-string + (cadr (split-string response " ")))) + (setq step (sasl-next-step client step)) + (elmo-pop3-send-command + process + (if (sasl-step-data step) + (elmo-base64-encode-string (sasl-step-data step) + 'no-line-break) + "") nil 'no-log)))))))) + +(luna-define-method elmo-network-setup-session ((session + elmo-pop3-session)) + (let ((process (elmo-network-session-process-internal session)) + count response) + (with-current-buffer (process-buffer process) + (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)) + (error "POP LIST command failed")) + (if (null (setq response + (elmo-pop3-read-contents + (current-buffer) process))) + (error "POP LIST command failed")) + ;; POP server always returns a sequence of serial numbers. + (setq count (elmo-pop3-parse-list-response response)) + ;; UIDL + (when elmo-pop3-use-uidl-internal + (setq elmo-pop3-uidl-number-hash (elmo-make-hash (* count 2))) + (setq elmo-pop3-number-uidl-hash (elmo-make-hash (* count 2))) + ;; UIDL + (elmo-pop3-send-command process "uidl") + (unless (elmo-pop3-read-response process) + (error "POP UIDL failed")) + (unless (setq response (elmo-pop3-read-contents + (current-buffer) process)) + (error "POP UIDL failed")) + (elmo-pop3-parse-uidl-response response))))) (defun elmo-pop3-read-contents (buffer process) - (save-excursion - (set-buffer buffer) + (with-current-buffer buffer (let ((case-fold-search nil) match-end) (goto-char elmo-pop3-read-point) (while (not (re-search-forward "^\\.\r\n" nil t)) - (accept-process-output process) + (accept-process-output process 1) (goto-char elmo-pop3-read-point)) (setq match-end (point)) (elmo-delete-cr (buffer-substring elmo-pop3-read-point (- match-end 3)))))) -;; dummy functions -(defun elmo-pop3-list-folders (spec &optional hierarchy) nil) -(defun elmo-pop3-append-msg (spec string) nil nil) -(defun elmo-pop3-folder-creatable-p (spec) nil) -(defun elmo-pop3-create-folder (spec) nil) +(luna-define-method elmo-folder-expand-msgdb-path ((folder elmo-pop3-folder)) + (convert-standard-filename + (expand-file-name + (elmo-safe-filename (elmo-net-folder-user-internal folder)) + (expand-file-name (elmo-net-folder-server-internal folder) + (expand-file-name + "pop" + elmo-msgdb-directory))))) -(defun elmo-pop3-folder-exists-p (spec) +(luna-define-method elmo-folder-exists-p ((folder elmo-pop3-folder)) (if (and elmo-pop3-exists-exactly - (elmo-pop3-plugged-p spec)) + (elmo-folder-plugged-p folder)) (save-excursion - (let (elmo-auto-change-plugged) ;;don't change plug status. - (condition-case nil - (prog1 - (elmo-pop3-get-connection spec) - (elmo-pop3-flush-connection)) - (error nil)))) - t)) - -(defun elmo-pop3-parse-list-response (string) - (save-excursion - (let ((tmp-buffer (get-buffer-create " *ELMO PARSE TMP*")) - ret-val) - (set-buffer tmp-buffer) - (let ((case-fold-search t)) - (erase-buffer) + (let (elmo-auto-change-plugged ; don't change plug status. + (elmo-inhibit-number-mapping t) ; No need to use uidl. + session) + (prog1 + (setq session (elmo-pop3-get-session folder)) + (if session + (elmo-network-close-session session))))) + (file-directory-p (elmo-folder-msgdb-path folder)))) + +(defun elmo-pop3-parse-uidl-response (string) + (let ((buffer (current-buffer)) + number list size) + (with-temp-buffer + (let (number uid list) (insert string) (goto-char (point-min)) - (while (re-search-forward "^\\([0-9]*\\)[\t ].*$" nil t) - (setq ret-val - (cons - (string-to-int - (elmo-match-buffer 1)) - ret-val))) - (kill-buffer tmp-buffer) - (nreverse ret-val))))) - -(defun elmo-pop3-list-folder (spec) - (save-excursion - (elmo-pop3-flush-connection) - (let* ((connection (elmo-pop3-get-connection spec)) - (buffer (nth 0 connection)) - (process (nth 1 connection)) - response errmsg ret-val) - (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)))) + (while (re-search-forward "^\\([0-9]+\\)[\t ]+\\([^ \n]+\\)$" nil t) + (setq number (elmo-match-buffer 1)) + (setq uid (elmo-match-buffer 2)) + (with-current-buffer buffer + (elmo-set-hash-val uid number elmo-pop3-uidl-number-hash) + (elmo-set-hash-val (concat "#" number) uid + elmo-pop3-number-uidl-hash)) + (setq list (cons uid list))) + (with-current-buffer buffer (setq elmo-pop3-uidl-done t)) + (nreverse list))))) -(defun elmo-pop3-max-of-folder (spec) - (save-excursion - (elmo-pop3-flush-connection) - (let* ((connection (elmo-pop3-get-connection spec)) - (buffer (nth 0 connection)) - (process (nth 1 connection)) +(defun elmo-pop3-parse-list-response (string) + (let ((buffer (current-buffer)) + (count 0) + alist) + (with-temp-buffer + (insert string) + (goto-char (point-min)) + (while (re-search-forward "^\\([0-9]+\\)[\t ]+\\([0-9]+\\)$" nil t) + (setq alist + (cons + (cons (elmo-match-buffer 1) + (elmo-match-buffer 2)) + alist)) + (setq count (1+ count))) + (with-current-buffer buffer + (setq elmo-pop3-size-hash (elmo-make-hash (* (length alist) 2))) + (while alist + (elmo-set-hash-val (concat "#" (car (car alist))) + (cdr (car alist)) + elmo-pop3-size-hash) + (setq alist (cdr alist))) + (setq elmo-pop3-list-done t)) + count))) + +(defun elmo-pop3-list-location (folder) + (with-current-buffer (process-buffer + (elmo-network-session-process-internal + (elmo-pop3-get-session folder))) + (let (locations) + (if elmo-pop3-uidl-done + (progn + (mapatoms + (lambda (atom) + (setq locations (cons (symbol-name atom) locations))) + elmo-pop3-uidl-number-hash) + (sort locations + (lambda (loc1 loc2) + (< (elmo-pop3-uidl-to-number loc1) + (elmo-pop3-uidl-to-number loc2))))) + (error "POP3: Error in UIDL"))))) + +(defun elmo-pop3-list-folder-by-location (folder locations) + (let* ((location-alist (elmo-pop3-folder-location-alist-internal folder)) + (locations-in-db (mapcar 'cdr location-alist)) + result new-locs new-alist deleted-locs i) + (setq new-locs + (elmo-delete-if (function + (lambda (x) (member x locations-in-db))) + locations)) + (setq deleted-locs + (elmo-delete-if (function + (lambda (x) (member x locations))) + locations-in-db)) + (setq i (or (elmo-max-of-list (mapcar 'car location-alist)) 0)) + (mapcar + (function + (lambda (x) + (setq location-alist + (delq (rassoc x location-alist) location-alist)))) + deleted-locs) + (while new-locs + (setq i (1+ i)) + (setq new-alist (cons (cons i (car new-locs)) new-alist)) + (setq new-locs (cdr new-locs))) + (setq result (nconc location-alist new-alist)) + (setq result (sort result (lambda (x y) (< (car x)(car y))))) + (elmo-pop3-folder-set-location-alist-internal folder result) + (mapcar 'car result))) + +(defun elmo-pop3-list-by-uidl-subr (folder &optional nonsort) + (let ((flist (elmo-pop3-list-folder-by-location + folder + (elmo-pop3-list-location folder)))) + (if nonsort + (cons (elmo-max-of-list flist) (length flist)) + (sort flist '<)))) + +(defun elmo-pop3-list-by-list (folder) + (with-current-buffer (process-buffer + (elmo-network-session-process-internal + (elmo-pop3-get-session folder))) + (let (list) + (if elmo-pop3-list-done + (progn + (mapatoms (lambda (atom) + (setq list (cons (string-to-int + (substring (symbol-name atom) 1)) + list))) + elmo-pop3-size-hash) + (sort list '<)) + (error "POP3: Error in list"))))) + +(defsubst elmo-pop3-folder-list-messages (folder) + (if (and (not elmo-inhibit-number-mapping) + (elmo-pop3-folder-use-uidl-internal folder)) + (elmo-pop3-list-by-uidl-subr folder) + (elmo-pop3-list-by-list folder))) + +(luna-define-method elmo-folder-list-messages-plugged + ((folder elmo-pop3-folder) &optional nohide) + (elmo-pop3-folder-list-messages folder)) + +(luna-define-method elmo-folder-status ((folder elmo-pop3-folder)) + (elmo-folder-open-internal folder) + (elmo-folder-check folder) + (if (elmo-pop3-folder-use-uidl-internal folder) + (prog1 + (elmo-pop3-list-by-uidl-subr folder 'nonsort) + (elmo-folder-close-internal folder)) + (let* ((process + (elmo-network-session-process-internal + (elmo-pop3-get-session folder))) (total 0) response) - (elmo-pop3-send-command buffer process "STAT") - (setq response (elmo-pop3-read-response buffer process)) - ;; response: "^\+OK 2 7570$" - (if (not (string-match "^\+OK[ \t]*\\([0-9]*\\)" response)) - (error "POP STAT command failed") - (setq total - (string-to-int - (substring response (match-beginning 1)(match-end 1 )))) - (cons total total))))) + (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") + (setq total + (string-to-int + (substring response (match-beginning 1)(match-end 1 )))) + (elmo-folder-close-internal folder) + (cons total total)))))) (defvar elmo-pop3-header-fetch-chop-length 200) @@ -432,15 +610,15 @@ (cond ((eq (following-char) ?+) (if (re-search-forward "\n\\.\r?\n" nil t) - t + t nil)) ((looking-at "-") (if (search-forward "\n" nil t) - t + t nil)) (t nil))) - + (defun elmo-pop3-retrieve-headers (buffer tobuffer process articles) (save-excursion (set-buffer buffer) @@ -451,12 +629,10 @@ (last-point (point-min))) ;; Send HEAD commands. (while articles - (elmo-pop3-send-command-no-erase - buffer - process - (format "top %s 0" (car articles)) - ) - ; (accept-process-output process 1) + (elmo-pop3-send-command process (format + "top %s 0" (car articles)) + 'no-erase) +;;; (accept-process-output process 1) (setq articles (cdr articles)) (setq count (1+ count)) ;; Every 200 requests we have to read the stream in @@ -475,62 +651,106 @@ (setq last-point (point)) (setq received (1+ received))) (< received count)) - (and (zerop (% received 20)) - (elmo-display-progress - 'elmo-pop3-retrieve-headers "Getting headers..." - (/ (* received 100) number))) + (when (> number elmo-display-progress-threshold) + (if (or (zerop (% received 5)) (= received number)) + (elmo-display-progress + 'elmo-pop3-retrieve-headers "Getting headers..." + (/ (* received 100) number)))) (accept-process-output process 1) - ;(accept-process-output process) - (discard-input) - ))) - (elmo-display-progress - 'elmo-pop3-retrieve-headers "Getting headers..." 100) +;;; (accept-process-output process) + (discard-input)))) ;; Remove all "\r"'s. (goto-char (point-min)) (while (search-forward "\r\n" nil t) (replace-match "\n")) - (copy-to-buffer tobuffer (point-min) (point-max)) - ;(elmo-pop3-close-connection nil process buffer) ; close connection - ))) - -(defalias 'elmo-pop3-msgdb-create 'elmo-pop3-msgdb-create-as-numlist) -(defun elmo-pop3-msgdb-create-as-numlist (spec numlist new-mark - already-mark seen-mark - important-mark seen-list) - (when numlist - (let* ((connection (elmo-pop3-get-connection spec)) - (buffer (nth 0 connection)) - (process (nth 1 connection)) - response errmsg ret-val) - (elmo-pop3-msgdb-create-by-header buffer process numlist - new-mark already-mark - seen-mark seen-list)))) - -(defun elmo-pop3-msgdb-create-by-header (buffer process numlist - new-mark already-mark - seen-mark - seen-list) - (let ((tmp-buffer (get-buffer-create " *ELMO Overview TMP*")) - ret-val) - (elmo-pop3-retrieve-headers - buffer tmp-buffer process numlist) - (setq ret-val + (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) + (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 + process + numlist + new-mark already-mark + seen-mark seen-list + (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)))) + +(defun elmo-pop3-uidl-to-number (uidl) + (string-to-number (elmo-get-hash-val uidl + elmo-pop3-uidl-number-hash))) + +(defun elmo-pop3-number-to-uidl (number) + (elmo-get-hash-val (format "#%d" number) + elmo-pop3-number-uidl-hash)) + +(defun elmo-pop3-number-to-size (number) + (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) + (let ((tmp-buffer (get-buffer-create " *ELMO Overview TMP*"))) + (with-current-buffer (process-buffer process) + (if loc-alist ; use uidl. + (setq numlist + (delq + nil + (mapcar + (lambda (number) + (elmo-pop3-uidl-to-number (cdr (assq number loc-alist)))) + numlist)))) + (elmo-pop3-retrieve-headers (process-buffer process) + tmp-buffer process numlist) + (prog1 (elmo-pop3-msgdb-create-message tmp-buffer + process (length numlist) numlist - new-mark already-mark seen-mark seen-list)) - (kill-buffer tmp-buffer) - ret-val)) + new-mark already-mark seen-mark seen-list loc-alist) + (kill-buffer tmp-buffer))))) (defun elmo-pop3-msgdb-create-message (buffer - num numlist new-mark already-mark + process + num + numlist new-mark already-mark seen-mark - seen-list) + seen-list + loc-alist) (save-excursion - (let (beg - overview number-alist mark-alist - entity i number message-id gmark seen) + (let (beg overview number-alist mark-alist + entity i number message-id gmark seen size) (set-buffer buffer) (elmo-set-buffer-multibyte default-enable-multibyte-characters) (goto-char (point-min)) @@ -551,15 +771,29 @@ (setq overview (elmo-msgdb-append-element overview entity)) + (with-current-buffer (process-buffer process) + (elmo-msgdb-overview-entity-set-size + entity + (string-to-number + (elmo-pop3-number-to-size + (elmo-msgdb-overview-entity-get-number entity)))) + (if (setq number + (car + (rassoc + (elmo-pop3-number-to-uidl + (elmo-msgdb-overview-entity-get-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))) + (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-cache-exists-p - message-id) ; XXX + (if (elmo-file-cache-status + (elmo-file-cache-get message-id)) (if seen nil already-mark) @@ -571,104 +805,132 @@ (elmo-msgdb-mark-append mark-alist (elmo-msgdb-overview-entity-get-number entity) - gmark))) - ))) - (setq i (1+ i)) - (and (zerop (% i 20)) - (elmo-display-progress - 'elmo-pop3-msgdb-create-message "Creating msgdb..." - (/ (* i 100) num))) - ) - (elmo-display-progress - 'elmo-pop3-msgdb-create-message "Creating msgdb..." 100) + gmark)))))) + (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)))) -(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) (while (not (re-search-forward "^\\.\r?\n" nil t)) - (accept-process-output process) + (accept-process-output process 1) (goto-char start)) (setq end (point)) (with-current-buffer outbuf (erase-buffer) - (insert-buffer-substring buffer start (- end 3)) - (elmo-delete-cr-get-content-type))))) - -(defun elmo-pop3-read-msg (spec number outbuf) - (save-excursion - (let* ((connection (elmo-pop3-get-connection spec)) - (buffer (car connection)) - (process (cadr connection)) - (cwf (caddr connection)) - response errmsg msg) - (elmo-pop3-send-command buffer process - (format "retr %s" number)) - (when (null (setq response (elmo-pop3-read-response - buffer process t))) - (error "Fetching message failed")) - (setq response (elmo-pop3-read-body buffer process outbuf)) - (set-buffer outbuf) - (goto-char (point-min)) - (while (re-search-forward "^\\." nil t) - (replace-match "") - (forward-line)) - response))) - -(defun elmo-pop3-delete-msg (buffer process number) - (let (response errmsg msg) - (elmo-pop3-send-command buffer process - (format "dele %s" number)) - (when (null (setq response (elmo-pop3-read-response - buffer process t))) - (error "Deleting message failed")))) - -(defun elmo-pop3-delete-msgs (spec msgs) - (save-excursion - (let* ((connection (elmo-pop3-get-connection spec)) - (buffer (car connection)) - (process (cadr connection))) - (mapcar '(lambda (msg) (elmo-pop3-delete-msg - buffer process msg)) - msgs)))) - -(defun elmo-pop3-search (spec condition &optional numlist) - (error "Searching in pop3 folder is not implemented yet")) - -(defun elmo-pop3-use-cache-p (spec number) + (insert-buffer-substring (process-buffer process) start (- end 3))) + t))) + +(luna-define-method elmo-folder-open-internal ((folder elmo-pop3-folder)) + (if (and (not elmo-inhibit-number-mapping) + (elmo-pop3-folder-use-uidl-internal folder)) + (elmo-pop3-folder-set-location-alist-internal + folder (elmo-msgdb-location-load (elmo-folder-msgdb-path folder))))) + +(luna-define-method elmo-folder-commit :after ((folder elmo-pop3-folder)) + (when (elmo-folder-persistent-p folder) + (elmo-msgdb-location-save (elmo-folder-msgdb-path folder) + (elmo-pop3-folder-location-alist-internal + folder)))) + +(luna-define-method elmo-folder-close-internal ((folder elmo-pop3-folder)) + (elmo-pop3-folder-set-location-alist-internal folder nil) + ;; Just close connection + (elmo-folder-check folder)) + +(luna-define-method elmo-message-fetch-plugged ((folder elmo-pop3-folder) + number strategy + &optional section + outbuf unseen) + (let* ((loc-alist (elmo-pop3-folder-location-alist-internal folder)) + (process (elmo-network-session-process-internal + (elmo-pop3-get-session folder))) + size response errmsg msg) + (with-current-buffer (process-buffer process) + (if loc-alist + (setq number (elmo-pop3-uidl-to-number + (cdr (assq number loc-alist))))) + (setq size (string-to-number + (elmo-pop3-number-to-size number))) + (when number + (elmo-pop3-send-command process + (format "retr %s" number)) + (unless elmo-inhibit-display-retrieval-progress + (setq elmo-pop3-total-size size) + (elmo-display-progress + 'elmo-display-retrieval-progress + (format "Retrieving (0/%d bytes)..." elmo-pop3-total-size) + 0)) + (unwind-protect + (progn + (when (null (setq response (elmo-pop3-read-response + process t))) + (error "Fetching message failed")) + (setq response (elmo-pop3-read-body process outbuf))) + (setq elmo-pop3-total-size nil)) + (unless elmo-inhibit-display-retrieval-progress + (elmo-display-progress + 'elmo-display-retrieval-progress + "Retrieving..." 100) ; remove progress bar. + (message "Retrieving...done.")) + (set-buffer outbuf) + (goto-char (point-min)) + (while (re-search-forward "^\\." nil t) + (replace-match "") + (forward-line)) + response)))) + +(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 process + (format "dele %s" number)) + (when (null (setq response (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) + (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)) + msgs))) + +(luna-define-method elmo-message-use-cache-p ((folder elmo-pop3-folder) number) elmo-pop3-use-cache) -(defun elmo-pop3-local-file-p (spec number) - nil) - -(defun elmo-pop3-port-label (spec) - (concat "pop3" - (if (elmo-pop3-spec-ssl spec) "!ssl" ""))) - -(defsubst elmo-pop3-portinfo (spec) - (list (elmo-pop3-spec-hostname spec) - (elmo-pop3-spec-port spec))) - -(defun elmo-pop3-plugged-p (spec) - (apply 'elmo-plugged-p - (append (elmo-pop3-portinfo spec) - (list nil (quote (elmo-pop3-port-label spec)))))) +(luna-define-method elmo-folder-persistent-p ((folder elmo-pop3-folder)) + (and (elmo-folder-persistent-internal folder) + (elmo-pop3-folder-use-uidl-internal folder))) -(defun elmo-pop3-set-plugged (spec plugged add) - (apply 'elmo-set-plugged plugged - (append (elmo-pop3-portinfo spec) - (list nil nil (quote (elmo-pop3-port-label spec)) add)))) +(luna-define-method elmo-folder-clear :around ((folder elmo-pop3-folder) + &optional keep-killed) + (unless keep-killed + (elmo-pop3-folder-set-location-alist-internal folder nil)) + (luna-call-next-method)) -(defalias 'elmo-pop3-sync-number-alist - 'elmo-generic-sync-number-alist) -(defalias 'elmo-pop3-list-folder-unread - 'elmo-generic-list-folder-unread) -(defalias 'elmo-pop3-list-folder-important - 'elmo-generic-list-folder-important) -(defalias 'elmo-pop3-commit 'elmo-generic-commit) +(luna-define-method elmo-folder-check ((folder elmo-pop3-folder)) + (if (elmo-folder-plugged-p folder) + (let ((session (elmo-pop3-get-session folder 'if-exists))) + (when session + (elmo-network-close-session session))))) -(provide 'elmo-pop3) +(require 'product) +(product-provide (provide 'elmo-pop3) (require 'elmo-version)) ;;; elmo-pop3.el ends here