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