95234509582671b8b277ad5e3ea39fba36f6a42b
[elisp/wanderlust.git] / elmo / elmo-pop3.el
1 ;;; elmo-pop3.el --- POP3 Interface for ELMO.
2
3 ;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
4 ;; Copyright (C) 1999,2000      Kenichi OKADA <okada@opaopa.org>
5
6 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
7 ;;      Kenichi OKADA <okada@opaopa.org>
8 ;; Keywords: mail, net news
9
10 ;; This file is part of ELMO (Elisp Library for Message Orchestration).
11
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)
15 ;; any later version.
16 ;;
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.
21 ;;
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.
26 ;;
27
28 ;;; Commentary:
29 ;;
30
31 ;;; Code:
32 ;;
33
34 (require 'elmo-msgdb)
35 (require 'elmo-net)
36
37 (eval-when-compile
38   (require 'elmo-util))
39
40 (eval-and-compile
41   (autoload 'md5 "md5"))
42
43 (defcustom elmo-pop3-default-use-uidl t
44   "If non-nil, use UIDL on POP3."
45   :type 'boolean
46   :group 'elmo)
47
48 (defvar elmo-pop3-use-uidl-internal t
49   "(Internal switch for using UIDL on POP3).")
50
51 (defvar elmo-pop3-use-cache t
52   "Use cache in pop3 folder.")
53
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
57 set as non-nil.")
58
59 (defcustom elmo-pop3-exists-exactly nil
60   "If non-nil, POP3 folder existence is checked everytime before the session."
61   :type 'boolean
62   :group 'elmo)
63
64 (defvar sasl-mechanism-alist)
65
66 (defvar elmo-pop3-total-size nil)
67
68 ;; For debugging.
69 (defvar elmo-pop3-debug nil
70   "Non-nil forces POP3 folder as debug mode.
71 Debug information is inserted in the buffer \"*POP3 DEBUG*\"")
72
73 ;;; Debug
74 (defsubst elmo-pop3-debug (message &rest args)
75   (if elmo-pop3-debug
76       (let ((biff (string-match "BIFF-" (buffer-name)))
77             pos)
78         (with-current-buffer (get-buffer-create (concat "*POP3 DEBUG*"
79                                                         (if biff "BIFF")))
80           (goto-char (point-max))
81           (setq pos (point))
82           (insert (apply 'format message args) "\n")))))
83
84 ;;; ELMO POP3 folder
85 (eval-and-compile
86   (luna-define-class elmo-pop3-folder (elmo-net-folder)
87                      (use-uidl location-alist))
88   (luna-define-internal-accessors 'elmo-pop3-folder))
89
90 (luna-define-method elmo-folder-initialize :around ((folder
91                                                      elmo-pop3-folder)
92                                                     name)
93   (let ((elmo-network-stream-type-alist
94          (if elmo-pop3-stream-type-alist
95              (append elmo-pop3-stream-type-alist
96                      elmo-network-stream-type-alist)
97            elmo-network-stream-type-alist))
98         parse)
99     (setq name (luna-call-next-method))
100     ;; user
101     (setq parse (elmo-parse-token name "/:"))
102     (elmo-net-folder-set-user-internal folder
103                                        (if (eq (length (car parse)) 0)
104                                            elmo-pop3-default-user
105                                          (car parse)))
106     ;; auth
107     (setq parse (elmo-parse-prefixed-element ?/ (cdr parse) ":"))
108     (elmo-net-folder-set-auth-internal folder
109                                        (if (eq (length (car parse)) 0)
110                                            elmo-pop3-default-authenticate-type
111                                          (intern (downcase (car parse)))))
112     ;; uidl
113     (setq parse (elmo-parse-prefixed-element ?: (cdr parse)))
114     (elmo-pop3-folder-set-use-uidl-internal folder
115                                             (if (eq (length (car parse)) 0)
116                                                 elmo-pop3-default-use-uidl
117                                               (string= (car parse) "uidl")))
118     (unless (elmo-net-folder-server-internal folder)
119       (elmo-net-folder-set-server-internal folder
120                                            elmo-pop3-default-server))
121     (unless (elmo-net-folder-port-internal folder)
122       (elmo-net-folder-set-port-internal folder
123                                          elmo-pop3-default-port))
124     (unless (elmo-net-folder-stream-type-internal folder)
125       (elmo-net-folder-set-stream-type-internal
126        folder
127        (elmo-get-network-stream-type
128         elmo-pop3-default-stream-type)))
129     folder))
130
131 ;;; POP3 session
132 (luna-define-class elmo-pop3-session (elmo-network-session) ())
133
134 ;; buffer-local
135 (defvar elmo-pop3-read-point nil)
136 (defvar elmo-pop3-number-uidl-hash nil) ; number -> uidl
137 (defvar elmo-pop3-uidl-number-hash nil) ; uidl -> number
138 (defvar elmo-pop3-size-hash nil) ; number -> size
139 (defvar elmo-pop3-uidl-done nil)
140 (defvar elmo-pop3-list-done nil)
141 (defvar elmo-pop3-lock nil)
142
143 (defvar elmo-pop3-local-variables '(elmo-pop3-read-point
144                                     elmo-pop3-uidl-number-hash
145                                     elmo-pop3-number-uidl-hash
146                                     elmo-pop3-uidl-done
147                                     elmo-pop3-size-hash
148                                     elmo-pop3-list-done
149                                     elmo-pop3-lock))
150
151 (luna-define-method elmo-network-close-session ((session elmo-pop3-session))
152   (when (elmo-network-session-process-internal session)
153     (when (memq (process-status
154                  (elmo-network-session-process-internal session))
155                 '(open run))
156       (elmo-pop3-send-command (elmo-network-session-process-internal session)
157                               "quit")
158       ;; process is dead.
159       (or (elmo-pop3-read-response
160            (elmo-network-session-process-internal session)
161            t)
162           (error "POP error: QUIT failed")))
163     (kill-buffer (process-buffer
164                   (elmo-network-session-process-internal session)))
165     (delete-process (elmo-network-session-process-internal session))))
166
167 (defun elmo-pop3-get-session (folder &optional if-exists)
168   "Get POP3 session for FOLDER.
169 If IF-EXISTS is non-nil, don't get new session.
170 If IF-EXISTS is `any-exists', get BIFF session or normal session if exists."
171   (let ((elmo-pop3-use-uidl-internal (if elmo-inhibit-number-mapping
172                                          nil
173                                        (elmo-pop3-folder-use-uidl-internal
174                                         folder))))
175     (prog1
176         (if (eq if-exists 'any-exists)
177             (or (elmo-network-get-session 'elmo-pop3-session
178                                           "POP3"
179                                           folder if-exists)
180                 (elmo-network-get-session 'elmo-pop3-session
181                                           "BIFF-POP3"
182                                           folder if-exists))
183           (elmo-network-get-session 'elmo-pop3-session
184                                     (concat
185                                      (if (elmo-folder-biff-internal folder)
186                                          "BIFF-")
187                                      "POP3")
188                                     folder if-exists))
189       ;; For saving existency.
190       (unless (file-exists-p (elmo-folder-msgdb-path folder))
191         (elmo-make-directory (elmo-folder-msgdb-path folder))))))
192
193 (defun elmo-pop3-send-command (process command &optional no-erase no-log)
194   (with-current-buffer (process-buffer process)
195     (unless no-erase
196       (erase-buffer))
197     (goto-char (point-min))
198     (setq elmo-pop3-read-point (point))
199     (elmo-pop3-debug "SEND: %s\n" (if no-log "<NO LOGGING>" command))
200     (process-send-string process command)
201     (process-send-string process "\r\n")))
202
203 (defun elmo-pop3-read-response (process &optional not-command)
204   ;; buffer is in case for process is dead.
205   (with-current-buffer (process-buffer process)
206     (let ((case-fold-search nil)
207           (response-string nil)
208           (response-continue t)
209           (return-value nil)
210           match-end)
211       (while response-continue
212         (goto-char elmo-pop3-read-point)
213         (while (not (re-search-forward "\r?\n" nil t))
214           (accept-process-output process 1)
215           (goto-char elmo-pop3-read-point))
216         (setq match-end (point))
217         (setq response-string
218               (buffer-substring elmo-pop3-read-point (- match-end 2)))
219         (goto-char elmo-pop3-read-point)
220         (if (looking-at "\\+.*$")
221             (progn
222               (setq response-continue nil)
223               (setq elmo-pop3-read-point match-end)
224               (setq return-value
225                     (if return-value
226                         (concat return-value "\n" response-string)
227                       response-string)))
228           (if (looking-at "\\-.*$")
229               (progn
230                 (setq response-continue nil)
231                 (setq elmo-pop3-read-point match-end)
232                 (setq return-value nil))
233             (setq elmo-pop3-read-point match-end)
234             (if not-command
235                 (setq response-continue nil))
236             (setq return-value
237                   (if return-value
238                       (concat return-value "\n" response-string)
239                     response-string)))
240           (setq elmo-pop3-read-point match-end)))
241       return-value)))
242
243 (defun elmo-pop3-process-filter (process output)
244   (when (buffer-live-p (process-buffer process))
245     (with-current-buffer (process-buffer process)
246       (goto-char (point-max))
247       (insert output)
248       (elmo-pop3-debug "RECEIVED: %s\n" output)
249       (if (and elmo-pop3-total-size
250                (> elmo-pop3-total-size
251                   (min elmo-display-retrieval-progress-threshold 100)))
252           (elmo-display-progress
253            'elmo-display-retrieval-progress
254            (format "Retrieving (%d/%d bytes)..."
255                    (buffer-size)
256                    elmo-pop3-total-size)
257            (/ (buffer-size) (/ elmo-pop3-total-size 100)))))))
258
259 (defun elmo-pop3-auth-user (session)
260   (let ((process (elmo-network-session-process-internal session)))
261     ;; try USER/PASS
262     (elmo-pop3-send-command
263      process
264      (format "user %s" (elmo-network-session-user-internal session))
265      nil 'no-log)
266     (or (elmo-pop3-read-response process t)
267         (progn
268           (delete-process process)
269           (signal 'elmo-authenticate-error
270                   '(elmo-pop-auth-user))))
271     (elmo-pop3-send-command  process
272                              (format
273                               "pass %s"
274                               (elmo-get-passwd
275                                (elmo-network-session-password-key session)))
276                              nil 'no-log)
277     (or (elmo-pop3-read-response process t)
278         (progn
279           (delete-process process)
280           (signal 'elmo-authenticate-error
281                   '(elmo-pop-auth-user))))))
282
283 (defun elmo-pop3-auth-apop (session)
284   (if (string-match "^\+OK .*\\(<[^\>]+>\\)"
285                     (elmo-network-session-greeting-internal session))
286       ;; good, APOP ready server
287       (progn
288         (elmo-pop3-send-command
289          (elmo-network-session-process-internal session)
290          (format "apop %s %s"
291                  (elmo-network-session-user-internal session)
292                  (md5
293                   (concat (match-string
294                            1
295                            (elmo-network-session-greeting-internal session))
296                           (elmo-get-passwd
297                            (elmo-network-session-password-key session)))))
298          nil 'no-log)
299         (or (elmo-pop3-read-response
300              (elmo-network-session-process-internal session)
301              t)
302             (progn
303               (delete-process (elmo-network-session-process-internal session))
304               (signal 'elmo-authenticate-error
305                       '(elmo-pop3-auth-apop)))))
306     (signal 'elmo-open-error '(elmo-pop3-auth-apop))))
307
308 (luna-define-method elmo-network-initialize-session-buffer :after
309   ((session elmo-pop3-session) buffer)
310   (with-current-buffer buffer
311     (mapcar 'make-variable-buffer-local elmo-pop3-local-variables)))
312
313 (luna-define-method elmo-network-initialize-session ((session
314                                                       elmo-pop3-session))
315   (let ((process (elmo-network-session-process-internal session))
316         response mechanism)
317     (with-current-buffer (process-buffer process)
318       (set-process-filter process 'elmo-pop3-process-filter)
319       (setq elmo-pop3-read-point (point-min))
320       ;; Skip garbage output from process before greeting.
321       (while (and (memq (process-status process) '(open run))
322                   (goto-char (point-max))
323                   (forward-line -1)
324                   (not (looking-at "+OK")))
325         (accept-process-output process 1))
326       (setq elmo-pop3-read-point (point))
327       (or (elmo-network-session-set-greeting-internal
328            session
329            (elmo-pop3-read-response process t))
330           (signal 'elmo-open-error
331                   '(elmo-network-intialize-session)))
332       (when (eq (elmo-network-stream-type-symbol
333                  (elmo-network-session-stream-type-internal session))
334                 'starttls)
335         (elmo-pop3-send-command process "stls")
336         (if (string-match "^\+OK"
337                           (elmo-pop3-read-response process))
338             (starttls-negotiate process)
339           (signal 'elmo-open-error
340                   '(elmo-pop3-starttls-error)))))))
341
342 (luna-define-method elmo-network-authenticate-session ((session
343                                                         elmo-pop3-session))
344   (with-current-buffer (process-buffer
345                         (elmo-network-session-process-internal session))
346     (let* ((process (elmo-network-session-process-internal session))
347            (auth (elmo-network-session-auth-internal session))
348            (auth (mapcar '(lambda (mechanism) (upcase (symbol-name mechanism)))
349                          (if (listp auth) auth (list auth))))
350            sasl-mechanisms
351            client name step response mechanism
352            sasl-read-passphrase)
353       (or (and (string= "USER" (car auth))
354                (elmo-pop3-auth-user session))
355           (and (string= "APOP" (car auth))
356                (elmo-pop3-auth-apop session))
357           (progn
358             (require 'sasl)
359             (setq sasl-mechanisms (mapcar 'car sasl-mechanism-alist))
360             (setq mechanism (sasl-find-mechanism auth))
361             (unless mechanism
362               (signal 'elmo-authenticate-error '(elmo-pop3-auth-no-mechanisms)))
363             (setq client
364                   (sasl-make-client
365                    mechanism
366                    (elmo-network-session-user-internal session)
367                    "pop"
368                    (elmo-network-session-server-internal session)))
369 ;;;         (if elmo-pop3-auth-user-realm
370 ;;;             (sasl-client-set-property client 'realm elmo-pop3-auth-user-realm))
371             (setq name (sasl-mechanism-name mechanism))
372             (elmo-network-session-set-auth-internal session
373                                                     (intern (downcase name)))
374             (setq sasl-read-passphrase
375                   (function
376                    (lambda (prompt)
377                      (elmo-get-passwd
378                       (elmo-network-session-password-key session)))))
379             (setq step (sasl-next-step client nil))
380             (elmo-pop3-send-command
381              process
382              (concat "AUTH " name
383                      (and (sasl-step-data step)
384                           (concat
385                            " "
386                            (elmo-base64-encode-string
387                             (sasl-step-data step) 'no-line-break))))
388              nil 'no-log)
389             (catch 'done
390               (while t
391                 (unless (setq response (elmo-pop3-read-response process t))
392                   ;; response is NO or BAD.
393                   (signal 'elmo-authenticate-error
394                           (list (intern
395                                  (concat "elmo-pop3-auth-"
396                                          (downcase name))))))
397                 (if (string-match "^\+OK" response)
398                     (if (sasl-next-step client step)
399                         ;; Bogus server?
400                         (signal 'elmo-authenticate-error
401                                 (list (intern
402                                        (concat "elmo-pop3-auth-"
403                                                (downcase name)))))
404                       ;; The authentication process is finished.
405                       (throw 'done nil)))
406                 (sasl-step-set-data
407                  step
408                  (elmo-base64-decode-string
409                   (cadr (split-string response " "))))
410                 (setq step (sasl-next-step client step))
411                 (elmo-pop3-send-command
412                  process
413                  (if (sasl-step-data step)
414                      (elmo-base64-encode-string (sasl-step-data step)
415                                                 'no-line-break)
416                    "") nil 'no-log))))))))
417
418 (luna-define-method elmo-network-setup-session ((session
419                                                  elmo-pop3-session))
420   (let ((process (elmo-network-session-process-internal session))
421         count response)
422     (with-current-buffer (process-buffer process)
423       (setq elmo-pop3-size-hash (elmo-make-hash 31))
424       ;; To get obarray of uidl and size
425       (elmo-pop3-send-command process "list")
426       (if (null (elmo-pop3-read-response process))
427           (error "POP LIST command failed"))
428       (if (null (setq response
429                       (elmo-pop3-read-contents
430                        (current-buffer) process)))
431           (error "POP LIST command failed"))
432       ;; POP server always returns a sequence of serial numbers.
433       (setq count (elmo-pop3-parse-list-response response))
434       ;; UIDL
435       (when elmo-pop3-use-uidl-internal
436         (setq elmo-pop3-uidl-number-hash (elmo-make-hash (* count 2)))
437         (setq elmo-pop3-number-uidl-hash (elmo-make-hash (* count 2)))
438         ;; UIDL
439         (elmo-pop3-send-command process "uidl")
440         (unless (elmo-pop3-read-response process)
441           (error "POP UIDL failed"))
442         (unless (setq response (elmo-pop3-read-contents
443                                 (current-buffer) process))
444           (error "POP UIDL failed"))
445         (elmo-pop3-parse-uidl-response response)))))
446
447 (defun elmo-pop3-read-contents (buffer process)
448   (with-current-buffer buffer
449     (let ((case-fold-search nil)
450           match-end)
451       (goto-char elmo-pop3-read-point)
452       (while (not (re-search-forward "^\\.\r\n" nil t))
453         (accept-process-output process 1)
454         (goto-char elmo-pop3-read-point))
455       (setq match-end (point))
456       (elmo-delete-cr
457        (buffer-substring elmo-pop3-read-point
458                          (- match-end 3))))))
459
460 (luna-define-method elmo-folder-expand-msgdb-path ((folder elmo-pop3-folder))
461   (convert-standard-filename
462    (expand-file-name
463     (elmo-safe-filename (elmo-net-folder-user-internal folder))
464     (expand-file-name (elmo-net-folder-server-internal folder)
465                       (expand-file-name
466                        "pop"
467                        elmo-msgdb-directory)))))
468
469 (luna-define-method elmo-folder-exists-p ((folder elmo-pop3-folder))
470   (if (and elmo-pop3-exists-exactly
471            (elmo-folder-plugged-p folder))
472       (save-excursion
473         (let (elmo-auto-change-plugged  ; don't change plug status.
474               (elmo-inhibit-number-mapping t) ; No need to use uidl.
475               session)
476           (prog1
477               (setq session (elmo-pop3-get-session folder))
478             (if session
479                 (elmo-network-close-session session)))))
480     (or (file-directory-p (elmo-folder-msgdb-path folder))
481         ;; First time.
482         (when (elmo-folder-plugged-p folder)
483           (let ((elmo-pop3-exists-exactly t))
484             (elmo-folder-exists-p folder))))))
485
486 (defun elmo-pop3-parse-uidl-response (string)
487   (let ((buffer (current-buffer))
488         number list size)
489     (with-temp-buffer
490       (let (number uid list)
491         (insert string)
492         (goto-char (point-min))
493         (while (re-search-forward "^\\([0-9]+\\)[\t ]+\\([^ \n]+\\)$" nil t)
494           (setq number  (elmo-match-buffer 1))
495           (setq uid (elmo-match-buffer 2))
496           (with-current-buffer buffer
497             (elmo-set-hash-val uid number elmo-pop3-uidl-number-hash)
498             (elmo-set-hash-val (concat "#" number) uid
499                                elmo-pop3-number-uidl-hash))
500           (setq list (cons uid list)))
501         (with-current-buffer buffer (setq elmo-pop3-uidl-done t))
502         (nreverse list)))))
503
504 (defun elmo-pop3-parse-list-response (string)
505   (let ((buffer (current-buffer))
506         (count 0)
507         alist)
508     (with-temp-buffer
509       (insert string)
510       (goto-char (point-min))
511       (while (re-search-forward "^\\([0-9]+\\)[\t ]+\\([0-9]+\\)$" nil t)
512         (setq alist
513               (cons
514                (cons (elmo-match-buffer 1)
515                      (elmo-match-buffer 2))
516                alist))
517         (setq count (1+ count)))
518       (with-current-buffer buffer
519         (setq elmo-pop3-size-hash (elmo-make-hash (* (length alist) 2)))
520         (while alist
521           (elmo-set-hash-val (concat "#" (car (car alist)))
522                              (cdr (car alist))
523                              elmo-pop3-size-hash)
524           (setq alist (cdr alist)))
525         (setq elmo-pop3-list-done t))
526       count)))
527
528 (defun elmo-pop3-list-location (folder)
529   (with-current-buffer (process-buffer
530                         (elmo-network-session-process-internal
531                          (elmo-pop3-get-session folder)))
532     (let (locations)
533       (if elmo-pop3-uidl-done
534           (progn
535             (mapatoms
536              (lambda (atom)
537                (setq locations (cons (symbol-name atom) locations)))
538              elmo-pop3-uidl-number-hash)
539             (sort locations
540                   (lambda (loc1 loc2)
541                     (< (elmo-pop3-uidl-to-number loc1)
542                        (elmo-pop3-uidl-to-number loc2)))))
543         (error "POP3: Error in UIDL")))))
544
545 (defun elmo-pop3-list-folder-by-location (folder locations)
546   (let* ((location-alist (elmo-pop3-folder-location-alist-internal folder))
547          (locations-in-db (mapcar 'cdr location-alist))
548          result new-locs new-alist deleted-locs i)
549     (setq new-locs
550           (elmo-delete-if (function
551                            (lambda (x) (member x locations-in-db)))
552                           locations))
553     (setq deleted-locs
554           (elmo-delete-if (function
555                            (lambda (x) (member x locations)))
556                           locations-in-db))
557     (setq i (or (elmo-max-of-list (mapcar 'car location-alist)) 0))
558     (mapcar
559      (function
560       (lambda (x)
561         (setq location-alist
562               (delq (rassoc x location-alist) location-alist))))
563      deleted-locs)
564     (while new-locs
565       (setq i (1+ i))
566       (setq new-alist (cons (cons i (car new-locs)) new-alist))
567       (setq new-locs (cdr new-locs)))
568     (setq result (nconc location-alist new-alist))
569     (setq result (sort result (lambda (x y) (< (car x)(car y)))))
570     (elmo-pop3-folder-set-location-alist-internal folder result)
571     (mapcar 'car result)))
572
573 (defun elmo-pop3-list-by-uidl-subr (folder &optional nonsort)
574   (let ((flist (elmo-pop3-list-folder-by-location
575                 folder
576                 (elmo-pop3-list-location folder))))
577     (if nonsort
578         (cons (elmo-max-of-list flist) (length flist))
579       (sort flist '<))))
580
581 (defun elmo-pop3-list-by-list (folder)
582   (with-current-buffer (process-buffer
583                         (elmo-network-session-process-internal
584                          (elmo-pop3-get-session folder)))
585     (let (list)
586       (if elmo-pop3-list-done
587           (progn
588             (mapatoms (lambda (atom)
589                         (setq list (cons (string-to-int
590                                           (substring (symbol-name atom) 1))
591                                          list)))
592                       elmo-pop3-size-hash)
593             (sort list '<))
594         (error "POP3: Error in list")))))
595
596 (defsubst elmo-pop3-folder-list-messages (folder)
597   (if (and (not elmo-inhibit-number-mapping)
598            (elmo-pop3-folder-use-uidl-internal folder))
599       (elmo-pop3-list-by-uidl-subr folder)
600     (elmo-pop3-list-by-list folder)))
601
602 (luna-define-method elmo-folder-list-messages-plugged
603   ((folder elmo-pop3-folder) &optional nohide)
604   (elmo-pop3-folder-list-messages folder))
605
606 (luna-define-method elmo-folder-status ((folder elmo-pop3-folder))
607   (elmo-folder-open-internal folder)
608   (elmo-folder-check folder)
609   (if (elmo-pop3-folder-use-uidl-internal folder)
610       (prog1
611           (elmo-pop3-list-by-uidl-subr folder 'nonsort)
612         (elmo-folder-close-internal folder))
613     (let* ((process
614             (elmo-network-session-process-internal
615              (elmo-pop3-get-session folder)))
616            (total 0)
617            response)
618       (with-current-buffer (process-buffer process)
619         (elmo-pop3-send-command process "STAT")
620         (setq response (elmo-pop3-read-response process))
621         ;; response: "^\+OK 2 7570$"
622         (if (not (string-match "^\+OK[ \t]*\\([0-9]*\\)" response))
623             (error "POP STAT command failed")
624           (setq total
625                 (string-to-int
626                  (substring response (match-beginning 1)(match-end 1 ))))
627           (elmo-folder-close-internal folder)
628           (cons total total))))))
629
630 (defvar elmo-pop3-header-fetch-chop-length 200)
631
632 (defsubst elmo-pop3-next-result-arrived-p ()
633   (cond
634    ((eq (following-char) ?+)
635     (if (re-search-forward "\n\\.\r?\n" nil t)
636         t
637       nil))
638    ((looking-at "-")
639     (if (search-forward "\n" nil t)
640         t
641       nil))
642    (t
643     nil)))
644
645 (defun elmo-pop3-retrieve-headers (buffer tobuffer process articles)
646   (save-excursion
647     (set-buffer buffer)
648     (erase-buffer)
649     (let ((number (length articles))
650           (count 0)
651           (received 0)
652           (last-point (point-min)))
653       ;; Send HEAD commands.
654       (while articles
655         (elmo-pop3-send-command process (format
656                                          "top %s 0" (car articles))
657                                 'no-erase)
658 ;;;     (accept-process-output process 1)
659         (setq articles (cdr articles))
660         (setq count (1+ count))
661         ;; Every 200 requests we have to read the stream in
662         ;; order to avoid deadlocks.
663         (when (or elmo-pop3-send-command-synchronously
664                   (null articles)       ;All requests have been sent.
665                   (zerop (% count elmo-pop3-header-fetch-chop-length)))
666           (unless elmo-pop3-send-command-synchronously
667             (accept-process-output process 1))
668           (discard-input)
669           (while (progn
670                    (set-buffer buffer)
671                    (goto-char last-point)
672                    ;; Count replies.
673                    (while (elmo-pop3-next-result-arrived-p)
674                      (setq last-point (point))
675                      (setq received (1+ received)))
676                    (< received count))
677             (when (> number elmo-display-progress-threshold)
678               (if (or (zerop (% received 5)) (= received number))
679                   (elmo-display-progress
680                    'elmo-pop3-retrieve-headers "Getting headers..."
681                    (/ (* received 100) number))))
682             (accept-process-output process 1)
683 ;;;         (accept-process-output process)
684             (discard-input))))
685       ;; Remove all "\r"'s.
686       (goto-char (point-min))
687       (while (search-forward "\r\n" nil t)
688         (replace-match "\n"))
689       (copy-to-buffer tobuffer (point-min) (point-max)))))
690
691 (luna-define-method elmo-folder-msgdb-create ((folder elmo-pop3-folder)
692                                               numlist flag-table)
693   (let ((process (elmo-network-session-process-internal
694                   (elmo-pop3-get-session folder))))
695     (with-current-buffer (process-buffer process)
696       (elmo-pop3-sort-msgdb-by-original-number
697        folder
698        (elmo-pop3-msgdb-create-by-header
699         process
700         numlist
701         flag-table
702         (if (elmo-pop3-folder-use-uidl-internal folder)
703             (elmo-pop3-folder-location-alist-internal folder)))))))
704
705 (defun elmo-pop3-sort-overview-by-original-number (overview loc-alist)
706   (if loc-alist
707       (sort overview
708             (lambda (ent1 ent2)
709               (< (elmo-pop3-uidl-to-number
710                   (cdr (assq (elmo-msgdb-overview-entity-get-number ent1)
711                              loc-alist)))
712                  (elmo-pop3-uidl-to-number
713                   (cdr (assq (elmo-msgdb-overview-entity-get-number ent2)
714                              loc-alist))))))
715     overview))
716
717 (defun elmo-pop3-sort-msgdb-by-original-number (folder msgdb)
718   (message "Sorting...")
719   (let ((overview (elmo-msgdb-get-overview msgdb)))
720     (elmo-msgdb-set-overview
721      msgdb
722      (elmo-pop3-sort-overview-by-original-number
723       overview
724       (elmo-pop3-folder-location-alist-internal folder)))
725     (message "Sorting...done")
726     msgdb))
727
728 (defun elmo-pop3-uidl-to-number (uidl)
729   (string-to-number (elmo-get-hash-val uidl
730                                        elmo-pop3-uidl-number-hash)))
731
732 (defun elmo-pop3-number-to-uidl (number)
733   (elmo-get-hash-val (format "#%d" number)
734                      elmo-pop3-number-uidl-hash))
735
736 (defun elmo-pop3-number-to-size (number)
737   (elmo-get-hash-val (format "#%d" number)
738                      elmo-pop3-size-hash))
739
740 (defun elmo-pop3-msgdb-create-by-header (process numlist
741                                                  flag-table
742                                                  loc-alist)
743   (let ((tmp-buffer (get-buffer-create " *ELMO Overview TMP*")))
744     (with-current-buffer (process-buffer process)
745       (if loc-alist ; use uidl.
746           (setq numlist
747                 (delq
748                  nil
749                  (mapcar
750                   (lambda (number)
751                     (elmo-pop3-uidl-to-number (cdr (assq number loc-alist))))
752                   numlist))))
753       (elmo-pop3-retrieve-headers (process-buffer process)
754                                   tmp-buffer process numlist)
755       (prog1
756           (elmo-pop3-msgdb-create-message
757            tmp-buffer
758            process
759            (length numlist)
760            numlist
761            flag-table loc-alist)
762         (kill-buffer tmp-buffer)))))
763
764 (defun elmo-pop3-msgdb-create-message (buffer
765                                        process
766                                        num
767                                        numlist
768                                        flag-table
769                                        loc-alist)
770   (save-excursion
771     (let ((new-msgdb (elmo-make-msgdb))
772           beg entity i number message-id gmark)
773       (set-buffer buffer)
774       (elmo-set-buffer-multibyte default-enable-multibyte-characters)
775       (goto-char (point-min))
776       (setq i 0)
777       (message "Creating msgdb...")
778       (while (not (eobp))
779         (setq beg (save-excursion (forward-line 1) (point)))
780         (elmo-pop3-next-result-arrived-p)
781         (save-excursion
782           (forward-line -1)
783           (save-restriction
784             (narrow-to-region beg (point))
785             (setq entity
786                   (elmo-msgdb-create-overview-from-buffer
787                    (car numlist)))
788             (setq numlist (cdr numlist))
789             (when entity
790               (with-current-buffer (process-buffer process)
791                 (elmo-msgdb-overview-entity-set-size
792                  entity
793                  (string-to-number
794                   (elmo-pop3-number-to-size
795                    (elmo-msgdb-overview-entity-get-number entity))))
796                 (if (setq number
797                           (car
798                            (rassoc
799                             (elmo-pop3-number-to-uidl
800                              (elmo-msgdb-overview-entity-get-number entity))
801                             loc-alist)))
802                     (elmo-msgdb-overview-entity-set-number entity number)))
803               (setq message-id (elmo-message-entity-field entity 'message-id))
804               (setq gmark (or (elmo-msgdb-global-mark-get message-id)
805                               (elmo-msgdb-mark
806                                (elmo-flag-table-get flag-table message-id)
807                                (elmo-file-cache-status
808                                 (elmo-file-cache-get message-id))
809                                'new)))
810               (elmo-msgdb-append-entity new-msgdb entity gmark))))
811         (when (> num elmo-display-progress-threshold)
812           (setq i (1+ i))
813           (if (or (zerop (% i 5)) (= i num))
814               (elmo-display-progress
815                'elmo-pop3-msgdb-create-message "Creating msgdb..."
816                (/ (* i 100) num)))))
817       new-msgdb)))
818
819 (defun elmo-pop3-read-body (process outbuf)
820   (with-current-buffer (process-buffer process)
821     (let ((start elmo-pop3-read-point)
822           end)
823       (goto-char start)
824       (while (not (re-search-forward "^\\.\r?\n" nil t))
825         (accept-process-output process 1)
826         (goto-char start))
827       (setq end (point))
828       (with-current-buffer outbuf
829         (erase-buffer)
830         (insert-buffer-substring (process-buffer process) start (- end 3)))
831       t)))
832
833 (luna-define-method elmo-folder-open-internal ((folder elmo-pop3-folder))
834   (if (and (not elmo-inhibit-number-mapping)
835            (elmo-pop3-folder-use-uidl-internal folder))
836       (elmo-pop3-folder-set-location-alist-internal
837        folder (elmo-msgdb-location-load (elmo-folder-msgdb-path folder)))))
838
839 (luna-define-method elmo-folder-commit :after ((folder elmo-pop3-folder))
840   (when (elmo-folder-persistent-p folder)
841     (elmo-msgdb-location-save (elmo-folder-msgdb-path folder)
842                               (elmo-pop3-folder-location-alist-internal
843                                folder))))
844
845 (luna-define-method elmo-folder-close-internal ((folder elmo-pop3-folder))
846   (elmo-pop3-folder-set-location-alist-internal folder nil)
847   ;; Just close connection
848   (elmo-folder-check folder))
849
850 (luna-define-method elmo-message-fetch-plugged ((folder elmo-pop3-folder)
851                                                 number strategy
852                                                 &optional section
853                                                 outbuf unseen)
854   (let* ((loc-alist (elmo-pop3-folder-location-alist-internal folder))
855          (process (elmo-network-session-process-internal
856                    (elmo-pop3-get-session folder)))
857         size  response errmsg msg)
858     (with-current-buffer (process-buffer process)
859       (if loc-alist
860           (setq number (elmo-pop3-uidl-to-number
861                         (cdr (assq number loc-alist)))))
862       (setq size (string-to-number
863                   (elmo-pop3-number-to-size number)))
864       (when number
865         (elmo-pop3-send-command process
866                                 (format "retr %s" number))
867         (unless elmo-inhibit-display-retrieval-progress
868           (setq elmo-pop3-total-size size)
869           (elmo-display-progress
870            'elmo-display-retrieval-progress
871            (format "Retrieving (0/%d bytes)..." elmo-pop3-total-size)
872            0))
873         (unwind-protect
874             (progn
875               (when (null (setq response (elmo-pop3-read-response
876                                           process t)))
877                 (error "Fetching message failed"))
878               (setq response  (elmo-pop3-read-body process outbuf)))
879           (setq elmo-pop3-total-size nil))
880         (unless elmo-inhibit-display-retrieval-progress
881           (elmo-display-progress
882            'elmo-display-retrieval-progress
883            "Retrieving..." 100)  ; remove progress bar.
884           (message "Retrieving...done"))
885         (set-buffer outbuf)
886         (goto-char (point-min))
887         (while (re-search-forward "^\\." nil t)
888           (replace-match "")
889           (forward-line))
890         response))))
891
892 (defun elmo-pop3-delete-msg (process number loc-alist)
893   (with-current-buffer (process-buffer process)
894     (let (response errmsg msg)
895       (if loc-alist
896           (setq number (elmo-pop3-uidl-to-number
897                         (cdr (assq number loc-alist)))))
898       (if number
899           (progn
900             (elmo-pop3-send-command process
901                                     (format "dele %s" number))
902             (when (null (setq response (elmo-pop3-read-response
903                                         process t)))
904               (error "Deleting message failed")))
905         (error "Deleting message failed")))))
906
907 (luna-define-method elmo-folder-delete-messages-plugged ((folder
908                                                           elmo-pop3-folder)
909                                                          msgs)
910   (let ((loc-alist (elmo-pop3-folder-location-alist-internal folder))
911         (process (elmo-network-session-process-internal
912                   (elmo-pop3-get-session folder))))
913     (mapcar '(lambda (msg) (elmo-pop3-delete-msg process msg loc-alist))
914             msgs)))
915
916 (luna-define-method elmo-message-use-cache-p ((folder elmo-pop3-folder) number)
917   elmo-pop3-use-cache)
918
919 (luna-define-method elmo-folder-persistent-p ((folder elmo-pop3-folder))
920   (and (elmo-folder-persistent-internal folder)
921        (elmo-pop3-folder-use-uidl-internal folder)))
922
923 (luna-define-method elmo-folder-clear :around ((folder elmo-pop3-folder)
924                                                &optional keep-killed)
925   (unless keep-killed
926     (elmo-pop3-folder-set-location-alist-internal folder nil))
927   (luna-call-next-method))
928
929 (luna-define-method elmo-folder-check ((folder elmo-pop3-folder))
930   (if (elmo-folder-plugged-p folder)
931       (let ((session (elmo-pop3-get-session folder 'if-exists)))
932         (when session
933           (elmo-network-close-session session)))))
934
935 (require 'product)
936 (product-provide (provide 'elmo-pop3) (require 'elmo-version))
937
938 ;;; elmo-pop3.el ends here