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