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