elmo/elmo-pop3.el

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