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