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" (format-time-string "%T") 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" (format-time-string "%T") 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" (format-time-string "%T") (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" (format-time-string "%T") (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" (format-time-string "%T") (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
1989   ((folder elmo-imap4-folder) &optional enable-killed)
1990   (let* ((old (elmo-msgdb-list-messages (elmo-folder-msgdb folder)))
1991          (new (elmo-imap4-folder-list-range
1992                folder (1+ (or (elmo-folder-get-info-max folder) 0)) "*"))
1993          (united-old-new (elmo-union old new)))
1994     (if (= (length united-old-new) (or (elmo-folder-get-info-length folder) 0))
1995         united-old-new
1996       (elmo-union new
1997                   (elmo-imap4-folder-list-range
1998                    folder
1999                    1 (1+ (or (elmo-folder-get-info-max folder) 0)))))))
2000
2001 (luna-define-method elmo-folder-list-flagged-plugged
2002   ((folder elmo-imap4-folder) flag)
2003   (elmo-imap4-folder-list-flagged folder flag))
2004
2005 (luna-define-method elmo-folder-use-flag-p ((folder elmo-imap4-folder))
2006   (not (string-match elmo-imap4-disuse-server-flag-mailbox-regexp
2007                      (elmo-imap4-folder-mailbox-internal folder))))
2008
2009 (luna-define-method elmo-folder-list-subfolders ((folder elmo-imap4-folder)
2010                                                  &optional one-level)
2011   (let* ((root (elmo-imap4-folder-mailbox-internal folder))
2012          (session (elmo-imap4-get-session folder))
2013          (prefix (elmo-folder-prefix-internal folder))
2014          (namespace-assoc
2015                   (elmo-string-matched-assoc
2016                    root
2017                    (with-current-buffer (elmo-network-session-buffer session)
2018                      elmo-imap4-server-namespace)))
2019          (delim (or (cdr namespace-assoc)
2020                  elmo-imap4-default-hierarchy-delimiter))
2021          ;; Append delimiter when root with namespace.
2022          (root-nodelim root)
2023          (root (if (and namespace-assoc
2024                         (match-end 1)
2025                         (string= (substring root (match-end 1))
2026                                  ""))
2027                    (concat root delim)
2028                  root))
2029          result append-serv type)
2030     (setq result (elmo-imap4-response-get-selectable-mailbox-list
2031                   (elmo-imap4-send-command-wait
2032                    session
2033                    (list "list " (elmo-imap4-mailbox root) " *"))))
2034     ;; The response of Courier-imap doesn't contain a specified folder itself.
2035     (unless (member root result)
2036       (setq result
2037             (append result
2038                     (elmo-imap4-response-get-selectable-mailbox-list
2039                      (elmo-imap4-send-command-wait
2040                       session
2041                       (list "list \"\" " (elmo-imap4-mailbox
2042                                           root-nodelim)))))))
2043     (when (or (not (string= (elmo-net-folder-user-internal folder)
2044                             elmo-imap4-default-user))
2045               (not (eq (elmo-net-folder-auth-internal folder)
2046                        (or elmo-imap4-default-authenticate-type 'clear))))
2047       (setq append-serv (concat ":"
2048                                 (elmo-quote-syntactical-element
2049                                  (elmo-net-folder-user-internal folder)
2050                                  'user elmo-imap4-folder-name-syntax))))
2051     (unless (eq (elmo-net-folder-auth-internal folder)
2052                 (or elmo-imap4-default-authenticate-type 'clear))
2053       (setq append-serv
2054             (concat append-serv "/"
2055                     (symbol-name (elmo-net-folder-auth-internal folder)))))
2056     (unless (string= (elmo-net-folder-server-internal folder)
2057                      elmo-imap4-default-server)
2058       (setq append-serv (concat append-serv "@"
2059                                 (elmo-net-folder-server-internal folder))))
2060     (unless (eq (elmo-net-folder-port-internal folder) elmo-imap4-default-port)
2061       (setq append-serv (concat append-serv ":"
2062                                 (number-to-string
2063                                  (elmo-net-folder-port-internal folder)))))
2064     (setq type (elmo-net-folder-stream-type-internal folder))
2065     (unless (eq (elmo-network-stream-type-symbol type)
2066                 elmo-imap4-default-stream-type)
2067       (if type
2068           (setq append-serv (concat append-serv
2069                                     (elmo-network-stream-type-spec-string
2070                                      type)))))
2071     (if one-level
2072         (let ((re-delim (regexp-quote delim))
2073               (case-fold-search nil)
2074               folder ret has-child-p)
2075           ;; Append delimiter
2076           (when (and root
2077                      (not (string= root ""))
2078                      (not (string-match
2079                            (concat "\\(.*\\)" re-delim "\\'")
2080                            root)))
2081             (setq root (concat root delim)))
2082           (while (setq folder (car result))
2083             (setq has-child-p
2084                   (when (string-match
2085                          (concat "^\\(" (regexp-quote root) "[^" re-delim "]" "+\\)"
2086                                  re-delim)
2087                          folder)
2088                     (setq folder (match-string 1 folder))))
2089             (setq result (delq
2090                           nil
2091                           (mapcar (lambda (fld)
2092                                     (if (string-match
2093                                          (concat "^" (regexp-quote folder)
2094                                                  "\\(" re-delim "\\|\\'\\)")
2095                                          fld)
2096                                         (progn (setq has-child-p t) nil)
2097                                       fld))
2098                                   (cdr result)))
2099                   folder (concat prefix
2100                                  (elmo-quote-syntactical-element
2101                                   (elmo-imap4-decode-folder-string folder)
2102                                   'mailbox elmo-imap4-folder-name-syntax)
2103                                  (and append-serv
2104                                       (eval append-serv)))
2105                   ret (append ret (if has-child-p
2106                                       (list (list folder))
2107                                     (list folder)))))
2108           ret)
2109       (mapcar (lambda (fld)
2110                 (concat prefix
2111                         (elmo-quote-syntactical-element
2112                          (elmo-imap4-decode-folder-string fld)
2113                          'mailbox elmo-imap4-folder-name-syntax)
2114                         (and append-serv
2115                              (eval append-serv))))
2116               result))))
2117
2118 (luna-define-method elmo-folder-exists-p-plugged ((folder elmo-imap4-folder))
2119   (let ((session (elmo-imap4-get-session folder)))
2120     (if (string=
2121          (elmo-imap4-session-current-mailbox-internal session)
2122          (elmo-imap4-folder-mailbox-internal folder))
2123         t
2124       (elmo-imap4-session-select-mailbox
2125        session
2126        (elmo-imap4-folder-mailbox-internal folder)
2127        'force 'notify-bye))))
2128
2129 (luna-define-method elmo-folder-creatable-p ((folder elmo-imap4-folder))
2130   t)
2131
2132 (luna-define-method elmo-folder-writable-p ((folder elmo-imap4-folder))
2133   t)
2134
2135 (luna-define-method elmo-folder-delete ((folder elmo-imap4-folder))
2136   (let* ((exists (elmo-folder-exists-p folder))
2137          (msgs (and exists
2138                     (elmo-folder-list-messages folder))))
2139     (when (yes-or-no-p (format "%sDelete msgdb and substance of \"%s\"? "
2140                                (if (> (length msgs) 0)
2141                                    (format "%d msg(s) exists. " (length msgs))
2142                                  "")
2143                                (elmo-folder-name-internal folder)))
2144       (let ((session (elmo-imap4-get-session folder)))
2145         (when (elmo-imap4-folder-mailbox-internal folder)
2146           (when msgs (elmo-folder-delete-messages-internal folder msgs))
2147           ;; close selected mailbox except one with \Noselect attribute
2148           (when exists
2149             (elmo-imap4-send-command-wait session "close"))
2150           (elmo-imap4-send-command-wait
2151            session
2152            (list "delete "
2153                  (elmo-imap4-mailbox
2154                   (elmo-imap4-folder-mailbox-internal folder)))))
2155         (elmo-imap4-session-set-current-mailbox-internal session nil))
2156       (elmo-msgdb-delete-path folder)
2157       t)))
2158
2159 (luna-define-method elmo-folder-rename-internal ((folder elmo-imap4-folder)
2160                                                  new-folder)
2161   (let ((session (elmo-imap4-get-session folder)))
2162     ;; make sure the folder is selected.
2163     (elmo-imap4-session-select-mailbox session
2164                                        (elmo-imap4-folder-mailbox-internal
2165                                         folder))
2166     (elmo-imap4-send-command-wait session "close")
2167     (elmo-imap4-send-command-wait
2168      session
2169      (list "rename "
2170            (elmo-imap4-mailbox
2171             (elmo-imap4-folder-mailbox-internal folder))
2172            " "
2173            (elmo-imap4-mailbox
2174             (elmo-imap4-folder-mailbox-internal new-folder))))
2175     (elmo-imap4-session-set-current-mailbox-internal
2176      session (elmo-imap4-folder-mailbox-internal new-folder))))
2177
2178 (defun elmo-imap4-copy-messages (src-folder dst-folder numbers)
2179   (let ((session (elmo-imap4-get-session src-folder))
2180         (set-list (elmo-imap4-make-number-set-list
2181                    numbers
2182                    elmo-imap4-number-set-chop-length))
2183         succeeds)
2184     (elmo-imap4-session-select-mailbox session
2185                                        (elmo-imap4-folder-mailbox-internal
2186                                         src-folder))
2187     (while set-list
2188       (if (elmo-imap4-send-command-wait session
2189                                         (list
2190                                          (format
2191                                           (if elmo-imap4-use-uid
2192                                               "uid copy %s "
2193                                             "copy %s ")
2194                                           (cdr (car set-list)))
2195                                          (elmo-imap4-mailbox
2196                                           (elmo-imap4-folder-mailbox-internal
2197                                            dst-folder))))
2198           (setq succeeds (append succeeds numbers)))
2199       (setq set-list (cdr set-list)))
2200     succeeds))
2201
2202 (defun elmo-imap4-set-flag (folder numbers flag &optional remove)
2203   "Set flag on messages.
2204 FOLDER is the ELMO folder structure.
2205 NUMBERS is the message numbers to be flagged.
2206 FLAG is the flag name.
2207 If optional argument REMOVE is non-nil, remove FLAG."
2208   (let ((session (elmo-imap4-get-session folder))
2209         response set-list)
2210     (elmo-imap4-session-select-mailbox session
2211                                        (elmo-imap4-folder-mailbox-internal
2212                                         folder))
2213     (when (or (elmo-string-member-ignore-case
2214                flag
2215                (elmo-imap4-session-flags-internal session))
2216               (member "\\*" (elmo-imap4-session-flags-internal session))
2217               (string= flag "\\Deleted")) ; XXX Humm..
2218       (setq set-list (elmo-imap4-make-number-set-list
2219                       numbers
2220                       elmo-imap4-number-set-chop-length))
2221       (while set-list
2222         (with-current-buffer (elmo-network-session-buffer session)
2223           (setq elmo-imap4-fetch-callback nil)
2224           (setq elmo-imap4-fetch-callback-data nil))
2225         (unless (elmo-imap4-response-ok-p
2226                  (elmo-imap4-send-command-wait
2227                   session
2228                   (format
2229                    (if elmo-imap4-use-uid
2230                        "uid store %s %sflags.silent (%s)"
2231                      "store %s %sflags.silent (%s)")
2232                    (cdr (car set-list))
2233                    (if remove "-" "+")
2234                    flag)))
2235           (setq response 'fail))
2236         (setq set-list (cdr set-list)))
2237       (not (eq response 'fail)))))
2238
2239 (luna-define-method elmo-folder-delete-messages-plugged
2240   ((folder elmo-imap4-folder) numbers)
2241   (let ((session (elmo-imap4-get-session folder))
2242         (expunge
2243          (or (null (elmo-imap4-list folder "deleted"))
2244              (y-or-n-p
2245               "There's hidden deleted messages, expunge anyway?"))))
2246     (elmo-imap4-session-select-mailbox
2247      session
2248      (elmo-imap4-folder-mailbox-internal folder))
2249     (unless (elmo-imap4-set-flag folder numbers "\\Deleted")
2250       (error "Failed to set deleted flag"))
2251     (when expunge
2252       (elmo-imap4-send-command session "expunge"))
2253     t))
2254
2255 (defun elmo-imap4-detect-search-charset (string)
2256   (with-temp-buffer
2257     (insert string)
2258     (detect-mime-charset-region (point-min) (point-max))))
2259
2260 (defun elmo-imap4-search-internal-primitive (folder session filter from-msgs)
2261   (let ((search-key (elmo-filter-key filter))
2262         (imap-search-keys '("bcc" "body" "cc" "from" "subject" "to"
2263                             "larger" "smaller" "flag"))
2264         (total 0)
2265         (length (length from-msgs))
2266         charset set-list end results)
2267     (cond
2268      ((string= "last" search-key)
2269       (let ((numbers (or from-msgs (elmo-folder-list-messages folder))))
2270         (nthcdr (max (- (length numbers)
2271                         (string-to-number (elmo-filter-value filter)))
2272                      0)
2273                 numbers)))
2274      ((string= "first" search-key)
2275       (let* ((numbers (or from-msgs (elmo-folder-list-messages folder)))
2276              (rest (nthcdr (string-to-number (elmo-filter-value filter) )
2277                            numbers)))
2278         (mapc (lambda (x) (delete x numbers)) rest)
2279         numbers))
2280      ((string= "flag" search-key)
2281       (elmo-imap4-folder-list-flagged
2282        folder (intern (elmo-filter-value filter))))
2283      ((or (string= "since" search-key)
2284           (string= "before" search-key))
2285       (setq search-key (concat "sent" search-key)
2286             set-list (elmo-imap4-make-number-set-list
2287                       from-msgs
2288                       elmo-imap4-number-set-chop-length)
2289             end nil)
2290       (while (not end)
2291         (setq results
2292               (append
2293                results
2294                (elmo-imap4-response-value
2295                 (elmo-imap4-send-command-wait
2296                  session
2297                  (format
2298                   (if elmo-imap4-use-uid
2299                       "uid search %s%s%s %s"
2300                     "search %s%s%s %s")
2301                   (if from-msgs
2302                       (concat
2303                        (if elmo-imap4-use-uid "uid ")
2304                        (cdr (car set-list))
2305                        " ")
2306                     "")
2307                   (if (eq (elmo-filter-type filter)
2308                           'unmatch)
2309                       "not " "")
2310                   search-key
2311                   (elmo-date-get-description
2312                    (elmo-date-get-datevec
2313                     (elmo-filter-value filter)))))
2314                 'search)))
2315         (setq set-list (cdr set-list)
2316               end (null set-list)))
2317       results)
2318      (t
2319       (setq charset
2320             (if (eq (length (elmo-filter-value filter)) 0)
2321                 (setq charset 'us-ascii)
2322               (elmo-imap4-detect-search-charset
2323                (elmo-filter-value filter)))
2324             set-list (elmo-imap4-make-number-set-list
2325                       from-msgs
2326                       elmo-imap4-number-set-chop-length)
2327             end nil)
2328       (while (not end)
2329         (setq results
2330               (append
2331                results
2332                (elmo-imap4-response-value
2333                 (elmo-imap4-send-command-wait
2334                  session
2335                  (list
2336                   (if elmo-imap4-use-uid "uid ")
2337                   "search "
2338                   "CHARSET "
2339                   (elmo-imap4-astring
2340                    (symbol-name charset))
2341                   " "
2342                   (if from-msgs
2343                       (concat
2344                        (if elmo-imap4-use-uid "uid ")
2345                        (cdr (car set-list))
2346                        " ")
2347                     "")
2348                   (if (eq (elmo-filter-type filter)
2349                           'unmatch)
2350                       "not " "")
2351                   (format "%s%s "
2352                           (if (member
2353                                (elmo-filter-key filter)
2354                                imap-search-keys)
2355                               ""
2356                             "header ")
2357                           (elmo-filter-key filter))
2358                   (elmo-imap4-astring
2359                    (encode-mime-charset-string
2360                     (elmo-filter-value filter) charset))))
2361                 'search)))
2362         (setq set-list (cdr set-list)
2363               end (null set-list)))
2364       results))))
2365
2366 (defun elmo-imap4-search-internal (folder session condition from-msgs)
2367   (let (result)
2368     (cond
2369      ((vectorp condition)
2370       (setq result (elmo-imap4-search-internal-primitive
2371                     folder session condition from-msgs)))
2372      ((eq (car condition) 'and)
2373       (setq result (elmo-imap4-search-internal folder session (nth 1 condition)
2374                                                from-msgs)
2375             result (elmo-list-filter result
2376                                      (elmo-imap4-search-internal
2377                                       folder session (nth 2 condition)
2378                                       from-msgs))))
2379      ((eq (car condition) 'or)
2380       (setq result (elmo-imap4-search-internal
2381                     folder session (nth 1 condition) from-msgs)
2382             result (elmo-uniq-list
2383                     (nconc result
2384                            (elmo-imap4-search-internal
2385                             folder session (nth 2 condition) from-msgs)))
2386             result (sort result '<))))))
2387
2388 (luna-define-method elmo-folder-search :around ((folder elmo-imap4-folder)
2389                                                 condition &optional numbers)
2390   (if (elmo-folder-plugged-p folder)
2391       (save-excursion
2392         (let ((session (elmo-imap4-get-session folder))
2393               ret)
2394           (message "Searching...")
2395           (elmo-imap4-session-select-mailbox
2396            session
2397            (elmo-imap4-folder-mailbox-internal folder))
2398           (setq ret (elmo-imap4-search-internal folder session condition numbers))
2399           (message "Searching...done")
2400           ret))
2401     (luna-call-next-method)))
2402
2403 (luna-define-method elmo-folder-msgdb-create-plugged
2404   ((folder elmo-imap4-folder) numbers flag-table)
2405   (when numbers
2406     (let ((session (elmo-imap4-get-session folder))
2407           (headers
2408            (elmo-uniq-list
2409             (append
2410              '("Subject" "From" "To" "Cc" "Date"
2411                "Message-Id" "References" "In-Reply-To")
2412              (mapcar #'capitalize (elmo-msgdb-extra-fields 'non-virtual)))))
2413           (total 0)
2414           print-length print-depth
2415           rfc2060 set-list)
2416       (setq rfc2060 (elmo-imap4-session-capable-p session 'imap4rev1))
2417       (elmo-with-progress-display (elmo-folder-msgdb-create (length numbers))
2418           "Creating msgdb"
2419         (elmo-imap4-session-select-mailbox
2420          session (elmo-imap4-folder-mailbox-internal folder))
2421         (setq set-list (elmo-imap4-make-number-set-list
2422                         numbers
2423                         elmo-imap4-overview-fetch-chop-length))
2424         ;; Setup callback.
2425         (with-current-buffer (elmo-network-session-buffer session)
2426           (setq elmo-imap4-current-msgdb (elmo-make-msgdb)
2427                 elmo-imap4-seen-messages nil
2428                 elmo-imap4-fetch-callback 'elmo-imap4-fetch-callback-1
2429                 elmo-imap4-fetch-callback-data (cons flag-table folder))
2430           (while set-list
2431             (elmo-imap4-send-command-wait
2432              session
2433              ;; get overview entity from IMAP4
2434              (format "%sfetch %s (%s rfc822.size flags)"
2435                      (if elmo-imap4-use-uid "uid " "")
2436                      (cdr (car set-list))
2437                      (if rfc2060
2438                          (format "body.peek[header.fields %s]" headers)
2439                        (format "%s" headers))))
2440             (setq set-list (cdr set-list)))
2441           (when elmo-imap4-seen-messages
2442             (elmo-imap4-set-flag folder elmo-imap4-seen-messages "\\Seen"))
2443           ;; cannot setup the global flag while retrieval.
2444           (dolist (number (elmo-msgdb-list-messages elmo-imap4-current-msgdb))
2445             (elmo-global-flags-set (elmo-msgdb-flags elmo-imap4-current-msgdb
2446                                                      number)
2447                                    folder number
2448                                    (elmo-message-entity-field
2449                                     (elmo-msgdb-message-entity
2450                                      elmo-imap4-current-msgdb number)
2451                                     'message-id)))
2452           elmo-imap4-current-msgdb)))))
2453
2454 (luna-define-method elmo-folder-set-flag-plugged ((folder elmo-imap4-folder)
2455                                                   numbers flag)
2456   (let ((spec (cdr (assq flag elmo-imap4-flag-specs))))
2457     (elmo-imap4-set-flag folder numbers (or (car spec)
2458                                             (capitalize (symbol-name flag)))
2459                          (nth 1 spec))))
2460
2461 (luna-define-method elmo-folder-unset-flag-plugged ((folder elmo-imap4-folder)
2462                                                     numbers flag)
2463   (let ((spec (cdr (assq flag elmo-imap4-flag-specs))))
2464     (elmo-imap4-set-flag folder numbers (or (car spec)
2465                                             (capitalize (symbol-name flag)))
2466                          (not (nth 1 spec)))))
2467
2468 (luna-define-method elmo-message-use-cache-p ((folder elmo-imap4-folder)
2469                                               number)
2470   elmo-imap4-use-cache)
2471
2472 (luna-define-method elmo-folder-message-appendable-p ((folder elmo-imap4-folder))
2473   (if (elmo-folder-plugged-p folder)
2474       (not (elmo-imap4-session-read-only-internal
2475             (elmo-imap4-get-session folder)))
2476     elmo-enable-disconnected-operation)) ; offline refile.
2477
2478 (luna-define-method elmo-folder-check-plugged ((folder elmo-imap4-folder))
2479   (let ((session (elmo-imap4-get-session folder 'if-exists)))
2480     (when session
2481       (if (string=
2482            (elmo-imap4-session-current-mailbox-internal session)
2483            (elmo-imap4-folder-mailbox-internal folder))
2484           (if elmo-imap4-use-select-to-update-status
2485               (elmo-imap4-session-select-mailbox
2486                session
2487                (elmo-imap4-folder-mailbox-internal folder)
2488                'force)
2489             (elmo-imap4-session-check session))))))
2490
2491 (defsubst elmo-imap4-folder-diff-plugged (folder)
2492   (let ((session (elmo-imap4-get-session folder))
2493         messages new unread response killed uidnext)
2494 ;;;    (elmo-imap4-commit spec)
2495     (with-current-buffer (elmo-network-session-buffer session)
2496       (setq elmo-imap4-status-callback nil)
2497       (setq elmo-imap4-status-callback-data nil))
2498     (if elmo-imap4-use-select-to-update-status
2499         (elmo-imap4-session-select-mailbox
2500          session
2501          (elmo-imap4-folder-mailbox-internal folder)))
2502     (setq response
2503           (elmo-imap4-send-command-wait session
2504                                         (list
2505                                          "status "
2506                                          (elmo-imap4-mailbox
2507                                           (elmo-imap4-folder-mailbox-internal
2508                                            folder))
2509                                          " (recent unseen messages uidnext)")))
2510     (setq response (elmo-imap4-response-value response 'status))
2511     (setq messages (elmo-imap4-response-value response 'messages))
2512     (setq uidnext (elmo-imap4-response-value response 'uidnext))
2513     (setq killed (elmo-msgdb-killed-list-load (elmo-folder-msgdb-path folder)))
2514     ;;
2515     (when killed
2516       (when (and (consp (car killed))
2517                  (eq (car (car killed)) 1))
2518         (setq messages (- uidnext (cdr (car killed)) 1)))
2519       (setq messages (- messages
2520                         (elmo-msgdb-killed-list-length (cdr killed)))))
2521     (setq new (elmo-imap4-response-value response 'recent)
2522           unread (elmo-imap4-response-value response 'unseen))
2523     (if (< unread new) (setq new unread))
2524     (list new unread messages)))
2525
2526 (luna-define-method elmo-folder-diff-plugged ((folder elmo-imap4-folder))
2527   (elmo-imap4-folder-diff-plugged folder))
2528
2529 (luna-define-method elmo-folder-diff-async ((folder elmo-imap4-folder))
2530   (setq elmo-imap4-server-diff-async-callback
2531         elmo-folder-diff-async-callback)
2532   (setq elmo-imap4-server-diff-async-callback-data
2533         elmo-folder-diff-async-callback-data)
2534   (elmo-imap4-server-diff-async folder))
2535
2536 (luna-define-method elmo-folder-open :around ((folder elmo-imap4-folder)
2537                                               &optional load-msgdb)
2538   (if (elmo-folder-plugged-p folder)
2539       (let (session mailbox msgdb result response tag)
2540         (condition-case err
2541             (progn
2542               (setq session (elmo-imap4-get-session folder)
2543                     mailbox (elmo-imap4-folder-mailbox-internal folder)
2544                     tag (elmo-imap4-send-command session
2545                                                  (list "select "
2546                                                        (elmo-imap4-mailbox
2547                                                         mailbox))))
2548               (message "Selecting %s..."
2549                        (elmo-folder-name-internal folder))
2550               (if load-msgdb
2551                   (setq msgdb (elmo-folder-msgdb-load folder 'silent)))
2552               (elmo-folder-set-killed-list-internal
2553                folder
2554                (elmo-msgdb-killed-list-load (elmo-folder-msgdb-path folder)))
2555               (if (setq result (elmo-imap4-response-ok-p
2556                                 (setq response
2557                                       (elmo-imap4-read-response session tag))))
2558                   (progn
2559                     (let ((exists (assq 'exists response))) ; update message count,
2560                       (when exists                          ; so merge update can go
2561                         (elmo-folder-set-info-hashtb folder nil (cadr exists))))
2562                     (elmo-imap4-session-set-current-mailbox-internal
2563                      session mailbox)
2564                     (elmo-imap4-session-set-read-only-internal
2565                      session
2566                      (nth 1 (assq 'read-only (assq 'ok response))))
2567                     (elmo-imap4-session-set-flags-internal
2568                      session
2569                      (nth 1 (or (assq 'permanentflags response)
2570                                 (assq 'flags response)))))
2571                 (elmo-imap4-session-set-current-mailbox-internal session nil)
2572                 (if (elmo-imap4-response-bye-p response)
2573                     (elmo-imap4-process-bye session)
2574                   (error "%s"
2575                          (or (elmo-imap4-response-error-text response)
2576                              (format "Select %s failed" mailbox)))))
2577               (message "Selecting %s...done"
2578                        (elmo-folder-name-internal folder))
2579               (elmo-folder-set-msgdb-internal
2580                folder msgdb))
2581           (quit
2582            (if (elmo-imap4-response-ok-p response)
2583                (elmo-imap4-session-set-current-mailbox-internal
2584                 session mailbox)
2585              (and session
2586                   (elmo-imap4-session-set-current-mailbox-internal
2587                    session nil))))
2588           (error
2589            (if (elmo-imap4-response-ok-p response)
2590                (elmo-imap4-session-set-current-mailbox-internal
2591                 session mailbox)
2592              (and session
2593                   (elmo-imap4-session-set-current-mailbox-internal
2594                    session nil))))))
2595     (luna-call-next-method)))
2596
2597 ;; elmo-folder-open-internal: do nothing.
2598
2599 (luna-define-method elmo-find-fetch-strategy ((folder elmo-imap4-folder) number
2600                                               &optional
2601                                               ignore-cache
2602                                               require-entireness)
2603   (let ((entity (elmo-message-entity folder number)))
2604     (if (null entity)
2605         (elmo-make-fetch-strategy 'entire)
2606       (let* ((size (elmo-message-entity-field entity 'size))
2607              (message-id (elmo-message-entity-field entity 'message-id))
2608              (cache-file (elmo-file-cache-get message-id))
2609              (use-cache (and (not ignore-cache)
2610                              (elmo-message-use-cache-p folder number)
2611                              (if require-entireness
2612                                  (eq (elmo-file-cache-status cache-file)
2613                                      'entire)
2614                                (elmo-file-cache-status cache-file)))))
2615         (elmo-make-fetch-strategy
2616          (if use-cache
2617              (elmo-file-cache-status cache-file)
2618            (if (and (not require-entireness)
2619                     elmo-message-fetch-threshold
2620                     (integerp size)
2621                     (>= size elmo-message-fetch-threshold)
2622                     (or (not elmo-message-fetch-confirm)
2623                         (not (prog1
2624                                  (y-or-n-p
2625                                   (format
2626                                    "Fetch entire message at once? (%dbytes)"
2627                                    size))
2628                                (message "")))))
2629                'section
2630              'entire))
2631          use-cache
2632          (elmo-message-use-cache-p folder number)
2633          (elmo-file-cache-path cache-file))))))
2634
2635 (luna-define-method elmo-folder-create-plugged ((folder elmo-imap4-folder))
2636   (elmo-imap4-send-command-wait
2637    (elmo-imap4-get-session folder)
2638    (list "create "
2639          (elmo-imap4-mailbox
2640           (elmo-imap4-folder-mailbox-internal folder)))))
2641
2642 (defun elmo-imap4-flags-to-imap (flags)
2643   "Convert FLAGS to the IMAP flag string."
2644   (let ((imap-flag (if (not (memq 'unread flags)) "\\Seen")))
2645     (dolist (flag flags)
2646       (unless (memq flag '(new read unread cached))
2647         (setq imap-flag
2648               (concat imap-flag
2649                       (if imap-flag " ")
2650                       (or (car (cdr (assq flag elmo-imap4-flag-specs)))
2651                           (capitalize (symbol-name flag)))))))
2652     imap-flag))
2653
2654 (luna-define-method elmo-folder-append-buffer
2655   ((folder elmo-imap4-folder) &optional flags number)
2656   (if (elmo-folder-plugged-p folder)
2657       (let ((session (elmo-imap4-get-session folder))
2658             send-buffer result)
2659         (elmo-imap4-session-select-mailbox session
2660                                            (elmo-imap4-folder-mailbox-internal
2661                                             folder))
2662         (setq send-buffer (elmo-imap4-setup-send-buffer))
2663         (unwind-protect
2664             (setq result
2665                   (elmo-imap4-send-command-wait
2666                    session
2667                    (list
2668                     "append "
2669                     (elmo-imap4-mailbox (elmo-imap4-folder-mailbox-internal
2670                                          folder))
2671                     (if (and flags (elmo-folder-use-flag-p folder))
2672                         (concat " (" (elmo-imap4-flags-to-imap flags) ") ")
2673                       " () ")
2674                     (elmo-imap4-buffer-literal send-buffer))))
2675           (kill-buffer send-buffer))
2676         (when result
2677           (elmo-folder-preserve-flags
2678            folder (elmo-msgdb-get-message-id-from-buffer) flags))
2679         result)
2680     ;; Unplugged
2681     (if elmo-enable-disconnected-operation
2682         (elmo-folder-append-buffer-dop folder flags number)
2683       (error "Unplugged"))))
2684
2685 (eval-when-compile
2686   (defmacro elmo-imap4-identical-system-p (folder1 folder2)
2687     "Return t if FOLDER1 and FOLDER2 are in the same IMAP4 system."
2688     `(and (string= (elmo-net-folder-server-internal ,folder1)
2689                    (elmo-net-folder-server-internal ,folder2))
2690           (eq (elmo-net-folder-port-internal ,folder1)
2691               (elmo-net-folder-port-internal ,folder2))
2692           (string= (elmo-net-folder-user-internal ,folder1)
2693                    (elmo-net-folder-user-internal ,folder2)))))
2694
2695 (luna-define-method elmo-folder-next-message-number-plugged
2696   ((folder elmo-imap4-folder))
2697   (let ((session (elmo-imap4-get-session folder))
2698         messages new unread response killed uidnext)
2699     (with-current-buffer (elmo-network-session-buffer session)
2700       (setq elmo-imap4-status-callback nil)
2701       (setq elmo-imap4-status-callback-data nil))
2702     (if elmo-imap4-use-select-to-update-status
2703         (elmo-imap4-session-select-mailbox
2704          session
2705          (elmo-imap4-folder-mailbox-internal folder)))
2706     (setq response
2707           (elmo-imap4-send-command-wait session
2708                                         (list
2709                                          "status "
2710                                          (elmo-imap4-mailbox
2711                                           (elmo-imap4-folder-mailbox-internal
2712                                            folder))
2713                                          " (uidnext)"))
2714           response (elmo-imap4-response-value response 'status))
2715     (elmo-imap4-response-value response 'uidnext)))
2716
2717 (defun elmo-folder-append-messages-imap4-imap4 (dst-folder
2718                                                 src-folder
2719                                                 numbers
2720                                                 same-number)
2721   (if (and (elmo-imap4-identical-system-p dst-folder src-folder)
2722            (elmo-folder-plugged-p dst-folder))
2723       ;; Plugged
2724       (prog1
2725           (elmo-imap4-copy-messages src-folder dst-folder numbers)
2726         (elmo-progress-notify 'elmo-folder-move-messages (length numbers)))
2727     (elmo-folder-append-messages dst-folder src-folder numbers same-number
2728                                  'elmo-folder-append-messages-imap4-imap4)))
2729
2730 (luna-define-method elmo-message-deletable-p ((folder elmo-imap4-folder)
2731                                               number)
2732   (if (elmo-folder-plugged-p folder)
2733       (not (elmo-imap4-session-read-only-internal
2734             (elmo-imap4-get-session folder)))
2735     elmo-enable-disconnected-operation)) ; offline refile.
2736
2737 ;;;(luna-define-method elmo-message-fetch-unplugged
2738 ;;;  ((folder elmo-imap4-folder)
2739 ;;;   number strategy  &optional section outbuf unseen)
2740 ;;;  (error "%d%s is not cached." number (if section
2741 ;;;                                       (format "(%s)" section)
2742 ;;;                                     "")))
2743
2744 (defsubst elmo-imap4-message-fetch (folder number strategy
2745                                            section outbuf unseen)
2746   (let ((session (elmo-imap4-get-session folder))
2747         response)
2748     (elmo-imap4-session-select-mailbox session
2749                                        (elmo-imap4-folder-mailbox-internal
2750                                         folder))
2751     (with-current-buffer (elmo-network-session-buffer session)
2752       (setq elmo-imap4-fetch-callback nil)
2753       (setq elmo-imap4-fetch-callback-data nil))
2754     (elmo-with-progress-display (elmo-retrieve-message
2755                                  (elmo-message-field folder number :size)
2756                                  elmo-imap4-literal-progress-reporter)
2757         "Retrieving"
2758       (setq response
2759             (elmo-imap4-send-command-wait session
2760                                           (format
2761                                            (if elmo-imap4-use-uid
2762                                                "uid fetch %s body%s[%s]"
2763                                              "fetch %s body%s[%s]")
2764                                            number
2765                                            (if unseen ".peek" "")
2766                                            (or section "")))))
2767     (if (setq response (elmo-imap4-response-bodydetail-text
2768                         (elmo-imap4-response-value-all
2769                          response 'fetch)))
2770         (with-current-buffer outbuf
2771           (erase-buffer)
2772           (insert response)
2773           (elmo-delete-cr-buffer)
2774           t))))
2775
2776 (luna-define-method elmo-message-fetch-plugged ((folder elmo-imap4-folder)
2777                                                 number strategy
2778                                                 &optional section
2779                                                 outbuf unseen)
2780   (when elmo-imap4-set-seen-flag-explicitly
2781     (elmo-imap4-set-flag folder (list number) "\\Seen"))
2782   (elmo-imap4-message-fetch folder number strategy section outbuf unseen))
2783
2784 (luna-define-method elmo-message-fetch-field ((folder elmo-imap4-folder)
2785                                               number field)
2786   (let ((session (elmo-imap4-get-session folder)))
2787     (elmo-imap4-session-select-mailbox session
2788                                        (elmo-imap4-folder-mailbox-internal
2789                                         folder))
2790     (with-current-buffer (elmo-network-session-buffer session)
2791       (setq elmo-imap4-fetch-callback nil)
2792       (setq elmo-imap4-fetch-callback-data nil))
2793     (with-temp-buffer
2794       (insert
2795        (elmo-imap4-response-bodydetail-text
2796         (elmo-imap4-response-value
2797          (elmo-imap4-send-command-wait session
2798                                        (concat
2799                                         (if elmo-imap4-use-uid
2800                                             "uid ")
2801                                         (format
2802                                          "fetch %s (body.peek[header.fields (%s)])"
2803                                          number field)))
2804          'fetch)))
2805       (elmo-delete-cr-buffer)
2806       (goto-char (point-min))
2807       (std11-field-body (symbol-name field)))))
2808
2809 (luna-define-method elmo-folder-search-requires-msgdb-p ((folder
2810                                                           elmo-imap4-folder)
2811                                                          condition)
2812   nil)
2813
2814 (autoload 'elmo-global-flags-set "elmo-flag")
2815 (autoload 'elmo-get-global-flags "elmo-flag")
2816
2817 (require 'product)
2818 (product-provide (provide 'elmo-imap4) (require 'elmo-version))
2819
2820 ;;; elmo-imap4.el ends here