X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Felmo-pop3.el;h=29ad7441555f1102a0f6ac093a064b9bbda23a7a;hb=387de08a4889ea0d05877cd94f52c8242ea02aca;hp=1a82f445c34fe86d3c80d51aaf23db6505af2c06;hpb=e64882498d21cef2b964ddc18d41421ab36bd19b;p=elisp%2Fwanderlust.git diff --git a/elmo/elmo-pop3.el b/elmo/elmo-pop3.el index 1a82f44..29ad744 100644 --- a/elmo/elmo-pop3.el +++ b/elmo/elmo-pop3.el @@ -1,8 +1,10 @@ ;;; 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). @@ -31,46 +33,35 @@ (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-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))) -(condition-case nil - (progn - (require 'sasl)) - (error)) - -(defvar elmo-pop3-use-uidl t - "*If non-nil, use UIDL.") + (require 'elmo-util)) + +(eval-and-compile + (autoload 'md5 "md5")) (defvar elmo-pop3-exists-exactly t) +(defvar sasl-mechanism-alist) -(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.") +(defvar elmo-pop3-total-size nil) -(eval-and-compile - (luna-define-class elmo-pop3-session (elmo-network-session) ())) +;; For debugging. +(defvar elmo-pop3-debug nil + "Non-nil forces POP3 folder as debug mode. +Debug information is inserted in the buffer \"*POP3 DEBUG*\"") + +(defvar elmo-pop3-debug-inhibit-logging nil) + +;;; Debug +(defsubst elmo-pop3-debug (message &rest args) + (if elmo-pop3-debug + (with-current-buffer (get-buffer-create "*POP3 DEBUG*") + (goto-char (point-max)) + (if elmo-pop3-debug-inhibit-logging + (insert "NO LOGGING\n") + (insert (apply 'format message args) "\n"))))) + +(luna-define-class elmo-pop3-session (elmo-network-session)) ;; buffer-local (defvar elmo-pop3-read-point nil) @@ -88,17 +79,18 @@ elmo-pop3-list-done)) (luna-define-method elmo-network-close-session ((session elmo-pop3-session)) - (unless (memq (process-status + (when (elmo-network-session-process-internal session) + (when (memq (process-status (elmo-network-session-process-internal session)) - '(closed exit)) - (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))) + '(open run)) + (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 @@ -117,6 +109,7 @@ (erase-buffer)) (goto-char (point-min)) (setq elmo-pop3-read-point (point)) + (elmo-pop3-debug "SEND: %s\n" command) (process-send-string process command) (process-send-string process "\r\n"))) @@ -151,7 +144,7 @@ (setq return-value nil)) (setq elmo-pop3-read-point match-end) (if not-command - (setq response-continue nil)) + (setq response-continue nil)) (setq return-value (if return-value (concat return-value "\n" response-string) @@ -163,7 +156,11 @@ (save-excursion (set-buffer (process-buffer process)) (goto-char (point-max)) - (insert output))) + (insert output) + (elmo-pop3-debug "RECEIVED: %s\n" output) + (if elmo-pop3-total-size + (message "Retrieving...(%d/%d bytes)." + (buffer-size) elmo-pop3-total-size)))) (defun elmo-pop3-auth-user (session) (let ((process (elmo-network-session-process-internal session))) @@ -188,7 +185,6 @@ (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" @@ -204,97 +200,8 @@ t) (signal 'elmo-authenticate-error '(elmo-pop3-auth-apop)))) - (signal 'elmo-open-error '(elmo-pop-auth-user)))) + (signal 'elmo-open-error '(elmo-pop3-auth-apop)))) -(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-buffer :after ((session elmo-pop3-session) buffer) (with-current-buffer buffer @@ -303,10 +210,17 @@ (luna-define-method elmo-network-initialize-session ((session elmo-pop3-session)) (let ((process (elmo-network-session-process-internal session)) - response capability mechanism) + 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)) @@ -320,53 +234,115 @@ (elmo-pop3-read-response process)) (starttls-negotiate process) (signal 'elmo-open-error - '(elmo-network-intialize-session))))))) + '(elmo-pop3-starttls-error))))))) (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))) + (with-current-buffer (process-buffer + (elmo-network-session-process-internal session)) + (let* ((process (elmo-network-session-process-internal session)) + (elmo-pop3-debug-inhibit-logging t) + (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-host-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 + (sasl-step-data step) 'no-line-break))))) ;) + (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) + ""))))))))) (luna-define-method elmo-network-setup-session ((session elmo-pop3-session)) (let ((process (elmo-network-session-process-internal session)) - response) + count response) (with-current-buffer (process-buffer process) - (setq elmo-pop3-size-hash (make-vector 31 0)) + (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 folder failed")) + (error "POP LIST command failed")) (if (null (setq response (elmo-pop3-read-contents (current-buffer) process))) - (error "POP List folder failed")) + (error "POP LIST command failed")) ;; POP server always returns a sequence of serial numbers. - (elmo-pop3-parse-list-response response) + (setq count (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)) + (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 "UIDL failed")) + (error "POP UIDL failed")) (unless (setq response (elmo-pop3-read-contents (current-buffer) process)) - (error "UIDL failed")) + (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) @@ -389,6 +365,7 @@ (elmo-pop3-plugged-p spec)) (save-excursion (let (elmo-auto-change-plugged ; don't change plug status. + elmo-pop3-use-uidl ; No need to use uidl. session) (prog1 (setq session (elmo-pop3-get-session spec)) @@ -403,7 +380,7 @@ (let (number uid list) (insert string) (goto-char (point-min)) - (while (re-search-forward "^\\([0-9]+\\)[\t ]\\([^ \n]+\\)$" nil t) + (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 @@ -416,22 +393,27 @@ (defun elmo-pop3-parse-list-response (string) (let ((buffer (current-buffer)) - number list size) + (count 0) + alist) (with-temp-buffer (insert string) (goto-char (point-min)) - (while (re-search-forward "^\\([0-9]+\\)[\t ]\\([0-9]+\\)$" nil t) - (setq list + (while (re-search-forward "^\\([0-9]+\\)[\t ]+\\([0-9]+\\)$" nil t) + (setq alist (cons - (string-to-int (setq number (elmo-match-buffer 1))) - list)) - (setq size (elmo-match-buffer 2)) - (with-current-buffer buffer - (elmo-set-hash-val (concat "#" number) - size - elmo-pop3-size-hash))) - (with-current-buffer buffer (setq elmo-pop3-list-done t)) - (nreverse list)))) + (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 (spec) (with-current-buffer (process-buffer @@ -470,7 +452,7 @@ (sort list '<)) (error "POP3: Error in list"))))) -(defun elmo-pop3-list-folder (spec) +(defun elmo-pop3-list-folder (spec &optional nohide) (let ((killed (and elmo-use-killed-list (elmo-msgdb-killed-list-load (elmo-msgdb-expand-path spec)))) @@ -485,7 +467,9 @@ (defun elmo-pop3-max-of-folder (spec) (elmo-pop3-commit spec) (if elmo-pop3-use-uidl - (elmo-pop3-list-by-uidl-subr spec 'nonsort) + (prog1 + (elmo-pop3-list-by-uidl-subr spec 'nonsort) + (elmo-pop3-commit spec)) (let* ((process (elmo-network-session-process-internal (elmo-pop3-get-session spec))) @@ -500,6 +484,7 @@ (setq total (string-to-int (substring response (match-beginning 1)(match-end 1 )))) + (elmo-pop3-commit spec) (cons total total)))))) (defvar elmo-pop3-header-fetch-chop-length 200) @@ -516,7 +501,7 @@ nil)) (t nil))) - + (defun elmo-pop3-retrieve-headers (buffer tobuffer process articles) (save-excursion (set-buffer buffer) @@ -565,6 +550,27 @@ (defalias 'elmo-pop3-msgdb-create 'elmo-pop3-msgdb-create-as-numlist) +(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 (msgdb) + (message "Sorting...") + (let ((overview (elmo-msgdb-get-overview msgdb))) + (setq overview (elmo-pop3-sort-overview-by-original-number + overview + (elmo-msgdb-get-location msgdb))) + (message "Sorting...done") + (list overview (nth 1 msgdb)(nth 2 msgdb)(nth 3 msgdb)(nth 4 msgdb)))) + (defun elmo-pop3-msgdb-create-as-numlist (spec numlist new-mark already-mark seen-mark important-mark seen-list @@ -577,10 +583,12 @@ (setq loc-alist (if msgdb (elmo-msgdb-get-location msgdb) (elmo-msgdb-location-load (elmo-msgdb-expand-path spec))))) - (elmo-pop3-msgdb-create-by-header process numlist - new-mark already-mark - seen-mark seen-list - loc-alist)))) + (with-current-buffer (process-buffer process) + (elmo-pop3-sort-msgdb-by-original-number + (elmo-pop3-msgdb-create-by-header process numlist + new-mark already-mark + seen-mark seen-list + loc-alist)))))) (defun elmo-pop3-uidl-to-number (uidl) (string-to-number (elmo-get-hash-val uidl @@ -707,7 +715,7 @@ (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) +(defun elmo-pop3-read-msg (spec number outbuf &optional msgdb unread) (let* ((loc-alist (if elmo-pop3-use-uidl (if msgdb (elmo-msgdb-get-location msgdb) @@ -715,18 +723,34 @@ (elmo-msgdb-expand-path spec))))) (process (elmo-network-session-process-internal (elmo-pop3-get-session spec))) - response errmsg msg) + 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)) - (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 size) + (unless elmo-inhibit-display-retrieval-progress + (setq elmo-pop3-total-size size) + (elmo-display-progress + 'elmo-pop3-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 "" 100) ; remove progress bar. + (message "Retrieving...done.")) (set-buffer outbuf) (goto-char (point-min)) (while (re-search-forward "^\\." nil t) @@ -802,9 +826,8 @@ (defun elmo-pop3-commit (spec) (if (elmo-pop3-plugged-p spec) (let ((session (elmo-pop3-get-session spec 'if-exists))) - (and session - (elmo-network-close-session session))))) - + (when session + (elmo-network-close-session session))))) (require 'product) (product-provide (provide 'elmo-pop3) (require 'elmo-version))