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