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