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