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