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