1 ;;; elmo-pop3.el --- POP3 Interface for ELMO.
3 ;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
4 ;; Copyright (C) 1999,2000 Kenichi OKADA <okada@opaopa.org>
6 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
7 ;; Kenichi OKADA <okada@opaopa.org>
8 ;; Keywords: mail, net news
10 ;; This file is part of ELMO (Elisp Library for Message Orchestration).
12 ;; This program is free software; you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation; either version 2, or (at your option)
17 ;; This program is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25 ;; Boston, MA 02111-1307, USA.
41 (autoload 'md5 "md5"))
43 (defcustom elmo-pop3-default-use-uidl t
44 "If non-nil, use UIDL on POP3."
48 (defvar elmo-pop3-use-uidl-internal t
49 "(Internal switch for using UIDL on POP3).")
51 (defvar elmo-pop3-use-cache t
52 "Use cache in pop3 folder.")
54 (defvar elmo-pop3-send-command-synchronously nil
55 "If non-nil, commands are send synchronously.
56 If server doesn't accept asynchronous commands, this variable should be
59 (defvar elmo-pop3-exists-exactly t)
60 (defvar sasl-mechanism-alist)
62 (defvar elmo-pop3-total-size nil)
65 (defvar elmo-pop3-debug nil
66 "Non-nil forces POP3 folder as debug mode.
67 Debug information is inserted in the buffer \"*POP3 DEBUG*\"")
69 (defvar elmo-pop3-debug-inhibit-logging nil)
72 (defsubst elmo-pop3-debug (message &rest args)
74 (with-current-buffer (get-buffer-create "*POP3 DEBUG*")
75 (goto-char (point-max))
76 (if elmo-pop3-debug-inhibit-logging
77 (insert "NO LOGGING\n")
78 (insert (apply 'format message args) "\n")))))
82 (luna-define-class elmo-pop3-folder (elmo-net-folder)
83 (use-uidl location-alist))
84 (luna-define-internal-accessors 'elmo-pop3-folder))
86 (luna-define-method elmo-folder-initialize :around ((folder
89 (let ((elmo-network-stream-type-alist
90 (if elmo-pop3-stream-type-alist
91 (append elmo-pop3-stream-type-alist
92 elmo-network-stream-type-alist)
93 elmo-network-stream-type-alist))
95 (setq name (luna-call-next-method))
97 (setq parse (elmo-parse-token name "/:"))
98 (elmo-net-folder-set-user-internal folder
99 (if (eq (length (car parse)) 0)
100 elmo-pop3-default-user
103 (setq parse (elmo-parse-prefixed-element ?/ (cdr parse) ":"))
104 (elmo-net-folder-set-auth-internal folder
105 (if (eq (length (car parse)) 0)
106 elmo-pop3-default-authenticate-type
107 (intern (downcase (car parse)))))
109 (setq parse (elmo-parse-prefixed-element ?: (cdr parse)))
110 (elmo-pop3-folder-set-use-uidl-internal folder
111 (if (eq (length (car parse)) 0)
112 elmo-pop3-default-use-uidl
113 (string= (car parse) "uidl")))
114 (unless (elmo-net-folder-server-internal folder)
115 (elmo-net-folder-set-server-internal folder
116 elmo-pop3-default-server))
117 (unless (elmo-net-folder-port-internal folder)
118 (elmo-net-folder-set-port-internal folder
119 elmo-pop3-default-port))
120 (unless (elmo-net-folder-stream-type-internal folder)
121 (elmo-net-folder-set-stream-type-internal
123 (elmo-get-network-stream-type
124 elmo-pop3-default-stream-type)))
128 (luna-define-class elmo-pop3-session (elmo-network-session) ())
131 (defvar elmo-pop3-read-point nil)
132 (defvar elmo-pop3-number-uidl-hash nil) ; number -> uidl
133 (defvar elmo-pop3-uidl-number-hash nil) ; uidl -> number
134 (defvar elmo-pop3-size-hash nil) ; number -> size
135 (defvar elmo-pop3-uidl-done nil)
136 (defvar elmo-pop3-list-done nil)
137 (defvar elmo-pop3-lock nil)
139 (defvar elmo-pop3-local-variables '(elmo-pop3-read-point
140 elmo-pop3-uidl-number-hash
141 elmo-pop3-number-uidl-hash
147 (luna-define-method elmo-network-close-session ((session elmo-pop3-session))
148 (when (elmo-network-session-process-internal session)
149 (when (memq (process-status
150 (elmo-network-session-process-internal session))
152 (let ((buffer (process-buffer
153 (elmo-network-session-process-internal session))))
154 (elmo-pop3-send-command (elmo-network-session-process-internal session)
157 (or (elmo-pop3-read-response
158 (elmo-network-session-process-internal session)
160 (error "POP error: QUIT failed"))))
161 (kill-buffer (process-buffer
162 (elmo-network-session-process-internal session)))
163 (delete-process (elmo-network-session-process-internal session))))
165 (defun elmo-pop3-get-session (folder &optional if-exists)
166 (let ((elmo-pop3-use-uidl-internal (if elmo-inhibit-number-mapping
168 (elmo-pop3-folder-use-uidl-internal
170 (elmo-network-get-session 'elmo-pop3-session "POP3" folder if-exists)))
172 (defun elmo-pop3-send-command (process command &optional no-erase)
173 (with-current-buffer (process-buffer process)
176 (goto-char (point-min))
177 (setq elmo-pop3-read-point (point))
178 (elmo-pop3-debug "SEND: %s\n" command)
179 (process-send-string process command)
180 (process-send-string process "\r\n")))
182 (defun elmo-pop3-read-response (process &optional not-command)
183 ;; buffer is in case for process is dead.
184 (with-current-buffer (process-buffer process)
185 (let ((case-fold-search nil)
186 (response-string nil)
187 (response-continue t)
190 (while response-continue
191 (goto-char elmo-pop3-read-point)
192 (while (not (re-search-forward "\r?\n" nil t))
193 (accept-process-output process)
194 (goto-char elmo-pop3-read-point))
195 (setq match-end (point))
196 (setq response-string
197 (buffer-substring elmo-pop3-read-point (- match-end 2)))
198 (goto-char elmo-pop3-read-point)
199 (if (looking-at "\\+.*$")
201 (setq response-continue nil)
202 (setq elmo-pop3-read-point match-end)
205 (concat return-value "\n" response-string)
207 (if (looking-at "\\-.*$")
209 (setq response-continue nil)
210 (setq elmo-pop3-read-point match-end)
211 (setq return-value nil))
212 (setq elmo-pop3-read-point match-end)
214 (setq response-continue nil))
217 (concat return-value "\n" response-string)
219 (setq elmo-pop3-read-point match-end)))
222 (defun elmo-pop3-process-filter (process output)
224 (set-buffer (process-buffer process))
225 (goto-char (point-max))
227 (elmo-pop3-debug "RECEIVED: %s\n" output)
228 (if (and elmo-pop3-total-size
229 (> elmo-pop3-total-size
230 (min elmo-display-retrieval-progress-threshold 100)))
231 (elmo-display-progress
232 'elmo-display-retrieval-progress
233 (format "Retrieving (%d/%d bytes)..."
235 elmo-pop3-total-size)
236 (/ (buffer-size) (/ elmo-pop3-total-size 100))))))
238 (defun elmo-pop3-auth-user (session)
239 (let ((process (elmo-network-session-process-internal session)))
241 (elmo-pop3-send-command
243 (format "user %s" (elmo-network-session-user-internal session)))
244 (or (elmo-pop3-read-response process t)
245 (signal 'elmo-authenticate-error
246 '(elmo-pop-auth-user)))
247 (elmo-pop3-send-command process
251 (elmo-network-session-password-key session))))
252 (or (elmo-pop3-read-response process t)
253 (signal 'elmo-authenticate-error
254 '(elmo-pop-auth-user)))))
256 (defun elmo-pop3-auth-apop (session)
257 (if (string-match "^\+OK .*\\(<[^\>]+>\\)"
258 (elmo-network-session-greeting-internal session))
259 ;; good, APOP ready server
261 (elmo-pop3-send-command
262 (elmo-network-session-process-internal session)
264 (elmo-network-session-user-internal session)
266 (concat (match-string
268 (elmo-network-session-greeting-internal session))
270 (elmo-network-session-password-key session))))))
271 (or (elmo-pop3-read-response
272 (elmo-network-session-process-internal session)
274 (signal 'elmo-authenticate-error
275 '(elmo-pop3-auth-apop))))
276 (signal 'elmo-open-error '(elmo-pop3-auth-apop))))
278 (luna-define-method elmo-network-initialize-session-buffer :after
279 ((session elmo-pop3-session) buffer)
280 (with-current-buffer buffer
281 (mapcar 'make-variable-buffer-local elmo-pop3-local-variables)))
283 (luna-define-method elmo-network-initialize-session ((session
285 (let ((process (elmo-network-session-process-internal session))
287 (with-current-buffer (process-buffer process)
288 (set-process-filter process 'elmo-pop3-process-filter)
289 (setq elmo-pop3-read-point (point-min))
290 ;; Skip garbage output from process before greeting.
291 (while (and (memq (process-status process) '(open run))
292 (goto-char (point-max))
294 (not (looking-at "+OK")))
295 (accept-process-output process 1))
296 (setq elmo-pop3-read-point (point))
297 (or (elmo-network-session-set-greeting-internal
299 (elmo-pop3-read-response process t))
300 (signal 'elmo-open-error
301 '(elmo-network-intialize-session)))
302 (when (eq (elmo-network-stream-type-symbol
303 (elmo-network-session-stream-type-internal session))
305 (elmo-pop3-send-command process "stls")
306 (if (string-match "^\+OK"
307 (elmo-pop3-read-response process))
308 (starttls-negotiate process)
309 (signal 'elmo-open-error
310 '(elmo-pop3-starttls-error)))))))
312 (luna-define-method elmo-network-authenticate-session ((session
314 (with-current-buffer (process-buffer
315 (elmo-network-session-process-internal session))
316 (let* ((process (elmo-network-session-process-internal session))
317 (elmo-pop3-debug-inhibit-logging t)
318 (auth (elmo-network-session-auth-internal session))
319 (auth (mapcar '(lambda (mechanism) (upcase (symbol-name mechanism)))
320 (if (listp auth) auth (list auth))))
322 client name step response mechanism
323 sasl-read-passphrase)
324 (or (and (string= "USER" (car auth))
325 (elmo-pop3-auth-user session))
326 (and (string= "APOP" (car auth))
327 (elmo-pop3-auth-apop session))
330 (setq sasl-mechanisms (mapcar 'car sasl-mechanism-alist))
331 (setq mechanism (sasl-find-mechanism auth))
333 (signal 'elmo-authenticate-error '(elmo-pop3-auth-no-mechanisms)))
337 (elmo-network-session-user-internal session)
339 (elmo-network-session-server-internal session)))
340 ;;; (if elmo-pop3-auth-user-realm
341 ;;; (sasl-client-set-property client 'realm elmo-pop3-auth-user-realm))
342 (setq name (sasl-mechanism-name mechanism))
343 (elmo-network-session-set-auth-internal session
344 (intern (downcase name)))
345 (setq sasl-read-passphrase
349 (elmo-network-session-password-key session)))))
350 (setq step (sasl-next-step client nil))
351 (elmo-pop3-send-command
354 (and (sasl-step-data step)
357 (elmo-base64-encode-string
358 (sasl-step-data step) 'no-line-break))))) ;)
361 (unless (setq response (elmo-pop3-read-response process t))
362 ;; response is NO or BAD.
363 (signal 'elmo-authenticate-error
365 (concat "elmo-pop3-auth-"
367 (if (string-match "^\+OK" response)
368 (if (sasl-next-step client step)
370 (signal 'elmo-authenticate-error
372 (concat "elmo-pop3-auth-"
374 ;; The authentication process is finished.
378 (elmo-base64-decode-string
379 (cadr (split-string response " "))))
380 (setq step (sasl-next-step client step))
381 (elmo-pop3-send-command
383 (if (sasl-step-data step)
384 (elmo-base64-encode-string (sasl-step-data step)
388 (luna-define-method elmo-network-setup-session ((session
390 (let ((process (elmo-network-session-process-internal session))
392 (with-current-buffer (process-buffer process)
393 (setq elmo-pop3-size-hash (elmo-make-hash 31))
394 ;; To get obarray of uidl and size
395 (elmo-pop3-send-command process "list")
396 (if (null (elmo-pop3-read-response process))
397 (error "POP LIST command failed"))
398 (if (null (setq response
399 (elmo-pop3-read-contents
400 (current-buffer) process)))
401 (error "POP LIST command failed"))
402 ;; POP server always returns a sequence of serial numbers.
403 (setq count (elmo-pop3-parse-list-response response))
405 (when elmo-pop3-use-uidl-internal
406 (setq elmo-pop3-uidl-number-hash (elmo-make-hash (* count 2)))
407 (setq elmo-pop3-number-uidl-hash (elmo-make-hash (* count 2)))
409 (elmo-pop3-send-command process "uidl")
410 (unless (elmo-pop3-read-response process)
411 (error "POP UIDL failed"))
412 (unless (setq response (elmo-pop3-read-contents
413 (current-buffer) process))
414 (error "POP UIDL failed"))
415 (elmo-pop3-parse-uidl-response response)))))
417 (defun elmo-pop3-read-contents (buffer process)
418 (with-current-buffer buffer
419 (let ((case-fold-search nil)
421 (goto-char elmo-pop3-read-point)
422 (while (not (re-search-forward "^\\.\r\n" nil t))
423 (accept-process-output process)
424 (goto-char elmo-pop3-read-point))
425 (setq match-end (point))
427 (buffer-substring elmo-pop3-read-point
430 (luna-define-method elmo-folder-expand-msgdb-path ((folder elmo-pop3-folder))
431 (convert-standard-filename
433 (elmo-safe-filename (elmo-net-folder-user-internal folder))
434 (expand-file-name (elmo-net-folder-server-internal folder)
439 (luna-define-method elmo-folder-exists-p ((folder elmo-pop3-folder))
440 (if (and elmo-pop3-exists-exactly
441 (elmo-folder-plugged-p folder))
443 (let (elmo-auto-change-plugged ; don't change plug status.
444 (elmo-inhibit-number-mapping t) ; No need to use uidl.
447 (setq session (elmo-pop3-get-session folder))
449 (elmo-network-close-session session)))))
452 (defun elmo-pop3-parse-uidl-response (string)
453 (let ((buffer (current-buffer))
456 (let (number uid list)
458 (goto-char (point-min))
459 (while (re-search-forward "^\\([0-9]+\\)[\t ]+\\([^ \n]+\\)$" nil t)
460 (setq number (elmo-match-buffer 1))
461 (setq uid (elmo-match-buffer 2))
462 (with-current-buffer buffer
463 (elmo-set-hash-val uid number elmo-pop3-uidl-number-hash)
464 (elmo-set-hash-val (concat "#" number) uid
465 elmo-pop3-number-uidl-hash))
466 (setq list (cons uid list)))
467 (with-current-buffer buffer (setq elmo-pop3-uidl-done t))
470 (defun elmo-pop3-parse-list-response (string)
471 (let ((buffer (current-buffer))
476 (goto-char (point-min))
477 (while (re-search-forward "^\\([0-9]+\\)[\t ]+\\([0-9]+\\)$" nil t)
480 (cons (elmo-match-buffer 1)
481 (elmo-match-buffer 2))
483 (setq count (1+ count)))
484 (with-current-buffer buffer
485 (setq elmo-pop3-size-hash (elmo-make-hash (* (length alist) 2)))
487 (elmo-set-hash-val (concat "#" (car (car alist)))
490 (setq alist (cdr alist)))
491 (setq elmo-pop3-list-done t))
494 (defun elmo-pop3-list-location (folder)
495 (with-current-buffer (process-buffer
496 (elmo-network-session-process-internal
497 (elmo-pop3-get-session folder)))
499 (if elmo-pop3-uidl-done
503 (setq locations (cons (symbol-name atom) locations)))
504 elmo-pop3-uidl-number-hash)
507 (< (elmo-pop3-uidl-to-number loc1)
508 (elmo-pop3-uidl-to-number loc2)))))
509 (error "POP3: Error in UIDL")))))
511 (defun elmo-pop3-list-folder-by-location (folder locations)
512 (let* ((location-alist (elmo-pop3-folder-location-alist-internal folder))
513 (locations-in-db (mapcar 'cdr location-alist))
514 result new-locs new-alist deleted-locs i)
516 (elmo-delete-if (function
517 (lambda (x) (member x locations-in-db)))
520 (elmo-delete-if (function
521 (lambda (x) (member x locations)))
523 (setq i (or (elmo-max-of-list (mapcar 'car location-alist)) 0))
528 (delq (rassoc x location-alist) location-alist))))
532 (setq new-alist (cons (cons i (car new-locs)) new-alist))
533 (setq new-locs (cdr new-locs)))
534 (setq result (nconc location-alist new-alist))
535 (setq result (sort result (lambda (x y) (< (car x)(car y)))))
536 (elmo-pop3-folder-set-location-alist-internal folder result)
537 (mapcar 'car result)))
539 (defun elmo-pop3-list-by-uidl-subr (folder &optional nonsort)
540 (let ((flist (elmo-pop3-list-folder-by-location
542 (elmo-pop3-list-location folder))))
544 (cons (elmo-max-of-list flist) (length flist))
547 (defun elmo-pop3-list-by-list (folder)
548 (with-current-buffer (process-buffer
549 (elmo-network-session-process-internal
550 (elmo-pop3-get-session folder)))
552 (if elmo-pop3-list-done
554 (mapatoms (lambda (atom)
555 (setq list (cons (string-to-int
556 (substring (symbol-name atom) 1))
560 (error "POP3: Error in list")))))
562 (defsubst elmo-pop3-folder-list-messages (folder)
563 (if (and (not elmo-inhibit-number-mapping)
564 (elmo-pop3-folder-use-uidl-internal folder))
565 (elmo-pop3-list-by-uidl-subr folder)
566 (elmo-pop3-list-by-list folder)))
568 (luna-define-method elmo-folder-list-messages-internal
569 ((folder elmo-pop3-folder) &optional nohide)
570 (elmo-pop3-folder-list-messages folder))
572 (luna-define-method elmo-folder-status ((folder elmo-pop3-folder))
573 (elmo-folder-open-internal folder)
574 (elmo-folder-check folder)
575 (if (elmo-pop3-folder-use-uidl-internal folder)
577 (elmo-pop3-list-by-uidl-subr folder 'nonsort)
578 (elmo-folder-close-internal folder))
580 (elmo-network-session-process-internal
581 (elmo-pop3-get-session folder)))
584 (with-current-buffer (process-buffer process)
585 (elmo-pop3-send-command process "STAT")
586 (setq response (elmo-pop3-read-response process))
587 ;; response: "^\+OK 2 7570$"
588 (if (not (string-match "^\+OK[ \t]*\\([0-9]*\\)" response))
589 (error "POP STAT command failed")
592 (substring response (match-beginning 1)(match-end 1 ))))
593 (elmo-folder-close-internal folder)
594 (cons total total))))))
596 (defvar elmo-pop3-header-fetch-chop-length 200)
598 (defsubst elmo-pop3-next-result-arrived-p ()
600 ((eq (following-char) ?+)
601 (if (re-search-forward "\n\\.\r?\n" nil t)
605 (if (search-forward "\n" nil t)
611 (defun elmo-pop3-retrieve-headers (buffer tobuffer process articles)
615 (let ((number (length articles))
618 (last-point (point-min)))
619 ;; Send HEAD commands.
621 (elmo-pop3-send-command process (format
622 "top %s 0" (car articles))
624 ;;; (accept-process-output process 1)
625 (setq articles (cdr articles))
626 (setq count (1+ count))
627 ;; Every 200 requests we have to read the stream in
628 ;; order to avoid deadlocks.
629 (when (or elmo-pop3-send-command-synchronously
630 (null articles) ;All requests have been sent.
631 (zerop (% count elmo-pop3-header-fetch-chop-length)))
632 (unless elmo-pop3-send-command-synchronously
633 (accept-process-output process 1))
637 (goto-char last-point)
639 (while (elmo-pop3-next-result-arrived-p)
640 (setq last-point (point))
641 (setq received (1+ received)))
643 (when (> number elmo-display-progress-threshold)
644 (if (or (zerop (% received 5)) (= received number))
645 (elmo-display-progress
646 'elmo-pop3-retrieve-headers "Getting headers..."
647 (/ (* received 100) number))))
648 (accept-process-output process 1)
649 ;;; (accept-process-output process)
651 ;; Remove all "\r"'s.
652 (goto-char (point-min))
653 (while (search-forward "\r\n" nil t)
654 (replace-match "\n"))
655 (copy-to-buffer tobuffer (point-min) (point-max)))))
657 (luna-define-method elmo-folder-msgdb-create ((folder elmo-pop3-folder)
659 already-mark seen-mark
660 important-mark seen-list)
661 (let ((process (elmo-network-session-process-internal
662 (elmo-pop3-get-session folder))))
663 (with-current-buffer (process-buffer process)
664 (elmo-pop3-sort-msgdb-by-original-number
666 (elmo-pop3-msgdb-create-by-header
669 new-mark already-mark
671 (if (elmo-pop3-folder-use-uidl-internal folder)
672 (elmo-pop3-folder-location-alist-internal folder)))))))
674 (defun elmo-pop3-sort-overview-by-original-number (overview loc-alist)
678 (< (elmo-pop3-uidl-to-number
679 (cdr (assq (elmo-msgdb-overview-entity-get-number ent1)
681 (elmo-pop3-uidl-to-number
682 (cdr (assq (elmo-msgdb-overview-entity-get-number ent2)
686 (defun elmo-pop3-sort-msgdb-by-original-number (folder msgdb)
687 (message "Sorting...")
688 (let ((overview (elmo-msgdb-get-overview msgdb)))
689 (setq overview (elmo-pop3-sort-overview-by-original-number
691 (elmo-pop3-folder-location-alist-internal folder)))
692 (message "Sorting...done")
693 (list overview (nth 1 msgdb)(nth 2 msgdb)(nth 3 msgdb))))
695 (defun elmo-pop3-uidl-to-number (uidl)
696 (string-to-number (elmo-get-hash-val uidl
697 elmo-pop3-uidl-number-hash)))
699 (defun elmo-pop3-number-to-uidl (number)
700 (elmo-get-hash-val (format "#%d" number)
701 elmo-pop3-number-uidl-hash))
703 (defun elmo-pop3-number-to-size (number)
704 (elmo-get-hash-val (format "#%d" number)
705 elmo-pop3-size-hash))
707 (defun elmo-pop3-msgdb-create-by-header (process numlist
708 new-mark already-mark
712 (let ((tmp-buffer (get-buffer-create " *ELMO Overview TMP*")))
713 (with-current-buffer (process-buffer process)
714 (if loc-alist ; use uidl.
720 (elmo-pop3-uidl-to-number (cdr (assq number loc-alist))))
722 (elmo-pop3-retrieve-headers (process-buffer process)
723 tmp-buffer process numlist)
725 (elmo-pop3-msgdb-create-message
730 new-mark already-mark seen-mark seen-list loc-alist)
731 (kill-buffer tmp-buffer)))))
733 (defun elmo-pop3-msgdb-create-message (buffer
736 numlist new-mark already-mark
741 (let (beg overview number-alist mark-alist
742 entity i number message-id gmark seen size)
744 (elmo-set-buffer-multibyte default-enable-multibyte-characters)
745 (goto-char (point-min))
747 (message "Creating msgdb...")
749 (setq beg (save-excursion (forward-line 1) (point)))
750 (elmo-pop3-next-result-arrived-p)
754 (narrow-to-region beg (point))
756 (elmo-msgdb-create-overview-from-buffer
758 (setq numlist (cdr numlist))
761 (elmo-msgdb-append-element
763 (with-current-buffer (process-buffer process)
764 (elmo-msgdb-overview-entity-set-size
767 (elmo-pop3-number-to-size
768 (elmo-msgdb-overview-entity-get-number entity))))
772 (elmo-pop3-number-to-uidl
773 (elmo-msgdb-overview-entity-get-number entity))
775 (elmo-msgdb-overview-entity-set-number entity number)))
777 (elmo-msgdb-number-add
779 (elmo-msgdb-overview-entity-get-number entity)
781 (setq message-id (car entity))
782 (setq seen (member message-id seen-list))
783 (if (setq gmark (or (elmo-msgdb-global-mark-get message-id)
784 (if (elmo-file-cache-status
785 (elmo-file-cache-get message-id))
790 (if elmo-pop3-use-cache
794 (elmo-msgdb-mark-append
796 (elmo-msgdb-overview-entity-get-number entity)
798 (when (> num elmo-display-progress-threshold)
800 (if (or (zerop (% i 5)) (= i num))
801 (elmo-display-progress
802 'elmo-pop3-msgdb-create-message "Creating msgdb..."
803 (/ (* i 100) num)))))
804 (list overview number-alist mark-alist))))
806 (defun elmo-pop3-read-body (process outbuf)
807 (with-current-buffer (process-buffer process)
808 (let ((start elmo-pop3-read-point)
811 (while (not (re-search-forward "^\\.\r?\n" nil t))
812 (accept-process-output process)
815 (with-current-buffer outbuf
817 (insert-buffer-substring (process-buffer process) start (- end 3))))))
819 (luna-define-method elmo-folder-open-internal ((folder elmo-pop3-folder))
820 (if (and (not elmo-inhibit-number-mapping)
821 (elmo-pop3-folder-use-uidl-internal folder))
822 (elmo-pop3-folder-set-location-alist-internal
823 folder (elmo-msgdb-location-load (elmo-folder-msgdb-path folder)))))
825 (luna-define-method elmo-folder-commit :after ((folder elmo-pop3-folder))
826 (when (elmo-folder-persistent-p folder)
827 (elmo-msgdb-location-save (elmo-folder-msgdb-path folder)
828 (elmo-pop3-folder-location-alist-internal
831 (luna-define-method elmo-folder-close-internal ((folder elmo-pop3-folder))
832 (elmo-pop3-folder-set-location-alist-internal folder nil)
833 ;; Just close connection
834 (elmo-folder-check folder))
836 (luna-define-method elmo-message-fetch-plugged ((folder elmo-pop3-folder)
840 (let* ((loc-alist (elmo-pop3-folder-location-alist-internal folder))
841 (process (elmo-network-session-process-internal
842 (elmo-pop3-get-session folder)))
843 size response errmsg msg)
844 (with-current-buffer (process-buffer process)
846 (setq number (elmo-pop3-uidl-to-number
847 (cdr (assq number loc-alist)))))
848 (setq size (string-to-number
849 (elmo-pop3-number-to-size number)))
851 (elmo-pop3-send-command process
852 (format "retr %s" number))
853 (unless elmo-inhibit-display-retrieval-progress
854 (setq elmo-pop3-total-size size)
855 (elmo-display-progress
856 'elmo-display-retrieval-progress
857 (format "Retrieving (0/%d bytes)..." elmo-pop3-total-size)
861 (when (null (setq response (elmo-pop3-read-response
863 (error "Fetching message failed"))
864 (setq response (elmo-pop3-read-body process outbuf)))
865 (setq elmo-pop3-total-size nil))
866 (unless elmo-inhibit-display-retrieval-progress
867 (elmo-display-progress
868 'elmo-display-retrieval-progress "" 100) ; remove progress bar.
869 (message "Retrieving...done."))
871 (goto-char (point-min))
872 (while (re-search-forward "^\\." nil t)
877 (defun elmo-pop3-delete-msg (process number loc-alist)
878 (with-current-buffer (process-buffer process)
879 (let (response errmsg msg)
881 (setq number (elmo-pop3-uidl-to-number
882 (cdr (assq number loc-alist)))))
885 (elmo-pop3-send-command process
886 (format "dele %s" number))
887 (when (null (setq response (elmo-pop3-read-response
889 (error "Deleting message failed")))
890 (error "Deleting message failed")))))
892 (luna-define-method elmo-folder-delete-messages-plugged
893 ((folder elmo-pop3-folder) msgs)
894 (let ((loc-alist (elmo-pop3-folder-location-alist-internal folder))
895 (process (elmo-network-session-process-internal
896 (elmo-pop3-get-session folder))))
897 (mapcar '(lambda (msg) (elmo-pop3-delete-msg
898 process msg loc-alist))
901 (luna-define-method elmo-message-use-cache-p ((folder elmo-pop3-folder) number)
904 (luna-define-method elmo-folder-persistent-p ((folder elmo-pop3-folder))
905 (and (elmo-folder-persistent-internal folder)
906 (elmo-pop3-folder-use-uidl-internal folder)))
908 (luna-define-method elmo-folder-clear :around ((folder elmo-pop3-folder)
909 &optional keep-killed)
911 (elmo-pop3-folder-set-location-alist-internal folder nil))
912 (luna-call-next-method))
914 (luna-define-method elmo-folder-check ((folder elmo-pop3-folder))
915 (if (elmo-folder-plugged-p folder)
916 (let ((session (elmo-pop3-get-session folder 'if-exists)))
918 (elmo-network-close-session session)))))
921 (product-provide (provide 'elmo-pop3) (require 'elmo-version))
923 ;;; elmo-pop3.el ends here