elmo/elmo-pop3.el

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