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