elmo/elmo-imap4.el

   1 ;;; elmo-imap4.el --- IMAP4 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 ;; Copyright (C) 2000           OKAZAKI Tetsurou <okazaki@be.to>
   6 ;; Copyright (C) 2000           Daiki Ueno <ueno@unixuser.org>
   7
   8 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
   9 ;;      Kenichi OKADA <okada@opaopa.org>
  10 ;;      OKAZAKI Tetsurou <okazaki@be.to>
  11 ;;      Daiki Ueno <ueno@unixuser.org>
  12 ;; Keywords: mail, net news
  13
  14 ;; This file is part of ELMO (Elisp Library for Message Orchestration).
  15
  16 ;; This program is free software; you can redistribute it and/or modify
  17 ;; it under the terms of the GNU General Public License as published by
  18 ;; the Free Software Foundation; either version 2, or (at your option)
  19 ;; any later version.
  20 ;;
  21 ;; This program is distributed in the hope that it will be useful,
  22 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  23 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  24 ;; GNU General Public License for more details.
  25 ;;
  26 ;; You should have received a copy of the GNU General Public License
  27 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  28 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  29 ;; Boston, MA 02111-1307, USA.
  30 ;;
  31
  32 ;;; Commentary:
  33 ;;
  34 ;; Origin of IMAP parser part is imap.el, included in Gnus.
  35 ;;
  36 ;;    Copyright (C) 1998, 1999, 2000
  37 ;;    Free Software Foundation, Inc.
  38 ;;    Author: Simon Josefsson <jas@pdc.kth.se>
  39 ;;
  40
  41 ;;; Code:
  42 (require 'elmo-vars)
  43 (require 'elmo-util)
  44 (require 'elmo-date)
  45 (require 'elmo-msgdb)
  46 (require 'elmo-cache)
  47 (require 'elmo)
  48 (require 'elmo-net)
  49 (require 'utf7)
  50 (require 'elmo-mime)
  51 (require 'time-stamp)
  52
  53 (eval-when-compile (require 'cl))
  54
  55 (defvar elmo-imap4-disuse-server-flag-mailbox-regexp "^#mh" ; UW imapd
  56   "Regexp to match IMAP4 mailbox names whose message flags on server should be ignored (For STATUS command).")
  57
  58 (defvar elmo-imap4-overview-fetch-chop-length 200
  59   "*Number of overviews to fetch in one request.")
  60
  61 ;; c.f. rfc2683 3.2.1.5 Long Command Lines
  62 ;;
  63 ;; "A client should limit the length of the command lines it generates
  64 ;;  to approximately 1000 octets (including all quoted strings but not
  65 ;;  including literals). If the client is unable to group things into
  66 ;;  ranges so that the command line is within that length, it should
  67 ;;  split the request into multiple commands. The client should use
  68 ;;  literals instead of long quoted strings, in order to keep the command
  69 ;;  length down.
  70 ;;  For its part, a server should allow for a command line of at least
  71 ;;  8000 octets. This provides plenty of leeway for accepting reasonable
  72 ;;  length commands from clients. The server should send a BAD response
  73 ;;  to a command that does not end within the server's maximum accepted
  74 ;;  command length. "
  75
  76 ;; To limit command line length, chop number set.
  77 (defvar elmo-imap4-number-set-chop-length 1000
  78   "*Number of messages to specify as a number-set argument for one request.")
  79
  80 (defvar elmo-imap4-force-login nil
  81   "*Non-nil forces to try 'login' if there is no 'auth' capability in imapd.")
  82
  83 (defvar elmo-imap4-use-select-to-update-status nil
  84   "*Some imapd have to send select command to update status.
  85 \(ex. UW imapd 4.5-BETA?\).  For these imapd, you must set this variable t.")
  86
  87 (defvar elmo-imap4-use-modified-utf7 nil
  88   "*Use mofidied UTF-7 (rfc2060) encoding for IMAP4 folder name.")
  89
  90 (defvar elmo-imap4-use-cache t
  91   "Use cache in imap4 folder.")
  92
  93 (defvar elmo-imap4-extra-namespace-alist
  94   '(("^\\({.*/nntp}\\).*$" . ".")) ; Default is for UW's remote nntp mailbox...
  95   "Extra namespace alist.
  96 A list of cons cell like: (REGEXP . DELIMITER).
  97 REGEXP should have a grouping for namespace prefix.")
  98 ;;
  99 ;;; internal variables
 100 ;;
 101 (defvar elmo-imap4-seq-prefix "elmo-imap4")
 102 (defvar elmo-imap4-seqno 0)
 103 (defvar elmo-imap4-use-uid t
 104   "Use UID as message number.")
 105
 106 (defvar elmo-imap4-current-response nil)
 107 (defvar elmo-imap4-status nil)
 108 (defvar elmo-imap4-reached-tag "elmo-imap40")
 109
 110 ;;; buffer local variables
 111 (defvar elmo-imap4-default-hierarchy-delimiter "/")
 112
 113 (defvar elmo-imap4-server-capability nil)
 114 (defvar elmo-imap4-server-namespace nil)
 115
 116 (defvar elmo-imap4-parsing nil) ; indicates parsing.
 117
 118 (defvar elmo-imap4-fetch-callback nil)
 119 (defvar elmo-imap4-fetch-callback-data nil)
 120 (defvar elmo-imap4-status-callback nil)
 121 (defvar elmo-imap4-status-callback-data nil)
 122
 123 (defvar elmo-imap4-server-diff-async-callback nil)
 124 (defvar elmo-imap4-server-diff-async-callback-data nil)
 125
 126 ;;; progress...(no use?)
 127 (defvar elmo-imap4-count-progress nil)
 128 (defvar elmo-imap4-count-progress-message nil)
 129 (defvar elmo-imap4-progress-count nil)
 130
 131 ;;; XXX Temporal implementation
 132 (defvar elmo-imap4-current-msgdb nil)
 133 (defvar elmo-imap4-seen-messages nil)
 134
 135 (defvar elmo-imap4-local-variables
 136   '(elmo-imap4-status
 137     elmo-imap4-current-response
 138     elmo-imap4-seqno
 139     elmo-imap4-parsing
 140     elmo-imap4-reached-tag
 141     elmo-imap4-count-progress
 142     elmo-imap4-count-progress-message
 143     elmo-imap4-progress-count
 144     elmo-imap4-fetch-callback
 145     elmo-imap4-fetch-callback-data
 146     elmo-imap4-status-callback
 147     elmo-imap4-status-callback-data
 148     elmo-imap4-current-msgdb
 149     elmo-imap4-seen-messages))
 150
 151 ;;;;
 152
 153 (defconst elmo-imap4-quoted-specials-list '(?\\ ?\"))
 154
 155 (defconst elmo-imap4-non-atom-char-regex
 156   (eval-when-compile
 157     (concat "[^" "]!#$&'+,./0-9:;<=>?@A-Z[^_`a-z|}~-" "]")))
 158
 159 (defconst elmo-imap4-non-text-char-regex
 160   (eval-when-compile
 161     (concat "[^"
 162             "]\x01-\x09\x0b\x0c\x0e-\x1f\x7f !\"#$%&'()*+,./0-9:;<=>?@A-Z[\\^_`a-z{|}~-"
 163             "]")))
 164
 165 (defconst elmo-imap4-literal-threshold 1024
 166  "Limitation of characters that can be used in a quoted string.")
 167
 168 (defconst elmo-imap4-flag-specs '((important "\\Flagged")
 169                                   (read "\\Seen")
 170                                   (unread "\\Seen" 'remove)
 171                                   (answered "\\Answered")
 172                                   ;; draft-melnikov-imap-keywords-03.txt
 173                                   (forwarded "$Forwarded")
 174                                   (work "$Work")
 175                                   (personal "$Personal")
 176                                   (shouldreply "$ShouldReply")))
 177
 178 (defconst elmo-imap4-folder-name-syntax
 179   `(mailbox
 180     (?: [user "^[A-Za-z]"] (?/ [auth ".+"]))
 181     ,@elmo-net-folder-name-syntax))
 182
 183 ;; For debugging.
 184 (defvar elmo-imap4-debug nil
 185   "Non-nil forces IMAP4 folder as debug mode.
 186 Debug information is inserted in the buffer \"*IMAP4 DEBUG*\"")
 187
 188 (defvar elmo-imap4-debug-inhibit-logging nil)
 189
 190 ;;; ELMO IMAP4 folder
 191 (eval-and-compile
 192   (luna-define-class elmo-imap4-folder (elmo-net-folder)
 193                      (mailbox))
 194   (luna-define-internal-accessors 'elmo-imap4-folder))
 195
 196 ;;; Session
 197 (eval-and-compile
 198   (luna-define-class elmo-imap4-session (elmo-network-session)
 199                      (capability current-mailbox read-only flags))
 200   (luna-define-internal-accessors 'elmo-imap4-session))
 201
 202 (defmacro elmo-imap4-session-capable-p (session capability)
 203   `(memq ,capability (elmo-imap4-session-capability-internal ,session)))
 204
 205 ;;; MIME-ELMO-IMAP Location
 206 (eval-and-compile
 207   (luna-define-class mime-elmo-imap-location
 208                      (mime-imap-location)
 209                      (folder number rawbuf strategy))
 210   (luna-define-internal-accessors 'mime-elmo-imap-location))
 211
 212 ;;; Debug
 213 (defmacro elmo-imap4-debug (message &rest args)
 214   `(if elmo-imap4-debug
 215        (elmo-imap4-debug-1 ,message ,@args)))
 216
 217 (defun elmo-imap4-debug-1 (message &rest args)
 218   (with-current-buffer (get-buffer-create "*IMAP4 DEBUG*")
 219     (goto-char (point-max))
 220     (if elmo-imap4-debug-inhibit-logging
 221         (insert "NO LOGGING\n")
 222       (insert (apply 'format message args) "\n"))))
 223
 224 (defsubst elmo-imap4-decode-folder-string (string)
 225   (if elmo-imap4-use-modified-utf7
 226       (utf7-decode string 'imap)
 227     string))
 228
 229 (defsubst elmo-imap4-encode-folder-string (string)
 230   (if elmo-imap4-use-modified-utf7
 231       (utf7-encode string 'imap)
 232     string))
 233
 234 ;;; Response
 235
 236 (defmacro elmo-imap4-response-continue-req-p (response)
 237   "Returns non-nil if RESPONSE is '+' response."
 238   `(assq 'continue-req ,response))
 239
 240 (defmacro elmo-imap4-response-ok-p (response)
 241   "Returns non-nil if RESPONSE is an 'OK' response."
 242   `(assq 'ok ,response))
 243
 244 (defmacro elmo-imap4-response-bye-p (response)
 245   "Returns non-nil if RESPONSE is an 'BYE' response."
 246   `(assq 'bye ,response))
 247
 248 (defmacro elmo-imap4-response-garbage-p (response)
 249   "Returns non-nil if RESPONSE is an 'garbage' response."
 250   `(assq 'garbage ,response))
 251
 252 (defmacro elmo-imap4-response-value (response symbol)
 253   "Get value of the SYMBOL from RESPONSE."
 254   `(nth 1 (assq ,symbol ,response)))
 255
 256 (defsubst elmo-imap4-response-value-all (response symbol)
 257   "Get all value of the SYMBOL from RESPONSE."
 258   (let (matched)
 259     (while response
 260       (if (eq (car (car response)) symbol)
 261           (setq matched (nconc matched (nth 1 (car response)))))
 262       (setq response (cdr response)))
 263     matched))
 264
 265 (defmacro elmo-imap4-response-error-text (response)
 266   "Returns text of NO, BAD, BYE response."
 267   `(nth 1 (or (elmo-imap4-response-value ,response 'no)
 268               (elmo-imap4-response-value ,response 'bad)
 269               (elmo-imap4-response-value ,response 'bye))))
 270
 271 (defmacro elmo-imap4-response-bodydetail-text (response)
 272   "Returns text of BODY[section]<partial>."
 273   `(nth 3 (assq 'bodydetail ,response)))
 274
 275 ;;; Session commands.
 276
 277 ;;;(defun elmo-imap4-send-command-wait (session command)
 278 ;;;  "Send COMMAND to the SESSION and wait for response.
 279 ;;;Returns RESPONSE (parsed lisp object) of IMAP session."
 280 ;;;  (elmo-imap4-read-response session
 281 ;;;                         (elmo-imap4-send-command
 282 ;;;                          session
 283 ;;;                          command)))
 284
 285 (defun elmo-imap4-send-command-wait (session command)
 286   "Send COMMAND to the SESSION.
 287 Returns RESPONSE (parsed lisp object) of IMAP session.
 288 If response is not `OK', causes error with IMAP response text."
 289   (elmo-imap4-accept-ok session
 290                         (elmo-imap4-send-command
 291                          session
 292                          command)))
 293
 294 (defun elmo-imap4-send-command (session command)
 295   "Send COMMAND to the SESSION.
 296 Returns a TAG string which is assigned to the COMMAND."
 297   (let* ((command-args (if (listp command)
 298                            command
 299                          (list command)))
 300          (process (elmo-network-session-process-internal session))
 301          cmdstr tag token kind)
 302     (with-current-buffer (process-buffer process)
 303       (setq tag (concat elmo-imap4-seq-prefix
 304                         (number-to-string
 305                          (setq elmo-imap4-seqno (+ 1 elmo-imap4-seqno)))))
 306       (setq cmdstr (concat tag " "))
 307 ;;; No need.
 308 ;;;      (erase-buffer)
 309       (goto-char (point-min))
 310       (when (elmo-imap4-response-bye-p elmo-imap4-current-response)
 311         (elmo-imap4-process-bye session))
 312       (setq elmo-imap4-current-response nil)
 313       (when elmo-imap4-parsing
 314         (message "Waiting for IMAP response...")
 315         (accept-process-output (elmo-network-session-process-internal
 316                                 session))
 317         (message "Waiting for IMAP response...done"))
 318       (setq elmo-imap4-parsing t)
 319       (while (setq token (car command-args))
 320         (cond ((stringp token)   ; formatted
 321                (setq cmdstr (concat cmdstr token)))
 322               ((listp token)     ; unformatted
 323                (setq kind (car token))
 324                (cond ((eq kind 'atom)
 325                       (setq cmdstr (concat cmdstr (nth 1 token))))
 326                      ((eq kind 'quoted)
 327                       (setq cmdstr (concat
 328                                     cmdstr
 329                                     (elmo-imap4-format-quoted (nth 1 token)))))
 330                      ((eq kind 'literal)
 331                       (if (elmo-imap4-session-capable-p session 'literal+)
 332                           ;; rfc2088
 333                           (progn
 334                             (setq cmdstr (concat cmdstr
 335                                                  (format "{%d+}" (nth 2 token))
 336                                                  "\r\n"))
 337                             (process-send-string process cmdstr)
 338                             (setq cmdstr nil))
 339                         (setq cmdstr (concat cmdstr
 340                                              (format "{%d}" (nth 2 token))
 341                                              "\r\n"))
 342                         (process-send-string process cmdstr)
 343                         (setq cmdstr nil)
 344                         (elmo-imap4-accept-continue-req session))
 345                       (cond ((stringp (nth 1 token))
 346                              (setq cmdstr (nth 1 token)))
 347                             ((bufferp (nth 1 token))
 348                              (with-current-buffer (nth 1 token)
 349                                (process-send-region
 350                                 process
 351                                 (point-min)
 352                                 (+ (point-min) (nth 2 token)))))
 353                             (t
 354                              (error "Wrong argument for literal"))))
 355                      (t
 356                       (error "Unknown token kind %s" kind))))
 357               (t
 358                (error "Invalid argument")))
 359         (setq command-args (cdr command-args)))
 360       (elmo-imap4-debug "[%s] <- %s" (time-stamp-hh:mm:ss) cmdstr)
 361       (process-send-string process (concat cmdstr "\r\n"))
 362       tag)))
 363
 364 (defun elmo-imap4-send-string (session string)
 365   "Send STRING to the SESSION."
 366   (with-current-buffer (process-buffer
 367                         (elmo-network-session-process-internal session))
 368     (setq elmo-imap4-current-response nil)
 369     (goto-char (point-min))
 370     (elmo-imap4-debug "[%s] <-- %s" (time-stamp-hh:mm:ss) string)
 371     (process-send-string (elmo-network-session-process-internal session)
 372                          string)
 373     (process-send-string (elmo-network-session-process-internal session)
 374                          "\r\n")))
 375
 376 (defun elmo-imap4-read-response (session tag)
 377   "Read parsed response from SESSION.
 378 TAG is the tag of the command"
 379   (with-current-buffer (process-buffer
 380                         (elmo-network-session-process-internal session))
 381     (while (not (or (string= tag elmo-imap4-reached-tag)
 382                     (elmo-imap4-response-bye-p elmo-imap4-current-response)
 383                     (when (elmo-imap4-response-garbage-p
 384                            elmo-imap4-current-response)
 385                       (message "Garbage response: %s"
 386                                (elmo-imap4-response-value
 387                                 elmo-imap4-current-response
 388                                 'garbage))
 389                       t)))
 390       (when (memq (process-status
 391                    (elmo-network-session-process-internal session))
 392                   '(open run))
 393         (accept-process-output (elmo-network-session-process-internal session)
 394                                1)))
 395     (elmo-imap4-debug "[%s] =>%s" (time-stamp-hh:mm:ss) (prin1-to-string elmo-imap4-current-response))
 396     (setq elmo-imap4-parsing nil)
 397     elmo-imap4-current-response))
 398
 399 (defsubst elmo-imap4-read-untagged (process)
 400   (with-current-buffer (process-buffer process)
 401     (while (not elmo-imap4-current-response)
 402       (accept-process-output process 1))
 403     (elmo-imap4-debug "[%s] =>%s" (time-stamp-hh:mm:ss) (prin1-to-string elmo-imap4-current-response))
 404     elmo-imap4-current-response))
 405
 406 (defun elmo-imap4-read-continue-req (session)
 407   "Returns a text following to continue-req in SESSION.
 408 If response is not `+' response, returns nil."
 409   (elmo-imap4-response-value
 410    (elmo-imap4-read-untagged
 411     (elmo-network-session-process-internal session))
 412    'continue-req))
 413
 414 (defun elmo-imap4-process-bye (session)
 415   (with-current-buffer (elmo-network-session-buffer session)
 416     (let ((r elmo-imap4-current-response))
 417       (setq elmo-imap4-current-response nil)
 418       (elmo-network-close-session session)
 419       (signal 'elmo-imap4-bye-error
 420               (list (concat (elmo-imap4-response-error-text r))
 421                     "Try Again")))))
 422
 423 (defun elmo-imap4-accept-continue-req (session)
 424   "Returns non-nil if `+' (continue-req) response is arrived in SESSION.
 425 If response is not `+' response, cause an error."
 426   (let (response)
 427     (setq response
 428           (elmo-imap4-read-untagged
 429            (elmo-network-session-process-internal session)))
 430     (or (elmo-imap4-response-continue-req-p response)
 431         (error "IMAP error: %s"
 432                (or (elmo-imap4-response-error-text response)
 433                    "No continut-req from server.")))))
 434
 435 (defun elmo-imap4-read-ok (session tag)
 436   "Returns non-nil if `OK' response of the command with TAG is arrived
 437 in SESSION. If response is not `OK' response, returns nil."
 438   (elmo-imap4-response-ok-p
 439    (elmo-imap4-read-response session tag)))
 440
 441 (defun elmo-imap4-accept-ok (session tag)
 442   "Accept only `OK' response from SESSION.
 443 If response is not `OK' response, causes error with IMAP response text."
 444   (let ((response (elmo-imap4-read-response session tag)))
 445     (if (elmo-imap4-response-ok-p response)
 446         response
 447       (if (elmo-imap4-response-bye-p response)
 448           (elmo-imap4-process-bye session)
 449         (error "IMAP error: %s"
 450                (or (elmo-imap4-response-error-text response)
 451                    "No `OK' response from server."))))))
 452
 453 ;;; MIME-ELMO-IMAP Location
 454 (luna-define-method mime-imap-location-section-body ((location
 455                                                       mime-elmo-imap-location)
 456                                                      section)
 457   (if (and (stringp section)
 458            (string= section "HEADER"))
 459       ;; Even in the section mode, header fields should be saved to the
 460       ;; raw buffer .
 461       (with-current-buffer (mime-elmo-imap-location-rawbuf-internal location)
 462         (erase-buffer)
 463         (elmo-message-fetch
 464          (mime-elmo-imap-location-folder-internal location)
 465          (mime-elmo-imap-location-number-internal location)
 466          (mime-elmo-imap-location-strategy-internal location)
 467          'unseen
 468          section)
 469         (buffer-string))
 470     (elmo-message-fetch-string
 471      (mime-elmo-imap-location-folder-internal location)
 472      (mime-elmo-imap-location-number-internal location)
 473      (mime-elmo-imap-location-strategy-internal location)
 474      'unseen
 475      section)))
 476
 477
 478 (luna-define-method mime-imap-location-bodystructure
 479   ((location mime-elmo-imap-location))
 480   (elmo-message-fetch-bodystructure
 481    (mime-elmo-imap-location-folder-internal location)
 482    (mime-elmo-imap-location-number-internal location)
 483    (mime-elmo-imap-location-strategy-internal location)))
 484
 485 (luna-define-method mime-imap-location-fetch-entity-p
 486   ((location mime-elmo-imap-location) entity)
 487   (or (not elmo-message-displaying) ; Fetching entity to save or force display.
 488       ;; cache exists
 489       (file-exists-p
 490        (expand-file-name
 491         (mmimap-entity-section (mime-entity-node-id-internal entity))
 492         (elmo-fetch-strategy-cache-path
 493          (mime-elmo-imap-location-strategy-internal location))))
 494       ;; not too large to fetch.
 495       (> elmo-message-fetch-threshold
 496          (or (mime-imap-entity-size-internal entity) 0))))
 497
 498 ;;;
 499
 500 (defun elmo-imap4-session-check (session)
 501   (with-current-buffer (elmo-network-session-buffer session)
 502     (setq elmo-imap4-fetch-callback nil)
 503     (setq elmo-imap4-fetch-callback-data nil))
 504   (elmo-imap4-send-command session "check"))
 505
 506 (defun elmo-imap4-atom-p (string)
 507   "Return t if STRING is an atom defined in rfc2060."
 508   (if (string= string "")
 509       nil
 510     (save-match-data
 511       (not (string-match elmo-imap4-non-atom-char-regex string)))))
 512
 513 (defun elmo-imap4-quotable-p (string)
 514   "Return t if STRING can be formatted as a quoted defined in rfc2060."
 515   (save-match-data
 516     (not (string-match elmo-imap4-non-text-char-regex string))))
 517
 518 (defun elmo-imap4-nil (string)
 519   "Return a list represents the special atom \"NIL\" defined in rfc2060, \
 520 if STRING is nil.
 521 Otherwise return nil."
 522   (if (eq string nil)
 523       (list 'atom "NIL")))
 524
 525 (defun elmo-imap4-atom (string)
 526   "Return a list represents STRING as an atom defined in rfc2060.
 527 Return nil if STRING is not an atom.  See `elmo-imap4-atom-p'."
 528   (if (elmo-imap4-atom-p string)
 529       (list 'atom string)))
 530
 531 (defun elmo-imap4-quoted (string)
 532   "Return a list represents STRING as a quoted defined in rfc2060.
 533 Return nil if STRING can not be formatted as a quoted.  See `elmo-imap4-quotable-p'."
 534   (if (elmo-imap4-quotable-p string)
 535       (list 'quoted string)))
 536
 537 (defun elmo-imap4-literal-1 (string-or-buffer length)
 538   "Internal function for `elmo-imap4-literal' and `elmo-imap4-buffer-literal'.
 539 Return a list represents STRING-OR-BUFFER as a literal defined in rfc2060.
 540 STRING-OR-BUFFER must be an encoded string or a single-byte string or a single-byte buffer.
 541 LENGTH must be the number of octets for STRING-OR-BUFFER."
 542   (list 'literal string-or-buffer length))
 543
 544 (defun elmo-imap4-literal (string)
 545   "Return a list represents STRING as a literal defined in rfc2060.
 546 STRING must be an encoded or a single-byte string."
 547   (elmo-imap4-literal-1 string (length string)))
 548
 549 (defun elmo-imap4-buffer-literal (buffer)
 550   "Return a list represents BUFFER as a literal defined in rfc2060.
 551 BUFFER must be a single-byte buffer."
 552   (elmo-imap4-literal-1 buffer (with-current-buffer buffer
 553                                  (buffer-size))))
 554
 555 (defun elmo-imap4-string-1 (string length)
 556   "Internal function for `elmo-imap4-string' and `elmo-imap4-buffer-string'.
 557 Return a list represents STRING as a string defined in rfc2060.
 558 STRING must be an encoded or a single-byte string.
 559 LENGTH must be the number of octets for STRING."
 560   (or (elmo-imap4-quoted string)
 561       (elmo-imap4-literal-1 string length)))
 562
 563 (defun elmo-imap4-string (string)
 564   "Return a list represents STRING as a string defined in rfc2060.
 565 STRING must be an encoded or a single-byte string."
 566   (let ((length (length string)))
 567     (if (< elmo-imap4-literal-threshold length)
 568         (elmo-imap4-literal-1 string length)
 569       (elmo-imap4-string-1 string length))))
 570
 571 (defun elmo-imap4-buffer-string (buffer)
 572   "Return a list represents BUFFER as a string defined in rfc2060.
 573 BUFFER must be a single-byte buffer."
 574   (let ((length (with-current-buffer buffer
 575                   (buffer-size))))
 576     (if (< elmo-imap4-literal-threshold length)
 577         (elmo-imap4-literal-1 buffer length)
 578       (elmo-imap4-string-1 (with-current-buffer buffer
 579                              (buffer-string))
 580                            length))))
 581
 582 (defun elmo-imap4-astring-1 (string length)
 583   "Internal function for `elmo-imap4-astring' and `elmo-imap4-buffer-astring'.
 584 Return a list represents STRING as an astring defined in rfc2060.
 585 STRING must be an encoded or a single-byte string.
 586 LENGTH must be the number of octets for STRING."
 587   (or (elmo-imap4-atom string)
 588       (elmo-imap4-string-1 string length)))
 589
 590 (defun elmo-imap4-astring (string)
 591   "Return a list represents STRING as an astring defined in rfc2060.
 592 STRING must be an encoded or a single-byte string."
 593   (let ((length (length string)))
 594     (if (< elmo-imap4-literal-threshold length)
 595         (elmo-imap4-literal-1 string length)
 596       (elmo-imap4-astring-1 string length))))
 597
 598 (defun elmo-imap4-buffer-astring (buffer)
 599   "Return a list represents BUFFER as an astring defined in rfc2060.
 600 BUFFER must be a single-byte buffer."
 601   (let ((length (with-current-buffer buffer
 602                   (buffer-size))))
 603     (if (< elmo-imap4-literal-threshold length)
 604         (elmo-imap4-literal-1 buffer length)
 605       (elmo-imap4-astring-1 (with-current-buffer buffer
 606                               (buffer-string))
 607                             length))))
 608
 609 (defun elmo-imap4-nstring (string)
 610   "Return a list represents STRING as a nstring defined in rfc2060.
 611 STRING must be an encoded or a single-byte string."
 612    (or (elmo-imap4-nil string)
 613        (elmo-imap4-string string)))
 614
 615 (defun elmo-imap4-buffer-nstring (buffer)
 616   "Return a list represents BUFFER as a nstring defined in rfc2060.
 617 BUFFER must be a single-byte buffer."
 618    (or (elmo-imap4-nil buffer)
 619        (elmo-imap4-buffer-string buffer)))
 620
 621 (defalias 'elmo-imap4-mailbox 'elmo-imap4-astring)
 622 (defalias 'elmo-imap4-field-body 'elmo-imap4-astring)
 623 (defalias 'elmo-imap4-userid 'elmo-imap4-astring)
 624 (defalias 'elmo-imap4-password 'elmo-imap4-astring)
 625
 626 (defun elmo-imap4-format-quoted (string)
 627   "Return STRING in a form of the quoted-string defined in rfc2060."
 628   (concat "\""
 629           (std11-wrap-as-quoted-pairs string elmo-imap4-quoted-specials-list)
 630           "\""))
 631
 632 (defsubst elmo-imap4-response-get-selectable-mailbox-list (response)
 633   (delq nil
 634         (mapcar
 635          (lambda (entry)
 636            (if (and (eq 'list (car entry))
 637                     (not (elmo-string-member-ignore-case "\\Noselect" (nth 1 (nth 1 entry)))))
 638                (car (nth 1 entry))))
 639          response)))
 640
 641 (luna-define-method elmo-message-fetch-bodystructure ((folder
 642                                                        elmo-imap4-folder)
 643                                                       number strategy)
 644   (if (elmo-fetch-strategy-use-cache strategy)
 645       (elmo-object-load
 646        (elmo-file-cache-expand-path
 647         (elmo-fetch-strategy-cache-path strategy)
 648         "bodystructure"))
 649     (let ((session (elmo-imap4-get-session folder))
 650           bodystructure)
 651       (elmo-imap4-session-select-mailbox
 652        session
 653        (elmo-imap4-folder-mailbox-internal folder))
 654       (with-current-buffer (elmo-network-session-buffer session)
 655         (setq elmo-imap4-fetch-callback nil)
 656         (setq elmo-imap4-fetch-callback-data nil))
 657       (prog1 (setq bodystructure
 658                    (elmo-imap4-response-value
 659                     (elmo-imap4-response-value
 660                      (elmo-imap4-send-command-wait
 661                       session
 662                       (format
 663                        (if elmo-imap4-use-uid
 664                            "uid fetch %s bodystructure"
 665                          "fetch %s bodystructure")
 666                        number))
 667                      'fetch)
 668                     'bodystructure))
 669         (when (elmo-fetch-strategy-save-cache strategy)
 670           (elmo-file-cache-delete
 671            (elmo-fetch-strategy-cache-path strategy))
 672           (elmo-object-save
 673            (elmo-file-cache-expand-path
 674             (elmo-fetch-strategy-cache-path strategy)
 675             "bodystructure")
 676            bodystructure))))))
 677
 678 ;;; Backend methods.
 679 (luna-define-method elmo-create-folder-plugged ((folder elmo-imap4-folder))
 680   (elmo-imap4-send-command-wait
 681    (elmo-imap4-get-session folder)
 682    (list "create " (elmo-imap4-mailbox
 683                     (elmo-imap4-folder-mailbox-internal folder)))))
 684
 685 (defun elmo-imap4-get-session (folder &optional if-exists)
 686   (elmo-network-get-session 'elmo-imap4-session
 687                             (concat
 688                              (if (elmo-folder-biff-internal folder)
 689                                  "BIFF-")
 690                              "IMAP")
 691                             folder if-exists))
 692
 693 (defun elmo-imap4-session-select-mailbox (session mailbox
 694                                                   &optional force no-error)
 695   "Select MAILBOX in SESSION.
 696 If optional argument FORCE is non-nil, select mailbox even if current mailbox
 697 is same as MAILBOX.
 698 If second optional argument NO-ERROR is non-nil, don't cause an error when
 699 selecting folder was failed.
 700 If NO-ERROR is 'notify-bye, only BYE response is reported as error.
 701 Returns response value if selecting folder succeed. "
 702   (when (or force
 703             (not (string=
 704                   (elmo-imap4-session-current-mailbox-internal session)
 705                   mailbox)))
 706     (let (response result)
 707       (unwind-protect
 708           (setq response
 709                 (elmo-imap4-read-response
 710                  session
 711                  (elmo-imap4-send-command
 712                   session
 713                   (list
 714                    "select "
 715                    (elmo-imap4-mailbox mailbox)))))
 716         (if (setq result (elmo-imap4-response-ok-p response))
 717             (progn
 718               (elmo-imap4-session-set-current-mailbox-internal session mailbox)
 719               (elmo-imap4-session-set-read-only-internal
 720                session
 721                (nth 1 (assq 'read-only (assq 'ok response))))
 722               (elmo-imap4-session-set-flags-internal
 723                session
 724                (nth 1 (or (assq 'permanentflags response)
 725                           (assq 'flags response)))))
 726           (elmo-imap4-session-set-current-mailbox-internal session nil)
 727           (if (and (eq no-error 'notify-bye)
 728                    (elmo-imap4-response-bye-p response))
 729               (elmo-imap4-process-bye session)
 730             (unless no-error
 731               (error "%s"
 732                      (or (elmo-imap4-response-error-text response)
 733                          (format "Select %s failed" mailbox)))))))
 734       (and result response))))
 735
 736 (defun elmo-imap4-check-validity (spec validity-file)
 737 ;;; Not used.
 738 ;;;(elmo-imap4-send-command-wait
 739 ;;;(elmo-imap4-get-session spec)
 740 ;;;(list "status "
 741 ;;;      (elmo-imap4-mailbox
 742 ;;;       (elmo-imap4-spec-mailbox spec))
 743 ;;;      " (uidvalidity)")))
 744   )
 745
 746 (defun elmo-imap4-sync-validity  (spec validity-file)
 747   ;; Not used.
 748   )
 749
 750 (defun elmo-imap4-elist (folder query tags)
 751   (let ((session (elmo-imap4-get-session folder)))
 752     (elmo-imap4-session-select-mailbox
 753      session
 754      (elmo-imap4-folder-mailbox-internal folder))
 755     (let ((answer (elmo-imap4-response-value
 756                    (elmo-imap4-send-command-wait
 757                     session query) 'esearch))
 758           tag result)
 759       (while answer
 760         (setq tag (intern (downcase (car answer))))
 761         (cond ((eq tag 'uid)
 762                nil)
 763               ((memq tag tags)
 764                (setq result
 765                      (append result
 766                              (if (eq tag 'all)
 767                                  (sort
 768                                   (elmo-number-set-to-number-list
 769                                    (mapcar #'(lambda (x)
 770                                                (let ((y (split-string x ":")))
 771                                                  (if (null (cdr y))
 772                                                      (string-to-number (car y))
 773                                                    (cons (string-to-number (car y))
 774                                                          (string-to-number (cadr y))))))
 775                                            (split-string (cadr answer) "\,"))) '<)
 776                                (string-to-number (cadr answer))))))
 777               (t nil))
 778         (setq answer (cdr answer)))
 779       result)))
 780
 781 (defun elmo-imap4-list (folder flag)
 782   (let ((session (elmo-imap4-get-session folder)))
 783     (elmo-imap4-session-select-mailbox
 784      session
 785      (elmo-imap4-folder-mailbox-internal folder))
 786     (if (elmo-imap4-session-capable-p session 'esearch)
 787         (elmo-imap4-elist folder
 788                           (concat (if elmo-imap4-use-uid "uid " "")
 789                                   "search return (all) " flag) '(all))
 790       (elmo-imap4-response-value
 791        (elmo-imap4-send-command-wait
 792         session
 793         (format (if elmo-imap4-use-uid "uid search %s"
 794                   "search %s") flag))
 795        'search))))
 796
 797 (defun elmo-imap4-session-flag-available-p (session flag)
 798   (case flag
 799     ((read unread) (elmo-string-member-ignore-case
 800                     "\\seen" (elmo-imap4-session-flags-internal session)))
 801     (important
 802      (elmo-string-member-ignore-case
 803       "\\flagged" (elmo-imap4-session-flags-internal session)))
 804     (digest
 805      (or (elmo-string-member-ignore-case
 806           "\\seen" (elmo-imap4-session-flags-internal session))
 807          (elmo-string-member-ignore-case
 808           "\\flagged" (elmo-imap4-session-flags-internal session))))
 809     (answered
 810      (elmo-string-member-ignore-case
 811       (concat "\\" (symbol-name flag))
 812       (elmo-imap4-session-flags-internal session)))
 813     (t
 814      (member "\\*" (elmo-imap4-session-flags-internal session)))))
 815
 816 (defun elmo-imap4-flag-to-imap-search-key (flag)
 817   (case flag
 818     (read "seen")
 819     (unread "unseen")
 820     (important "flagged")
 821     (answered "answered")
 822     (new "new")
 823     (t (concat
 824         "keyword "
 825         (or (car (cdr (assq flag elmo-imap4-flag-specs)))
 826             (symbol-name flag))))))
 827
 828 (defun elmo-imap4-flag-to-imap-criteria (flag)
 829   (case flag
 830     ((any digest)
 831      (let ((criteria "flagged")
 832            (global-flags (delq 'important (elmo-get-global-flags t t))))
 833        (dolist (flag (delete 'new
 834                              (delete 'cached
 835                                      (copy-sequence
 836                                       (case flag
 837                                         (any
 838                                          elmo-preserved-flags)
 839                                         (digest
 840                                          elmo-digest-flags))))))
 841          (setq criteria (concat "or "
 842                                 (elmo-imap4-flag-to-imap-search-key flag)
 843                                 " "
 844                                 criteria)))
 845        (while global-flags
 846          (setq criteria (concat "or keyword "
 847                                 (symbol-name (car global-flags))
 848                                 " "
 849                                 criteria))
 850          (setq global-flags (cdr global-flags)))
 851        criteria))
 852     (t
 853      (elmo-imap4-flag-to-imap-search-key flag))))
 854
 855 (defun elmo-imap4-folder-list-flagged (folder flag)
 856   "List flagged message numbers in the FOLDER.
 857 FLAG is one of the `unread', `read', `important', `answered', `any'."
 858   (let ((session (elmo-imap4-get-session folder))
 859         (criteria (elmo-imap4-flag-to-imap-criteria flag)))
 860     (if (elmo-imap4-session-flag-available-p session flag)
 861         (elmo-imap4-list folder criteria)
 862       ;; List flagged messages in the msgdb.
 863       (elmo-msgdb-list-flagged (elmo-folder-msgdb folder) flag))))
 864
 865 (defvar elmo-imap4-rfc822-size "RFC822\.SIZE")
 866 (defvar elmo-imap4-rfc822-text "RFC822\.TEXT")
 867 (defvar elmo-imap4-rfc822-header "RFC822\.HEADER")
 868 (defvar elmo-imap4-header-fields "HEADER\.FIELDS")
 869
 870 (defun elmo-imap4-make-number-set-list (msg-list &optional chop-length)
 871   "Make RFC2060's message set specifier from MSG-LIST.
 872 Returns a list of (NUMBER . SET-STRING).
 873 SET-STRING is the message set specifier described in RFC2060.
 874 NUMBER is contained message number in SET-STRING.
 875 Every SET-STRING does not contain number of messages longer than CHOP-LENGTH.
 876 If CHOP-LENGTH is not specified, message set is not chopped."
 877   (let (count cont-list set-list)
 878     (setq msg-list (sort (copy-sequence msg-list) '<))
 879     (while msg-list
 880       (setq cont-list nil)
 881       (setq count 0)
 882       (unless chop-length
 883         (setq chop-length (length msg-list)))
 884       (while (and (not (null msg-list))
 885                   (< count chop-length))
 886         (setq cont-list
 887               (elmo-number-set-append
 888                cont-list (car msg-list)))
 889         (incf count)
 890         (setq msg-list (cdr msg-list)))
 891       (setq set-list
 892             (cons
 893              (cons
 894               count
 895               (mapconcat
 896                (lambda (x)
 897                  (cond ((consp x)
 898                         (format "%s:%s" (car x) (cdr x)))
 899                        ((integerp x)
 900                         (number-to-string x))))
 901                cont-list
 902                ","))
 903              set-list)))
 904     (nreverse set-list)))
 905
 906 ;;
 907 ;; app-data:
 908 ;; cons of flag-table and folder structure
 909 (defsubst elmo-imap4-fetch-callback-1-subr (entity flags app-data)
 910   "A msgdb entity callback function."
 911   (let ((use-flag (elmo-folder-use-flag-p (cdr app-data)))
 912         (flag-table (car app-data))
 913         (msg-id (elmo-message-entity-field entity 'message-id))
 914         saved-flags flag-list)
 915 ;;;    (when (elmo-string-member-ignore-case "\\Flagged" flags)
 916 ;;;      (elmo-msgdb-global-mark-set msg-id elmo-msgdb-important-mark))
 917     (setq saved-flags (elmo-flag-table-get flag-table msg-id)
 918           flag-list
 919           (if use-flag
 920               (append
 921                (and (memq 'new saved-flags)
 922                     (not (elmo-string-member-ignore-case "\\Seen" flags))
 923                     '(new))
 924                (and (elmo-string-member-ignore-case "\\Flagged" flags)
 925                     '(important))
 926                (and (not (elmo-string-member-ignore-case "\\Seen" flags))
 927                     '(unread))
 928                (and (elmo-string-member-ignore-case "\\Answered" flags)
 929                     '(answered))
 930                (and (elmo-file-cache-exists-p msg-id)
 931                     '(cached)))
 932             saved-flags))
 933     (when (and (or (memq 'important flag-list)
 934                    (memq 'answered flag-list))
 935                (memq 'unread flag-list))
 936       (setq elmo-imap4-seen-messages
 937             (cons (elmo-message-entity-number entity)
 938                   elmo-imap4-seen-messages)))
 939     (elmo-msgdb-append-entity elmo-imap4-current-msgdb
 940                               entity
 941                               flag-list)))
 942
 943 ;; Current buffer is process buffer.
 944 (defun elmo-imap4-fetch-callback-1 (element app-data)
 945   (let ((handler (elmo-msgdb-message-entity-handler elmo-imap4-current-msgdb)))
 946     (elmo-imap4-fetch-callback-1-subr
 947      (with-temp-buffer
 948        (insert (or (elmo-imap4-response-bodydetail-text element)
 949                    ""))
 950        ;; Replace all CRLF with LF.
 951        (elmo-delete-cr-buffer)
 952        (elmo-msgdb-create-message-entity-from-buffer
 953         handler
 954         (elmo-imap4-response-value element 'uid)
 955         :size (elmo-imap4-response-value element 'rfc822size)))
 956      (elmo-imap4-response-value element 'flags)
 957      app-data)
 958     (elmo-progress-notify 'elmo-folder-msgdb-create)))
 959
 960 (defun elmo-imap4-parse-capability (string)
 961   (if (string-match "^\\*\\(.*\\)$" string)
 962       (read
 963        (concat "(" (downcase (elmo-match-string 1 string)) ")"))))
 964
 965 (defun elmo-imap4-clear-login (session)
 966   (when (elmo-imap4-session-capable-p session 'logindisabled)
 967     (signal 'elmo-authenticate-error '(elmo-imap4-clear-login)))
 968   (let ((elmo-imap4-debug-inhibit-logging t))
 969     (or
 970      (elmo-imap4-read-ok
 971       session
 972       (elmo-imap4-send-command
 973        session
 974        (list "login "
 975              (elmo-imap4-userid (elmo-network-session-user-internal session))
 976              " "
 977              (elmo-imap4-password
 978               (elmo-get-passwd (elmo-network-session-password-key session))))))
 979      (signal 'elmo-authenticate-error '(elmo-imap4-clear-login)))))
 980
 981 (defun elmo-imap4-auth-login (session)
 982   (let ((tag (elmo-imap4-send-command session "authenticate login"))
 983         (elmo-imap4-debug-inhibit-logging t))
 984     (or (elmo-imap4-read-continue-req session)
 985         (signal 'elmo-authenticate-error '(elmo-imap4-auth-login)))
 986     (elmo-imap4-send-string session
 987                             (elmo-base64-encode-string
 988                              (elmo-network-session-user-internal session)))
 989     (or (elmo-imap4-read-continue-req session)
 990         (signal 'elmo-authenticate-error '(elmo-imap4-auth-login)))
 991     (elmo-imap4-send-string session
 992                             (elmo-base64-encode-string
 993                              (elmo-get-passwd
 994                               (elmo-network-session-password-key session))))
 995     (or (elmo-imap4-read-ok session tag)
 996         (signal 'elmo-authenticate-error '(elmo-imap4-auth-login)))
 997     (setq elmo-imap4-status 'auth)))
 998
 999 (luna-define-method
1000   elmo-network-initialize-session-buffer :after ((session
1001                                                   elmo-imap4-session) buffer)
1002   (with-current-buffer buffer
1003     (mapc 'make-variable-buffer-local elmo-imap4-local-variables)
1004     (setq elmo-imap4-seqno 0)
1005     (setq elmo-imap4-status 'initial)))
1006
1007 (luna-define-method elmo-network-initialize-session ((session
1008                                                       elmo-imap4-session))
1009   (let ((process (elmo-network-session-process-internal session)))
1010     (with-current-buffer (process-buffer process)
1011       ;; Skip garbage output from process before greeting.
1012       (while (and (memq (process-status process) '(open run))
1013                   (goto-char (point-max))
1014                   (or (/= (forward-line -1) 0)
1015                       (not (elmo-imap4-parse-greeting))))
1016         (accept-process-output process 1))
1017       (erase-buffer)
1018       (set-process-filter process 'elmo-imap4-arrival-filter)
1019       (set-process-sentinel process 'elmo-imap4-sentinel)
1020 ;;;      (while (and (memq (process-status process) '(open run))
1021 ;;;               (eq elmo-imap4-status 'initial))
1022 ;;;     (message "Waiting for server response...")
1023 ;;;     (accept-process-output process 1))
1024 ;;;      (message "")
1025       (unless (memq elmo-imap4-status '(nonauth auth))
1026         (signal 'elmo-open-error
1027                 (list 'elmo-network-initialize-session)))
1028       (elmo-imap4-session-set-capability-internal
1029        session
1030        (elmo-imap4-response-value
1031         (elmo-imap4-send-command-wait session "capability")
1032         'capability))
1033       (when (eq (elmo-network-stream-type-symbol
1034                  (elmo-network-session-stream-type-internal session))
1035                 'starttls)
1036         (or (elmo-imap4-session-capable-p session 'starttls)
1037             (signal 'elmo-open-error
1038                     '(elmo-imap4-starttls-error)))
1039         (elmo-imap4-send-command-wait session "starttls")
1040         (starttls-negotiate process)
1041         (elmo-imap4-session-set-capability-internal
1042          session
1043          (elmo-imap4-response-value
1044           (elmo-imap4-send-command-wait session "capability")
1045           'capability))))))
1046
1047 (luna-define-method elmo-network-authenticate-session ((session
1048                                                         elmo-imap4-session))
1049   (with-current-buffer (process-buffer
1050                         (elmo-network-session-process-internal session))
1051     (let* ((auth (elmo-network-session-auth-internal session))
1052            (auth (if (listp auth) auth (list auth))))
1053       (unless (or (eq elmo-imap4-status 'auth)
1054                   (null auth))
1055         (cond
1056          ((eq 'clear (car auth))
1057           (elmo-imap4-clear-login session))
1058          ((eq 'login (car auth))
1059           (elmo-imap4-auth-login session))
1060          (t
1061           (let* ((elmo-imap4-debug-inhibit-logging t)
1062                  (sasl-mechanisms
1063                   (delq nil
1064                         (mapcar
1065                          (lambda (cap)
1066                            (if (string-match "^auth=\\(.*\\)$"
1067                                              (symbol-name cap))
1068                                (match-string 1 (upcase (symbol-name cap)))))
1069                          (elmo-imap4-session-capability-internal session))))
1070                  (mechanism
1071                   (sasl-find-mechanism
1072                    (delq nil
1073                          (mapcar (lambda (cap) (upcase (symbol-name cap)))
1074                                  (if (listp auth)
1075                                      auth
1076                                    (list auth)))))) ;)
1077                  client name step response tag
1078                  sasl-read-passphrase)
1079             (unless mechanism
1080               (if (or elmo-imap4-force-login
1081                       (y-or-n-p
1082                        (format
1083                         "There's no %s capability in server. continue?"
1084                         (elmo-list-to-string
1085                          (elmo-network-session-auth-internal session)))))
1086                   (setq mechanism (sasl-find-mechanism
1087                                    sasl-mechanisms))
1088                 (signal 'elmo-authenticate-error
1089                         '(elmo-imap4-auth-no-mechanisms))))
1090             (setq client
1091                   (sasl-make-client
1092                    mechanism
1093                    (elmo-network-session-user-internal session)
1094                    "imap"
1095                    (elmo-network-session-server-internal session)))
1096 ;;;         (if elmo-imap4-auth-user-realm
1097 ;;;             (sasl-client-set-property client 'realm elmo-imap4-auth-user-realm))
1098             (setq name (sasl-mechanism-name mechanism)
1099                   step (sasl-next-step client nil))
1100             (elmo-network-session-set-auth-internal
1101              session
1102              (intern (downcase name)))
1103             (setq sasl-read-passphrase
1104                   (lambda (prompt)
1105                     (elmo-get-passwd
1106                      (elmo-network-session-password-key session))))
1107             (setq tag
1108                   (elmo-imap4-send-command
1109                    session
1110                    (concat "AUTHENTICATE " name
1111                            (and (sasl-step-data step)
1112                                 (concat
1113                                  " "
1114                                  (elmo-base64-encode-string
1115                                   (sasl-step-data step)
1116                                   'no-lin-break))))))
1117             (catch 'done
1118               (while t
1119                 (setq response
1120                       (elmo-imap4-read-untagged
1121                        (elmo-network-session-process-internal session)))
1122                 (if (elmo-imap4-response-ok-p response)
1123                     (if (sasl-next-step client step)
1124                         ;; Bogus server?
1125                         (signal 'elmo-authenticate-error
1126                                 (list (intern
1127                                        (concat "elmo-imap4-auth-"
1128                                                (downcase name)))))
1129                       ;; The authentication process is finished.
1130                       (throw 'done nil)))
1131                 (unless (elmo-imap4-response-continue-req-p response)
1132                   ;; response is NO or BAD.
1133                   (signal 'elmo-authenticate-error
1134                           (list (intern
1135                                  (concat "elmo-imap4-auth-"
1136                                          (downcase name))))))
1137                 (sasl-step-set-data
1138                  step
1139                  (elmo-base64-decode-string
1140                   (elmo-imap4-response-value response 'continue-req)))
1141                 (setq step (sasl-next-step client step))
1142                 (setq tag
1143                       (elmo-imap4-send-string
1144                        session
1145                        (if (sasl-step-data step)
1146                            (elmo-base64-encode-string (sasl-step-data step)
1147                                                       'no-line-break)
1148                          ""))))))))))))
1149
1150 (luna-define-method elmo-network-setup-session ((session
1151                                                  elmo-imap4-session))
1152   (with-current-buffer (elmo-network-session-buffer session)
1153     (when (elmo-imap4-session-capable-p session 'namespace)
1154       (setq elmo-imap4-server-namespace
1155             (elmo-imap4-response-value
1156              (elmo-imap4-send-command-wait session "namespace")
1157              'namespace)))))
1158
1159 (defun elmo-imap4-setup-send-buffer (&optional string)
1160   (let ((send-buf (get-buffer-create " *elmo-imap4-setup-send-buffer*"))
1161         (source-buf (unless string (current-buffer))))
1162     (save-excursion
1163       (save-match-data
1164         (set-buffer send-buf)
1165         (erase-buffer)
1166         (set-buffer-multibyte nil)
1167         (if string
1168             (insert string)
1169           (with-current-buffer source-buf
1170             (copy-to-buffer send-buf (point-min) (point-max))))
1171         (goto-char (point-min))
1172         (if (eq (re-search-forward "^$" nil t)
1173                 (point-max))
1174             (insert "\n"))
1175         (goto-char (point-min))
1176         (while (search-forward "\n" nil t)
1177           (replace-match "\r\n"))))
1178     send-buf))
1179
1180 (defun elmo-imap4-setup-send-buffer-from-file (file)
1181   (let ((tmp-buf (get-buffer-create
1182                   " *elmo-imap4-setup-send-buffer-from-file*")))
1183     (save-excursion
1184       (save-match-data
1185         (set-buffer tmp-buf)
1186         (erase-buffer)
1187         (as-binary-input-file
1188          (insert-file-contents file))
1189         (goto-char (point-min))
1190         (if (eq (re-search-forward "^$" nil t)
1191                 (point-max))
1192             (insert "\n"))
1193         (goto-char (point-min))
1194         (while (search-forward "\n" nil t)
1195           (replace-match "\r\n"))))
1196     tmp-buf))
1197
1198 (luna-define-method elmo-delete-message-safe ((folder elmo-imap4-folder)
1199                                               number msgid)
1200   (let ((session (elmo-imap4-get-session folder))
1201         candidates)
1202     (elmo-imap4-session-select-mailbox
1203      session
1204      (elmo-imap4-folder-mailbox-internal folder))
1205     (setq candidates
1206           (elmo-imap4-response-value
1207            (elmo-imap4-send-command-wait session
1208                                          (list
1209                                           (if elmo-imap4-use-uid
1210                                               "uid search header message-id "
1211                                             "search header message-id ")
1212                                           (elmo-imap4-field-body msgid)))
1213            'search))
1214     (if (memq number candidates)
1215         (elmo-folder-delete-messages folder (list number)))))
1216
1217 (defun elmo-imap4-server-diff-async-callback-1 (status data)
1218   (funcall elmo-imap4-server-diff-async-callback
1219            (list (elmo-imap4-response-value status 'recent)
1220                  (elmo-imap4-response-value status 'unseen)
1221                  (elmo-imap4-response-value status 'messages))
1222            data))
1223
1224 (defun elmo-imap4-server-diff-async (folder)
1225   (let ((session (elmo-imap4-get-session folder)))
1226     ;; We should `check' folder to obtain newest information here.
1227     ;; But since there's no asynchronous check mechanism in elmo yet,
1228     ;; checking is not done here.
1229     (with-current-buffer (elmo-network-session-buffer session)
1230       (setq elmo-imap4-status-callback
1231             'elmo-imap4-server-diff-async-callback-1)
1232       (setq elmo-imap4-status-callback-data
1233             elmo-imap4-server-diff-async-callback-data))
1234     (elmo-imap4-send-command session
1235                              (list
1236                               "status "
1237                               (elmo-imap4-mailbox
1238                                (elmo-imap4-folder-mailbox-internal folder))
1239                               " (recent unseen messages)"))))
1240
1241 (luna-define-method elmo-server-diff-async ((folder elmo-imap4-folder))
1242   (let ((session (elmo-imap4-get-session folder)))
1243 ;;;    ;; commit.
1244 ;;;    (elmo-imap4-commit spec)
1245     (with-current-buffer (elmo-network-session-buffer session)
1246       (setq elmo-imap4-status-callback
1247             'elmo-imap4-server-diff-async-callback-1)
1248       (setq elmo-imap4-status-callback-data
1249             elmo-imap4-server-diff-async-callback-data))
1250     (elmo-imap4-send-command session
1251                              (list
1252                               "status "
1253                               (elmo-imap4-mailbox
1254                                (elmo-imap4-folder-mailbox-internal folder))
1255                               " (recent unseen messages)"))))
1256
1257 ;;; IMAP parser.
1258
1259 (defvar elmo-imap4-server-eol "\r\n"
1260   "The EOL string sent from the server.")
1261
1262 (defvar elmo-imap4-client-eol "\r\n"
1263   "The EOL string we send to the server.")
1264
1265 (defvar elmo-imap4-literal-progress-reporter nil)
1266
1267 (defun elmo-imap4-find-next-line ()
1268   "Return point at end of current line, taking into account literals.
1269 Return nil if no complete line has arrived."
1270   (when (re-search-forward (concat elmo-imap4-server-eol "\\|{\\([0-9]+\\)}"
1271                                    elmo-imap4-server-eol)
1272                            nil t)
1273     (if (match-string 1)
1274         (if (< (point-max) (+ (point) (string-to-number (match-string 1))))
1275             (progn
1276               (when elmo-imap4-literal-progress-reporter
1277                 (elmo-progress-notify
1278                  'elmo-retrieve-message
1279                  :set (- (point-max) (point))
1280                  :total (string-to-number (match-string 1))))
1281               nil)
1282           (goto-char (+ (point) (string-to-number (match-string 1))))
1283           (elmo-imap4-find-next-line))
1284       (point))))
1285
1286 (defun elmo-imap4-sentinel (process string)
1287   (delete-process process))
1288
1289 (defun elmo-imap4-arrival-filter (proc string)
1290   "IMAP process filter."
1291   (when (buffer-live-p (process-buffer proc))
1292   (with-current-buffer (process-buffer proc)
1293     (goto-char (point-max))
1294     (insert string)
1295     (let (end)
1296       (goto-char (point-min))
1297       (while (setq end (elmo-imap4-find-next-line))
1298         (save-restriction
1299           (narrow-to-region (point-min) end)
1300           (delete-backward-char (length elmo-imap4-server-eol))
1301           (goto-char (point-min))
1302           (unwind-protect
1303               (case elmo-imap4-status
1304                 (initial
1305                  (setq elmo-imap4-current-response
1306                        (list
1307                         (list 'greeting (elmo-imap4-parse-greeting)))))
1308                 ((auth nonauth selected examine)
1309                  (setq elmo-imap4-current-response
1310                        (cons (elmo-imap4-parse-response)
1311                              elmo-imap4-current-response)))
1312                 (t
1313                  (message "Unknown state %s in arrival filter"
1314                           elmo-imap4-status)))
1315             (delete-region (point-min) (point-max)))))))))
1316
1317 ;; IMAP parser.
1318
1319 (defsubst elmo-imap4-forward ()
1320   (or (eobp) (forward-char 1)))
1321
1322 (defsubst elmo-imap4-parse-number ()
1323   (when (looking-at "[0-9]+")
1324     (prog1
1325         (string-to-number (match-string 0))
1326       (goto-char (match-end 0)))))
1327
1328 (defsubst elmo-imap4-parse-literal ()
1329   (when (looking-at "{\\([0-9]+\\)}\r\n")
1330     (let ((pos (match-end 0))
1331           (len (string-to-number (match-string 1))))
1332       (if (< (point-max) (+ pos len))
1333           nil
1334         (goto-char (+ pos len))
1335         (buffer-substring pos (+ pos len))))))
1336 ;;;     (list ' pos (+ pos len))))))
1337
1338 (defsubst elmo-imap4-parse-string ()
1339   (cond ((eq (char-after (point)) ?\")
1340          (forward-char 1)
1341          (let ((p (point)) (name ""))
1342            (skip-chars-forward "^\"\\\\")
1343            (setq name (buffer-substring p (point)))
1344            (while (eq (char-after (point)) ?\\)
1345              (setq p (1+ (point)))
1346              (forward-char 2)
1347              (skip-chars-forward "^\"\\\\")
1348              (setq name (concat name (buffer-substring p (point)))))
1349            (forward-char 1)
1350            name))
1351         ((eq (char-after (point)) ?{)
1352          (elmo-imap4-parse-literal))))
1353
1354 (defsubst elmo-imap4-parse-nil ()
1355   (if (looking-at "NIL")
1356       (goto-char (match-end 0))))
1357
1358 (defsubst elmo-imap4-parse-nstring ()
1359   (or (elmo-imap4-parse-string)
1360       (and (elmo-imap4-parse-nil)
1361            nil)))
1362
1363 (defsubst elmo-imap4-parse-astring ()
1364   (or (elmo-imap4-parse-string)
1365       (buffer-substring (point)
1366                         (if (re-search-forward "[(){ \r\n%*\"\\]" nil t)
1367                             (goto-char (1- (match-end 0)))
1368                           (end-of-line)
1369                           (point)))))
1370
1371 (defsubst elmo-imap4-parse-address ()
1372   (let (address)
1373     (when (eq (char-after (point)) ?\()
1374       (elmo-imap4-forward)
1375       (setq address (vector (prog1 (elmo-imap4-parse-nstring)
1376                               (elmo-imap4-forward))
1377                             (prog1 (elmo-imap4-parse-nstring)
1378                               (elmo-imap4-forward))
1379                             (prog1 (elmo-imap4-parse-nstring)
1380                               (elmo-imap4-forward))
1381                             (elmo-imap4-parse-nstring)))
1382       (when (eq (char-after (point)) ?\))
1383         (elmo-imap4-forward)
1384         address))))
1385
1386 (defsubst elmo-imap4-parse-address-list ()
1387   (if (eq (char-after (point)) ?\()
1388       (let (address addresses)
1389         (elmo-imap4-forward)
1390         (while (and (not (eq (char-after (point)) ?\)))
1391                     ;; next line for MS Exchange bug
1392                     (progn (and (eq (char-after (point)) (string-to-char " "))
1393                                 (elmo-imap4-forward)) t)
1394                     (setq address (elmo-imap4-parse-address)))
1395           (setq addresses (cons address addresses)))
1396         (when (eq (char-after (point)) ?\))
1397           (elmo-imap4-forward)
1398           (nreverse addresses)))
1399     (assert (elmo-imap4-parse-nil))))
1400
1401 (defsubst elmo-imap4-parse-mailbox ()
1402   (let ((mailbox (elmo-imap4-parse-astring)))
1403     (if (string-equal "INBOX" (upcase mailbox))
1404         "INBOX"
1405       mailbox)))
1406
1407 (defun elmo-imap4-parse-greeting ()
1408   "Parse a IMAP greeting."
1409   (cond ((looking-at "\\* OK ")
1410          (setq elmo-imap4-status 'nonauth))
1411         ((looking-at "\\* PREAUTH ")
1412          (setq elmo-imap4-status 'auth))
1413         ((looking-at "\\* BYE ")
1414          (setq elmo-imap4-status 'closed))))
1415
1416 (defun elmo-imap4-parse-response ()
1417   "Parse a IMAP command response."
1418   (elmo-imap4-debug "[%s] -> %s" (time-stamp-hh:mm:ss) (buffer-substring (point) (point-max)))
1419   (let (token)
1420     (case (setq token (read (current-buffer)))
1421       (+ (progn
1422            (skip-chars-forward " ")
1423            (list 'continue-req (buffer-substring (point) (point-max)))))
1424       (* (case (prog1 (setq token (read (current-buffer)))
1425                  (elmo-imap4-forward))
1426            (OK         (elmo-imap4-parse-resp-text-code))
1427            (NO         (elmo-imap4-parse-resp-text-code))
1428            (BAD        (elmo-imap4-parse-resp-text-code))
1429            (BYE        (elmo-imap4-parse-bye))
1430            (FLAGS      (list 'flags
1431                              (elmo-imap4-parse-flag-list)))
1432            (LIST       (list 'list (elmo-imap4-parse-data-list)))
1433            (LSUB       (list 'lsub (elmo-imap4-parse-data-list)))
1434            (SEARCH     (list
1435                         'search
1436                         (read (concat "("
1437                                       (buffer-substring (point) (point-max))
1438                                       ")"))))
1439            (ESEARCH     (list
1440                          'esearch
1441                          (cddr (split-string (buffer-substring (point) (point-max)) " " "\,"))))
1442            (STATUS     (elmo-imap4-parse-status))
1443            ;; Added
1444            (NAMESPACE  (elmo-imap4-parse-namespace))
1445            (CAPABILITY (list 'capability
1446                              (read
1447                               (concat "(" (downcase (buffer-substring
1448                                                      (point) (point-max)))
1449                                       ")"))))
1450            (ACL (elmo-imap4-parse-acl))
1451            (t       (case (prog1 (read (current-buffer))
1452                             (elmo-imap4-forward))
1453                       (EXISTS  (list 'exists token))
1454                       (RECENT  (list 'recent token))
1455                       (EXPUNGE (list 'expunge token))
1456                       (FETCH   (elmo-imap4-parse-fetch token))
1457                       (t       (list 'garbage (buffer-string)))))))
1458       (t (if (not (string-match elmo-imap4-seq-prefix (symbol-name token)))
1459              (list 'garbage (buffer-string))
1460            (case (prog1 (read (current-buffer))
1461                    (elmo-imap4-forward))
1462              (OK  (progn
1463                     (setq elmo-imap4-parsing nil)
1464                     (setq token (symbol-name token))
1465                     (elmo-unintern token)
1466                     (elmo-imap4-debug "*%s* OK arrived" token)
1467                     (setq elmo-imap4-reached-tag token)
1468                     (list 'ok (elmo-imap4-parse-resp-text-code))))
1469              (NO  (progn
1470                     (setq elmo-imap4-parsing nil)
1471                     (setq token (symbol-name token))
1472                     (elmo-unintern token)
1473                     (elmo-imap4-debug "*%s* NO arrived" token)
1474                     (setq elmo-imap4-reached-tag token)
1475                     (let (code text)
1476                       (when (eq (char-after (point)) ?\[)
1477                         (setq code (buffer-substring (point)
1478                                                      (search-forward "]")))
1479                         (elmo-imap4-forward))
1480                       (setq text (buffer-substring (point) (point-max)))
1481                       (list 'no (list code text)))))
1482              (BAD (progn
1483                     (setq elmo-imap4-parsing nil)
1484                     (elmo-imap4-debug "*%s* BAD arrived" token)
1485                     (setq token (symbol-name token))
1486                     (elmo-unintern token)
1487                     (setq elmo-imap4-reached-tag token)
1488                     (let (code text)
1489                       (when (eq (char-after (point)) ?\[)
1490                         (setq code (buffer-substring (point)
1491                                                      (search-forward "]")))
1492                         (elmo-imap4-forward))
1493                       (setq text (buffer-substring (point) (point-max)))
1494                       (list 'bad (list code text)))))
1495              (t   (list 'garbage (buffer-string)))))))))
1496
1497 (defun elmo-imap4-parse-bye ()
1498   (let (code text)
1499     (when (eq (char-after (point)) ?\[)
1500       (setq code (buffer-substring (point)
1501                                    (search-forward "]")))
1502       (elmo-imap4-forward))
1503     (setq text (buffer-substring (point) (point-max)))
1504     (list 'bye (list code text))))
1505
1506 (defun elmo-imap4-parse-text ()
1507   (goto-char (point-min))
1508   (when (search-forward "[" nil t)
1509     (search-forward "]")
1510     (elmo-imap4-forward))
1511   (list 'text (buffer-substring (point) (point-max))))
1512
1513 (defun elmo-imap4-parse-resp-text-code ()
1514   (when (eq (char-after (point)) ?\[)
1515     (elmo-imap4-forward)
1516     (cond ((search-forward "PERMANENTFLAGS " nil t)
1517            (list 'permanentflags (elmo-imap4-parse-flag-list)))
1518           ((search-forward "UIDNEXT " nil t)
1519            (list 'uidnext (read (current-buffer))))
1520           ((search-forward "UNSEEN " nil t)
1521            (list 'unseen (read (current-buffer))))
1522           ((looking-at "UIDVALIDITY \\([0-9]+\\)")
1523            (list 'uidvalidity (match-string 1)))
1524           ((search-forward "READ-ONLY" nil t)
1525            (list 'read-only t))
1526           ((search-forward "READ-WRITE" nil t)
1527            (list 'read-write t))
1528           ((search-forward "NEWNAME " nil t)
1529            (let (oldname newname)
1530              (setq oldname (elmo-imap4-parse-string))
1531              (elmo-imap4-forward)
1532              (setq newname (elmo-imap4-parse-string))
1533              (list 'newname newname oldname)))
1534           ((search-forward "TRYCREATE" nil t)
1535            (list 'trycreate t))
1536           ((looking-at "APPENDUID \\([0-9]+\\) \\([0-9]+\\)")
1537            (list 'appenduid
1538                  (list (match-string 1)
1539                        (string-to-number (match-string 2)))))
1540           ((looking-at "COPYUID \\([0-9]+\\) \\([0-9,:]+\\) \\([0-9,:]+\\)")
1541            (list 'copyuid (list (match-string 1)
1542                                 (match-string 2)
1543                                 (match-string 3))))
1544           ((search-forward "ALERT] " nil t)
1545            (message "IMAP server information: %s"
1546                     (buffer-substring (point) (point-max))))
1547           (t (list 'unknown)))))
1548
1549 (defun elmo-imap4-parse-data-list ()
1550   (let (flags delimiter mailbox)
1551     (setq flags (elmo-imap4-parse-flag-list))
1552     (when (looking-at " NIL\\| \"\\\\?\\(.\\)\"")
1553       (setq delimiter (match-string 1))
1554       (goto-char (1+ (match-end 0)))
1555       (when (setq mailbox (elmo-imap4-parse-mailbox))
1556         (list mailbox flags delimiter)))))
1557
1558 (defsubst elmo-imap4-parse-header-list ()
1559   (when (eq (char-after (point)) ?\()
1560     (let (strlist)
1561       (while (not (eq (char-after (point)) ?\)))
1562         (elmo-imap4-forward)
1563         (push (elmo-imap4-parse-astring) strlist))
1564       (elmo-imap4-forward)
1565       (nreverse strlist))))
1566
1567 (defsubst elmo-imap4-parse-fetch-body-section ()
1568   (let ((section
1569          (buffer-substring (point)
1570                            (1-
1571                             (progn (re-search-forward "[] ]" nil t)
1572                                    (point))))))
1573     (if (eq (char-before) (string-to-char " "))
1574         (prog1
1575             (mapconcat 'identity
1576                        (cons section (elmo-imap4-parse-header-list)) " ")
1577           (search-forward "]" nil t))
1578       section)))
1579
1580 (defun elmo-imap4-parse-fetch (response)
1581   (when (eq (char-after (point)) ?\()
1582     (let (element list)
1583       (while (not (eq (char-after (point)) ?\)))
1584         (elmo-imap4-forward)
1585         (let ((token (read (current-buffer))))
1586           (elmo-imap4-forward)
1587           (setq element
1588                 (cond ((eq token 'UID)
1589                        (list 'uid (condition-case nil
1590                                       (read (current-buffer))
1591                                     (error nil))))
1592                       ((eq token 'FLAGS)
1593                        (list 'flags (elmo-imap4-parse-flag-list)))
1594                       ((eq token 'ENVELOPE)
1595                        (list 'envelope (elmo-imap4-parse-envelope)))
1596                       ((eq token 'INTERNALDATE)
1597                        (list 'internaldate (elmo-imap4-parse-string)))
1598                       ((eq token 'RFC822)
1599                        (list 'rfc822 (elmo-imap4-parse-nstring)))
1600                       ((eq token (intern elmo-imap4-rfc822-header))
1601                        (list 'rfc822header (elmo-imap4-parse-nstring)))
1602                       ((eq token (intern elmo-imap4-rfc822-text))
1603                        (list 'rfc822text (elmo-imap4-parse-nstring)))
1604                       ((eq token (intern elmo-imap4-rfc822-size))
1605                        (list 'rfc822size (read (current-buffer))))
1606                       ((eq token 'BODY)
1607                        (if (eq (char-before) ?\[)
1608                            (list
1609                             'bodydetail
1610                             (upcase (elmo-imap4-parse-fetch-body-section))
1611                             (and
1612                              (eq (char-after (point)) ?<)
1613                              (buffer-substring (1+ (point))
1614                                                (progn
1615                                                  (search-forward ">" nil t)
1616                                                  (point))))
1617                             (progn (elmo-imap4-forward)
1618                                    (elmo-imap4-parse-nstring)))
1619                          (list 'body (elmo-imap4-parse-body))))
1620                       ((eq token 'BODYSTRUCTURE)
1621                        (list 'bodystructure (elmo-imap4-parse-body)))))
1622           (setq list (cons element list))))
1623       (and elmo-imap4-fetch-callback
1624            (funcall elmo-imap4-fetch-callback
1625                     list elmo-imap4-fetch-callback-data))
1626       (list 'fetch list))))
1627
1628 (defun elmo-imap4-parse-status ()
1629   (let ((mailbox (elmo-imap4-parse-mailbox))
1630         status)
1631     (when (and mailbox (search-forward "(" nil t))
1632       (while (not (eq (char-after (point)) ?\)))
1633         (setq status
1634               (cons
1635                (let ((token (read (current-buffer))))
1636                  (case (intern (upcase (symbol-name token)))
1637                    (MESSAGES
1638                     (list 'messages (read (current-buffer))))
1639                    (RECENT
1640                     (list 'recent (read (current-buffer))))
1641                    (UIDNEXT
1642                     (list 'uidnext (read (current-buffer))))
1643                    (UIDVALIDITY
1644                     (and (looking-at " \\([0-9]+\\)")
1645                          (prog1 (list 'uidvalidity (match-string 1))
1646                            (goto-char (match-end 1)))))
1647                    (UNSEEN
1648                     (list 'unseen (read (current-buffer))))
1649                    (t
1650                     (message
1651                      "Unknown status data %s in mailbox %s ignored"
1652                      token mailbox))))
1653                status))
1654         (skip-chars-forward " ")))
1655     (and elmo-imap4-status-callback
1656          (funcall elmo-imap4-status-callback
1657                   status
1658                   elmo-imap4-status-callback-data))
1659     (list 'status status)))
1660
1661
1662 (defmacro elmo-imap4-value (value)
1663   `(if (eq ,value 'NIL)
1664        nil
1665      ,value))
1666
1667 (defmacro elmo-imap4-nth (pos list)
1668   `(let ((value (nth ,pos ,list)))
1669      (elmo-imap4-value value)))
1670
1671 (defun elmo-imap4-parse-namespace ()
1672   (list 'namespace
1673         (nconc
1674          (copy-sequence elmo-imap4-extra-namespace-alist)
1675          (elmo-imap4-parse-namespace-subr
1676           (read (concat "(" (buffer-substring
1677                              (point) (point-max))
1678                         ")"))))))
1679
1680 (defun elmo-imap4-parse-namespace-subr (ns)
1681   (let (prefix delim namespace-alist default-delim)
1682     ;; 0: personal, 1: other, 2: shared
1683     (dotimes (i 3)
1684       (setq namespace-alist
1685             (nconc namespace-alist
1686                    (delq nil
1687                          (mapcar
1688                           (lambda (namespace)
1689                             (setq prefix (elmo-imap4-nth 0 namespace)
1690                                   delim (elmo-imap4-nth 1 namespace))
1691                             (if (and prefix delim
1692                                      (string-match
1693                                       (concat (regexp-quote delim) "\\'")
1694                                       prefix))
1695                                 (setq prefix (substring prefix 0
1696                                                         (match-beginning 0))))
1697                             (if (eq (length prefix) 0)
1698                                 (progn (setq default-delim delim) nil)
1699                               (cons
1700                                (concat "^\\("
1701                                        (if (string= (downcase prefix) "inbox")
1702                                            "[Ii][Nn][Bb][Oo][Xx]"
1703                                          (regexp-quote prefix))
1704                                        "\\).*$")
1705                                delim)))
1706                           (elmo-imap4-nth i ns))))))
1707     (if default-delim
1708         (setq namespace-alist
1709               (nconc namespace-alist
1710                      (list (cons "^.*$" default-delim)))))
1711     namespace-alist))
1712
1713 (defun elmo-imap4-parse-acl ()
1714   (let ((mailbox (elmo-imap4-parse-mailbox))
1715         identifier rights acl)
1716     (while (eq (char-after (point)) (string-to-char " "))
1717       (elmo-imap4-forward)
1718       (setq identifier (elmo-imap4-parse-astring))
1719       (elmo-imap4-forward)
1720       (setq rights (elmo-imap4-parse-astring))
1721       (setq acl (append acl (list (cons identifier rights)))))
1722     (list 'acl acl mailbox)))
1723
1724 (defun elmo-imap4-parse-flag-list ()
1725   (let ((str (buffer-substring (+ (point) 1)
1726                                (progn (search-forward ")" nil t)
1727                                       (- (point) 1)))))
1728     (unless (eq (length str) 0)
1729       (split-string str))))
1730
1731 (defun elmo-imap4-parse-envelope ()
1732   (when (eq (char-after (point)) ?\()
1733     (elmo-imap4-forward)
1734     (vector (prog1 (elmo-imap4-parse-nstring);; date
1735               (elmo-imap4-forward))
1736             (prog1 (elmo-imap4-parse-nstring);; subject
1737               (elmo-imap4-forward))
1738             (prog1 (elmo-imap4-parse-address-list);; from
1739               (elmo-imap4-forward))
1740             (prog1 (elmo-imap4-parse-address-list);; sender
1741               (elmo-imap4-forward))
1742             (prog1 (elmo-imap4-parse-address-list);; reply-to
1743               (elmo-imap4-forward))
1744             (prog1 (elmo-imap4-parse-address-list);; to
1745               (elmo-imap4-forward))
1746             (prog1 (elmo-imap4-parse-address-list);; cc
1747               (elmo-imap4-forward))
1748             (prog1 (elmo-imap4-parse-address-list);; bcc
1749               (elmo-imap4-forward))
1750             (prog1 (elmo-imap4-parse-nstring);; in-reply-to
1751               (elmo-imap4-forward))
1752             (prog1 (elmo-imap4-parse-nstring);; message-id
1753               (elmo-imap4-forward)))))
1754
1755 (defsubst elmo-imap4-parse-string-list ()
1756   (cond ((eq (char-after (point)) ?\();; body-fld-param
1757          (let (strlist str)
1758            (elmo-imap4-forward)
1759            (while (setq str (elmo-imap4-parse-string))
1760              (push str strlist)
1761              (elmo-imap4-forward))
1762            (nreverse strlist)))
1763         ((elmo-imap4-parse-nil)
1764          nil)))
1765
1766 (defun elmo-imap4-parse-body-extension ()
1767   (if (eq (char-after (point)) ?\()
1768       (let (b-e)
1769         (elmo-imap4-forward)
1770         (push (elmo-imap4-parse-body-extension) b-e)
1771         (while (eq (char-after (point)) (string-to-char " "))
1772           (elmo-imap4-forward)
1773           (push (elmo-imap4-parse-body-extension) b-e))
1774         (assert (eq (char-after (point)) ?\)))
1775         (elmo-imap4-forward)
1776         (nreverse b-e))
1777     (or (elmo-imap4-parse-number)
1778         (elmo-imap4-parse-nstring))))
1779
1780 (defsubst elmo-imap4-parse-body-ext ()
1781   (let (ext)
1782     (when (eq (char-after (point)) (string-to-char " ")) ; body-fld-dsp
1783       (elmo-imap4-forward)
1784       (let (dsp)
1785         (if (eq (char-after (point)) ?\()
1786             (progn
1787               (elmo-imap4-forward)
1788               (push (elmo-imap4-parse-string) dsp)
1789               (elmo-imap4-forward)
1790               (push (elmo-imap4-parse-string-list) dsp)
1791               (elmo-imap4-forward))
1792           (assert (elmo-imap4-parse-nil)))
1793         (push (nreverse dsp) ext))
1794       (when (eq (char-after (point)) (string-to-char " ")) ; body-fld-lang
1795         (elmo-imap4-forward)
1796         (if (eq (char-after (point)) ?\()
1797             (push (elmo-imap4-parse-string-list) ext)
1798           (push (elmo-imap4-parse-nstring) ext))
1799         (while (eq (char-after (point)) (string-to-char " "));; body-extension
1800           (elmo-imap4-forward)
1801           (setq ext (append (elmo-imap4-parse-body-extension) ext)))))
1802     ext))
1803
1804 (defun elmo-imap4-parse-body ()
1805   (let (body)
1806     (when (eq (char-after (point)) ?\()
1807       (elmo-imap4-forward)
1808       (if (eq (char-after (point)) ?\()
1809           (let (subbody)
1810             (while (and (eq (char-after (point)) ?\()
1811                         (setq subbody (elmo-imap4-parse-body)))
1812               (push subbody body))
1813             (elmo-imap4-forward)
1814             (push (elmo-imap4-parse-string) body);; media-subtype
1815             (when (eq (char-after (point)) (string-to-char " ")) ; body-ext-mpart:
1816               (elmo-imap4-forward)
1817               (if (eq (char-after (point)) ?\();; body-fld-param
1818                   (push (elmo-imap4-parse-string-list) body)
1819                 (push (and (elmo-imap4-parse-nil) nil) body))
1820               (setq body
1821                     (append (elmo-imap4-parse-body-ext) body)));; body-ext-...
1822             (assert (eq (char-after (point)) ?\)))
1823             (elmo-imap4-forward)
1824             (nreverse body))
1825
1826         (push (elmo-imap4-parse-string) body);; media-type
1827         (elmo-imap4-forward)
1828         (push (elmo-imap4-parse-string) body);; media-subtype
1829         (elmo-imap4-forward)
1830         ;; next line for Sun SIMS bug
1831         (and (eq (char-after (point)) (string-to-char " "))
1832              (elmo-imap4-forward))
1833         (if (eq (char-after (point)) ?\();; body-fld-param
1834             (push (elmo-imap4-parse-string-list) body)
1835           (push (and (elmo-imap4-parse-nil) nil) body))
1836         (elmo-imap4-forward)
1837         (push (elmo-imap4-parse-nstring) body);; body-fld-id
1838         (elmo-imap4-forward)
1839         (push (elmo-imap4-parse-nstring) body);; body-fld-desc
1840         (elmo-imap4-forward)
1841         (push (elmo-imap4-parse-string) body);; body-fld-enc
1842         (elmo-imap4-forward)
1843         (push (elmo-imap4-parse-number) body);; body-fld-octets
1844
1845         ;; ok, we're done parsing the required parts, what comes now is one
1846         ;; of three things:
1847         ;;
1848         ;; envelope       (then we're parsing body-type-msg)
1849         ;; body-fld-lines (then we're parsing body-type-text)
1850         ;; body-ext-1part (then we're parsing body-type-basic)
1851         ;;
1852         ;; the problem is that the two first are in turn optionally followed
1853         ;; by the third.  So we parse the first two here (if there are any)...
1854
1855         (when (eq (char-after (point)) (string-to-char " "))
1856           (elmo-imap4-forward)
1857           (let (lines)
1858             (cond ((eq (char-after (point)) ?\();; body-type-msg:
1859                    (push (elmo-imap4-parse-envelope) body);; envelope
1860                    (elmo-imap4-forward)
1861                    (push (elmo-imap4-parse-body) body);; body
1862                    (elmo-imap4-forward)
1863                    (push (elmo-imap4-parse-number) body));; body-fld-lines
1864                   ((setq lines (elmo-imap4-parse-number));; body-type-text:
1865                    (push lines body));; body-fld-lines
1866                   (t
1867                    (backward-char)))));; no match...
1868
1869         ;; ...and then parse the third one here...
1870
1871         (when (eq (char-after (point)) (string-to-char " ")) ; body-ext-1part:
1872           (elmo-imap4-forward)
1873           (push (elmo-imap4-parse-nstring) body);; body-fld-md5
1874           (setq body
1875                 (append (elmo-imap4-parse-body-ext) body)));; body-ext-1part..
1876
1877         (assert (eq (char-after (point)) ?\)))
1878         (elmo-imap4-forward)
1879         (nreverse body)))))
1880
1881 (luna-define-method elmo-folder-initialize ((folder elmo-imap4-folder) name)
1882   (let ((default-user   elmo-imap4-default-user)
1883         (default-server elmo-imap4-default-server)
1884         (default-port   elmo-imap4-default-port)
1885         (elmo-network-stream-type-alist
1886          (if elmo-imap4-stream-type-alist
1887              (append elmo-imap4-stream-type-alist
1888                      elmo-network-stream-type-alist)
1889            elmo-network-stream-type-alist))
1890         tokens)
1891     (when (string-match "\\(.*\\)@\\(.*\\)" default-server)
1892       ;; case: imap4-default-server is specified like
1893       ;; "hoge%imap.server@gateway".
1894       (setq default-user (elmo-match-string 1 default-server))
1895       (setq default-server (elmo-match-string 2 default-server)))
1896     (setq tokens (car (elmo-parse-separated-tokens
1897                        name
1898                        elmo-imap4-folder-name-syntax)))
1899     ;; mailbox
1900     (elmo-imap4-folder-set-mailbox-internal folder
1901                                             (elmo-imap4-encode-folder-string
1902                                              (cdr (assq 'mailbox tokens))))
1903     ;; user
1904     (elmo-net-folder-set-user-internal folder
1905                                        (or (cdr (assq 'user tokens))
1906                                            default-user))
1907     ;; auth
1908     (elmo-net-folder-set-auth-internal
1909      folder
1910      (let ((auth (cdr (assq 'auth tokens))))
1911        (or (and auth (intern auth))
1912            elmo-imap4-default-authenticate-type
1913            'clear)))
1914     ;; network
1915     (elmo-net-folder-set-parameters
1916      folder
1917      tokens
1918      (list :server      default-server
1919            :port        default-port
1920            :stream-type
1921            (elmo-get-network-stream-type elmo-imap4-default-stream-type)))
1922     folder))
1923
1924 ;;; ELMO IMAP4 folder
1925 (luna-define-method elmo-folder-expand-msgdb-path ((folder
1926                                                     elmo-imap4-folder))
1927   (convert-standard-filename
1928    (let ((mailbox (elmo-imap4-folder-mailbox-internal folder)))
1929      (if (string= "inbox" (downcase mailbox))
1930          (setq mailbox "inbox"))
1931      (if (eq (string-to-char mailbox) ?/)
1932          (setq mailbox (substring mailbox 1 (length mailbox))))
1933      ;; don't use expand-file-name (e.g. %~/something)
1934      (concat
1935       (expand-file-name
1936        (or (elmo-net-folder-user-internal folder) "nobody")
1937        (expand-file-name (or (elmo-net-folder-server-internal folder)
1938                              "nowhere")
1939                          (expand-file-name
1940                           "imap"
1941                           elmo-msgdb-directory)))
1942       "/" mailbox))))
1943
1944 (luna-define-method elmo-folder-status-plugged ((folder
1945                                                  elmo-imap4-folder))
1946   (elmo-imap4-folder-status-plugged folder))
1947
1948 (defun elmo-imap4-folder-status-plugged (folder)
1949   (let ((session (elmo-imap4-get-session folder))
1950         (killed (elmo-msgdb-killed-list-load
1951                  (elmo-folder-msgdb-path folder)))
1952         status)
1953     (with-current-buffer (elmo-network-session-buffer session)
1954       (setq elmo-imap4-status-callback nil)
1955       (setq elmo-imap4-status-callback-data nil))
1956     (setq status (elmo-imap4-response-value
1957                   (elmo-imap4-send-command-wait
1958                    session
1959                    (list "status "
1960                          (elmo-imap4-mailbox
1961                           (elmo-imap4-folder-mailbox-internal folder))
1962                          " (uidnext messages)"))
1963                   'status))
1964     (cons
1965      (- (elmo-imap4-response-value status 'uidnext) 1)
1966      (if killed
1967          (-
1968           (elmo-imap4-response-value status 'messages)
1969           (elmo-msgdb-killed-list-length killed))
1970        (elmo-imap4-response-value status 'messages)))))
1971
1972 (defun elmo-imap4-folder-list-range (folder min max)
1973   (elmo-imap4-list
1974    folder
1975    (concat
1976     (let ((killed
1977           (elmo-folder-killed-list-internal
1978            folder)))
1979       (if (and killed
1980               (eq (length killed) 1)
1981               (consp (car killed))
1982               (eq (car (car killed)) 1))
1983 ;; What about elmo-imap4-use-uid?
1984          (format "uid %d:%s" (cdr (car killed)) max)
1985        (format "uid %s:%s" min max)))
1986     " undeleted")))
1987
1988 (luna-define-method elmo-folder-list-messages-plugged ((folder
1989                                                         elmo-imap4-folder)
1990                                                        &optional
1991                                                        enable-killed)
1992
1993   (let* ((old (elmo-msgdb-list-messages (elmo-folder-msgdb folder)))
1994          (new (elmo-imap4-folder-list-range folder
1995                (1+ (or (elmo-folder-get-info-max folder) 0)) "*"))
1996          (united-old-new (elmo-union old new)))
1997     (if (= (length united-old-new) (or (elmo-folder-get-info-length folder) 0))
1998         united-old-new
1999       (elmo-union new
2000                   (elmo-imap4-folder-list-range
2001                    folder
2002                    1 (1+ (or (elmo-folder-get-info-max folder) 0)))))))
2003
2004 (luna-define-method elmo-folder-list-flagged-plugged
2005   ((folder elmo-imap4-folder) flag)
2006   (elmo-imap4-folder-list-flagged folder flag))
2007
2008 (luna-define-method elmo-folder-use-flag-p ((folder elmo-imap4-folder))
2009   (not (string-match elmo-imap4-disuse-server-flag-mailbox-regexp
2010                      (elmo-imap4-folder-mailbox-internal folder))))
2011
2012 (luna-define-method elmo-folder-list-subfolders ((folder elmo-imap4-folder)
2013                                                  &optional one-level)
2014   (let* ((root (elmo-imap4-folder-mailbox-internal folder))
2015          (session (elmo-imap4-get-session folder))
2016          (prefix (elmo-folder-prefix-internal folder))
2017          (namespace-assoc
2018                   (elmo-string-matched-assoc
2019                    root
2020                    (with-current-buffer (elmo-network-session-buffer session)
2021                      elmo-imap4-server-namespace)))
2022          (delim (or (cdr namespace-assoc)
2023                  elmo-imap4-default-hierarchy-delimiter))
2024          ;; Append delimiter when root with namespace.
2025          (root-nodelim root)
2026          (root (if (and namespace-assoc
2027                         (match-end 1)
2028                         (string= (substring root (match-end 1))
2029                                  ""))
2030                    (concat root delim)
2031                  root))
2032          result append-serv type)
2033     (setq result (elmo-imap4-response-get-selectable-mailbox-list
2034                   (elmo-imap4-send-command-wait
2035                    session
2036                    (list "list " (elmo-imap4-mailbox root) " *"))))
2037     ;; The response of Courier-imap doesn't contain a specified folder itself.
2038     (unless (member root result)
2039       (setq result
2040             (append result
2041                     (elmo-imap4-response-get-selectable-mailbox-list
2042                      (elmo-imap4-send-command-wait
2043                       session
2044                       (list "list \"\" " (elmo-imap4-mailbox
2045                                           root-nodelim)))))))
2046     (when (or (not (string= (elmo-net-folder-user-internal folder)
2047                             elmo-imap4-default-user))
2048               (not (eq (elmo-net-folder-auth-internal folder)
2049                        (or elmo-imap4-default-authenticate-type 'clear))))
2050       (setq append-serv (concat ":"
2051                                 (elmo-quote-syntactical-element
2052                                  (elmo-net-folder-user-internal folder)
2053                                  'user elmo-imap4-folder-name-syntax))))
2054     (unless (eq (elmo-net-folder-auth-internal folder)
2055                 (or elmo-imap4-default-authenticate-type 'clear))
2056       (setq append-serv
2057             (concat append-serv "/"
2058                     (symbol-name (elmo-net-folder-auth-internal folder)))))
2059     (unless (string= (elmo-net-folder-server-internal folder)
2060                      elmo-imap4-default-server)
2061       (setq append-serv (concat append-serv "@"
2062                                 (elmo-net-folder-server-internal folder))))
2063     (unless (eq (elmo-net-folder-port-internal folder) elmo-imap4-default-port)
2064       (setq append-serv (concat append-serv ":"
2065                                 (number-to-string
2066                                  (elmo-net-folder-port-internal folder)))))
2067     (setq type (elmo-net-folder-stream-type-internal folder))
2068     (unless (eq (elmo-network-stream-type-symbol type)
2069                 elmo-imap4-default-stream-type)
2070       (if type
2071           (setq append-serv (concat append-serv
2072                                     (elmo-network-stream-type-spec-string
2073                                      type)))))
2074     (if one-level
2075         (let ((re-delim (regexp-quote delim))
2076               (case-fold-search nil)
2077               folder ret has-child-p)
2078           ;; Append delimiter
2079           (when (and root
2080                      (not (string= root ""))
2081                      (not (string-match
2082                            (concat "\\(.*\\)" re-delim "\\'")
2083                            root)))
2084             (setq root (concat root delim)))
2085           (while (setq folder (car result))
2086             (setq has-child-p
2087                   (when (string-match
2088                          (concat "^\\(" (regexp-quote root) "[^" re-delim "]" "+\\)"
2089                                  re-delim)
2090                          folder)
2091                     (setq folder (match-string 1 folder))))
2092             (setq result (delq
2093                           nil
2094                           (mapcar (lambda (fld)
2095                                     (if (string-match
2096                                          (concat "^" (regexp-quote folder)
2097                                                  "\\(" re-delim "\\|\\'\\)")
2098                                          fld)
2099                                         (progn (setq has-child-p t) nil)
2100                                       fld))
2101                                   (cdr result)))
2102                   folder (concat prefix
2103                                  (elmo-quote-syntactical-element
2104                                   (elmo-imap4-decode-folder-string folder)
2105                                   'mailbox elmo-imap4-folder-name-syntax)
2106                                  (and append-serv
2107                                       (eval append-serv)))
2108                   ret (append ret (if has-child-p
2109                                       (list (list folder))
2110                                     (list folder)))))
2111           ret)
2112       (mapcar (lambda (fld)
2113                 (concat prefix
2114                         (elmo-quote-syntactical-element
2115                          (elmo-imap4-decode-folder-string fld)
2116                          'mailbox elmo-imap4-folder-name-syntax)
2117                         (and append-serv
2118                              (eval append-serv))))
2119               result))))
2120
2121 (luna-define-method elmo-folder-exists-p-plugged ((folder elmo-imap4-folder))
2122   (let ((session (elmo-imap4-get-session folder)))
2123     (if (string=
2124          (elmo-imap4-session-current-mailbox-internal session)
2125          (elmo-imap4-folder-mailbox-internal folder))
2126         t
2127       (elmo-imap4-session-select-mailbox
2128        session
2129        (elmo-imap4-folder-mailbox-internal folder)
2130        'force 'notify-bye))))
2131
2132 (luna-define-method elmo-folder-creatable-p ((folder elmo-imap4-folder))
2133   t)
2134
2135 (luna-define-method elmo-folder-writable-p ((folder elmo-imap4-folder))
2136   t)
2137
2138 (luna-define-method elmo-folder-delete ((folder elmo-imap4-folder))
2139   (let* ((exists (elmo-folder-exists-p folder))
2140          (msgs (and exists
2141                     (elmo-folder-list-messages folder))))
2142     (when (yes-or-no-p (format "%sDelete msgdb and substance of \"%s\"? "
2143                                (if (> (length msgs) 0)
2144                                    (format "%d msg(s) exists. " (length msgs))
2145                                  "")
2146                                (elmo-folder-name-internal folder)))
2147       (let ((session (elmo-imap4-get-session folder)))
2148         (when (elmo-imap4-folder-mailbox-internal folder)
2149           (when msgs (elmo-folder-delete-messages-internal folder msgs))
2150           ;; close selected mailbox except one with \Noselect attribute
2151           (when exists
2152             (elmo-imap4-send-command-wait session "close"))
2153           (elmo-imap4-send-command-wait
2154            session
2155            (list "delete "
2156                  (elmo-imap4-mailbox
2157                   (elmo-imap4-folder-mailbox-internal folder)))))
2158         (elmo-imap4-session-set-current-mailbox-internal session nil))
2159       (elmo-msgdb-delete-path folder)
2160       t)))
2161
2162 (luna-define-method elmo-folder-rename-internal ((folder elmo-imap4-folder)
2163                                                  new-folder)
2164   (let ((session (elmo-imap4-get-session folder)))
2165     ;; make sure the folder is selected.
2166     (elmo-imap4-session-select-mailbox session
2167                                        (elmo-imap4-folder-mailbox-internal
2168                                         folder))
2169     (elmo-imap4-send-command-wait session "close")
2170     (elmo-imap4-send-command-wait
2171      session
2172      (list "rename "
2173            (elmo-imap4-mailbox
2174             (elmo-imap4-folder-mailbox-internal folder))
2175            " "
2176            (elmo-imap4-mailbox
2177             (elmo-imap4-folder-mailbox-internal new-folder))))
2178     (elmo-imap4-session-set-current-mailbox-internal
2179      session (elmo-imap4-folder-mailbox-internal new-folder))))
2180
2181 (defun elmo-imap4-copy-messages (src-folder dst-folder numbers)
2182   (let ((session (elmo-imap4-get-session src-folder))
2183         (set-list (elmo-imap4-make-number-set-list
2184                    numbers
2185                    elmo-imap4-number-set-chop-length))
2186         succeeds)
2187     (elmo-imap4-session-select-mailbox session
2188                                        (elmo-imap4-folder-mailbox-internal
2189                                         src-folder))
2190     (while set-list
2191       (if (elmo-imap4-send-command-wait session
2192                                         (list
2193                                          (format
2194                                           (if elmo-imap4-use-uid
2195                                               "uid copy %s "
2196                                             "copy %s ")
2197                                           (cdr (car set-list)))
2198                                          (elmo-imap4-mailbox
2199                                           (elmo-imap4-folder-mailbox-internal
2200                                            dst-folder))))
2201           (setq succeeds (append succeeds numbers)))
2202       (setq set-list (cdr set-list)))
2203     succeeds))
2204
2205 (defun elmo-imap4-set-flag (folder numbers flag &optional remove)
2206   "Set flag on messages.
2207 FOLDER is the ELMO folder structure.
2208 NUMBERS is the message numbers to be flagged.
2209 FLAG is the flag name.
2210 If optional argument REMOVE is non-nil, remove FLAG."
2211   (let ((session (elmo-imap4-get-session folder))
2212         response set-list)
2213     (elmo-imap4-session-select-mailbox session
2214                                        (elmo-imap4-folder-mailbox-internal
2215                                         folder))
2216     (when (or (elmo-string-member-ignore-case
2217                flag
2218                (elmo-imap4-session-flags-internal session))
2219               (member "\\*" (elmo-imap4-session-flags-internal session))
2220               (string= flag "\\Deleted")) ; XXX Humm..
2221       (setq set-list (elmo-imap4-make-number-set-list
2222                       numbers
2223                       elmo-imap4-number-set-chop-length))
2224       (while set-list
2225         (with-current-buffer (elmo-network-session-buffer session)
2226           (setq elmo-imap4-fetch-callback nil)
2227           (setq elmo-imap4-fetch-callback-data nil))
2228         (unless (elmo-imap4-response-ok-p
2229                  (elmo-imap4-send-command-wait
2230                   session
2231                   (format
2232                    (if elmo-imap4-use-uid
2233                        "uid store %s %sflags.silent (%s)"
2234                      "store %s %sflags.silent (%s)")
2235                    (cdr (car set-list))
2236                    (if remove "-" "+")
2237                    flag)))
2238           (setq response 'fail))
2239         (setq set-list (cdr set-list)))
2240       (not (eq response 'fail)))))
2241
2242 (luna-define-method elmo-folder-delete-messages-plugged
2243   ((folder elmo-imap4-folder) numbers)
2244   (let ((session (elmo-imap4-get-session folder))
2245         (expunge
2246          (or (null (elmo-imap4-list folder "deleted"))
2247              (y-or-n-p
2248               "There's hidden deleted messages, expunge anyway?"))))
2249     (elmo-imap4-session-select-mailbox
2250      session
2251      (elmo-imap4-folder-mailbox-internal folder))
2252     (unless (elmo-imap4-set-flag folder numbers "\\Deleted")
2253       (error "Failed to set deleted flag"))
2254     (when expunge
2255       (elmo-imap4-send-command session "expunge"))
2256     t))
2257
2258 (defun elmo-imap4-detect-search-charset (string)
2259   (with-temp-buffer
2260     (insert string)
2261     (detect-mime-charset-region (point-min) (point-max))))
2262
2263 (defun elmo-imap4-search-internal-primitive (folder session filter from-msgs)
2264   (let ((search-key (elmo-filter-key filter))
2265         (imap-search-keys '("bcc" "body" "cc" "from" "subject" "to"
2266                             "larger" "smaller" "flag"))
2267         (total 0)
2268         (length (length from-msgs))
2269         charset set-list end results)
2270     (cond
2271      ((string= "last" search-key)
2272       (let ((numbers (or from-msgs (elmo-folder-list-messages folder))))
2273         (nthcdr (max (- (length numbers)
2274                         (string-to-number (elmo-filter-value filter)))
2275                      0)
2276                 numbers)))
2277      ((string= "first" search-key)
2278       (let* ((numbers (or from-msgs (elmo-folder-list-messages folder)))
2279              (rest (nthcdr (string-to-number (elmo-filter-value filter) )
2280                            numbers)))
2281         (mapc (lambda (x) (delete x numbers)) rest)
2282         numbers))
2283      ((string= "flag" search-key)
2284       (elmo-imap4-folder-list-flagged
2285        folder (intern (elmo-filter-value filter))))
2286      ((or (string= "since" search-key)
2287           (string= "before" search-key))
2288       (setq search-key (concat "sent" search-key)
2289             set-list (elmo-imap4-make-number-set-list
2290                       from-msgs
2291                       elmo-imap4-number-set-chop-length)
2292             end nil)
2293       (while (not end)
2294         (setq results
2295               (append
2296                results
2297                (elmo-imap4-response-value
2298                 (elmo-imap4-send-command-wait
2299                  session
2300                  (format
2301                   (if elmo-imap4-use-uid
2302                       "uid search %s%s%s %s"
2303                     "search %s%s%s %s")
2304                   (if from-msgs
2305                       (concat
2306                        (if elmo-imap4-use-uid "uid ")
2307                        (cdr (car set-list))
2308                        " ")
2309                     "")
2310                   (if (eq (elmo-filter-type filter)
2311                           'unmatch)
2312                       "not " "")
2313                   search-key
2314                   (elmo-date-get-description
2315                    (elmo-date-get-datevec
2316                     (elmo-filter-value filter)))))
2317                 'search)))
2318         (setq set-list (cdr set-list)
2319               end (null set-list)))
2320       results)
2321      (t
2322       (setq charset
2323             (if (eq (length (elmo-filter-value filter)) 0)
2324                 (setq charset 'us-ascii)
2325               (elmo-imap4-detect-search-charset
2326                (elmo-filter-value filter)))
2327             set-list (elmo-imap4-make-number-set-list
2328                       from-msgs
2329                       elmo-imap4-number-set-chop-length)
2330             end nil)
2331       (while (not end)
2332         (setq results
2333               (append
2334                results
2335                (elmo-imap4-response-value
2336                 (elmo-imap4-send-command-wait
2337                  session
2338                  (list
2339                   (if elmo-imap4-use-uid "uid ")
2340                   "search "
2341                   "CHARSET "
2342                   (elmo-imap4-astring
2343                    (symbol-name charset))
2344                   " "
2345                   (if from-msgs
2346                       (concat
2347                        (if elmo-imap4-use-uid "uid ")
2348                        (cdr (car set-list))
2349                        " ")
2350                     "")
2351                   (if (eq (elmo-filter-type filter)
2352                           'unmatch)
2353                       "not " "")
2354                   (format "%s%s "
2355                           (if (member
2356                                (elmo-filter-key filter)
2357                                imap-search-keys)
2358                               ""
2359                             "header ")
2360                           (elmo-filter-key filter))
2361                   (elmo-imap4-astring
2362                    (encode-mime-charset-string
2363                     (elmo-filter-value filter) charset))))
2364                 'search)))
2365         (setq set-list (cdr set-list)
2366               end (null set-list)))
2367       results))))
2368
2369 (defun elmo-imap4-search-internal (folder session condition from-msgs)
2370   (let (result)
2371     (cond
2372      ((vectorp condition)
2373       (setq result (elmo-imap4-search-internal-primitive
2374                     folder session condition from-msgs)))
2375      ((eq (car condition) 'and)
2376       (setq result (elmo-imap4-search-internal folder session (nth 1 condition)
2377                                                from-msgs)
2378             result (elmo-list-filter result
2379                                      (elmo-imap4-search-internal
2380                                       folder session (nth 2 condition)
2381                                       from-msgs))))
2382      ((eq (car condition) 'or)
2383       (setq result (elmo-imap4-search-internal
2384                     folder session (nth 1 condition) from-msgs)
2385             result (elmo-uniq-list
2386                     (nconc result
2387                            (elmo-imap4-search-internal
2388                             folder session (nth 2 condition) from-msgs)))
2389             result (sort result '<))))))
2390
2391 (luna-define-method elmo-folder-search :around ((folder elmo-imap4-folder)
2392                                                 condition &optional numbers)
2393   (if (elmo-folder-plugged-p folder)
2394       (save-excursion
2395         (let ((session (elmo-imap4-get-session folder))
2396               ret)
2397           (message "Searching...")
2398           (elmo-imap4-session-select-mailbox
2399            session
2400            (elmo-imap4-folder-mailbox-internal folder))
2401           (setq ret (elmo-imap4-search-internal folder session condition numbers))
2402           (message "Searching...done")
2403           ret))
2404     (luna-call-next-method)))
2405
2406 (luna-define-method elmo-folder-msgdb-create-plugged
2407   ((folder elmo-imap4-folder) numbers flag-table)
2408   (when numbers
2409     (let ((session (elmo-imap4-get-session folder))
2410           (headers
2411            (elmo-uniq-list
2412             (append
2413              '("Subject" "From" "To" "Cc" "Date"
2414                "Message-Id" "References" "In-Reply-To")
2415              (mapcar #'capitalize (elmo-msgdb-extra-fields 'non-virtual)))))
2416           (total 0)
2417           print-length print-depth
2418           rfc2060 set-list)
2419       (setq rfc2060 (elmo-imap4-session-capable-p session 'imap4rev1))
2420       (elmo-with-progress-display (elmo-folder-msgdb-create (length numbers))
2421           "Creating msgdb"
2422         (elmo-imap4-session-select-mailbox
2423          session (elmo-imap4-folder-mailbox-internal folder))
2424         (setq set-list (elmo-imap4-make-number-set-list
2425                         numbers
2426                         elmo-imap4-overview-fetch-chop-length))
2427         ;; Setup callback.
2428         (with-current-buffer (elmo-network-session-buffer session)
2429           (setq elmo-imap4-current-msgdb (elmo-make-msgdb)
2430                 elmo-imap4-seen-messages nil
2431                 elmo-imap4-fetch-callback 'elmo-imap4-fetch-callback-1
2432                 elmo-imap4-fetch-callback-data (cons flag-table folder))
2433           (while set-list
2434             (elmo-imap4-send-command-wait
2435              session
2436              ;; get overview entity from IMAP4
2437              (format "%sfetch %s (%s rfc822.size flags)"
2438                      (if elmo-imap4-use-uid "uid " "")
2439                      (cdr (car set-list))
2440                      (if rfc2060
2441                          (format "body.peek[header.fields %s]" headers)
2442                        (format "%s" headers))))
2443             (setq set-list (cdr set-list)))
2444           (when elmo-imap4-seen-messages
2445             (elmo-imap4-set-flag folder elmo-imap4-seen-messages "\\Seen"))
2446           ;; cannot setup the global flag while retrieval.
2447           (dolist (number (elmo-msgdb-list-messages elmo-imap4-current-msgdb))
2448             (elmo-global-flags-set (elmo-msgdb-flags elmo-imap4-current-msgdb
2449                                                      number)
2450                                    folder number
2451                                    (elmo-message-entity-field
2452                                     (elmo-msgdb-message-entity
2453                                      elmo-imap4-current-msgdb number)
2454                                     'message-id)))
2455           elmo-imap4-current-msgdb)))))
2456
2457 (luna-define-method elmo-folder-set-flag-plugged ((folder elmo-imap4-folder)
2458                                                   numbers flag)
2459   (let ((spec (cdr (assq flag elmo-imap4-flag-specs))))
2460     (elmo-imap4-set-flag folder numbers (or (car spec)
2461                                             (capitalize (symbol-name flag)))
2462                          (nth 1 spec))))
2463
2464 (luna-define-method elmo-folder-unset-flag-plugged ((folder elmo-imap4-folder)
2465                                                     numbers flag)
2466   (let ((spec (cdr (assq flag elmo-imap4-flag-specs))))
2467     (elmo-imap4-set-flag folder numbers (or (car spec)
2468                                             (capitalize (symbol-name flag)))
2469                          (not (nth 1 spec)))))
2470
2471 (luna-define-method elmo-message-use-cache-p ((folder elmo-imap4-folder)
2472                                               number)
2473   elmo-imap4-use-cache)
2474
2475 (luna-define-method elmo-folder-message-appendable-p ((folder elmo-imap4-folder))
2476   (if (elmo-folder-plugged-p folder)
2477       (not (elmo-imap4-session-read-only-internal
2478             (elmo-imap4-get-session folder)))
2479     elmo-enable-disconnected-operation)) ; offline refile.
2480
2481 (luna-define-method elmo-folder-check-plugged ((folder elmo-imap4-folder))
2482   (let ((session (elmo-imap4-get-session folder 'if-exists)))
2483     (when session
2484       (if (string=
2485            (elmo-imap4-session-current-mailbox-internal session)
2486            (elmo-imap4-folder-mailbox-internal folder))
2487           (if elmo-imap4-use-select-to-update-status
2488               (elmo-imap4-session-select-mailbox
2489                session
2490                (elmo-imap4-folder-mailbox-internal folder)
2491                'force)
2492             (elmo-imap4-session-check session))))))
2493
2494 (defsubst elmo-imap4-folder-diff-plugged (folder)
2495   (let ((session (elmo-imap4-get-session folder))
2496         messages new unread response killed uidnext)
2497 ;;;    (elmo-imap4-commit spec)
2498     (with-current-buffer (elmo-network-session-buffer session)
2499       (setq elmo-imap4-status-callback nil)
2500       (setq elmo-imap4-status-callback-data nil))
2501     (if elmo-imap4-use-select-to-update-status
2502         (elmo-imap4-session-select-mailbox
2503          session
2504          (elmo-imap4-folder-mailbox-internal folder)))
2505     (setq response
2506           (elmo-imap4-send-command-wait session
2507                                         (list
2508                                          "status "
2509                                          (elmo-imap4-mailbox
2510                                           (elmo-imap4-folder-mailbox-internal
2511                                            folder))
2512                                          " (recent unseen messages uidnext)")))
2513     (setq response (elmo-imap4-response-value response 'status))
2514     (setq messages (elmo-imap4-response-value response 'messages))
2515     (setq uidnext (elmo-imap4-response-value response 'uidnext))
2516     (setq killed (elmo-msgdb-killed-list-load (elmo-folder-msgdb-path folder)))
2517     ;;
2518     (when killed
2519       (when (and (consp (car killed))
2520                  (eq (car (car killed)) 1))
2521         (setq messages (- uidnext (cdr (car killed)) 1)))
2522       (setq messages (- messages
2523                         (elmo-msgdb-killed-list-length (cdr killed)))))
2524     (setq new (elmo-imap4-response-value response 'recent)
2525           unread (elmo-imap4-response-value response 'unseen))
2526     (if (< unread new) (setq new unread))
2527     (list new unread messages)))
2528
2529 (luna-define-method elmo-folder-diff-plugged ((folder elmo-imap4-folder))
2530   (elmo-imap4-folder-diff-plugged folder))
2531
2532 (luna-define-method elmo-folder-diff-async ((folder elmo-imap4-folder))
2533   (setq elmo-imap4-server-diff-async-callback
2534         elmo-folder-diff-async-callback)
2535   (setq elmo-imap4-server-diff-async-callback-data
2536         elmo-folder-diff-async-callback-data)
2537   (elmo-imap4-server-diff-async folder))
2538
2539 (luna-define-method elmo-folder-open :around ((folder elmo-imap4-folder)
2540                                               &optional load-msgdb)
2541   (if (elmo-folder-plugged-p folder)
2542       (let (session mailbox msgdb result response tag)
2543         (condition-case err
2544             (progn
2545               (setq session (elmo-imap4-get-session folder)
2546                     mailbox (elmo-imap4-folder-mailbox-internal folder)
2547                     tag (elmo-imap4-send-command session
2548                                                  (list "select "
2549                                                        (elmo-imap4-mailbox
2550                                                         mailbox))))
2551               (message "Selecting %s..."
2552                        (elmo-folder-name-internal folder))
2553               (if load-msgdb
2554                   (setq msgdb (elmo-folder-msgdb-load folder 'silent)))
2555               (elmo-folder-set-killed-list-internal
2556                folder
2557                (elmo-msgdb-killed-list-load (elmo-folder-msgdb-path folder)))
2558               (if (setq result (elmo-imap4-response-ok-p
2559                                 (setq response
2560                                       (elmo-imap4-read-response session tag))))
2561                   (progn
2562                     (let ((exists (assq 'exists response))) ; update message count,
2563                       (when exists                          ; so merge update can go
2564                         (elmo-folder-set-info-hashtb folder nil (cadr exists))))
2565                     (elmo-imap4-session-set-current-mailbox-internal
2566                      session mailbox)
2567                     (elmo-imap4-session-set-read-only-internal
2568                      session
2569                      (nth 1 (assq 'read-only (assq 'ok response))))
2570                     (elmo-imap4-session-set-flags-internal
2571                      session
2572                      (nth 1 (or (assq 'permanentflags response)
2573                                 (assq 'flags response)))))
2574                 (elmo-imap4-session-set-current-mailbox-internal session nil)
2575                 (if (elmo-imap4-response-bye-p response)
2576                     (elmo-imap4-process-bye session)
2577                   (error "%s"
2578                          (or (elmo-imap4-response-error-text response)
2579                              (format "Select %s failed" mailbox)))))
2580               (message "Selecting %s...done"
2581                        (elmo-folder-name-internal folder))
2582               (elmo-folder-set-msgdb-internal
2583                folder msgdb))
2584           (quit
2585            (if (elmo-imap4-response-ok-p response)
2586                (elmo-imap4-session-set-current-mailbox-internal
2587                 session mailbox)
2588              (and session
2589                   (elmo-imap4-session-set-current-mailbox-internal
2590                    session nil))))
2591           (error
2592            (if (elmo-imap4-response-ok-p response)
2593                (elmo-imap4-session-set-current-mailbox-internal
2594                 session mailbox)
2595              (and session
2596                   (elmo-imap4-session-set-current-mailbox-internal
2597                    session nil))))))
2598     (luna-call-next-method)))
2599
2600 ;; elmo-folder-open-internal: do nothing.
2601
2602 (luna-define-method elmo-find-fetch-strategy ((folder elmo-imap4-folder) number
2603                                               &optional
2604                                               ignore-cache
2605                                               require-entireness)
2606   (let ((entity (elmo-message-entity folder number)))
2607     (if (null entity)
2608         (elmo-make-fetch-strategy 'entire)
2609       (let* ((size (elmo-message-entity-field entity 'size))
2610              (message-id (elmo-message-entity-field entity 'message-id))
2611              (cache-file (elmo-file-cache-get message-id))
2612              (use-cache (and (not ignore-cache)
2613                              (elmo-message-use-cache-p folder number)
2614                              (if require-entireness
2615                                  (eq (elmo-file-cache-status cache-file)
2616                                      'entire)
2617                                (elmo-file-cache-status cache-file)))))
2618         (elmo-make-fetch-strategy
2619          (if use-cache
2620              (elmo-file-cache-status cache-file)
2621            (if (and (not require-entireness)
2622                     elmo-message-fetch-threshold
2623                     (integerp size)
2624                     (>= size elmo-message-fetch-threshold)
2625                     (or (not elmo-message-fetch-confirm)
2626                         (not (prog1
2627                                  (y-or-n-p
2628                                   (format
2629                                    "Fetch entire message at once? (%dbytes)"
2630                                    size))
2631                                (message "")))))
2632                'section
2633              'entire))
2634          use-cache
2635          (elmo-message-use-cache-p folder number)
2636          (elmo-file-cache-path cache-file))))))
2637
2638 (luna-define-method elmo-folder-create-plugged ((folder elmo-imap4-folder))
2639   (elmo-imap4-send-command-wait
2640    (elmo-imap4-get-session folder)
2641    (list "create "
2642          (elmo-imap4-mailbox
2643           (elmo-imap4-folder-mailbox-internal folder)))))
2644
2645 (defun elmo-imap4-flags-to-imap (flags)
2646   "Convert FLAGS to the IMAP flag string."
2647   (let ((imap-flag (if (not (memq 'unread flags)) "\\Seen")))
2648     (dolist (flag flags)
2649       (unless (memq flag '(new read unread cached))
2650         (setq imap-flag
2651               (concat imap-flag
2652                       (if imap-flag " ")
2653                       (or (car (cdr (assq flag elmo-imap4-flag-specs)))
2654                           (capitalize (symbol-name flag)))))))
2655     imap-flag))
2656
2657 (luna-define-method elmo-folder-append-buffer
2658   ((folder elmo-imap4-folder) &optional flags number)
2659   (if (elmo-folder-plugged-p folder)
2660       (let ((session (elmo-imap4-get-session folder))
2661             send-buffer result)
2662         (elmo-imap4-session-select-mailbox session
2663                                            (elmo-imap4-folder-mailbox-internal
2664                                             folder))
2665         (setq send-buffer (elmo-imap4-setup-send-buffer))
2666         (unwind-protect
2667             (setq result
2668                   (elmo-imap4-send-command-wait
2669                    session
2670                    (list
2671                     "append "
2672                     (elmo-imap4-mailbox (elmo-imap4-folder-mailbox-internal
2673                                          folder))
2674                     (if (and flags (elmo-folder-use-flag-p folder))
2675                         (concat " (" (elmo-imap4-flags-to-imap flags) ") ")
2676                       " () ")
2677                     (elmo-imap4-buffer-literal send-buffer))))
2678           (kill-buffer send-buffer))
2679         (when result
2680           (elmo-folder-preserve-flags
2681            folder (elmo-msgdb-get-message-id-from-buffer) flags))
2682         result)
2683     ;; Unplugged
2684     (if elmo-enable-disconnected-operation
2685         (elmo-folder-append-buffer-dop folder flags number)
2686       (error "Unplugged"))))
2687
2688 (eval-when-compile
2689   (defmacro elmo-imap4-identical-system-p (folder1 folder2)
2690     "Return t if FOLDER1 and FOLDER2 are in the same IMAP4 system."
2691     `(and (string= (elmo-net-folder-server-internal ,folder1)
2692                    (elmo-net-folder-server-internal ,folder2))
2693           (eq (elmo-net-folder-port-internal ,folder1)
2694               (elmo-net-folder-port-internal ,folder2))
2695           (string= (elmo-net-folder-user-internal ,folder1)
2696                    (elmo-net-folder-user-internal ,folder2)))))
2697
2698 (luna-define-method elmo-folder-next-message-number-plugged
2699   ((folder elmo-imap4-folder))
2700   (let ((session (elmo-imap4-get-session folder))
2701         messages new unread response killed uidnext)
2702     (with-current-buffer (elmo-network-session-buffer session)
2703       (setq elmo-imap4-status-callback nil)
2704       (setq elmo-imap4-status-callback-data nil))
2705     (if elmo-imap4-use-select-to-update-status
2706         (elmo-imap4-session-select-mailbox
2707          session
2708          (elmo-imap4-folder-mailbox-internal folder)))
2709     (setq response
2710           (elmo-imap4-send-command-wait session
2711                                         (list
2712                                          "status "
2713                                          (elmo-imap4-mailbox
2714                                           (elmo-imap4-folder-mailbox-internal
2715                                            folder))
2716                                          " (uidnext)"))
2717           response (elmo-imap4-response-value response 'status))
2718     (elmo-imap4-response-value response 'uidnext)))
2719
2720 (defun elmo-folder-append-messages-imap4-imap4 (dst-folder
2721                                                 src-folder
2722                                                 numbers
2723                                                 same-number)
2724   (if (and (elmo-imap4-identical-system-p dst-folder src-folder)
2725            (elmo-folder-plugged-p dst-folder))
2726       ;; Plugged
2727       (prog1
2728           (elmo-imap4-copy-messages src-folder dst-folder numbers)
2729         (elmo-progress-notify 'elmo-folder-move-messages (length numbers)))
2730     (elmo-folder-append-messages dst-folder src-folder numbers same-number
2731                                  'elmo-folder-append-messages-imap4-imap4)))
2732
2733 (luna-define-method elmo-message-deletable-p ((folder elmo-imap4-folder)
2734                                               number)
2735   (if (elmo-folder-plugged-p folder)
2736       (not (elmo-imap4-session-read-only-internal
2737             (elmo-imap4-get-session folder)))
2738     elmo-enable-disconnected-operation)) ; offline refile.
2739
2740 ;;;(luna-define-method elmo-message-fetch-unplugged
2741 ;;;  ((folder elmo-imap4-folder)
2742 ;;;   number strategy  &optional section outbuf unseen)
2743 ;;;  (error "%d%s is not cached." number (if section
2744 ;;;                                       (format "(%s)" section)
2745 ;;;                                     "")))
2746
2747 (defsubst elmo-imap4-message-fetch (folder number strategy
2748                                            section outbuf unseen)
2749   (let ((session (elmo-imap4-get-session folder))
2750         response)
2751     (elmo-imap4-session-select-mailbox session
2752                                        (elmo-imap4-folder-mailbox-internal
2753                                         folder))
2754     (with-current-buffer (elmo-network-session-buffer session)
2755       (setq elmo-imap4-fetch-callback nil)
2756       (setq elmo-imap4-fetch-callback-data nil))
2757     (elmo-with-progress-display (elmo-retrieve-message
2758                                  (elmo-message-field folder number :size)
2759                                  elmo-imap4-literal-progress-reporter)
2760         "Retrieving"
2761       (setq response
2762             (elmo-imap4-send-command-wait session
2763                                           (format
2764                                            (if elmo-imap4-use-uid
2765                                                "uid fetch %s body%s[%s]"
2766                                              "fetch %s body%s[%s]")
2767                                            number
2768                                            (if unseen ".peek" "")
2769                                            (or section "")))))
2770     (if (setq response (elmo-imap4-response-bodydetail-text
2771                         (elmo-imap4-response-value-all
2772                          response 'fetch)))
2773         (with-current-buffer outbuf
2774           (erase-buffer)
2775           (insert response)
2776           (elmo-delete-cr-buffer)
2777           t))))
2778
2779 (luna-define-method elmo-message-fetch-plugged ((folder elmo-imap4-folder)
2780                                                 number strategy
2781                                                 &optional section
2782                                                 outbuf unseen)
2783   (elmo-imap4-message-fetch folder number strategy section outbuf unseen))
2784
2785 (luna-define-method elmo-message-fetch-field ((folder elmo-imap4-folder)
2786                                               number field)
2787   (let ((session (elmo-imap4-get-session folder)))
2788     (elmo-imap4-session-select-mailbox session
2789                                        (elmo-imap4-folder-mailbox-internal
2790                                         folder))
2791     (with-current-buffer (elmo-network-session-buffer session)
2792       (setq elmo-imap4-fetch-callback nil)
2793       (setq elmo-imap4-fetch-callback-data nil))
2794     (with-temp-buffer
2795       (insert
2796        (elmo-imap4-response-bodydetail-text
2797         (elmo-imap4-response-value
2798          (elmo-imap4-send-command-wait session
2799                                        (concat
2800                                         (if elmo-imap4-use-uid
2801                                             "uid ")
2802                                         (format
2803                                          "fetch %s (body.peek[header.fields (%s)])"
2804                                          number field)))
2805          'fetch)))
2806       (elmo-delete-cr-buffer)
2807       (goto-char (point-min))
2808       (std11-field-body (symbol-name field)))))
2809
2810 (luna-define-method elmo-folder-search-requires-msgdb-p ((folder
2811                                                           elmo-imap4-folder)
2812                                                          condition)
2813   nil)
2814
2815 (autoload 'elmo-global-flags-set "elmo-flag")
2816 (autoload 'elmo-get-global-flags "elmo-flag")
2817
2818 (require 'product)
2819 (product-provide (provide 'elmo-imap4) (require 'elmo-version))
2820
2821 ;;; elmo-imap4.el ends here