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