git.chise.org Git - elisp/gnus.git-/blob - lisp/imap.el

   1 ;;; imap.el --- imap library
   2 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004
   3 ;;        Free Software Foundation, Inc.
   4
   5 ;; Author: Simon Josefsson <jas@pdc.kth.se>
   6 ;; Keywords: mail
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25 ;;; Commentary:
  26
  27 ;; imap.el is a elisp library providing an interface for talking to
  28 ;; IMAP servers.
  29 ;;
  30 ;; imap.el is roughly divided in two parts, one that parses IMAP
  31 ;; responses from the server and storing data into buffer-local
  32 ;; variables, and one for utility functions which send commands to
  33 ;; server, waits for an answer, and return information.  The latter
  34 ;; part is layered on top of the previous.
  35 ;;
  36 ;; The imap.el API consist of the following functions, other functions
  37 ;; in this file should not be called directly and the result of doing
  38 ;; so are at best undefined.
  39 ;;
  40 ;; Global commands:
  41 ;;
  42 ;; imap-open,       imap-opened,    imap-authenticate, imap-close,
  43 ;; imap-capability, imap-namespace, imap-error-text
  44 ;;
  45 ;; Mailbox commands:
  46 ;;
  47 ;; imap-mailbox-get,       imap-mailbox-map,         imap-current-mailbox,
  48 ;; imap-current-mailbox-p, imap-search,              imap-mailbox-select,
  49 ;; imap-mailbox-examine,   imap-mailbox-unselect,    imap-mailbox-expunge
  50 ;; imap-mailbox-close,     imap-mailbox-create,      imap-mailbox-delete
  51 ;; imap-mailbox-rename,    imap-mailbox-lsub,        imap-mailbox-list
  52 ;; imap-mailbox-subscribe, imap-mailbox-unsubscribe, imap-mailbox-status
  53 ;; imap-mailbox-acl-get,   imap-mailbox-acl-set,     imap-mailbox-acl-delete
  54 ;;
  55 ;; Message commands:
  56 ;;
  57 ;; imap-fetch-asynch,                 imap-fetch,
  58 ;; imap-current-message,              imap-list-to-message-set,
  59 ;; imap-message-get,                  imap-message-map
  60 ;; imap-message-envelope-date,        imap-message-envelope-subject,
  61 ;; imap-message-envelope-from,        imap-message-envelope-sender,
  62 ;; imap-message-envelope-reply-to,    imap-message-envelope-to,
  63 ;; imap-message-envelope-cc,          imap-message-envelope-bcc
  64 ;; imap-message-envelope-in-reply-to, imap-message-envelope-message-id
  65 ;; imap-message-body,                 imap-message-flag-permanent-p
  66 ;; imap-message-flags-set,            imap-message-flags-del
  67 ;; imap-message-flags-add,            imap-message-copyuid
  68 ;; imap-message-copy,                 imap-message-appenduid
  69 ;; imap-message-append,               imap-envelope-from
  70 ;; imap-body-lines
  71 ;;
  72 ;; It is my hope that theese commands should be pretty self
  73 ;; explanatory for someone that know IMAP.  All functions have
  74 ;; additional documentation on how to invoke them.
  75 ;;
  76 ;; imap.el support RFC1730/2060/RFC3501 (IMAP4/IMAP4rev1), implemented
  77 ;; IMAP extensions are RFC2195 (CRAM-MD5), RFC2086 (ACL), RFC2342
  78 ;; (NAMESPACE), RFC2359 (UIDPLUS), the IMAP-part of RFC2595 (STARTTLS,
  79 ;; LOGINDISABLED) (with use of external library starttls.el and
  80 ;; program starttls), and the GSSAPI / kerberos V4 sections of RFC1731
  81 ;; (with use of external program `imtest'), RFC2971 (ID).  It also
  82 ;; take advantage the UNSELECT extension in Cyrus IMAPD.
  83 ;;
  84 ;; Without the work of John McClary Prevost and Jim Radford this library
  85 ;; would not have seen the light of day.  Many thanks.
  86 ;;
  87 ;; This is a transcript of short interactive session for demonstration
  88 ;; purposes.
  89 ;;
  90 ;; (imap-open "my.mail.server")
  91 ;; => " *imap* my.mail.server:0"
  92 ;;
  93 ;; The rest are invoked with current buffer as the buffer returned by
  94 ;; `imap-open'.  It is possible to do all without this, but it would
  95 ;; look ugly here since `buffer' is always the last argument for all
  96 ;; imap.el API functions.
  97 ;;
  98 ;; (imap-authenticate "myusername" "mypassword")
  99 ;; => auth
 100 ;;
 101 ;; (imap-mailbox-lsub "*")
 102 ;; => ("INBOX.sentmail" "INBOX.private" "INBOX.draft" "INBOX.spam")
 103 ;;
 104 ;; (imap-mailbox-list "INBOX.n%")
 105 ;; => ("INBOX.namedroppers" "INBOX.nnimap" "INBOX.ntbugtraq")
 106 ;;
 107 ;; (imap-mailbox-select "INBOX.nnimap")
 108 ;; => "INBOX.nnimap"
 109 ;;
 110 ;; (imap-mailbox-get 'exists)
 111 ;; => 166
 112 ;;
 113 ;; (imap-mailbox-get 'uidvalidity)
 114 ;; => "908992622"
 115 ;;
 116 ;; (imap-search "FLAGGED SINCE 18-DEC-98")
 117 ;; => (235 236)
 118 ;;
 119 ;; (imap-fetch 235 "RFC822.PEEK" 'RFC822)
 120 ;; => "X-Sieve: cmu-sieve 1.3^M\nX-Username: <jas@pdc.kth.se>^M\r...."
 121 ;;
 122 ;; Todo:
 123 ;;
 124 ;; o Parse UIDs as strings? We need to overcome the 28 bit limit somehow.
 125 ;; o Don't use `read' at all (important places already fixed)
 126 ;; o Accept list of articles instead of message set string in most
 127 ;;   imap-message-* functions.
 128 ;; o Send strings as literal if they contain, e.g., ".
 129 ;;
 130 ;; Revision history:
 131 ;;
 132 ;;  - 19991218 added starttls/digest-md5 patch,
 133 ;;             by Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
 134 ;;             NB! you need SLIM for starttls.el and digest-md5.el
 135 ;;  - 19991023 commited to pgnus
 136 ;;
 137
 138 ;;; Code:
 139
 140 (eval-when-compile (require 'cl))
 141 (eval-and-compile
 142   (autoload 'starttls-open-stream "starttls")
 143   (autoload 'starttls-negotiate "starttls")
 144   (autoload 'digest-md5-parse-digest-challenge "digest-md5")
 145   (autoload 'digest-md5-digest-response "digest-md5")
 146   (autoload 'digest-md5-digest-uri "digest-md5")
 147   (autoload 'digest-md5-challenge "digest-md5")
 148   (autoload 'rfc2104-hash "rfc2104")
 149   (autoload 'utf7-encode "utf7")
 150   (autoload 'utf7-decode "utf7")
 151   (autoload 'format-spec "format-spec")
 152   (autoload 'format-spec-make "format-spec")
 153   (autoload 'open-tls-stream "tls"))
 154
 155 ;; User variables.
 156
 157 (defgroup imap nil
 158   "Low-level IMAP issues."
 159   :version "21.1"
 160   :group 'mail)
 161
 162 (defcustom imap-kerberos4-program '("imtest -m kerberos_v4 -u %l -p %p %s"
 163                                     "imtest -kp %s %p")
 164   "List of strings containing commands for Kerberos 4 authentication.
 165 %s is replaced with server hostname, %p with port to connect to, and
 166 %l with the value of `imap-default-user'.  The program should accept
 167 IMAP commands on stdin and return responses to stdout.  Each entry in
 168 the list is tried until a successful connection is made."
 169   :group 'imap
 170   :type '(repeat string))
 171
 172 (defcustom imap-gssapi-program (list
 173                                 (concat "gsasl --client --connect %s:%p "
 174                                         "--imap --application-data "
 175                                         "--mechanism GSSAPI "
 176                                         "--authentication-id %l")
 177                                 "imtest -m gssapi -u %l -p %p %s")
 178   "List of strings containing commands for GSSAPI (krb5) authentication.
 179 %s is replaced with server hostname, %p with port to connect to, and
 180 %l with the value of `imap-default-user'.  The program should accept
 181 IMAP commands on stdin and return responses to stdout.  Each entry in
 182 the list is tried until a successful connection is made."
 183   :group 'imap
 184   :type '(repeat string))
 185
 186 (defcustom imap-ssl-program '("openssl s_client -quiet -ssl3 -connect %s:%p"
 187                               "openssl s_client -quiet -ssl2 -connect %s:%p"
 188                               "s_client -quiet -ssl3 -connect %s:%p"
 189                               "s_client -quiet -ssl2 -connect %s:%p")
 190   "A string, or list of strings, containing commands for SSL connections.
 191 Within a string, %s is replaced with the server address and %p with
 192 port number on server.  The program should accept IMAP commands on
 193 stdin and return responses to stdout.  Each entry in the list is tried
 194 until a successful connection is made."
 195   :group 'imap
 196   :type '(choice string
 197                  (repeat string)))
 198
 199 (defcustom imap-shell-program '("ssh %s imapd"
 200                                 "rsh %s imapd"
 201                                 "ssh %g ssh %s imapd"
 202                                 "rsh %g rsh %s imapd")
 203   "A list of strings, containing commands for IMAP connection.
 204 Within a string, %s is replaced with the server address, %p with port
 205 number on server, %g with `imap-shell-host', and %l with
 206 `imap-default-user'.  The program should read IMAP commands from stdin
 207 and write IMAP response to stdout. Each entry in the list is tried
 208 until a successful connection is made."
 209   :group 'imap
 210   :type '(repeat string))
 211
 212 (defcustom imap-process-connection-type nil
 213   "*Value for `process-connection-type' to use for Kerberos4, GSSAPI and SSL.
 214 The `process-connection-type' variable control type of device
 215 used to communicate with subprocesses.  Values are nil to use a
 216 pipe, or t or `pty' to use a pty.  The value has no effect if the
 217 system has no ptys or if all ptys are busy: then a pipe is used
 218 in any case.  The value takes effect when a IMAP server is
 219 opened, changing it after that has no effect.."
 220   :group 'imap
 221   :type 'boolean)
 222
 223 (defcustom imap-use-utf7 t
 224   "If non-nil, do utf7 encoding/decoding of mailbox names.
 225 Since the UTF7 decoding currently only decodes into ISO-8859-1
 226 characters, you may disable this decoding if you need to access UTF7
 227 encoded mailboxes which doesn't translate into ISO-8859-1."
 228   :group 'imap
 229   :type 'boolean)
 230
 231 (defcustom imap-log nil
 232   "If non-nil, a imap session trace is placed in *imap-log* buffer."
 233   :group 'imap
 234   :type 'boolean)
 235
 236 (defcustom imap-debug nil
 237   "If non-nil, random debug spews are placed in *imap-debug* buffer."
 238   :group 'imap
 239   :type 'boolean)
 240
 241 (defcustom imap-shell-host "gateway"
 242   "Hostname of rlogin proxy."
 243   :group 'imap
 244   :type 'string)
 245
 246 (defcustom imap-default-user (user-login-name)
 247   "Default username to use."
 248   :group 'imap
 249   :type 'string)
 250
 251 (defcustom imap-read-timeout (if (string-match
 252                                   "windows-nt\\|os/2\\|emx\\|cygwin"
 253                                   (symbol-name system-type))
 254                                  1.0
 255                                0.1)
 256   "*How long to wait between checking for the end of output.
 257 Shorter values mean quicker response, but is more CPU intensive."
 258   :type 'number
 259   :group 'imap)
 260
 261 (defcustom imap-store-password nil
 262   "If non-nil, store session password without promting."
 263   :group 'imap
 264   :type 'boolean)
 265
 266 ;; Various variables.
 267
 268 (defvar imap-fetch-data-hook nil
 269   "Hooks called after receiving each FETCH response.")
 270
 271 (defvar imap-streams '(gssapi kerberos4 starttls tls ssl network shell)
 272   "Priority of streams to consider when opening connection to server.")
 273
 274 (defvar imap-stream-alist
 275   '((gssapi    imap-gssapi-stream-p    imap-gssapi-open)
 276     (kerberos4 imap-kerberos4-stream-p imap-kerberos4-open)
 277     (tls       imap-tls-p              imap-tls-open)
 278     (ssl       imap-ssl-p              imap-ssl-open)
 279     (network   imap-network-p          imap-network-open)
 280     (shell     imap-shell-p            imap-shell-open)
 281     (starttls  imap-starttls-p         imap-starttls-open))
 282   "Definition of network streams.
 283
 284 \(NAME CHECK OPEN)
 285
 286 NAME names the stream, CHECK is a function returning non-nil if the
 287 server support the stream and OPEN is a function for opening the
 288 stream.")
 289
 290 (defvar imap-authenticators '(gssapi
 291                               kerberos4
 292                               digest-md5
 293                               cram-md5
 294                               login
 295                               anonymous)
 296   "Priority of authenticators to consider when authenticating to server.")
 297
 298 (defvar imap-authenticator-alist
 299   '((gssapi     imap-gssapi-auth-p    imap-gssapi-auth)
 300     (kerberos4  imap-kerberos4-auth-p imap-kerberos4-auth)
 301     (cram-md5   imap-cram-md5-p       imap-cram-md5-auth)
 302     (login      imap-login-p          imap-login-auth)
 303     (anonymous  imap-anonymous-p      imap-anonymous-auth)
 304     (digest-md5 imap-digest-md5-p     imap-digest-md5-auth))
 305   "Definition of authenticators.
 306
 307 \(NAME CHECK AUTHENTICATE)
 308
 309 NAME names the authenticator.  CHECK is a function returning non-nil if
 310 the server support the authenticator and AUTHENTICATE is a function
 311 for doing the actual authentication.")
 312
 313 (defvar imap-error nil
 314   "Error codes from the last command.")
 315
 316 ;; Internal constants.  Change theese and die.
 317
 318 (defconst imap-default-port 143)
 319 (defconst imap-default-ssl-port 993)
 320 (defconst imap-default-tls-port 993)
 321 (defconst imap-default-stream 'network)
 322 (defconst imap-coding-system-for-read 'binary)
 323 (defconst imap-coding-system-for-write 'binary)
 324 (defconst imap-local-variables '(imap-server
 325                                  imap-port
 326                                  imap-client-eol
 327                                  imap-server-eol
 328                                  imap-auth
 329                                  imap-stream
 330                                  imap-username
 331                                  imap-password
 332                                  imap-current-mailbox
 333                                  imap-current-target-mailbox
 334                                  imap-message-data
 335                                  imap-capability
 336                                  imap-id
 337                                  imap-namespace
 338                                  imap-state
 339                                  imap-reached-tag
 340                                  imap-failed-tags
 341                                  imap-tag
 342                                  imap-process
 343                                  imap-calculate-literal-size-first
 344                                  imap-mailbox-data))
 345 (defconst imap-log-buffer "*imap-log*")
 346 (defconst imap-debug-buffer "*imap-debug*")
 347
 348 ;; Internal variables.
 349
 350 (defvar imap-stream nil)
 351 (defvar imap-auth nil)
 352 (defvar imap-server nil)
 353 (defvar imap-port nil)
 354 (defvar imap-username nil)
 355 (defvar imap-password nil)
 356 (defvar imap-calculate-literal-size-first nil)
 357 (defvar imap-state 'closed
 358   "IMAP state.
 359 Valid states are `closed', `initial', `nonauth', `auth', `selected'
 360 and `examine'.")
 361
 362 (defvar imap-server-eol "\r\n"
 363   "The EOL string sent from the server.")
 364
 365 (defvar imap-client-eol "\r\n"
 366   "The EOL string we send to the server.")
 367
 368 (defvar imap-current-mailbox nil
 369   "Current mailbox name.")
 370
 371 (defvar imap-current-target-mailbox nil
 372   "Current target mailbox for COPY and APPEND commands.")
 373
 374 (defvar imap-mailbox-data nil
 375   "Obarray with mailbox data.")
 376
 377 (defvar imap-mailbox-prime 997
 378   "Length of imap-mailbox-data.")
 379
 380 (defvar imap-current-message nil
 381   "Current message number.")
 382
 383 (defvar imap-message-data nil
 384   "Obarray with message data.")
 385
 386 (defvar imap-message-prime 997
 387   "Length of imap-message-data.")
 388
 389 (defvar imap-capability nil
 390   "Capability for server.")
 391
 392 (defvar imap-id nil
 393   "Identity of server.
 394 See RFC 2971.")
 395
 396 (defvar imap-namespace nil
 397   "Namespace for current server.")
 398
 399 (defvar imap-reached-tag 0
 400   "Lower limit on command tags that have been parsed.")
 401
 402 (defvar imap-failed-tags nil
 403   "Alist of tags that failed.
 404 Each element is a list with four elements; tag (a integer), response
 405 state (a symbol, `OK', `NO' or `BAD'), response code (a string), and
 406 human readable response text (a string).")
 407
 408 (defvar imap-tag 0
 409   "Command tag number.")
 410
 411 (defvar imap-process nil
 412   "Process.")
 413
 414 (defvar imap-continuation nil
 415   "Non-nil indicates that the server emitted a continuation request.
 416 The actual value is really the text on the continuation line.")
 417
 418 (defvar imap-callbacks nil
 419   "List of response tags and callbacks, on the form `(number . function)'.
 420 The function should take two arguments, the first the IMAP tag and the
 421 second the status (OK, NO, BAD etc) of the command.")
 422
 423 \f
 424 ;; Utility functions:
 425
 426 (defun imap-remassoc (key alist)
 427   "Delete by side effect any elements of LIST whose car is `equal' to KEY.
 428 The modified LIST is returned.  If the first member
 429 of LIST has a car that is `equal' to KEY, there is no way to remove it
 430 by side effect; therefore, write `(setq foo (remassoc key foo))' to be
 431 sure of changing the value of `foo'."
 432   (when alist
 433     (if (equal key (caar alist))
 434         (cdr alist)
 435       (setcdr alist (imap-remassoc key (cdr alist)))
 436       alist)))
 437
 438 (defsubst imap-disable-multibyte ()
 439   "Enable multibyte in the current buffer."
 440   (when (fboundp 'set-buffer-multibyte)
 441     (set-buffer-multibyte nil)))
 442
 443 (defsubst imap-utf7-encode (string)
 444   (if imap-use-utf7
 445       (and string
 446            (condition-case ()
 447                (utf7-encode string t)
 448              (error (message
 449                      "imap: Could not UTF7 encode `%s', using it unencoded..."
 450                      string)
 451                     string)))
 452     string))
 453
 454 (defsubst imap-utf7-decode (string)
 455   (if imap-use-utf7
 456       (and string
 457            (condition-case ()
 458                (utf7-decode string t)
 459              (error (message
 460                      "imap: Could not UTF7 decode `%s', using it undecoded..."
 461                      string)
 462                     string)))
 463     string))
 464
 465 (defsubst imap-ok-p (status)
 466   (if (eq status 'OK)
 467       t
 468     (setq imap-error status)
 469     nil))
 470
 471 (defun imap-error-text (&optional buffer)
 472   (with-current-buffer (or buffer (current-buffer))
 473     (nth 3 (car imap-failed-tags))))
 474
 475 \f
 476 ;; Server functions; stream stuff:
 477
 478 (defun imap-kerberos4-stream-p (buffer)
 479   (imap-capability 'AUTH=KERBEROS_V4 buffer))
 480
 481 (defun imap-kerberos4-open (name buffer server port)
 482   (let ((cmds imap-kerberos4-program)
 483         cmd done)
 484     (while (and (not done) (setq cmd (pop cmds)))
 485       (message "Opening Kerberos 4 IMAP connection with `%s'..." cmd)
 486       (erase-buffer)
 487       (let* ((port (or port imap-default-port))
 488              (coding-system-for-read imap-coding-system-for-read)
 489              (coding-system-for-write imap-coding-system-for-write)
 490              (process-connection-type imap-process-connection-type)
 491              (process (start-process
 492                        name buffer shell-file-name shell-command-switch
 493                        (format-spec
 494                         cmd
 495                         (format-spec-make
 496                          ?s server
 497                          ?p (number-to-string port)
 498                          ?l imap-default-user))))
 499              response)
 500         (when process
 501           (with-current-buffer buffer
 502             (setq imap-client-eol "\n"
 503                   imap-calculate-literal-size-first t)
 504             (while (and (memq (process-status process) '(open run))
 505                         (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
 506                         (goto-char (point-min))
 507                         ;; Athena IMTEST can output SSL verify errors
 508                         (or (while (looking-at "^verify error:num=")
 509                               (forward-line))
 510                             t)
 511                         (or (while (looking-at "^TLS connection established")
 512                               (forward-line))
 513                             t)
 514                         ;; cyrus 1.6.x (13? < x <= 22) queries capabilities
 515                         (or (while (looking-at "^C:")
 516                               (forward-line))
 517                             t)
 518                         ;; cyrus 1.6 imtest print "S: " before server greeting
 519                         (or (not (looking-at "S: "))
 520                             (forward-char 3)
 521                             t)
 522                         (not (and (imap-parse-greeting)
 523                                   ;; success in imtest < 1.6:
 524                                   (or (re-search-forward
 525                                        "^__\\(.*\\)__\n" nil t)
 526                                       ;; success in imtest 1.6:
 527                                       (re-search-forward
 528                                        "^\\(Authenticat.*\\)" nil t))
 529                                   (setq response (match-string 1)))))
 530               (accept-process-output process 1)
 531               (sit-for 1))
 532             (and imap-log
 533                  (with-current-buffer (get-buffer-create imap-log-buffer)
 534                    (imap-disable-multibyte)
 535                    (buffer-disable-undo)
 536                    (goto-char (point-max))
 537                    (insert-buffer-substring buffer)))
 538             (erase-buffer)
 539             (message "Opening Kerberos 4 IMAP connection with `%s'...%s" cmd
 540                      (if response (concat "done, " response) "failed"))
 541             (if (and response (let ((case-fold-search nil))
 542                                 (not (string-match "failed" response))))
 543                 (setq done process)
 544               (if (memq (process-status process) '(open run))
 545                   (imap-send-command "LOGOUT"))
 546               (delete-process process)
 547               nil)))))
 548     done))
 549
 550 (defun imap-gssapi-stream-p (buffer)
 551   (imap-capability 'AUTH=GSSAPI buffer))
 552
 553 (defun imap-gssapi-open (name buffer server port)
 554   (let ((cmds imap-gssapi-program)
 555         cmd done)
 556     (while (and (not done) (setq cmd (pop cmds)))
 557       (message "Opening GSSAPI IMAP connection with `%s'..." cmd)
 558       (erase-buffer)
 559       (let* ((port (or port imap-default-port))
 560              (coding-system-for-read imap-coding-system-for-read)
 561              (coding-system-for-write imap-coding-system-for-write)
 562              (process-connection-type imap-process-connection-type)
 563              (process (start-process
 564                        name buffer shell-file-name shell-command-switch
 565                        (format-spec
 566                         cmd
 567                         (format-spec-make
 568                          ?s server
 569                          ?p (number-to-string port)
 570                          ?l imap-default-user))))
 571              response)
 572         (when process
 573           (with-current-buffer buffer
 574             (setq imap-client-eol "\n"
 575                   imap-calculate-literal-size-first t)
 576             (while (and (memq (process-status process) '(open run))
 577                         (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
 578                         (goto-char (point-min))
 579                         ;; cyrus 1.6.x (13? < x <= 22) queries capabilities
 580                         (or (while (looking-at "^C:")
 581                               (forward-line))
 582                             t)
 583                         ;; cyrus 1.6 imtest print "S: " before server greeting
 584                         (or (not (looking-at "S: "))
 585                             (forward-char 3)
 586                             t)
 587                         (not (and (imap-parse-greeting)
 588                                   ;; success in imtest 1.6:
 589                                   (re-search-forward
 590                                    (concat "^\\(\\(Authenticat.*\\)\\|\\("
 591                                            "Client authentication "
 592                                            "finished.*\\)\\)")
 593                                    nil t)
 594                                   (setq response (match-string 1)))))
 595               (accept-process-output process 1)
 596               (sit-for 1))
 597             (and imap-log
 598                  (with-current-buffer (get-buffer-create imap-log-buffer)
 599                    (imap-disable-multibyte)
 600                    (buffer-disable-undo)
 601                    (goto-char (point-max))
 602                    (insert-buffer-substring buffer)))
 603             (erase-buffer)
 604             (message "GSSAPI IMAP connection: %s" (or response "failed"))
 605             (if (and response (let ((case-fold-search nil))
 606                                 (not (string-match "failed" response))))
 607                 (setq done process)
 608               (if (memq (process-status process) '(open run))
 609                   (imap-send-command "LOGOUT"))
 610               (delete-process process)
 611               nil)))))
 612     done))
 613
 614 (defun imap-ssl-p (buffer)
 615   nil)
 616
 617 (defun imap-ssl-open (name buffer server port)
 618   "Open a SSL connection to server."
 619   (let ((cmds (if (listp imap-ssl-program) imap-ssl-program
 620                 (list imap-ssl-program)))
 621         cmd done)
 622     (while (and (not done) (setq cmd (pop cmds)))
 623       (message "imap: Opening SSL connection with `%s'..." cmd)
 624       (erase-buffer)
 625       (let* ((port (or port imap-default-ssl-port))
 626              (coding-system-for-read imap-coding-system-for-read)
 627              (coding-system-for-write imap-coding-system-for-write)
 628              (process-connection-type nil)
 629              process)
 630         (when (progn
 631                 (setq process (start-process
 632                                name buffer shell-file-name
 633                                shell-command-switch
 634                                (format-spec cmd
 635                                             (format-spec-make
 636                                              ?s server
 637                                              ?p (number-to-string port)))))
 638                 (process-kill-without-query process)
 639                 process)
 640           (with-current-buffer buffer
 641             (goto-char (point-min))
 642             (while (and (memq (process-status process) '(open run))
 643                         (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
 644                         (goto-char (point-max))
 645                         (forward-line -1)
 646                         (not (imap-parse-greeting)))
 647               (accept-process-output process 1)
 648               (sit-for 1))
 649             (and imap-log
 650                  (with-current-buffer (get-buffer-create imap-log-buffer)
 651                    (imap-disable-multibyte)
 652                    (buffer-disable-undo)
 653                    (goto-char (point-max))
 654                    (insert-buffer-substring buffer)))
 655             (erase-buffer)
 656             (when (memq (process-status process) '(open run))
 657               (setq done process))))))
 658     (if done
 659         (progn
 660           (message "imap: Opening SSL connection with `%s'...done" cmd)
 661           done)
 662       (message "imap: Opening SSL connection with `%s'...failed" cmd)
 663       nil)))
 664
 665 (defun imap-tls-p (buffer)
 666   nil)
 667
 668 (defun imap-tls-open (name buffer server port)
 669   (let* ((port (or port imap-default-tls-port))
 670          (coding-system-for-read imap-coding-system-for-read)
 671          (coding-system-for-write imap-coding-system-for-write)
 672          (process (open-tls-stream name buffer server port)))
 673     (when process
 674       (while (and (memq (process-status process) '(open run))
 675                   (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
 676                   (goto-char (point-max))
 677                   (forward-line -1)
 678                   (not (imap-parse-greeting)))
 679         (accept-process-output process 1)
 680         (sit-for 1))
 681       (and imap-log
 682            (with-current-buffer (get-buffer-create imap-log-buffer)
 683              (imap-disable-multibyte)
 684              (buffer-disable-undo)
 685              (goto-char (point-max))
 686              (insert-buffer-substring buffer)))
 687       (when (memq (process-status process) '(open run))
 688         process))))
 689
 690 (defun imap-network-p (buffer)
 691   t)
 692
 693 (defun imap-network-open (name buffer server port)
 694   (let* ((port (or port imap-default-port))
 695          (coding-system-for-read imap-coding-system-for-read)
 696          (coding-system-for-write imap-coding-system-for-write)
 697          (process (open-network-stream name buffer server port)))
 698     (when process
 699       (while (and (memq (process-status process) '(open run))
 700                   (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
 701                   (goto-char (point-min))
 702                   (not (imap-parse-greeting)))
 703         (accept-process-output process 1)
 704         (sit-for 1))
 705       (and imap-log
 706            (with-current-buffer (get-buffer-create imap-log-buffer)
 707              (imap-disable-multibyte)
 708              (buffer-disable-undo)
 709              (goto-char (point-max))
 710              (insert-buffer-substring buffer)))
 711       (when (memq (process-status process) '(open run))
 712         process))))
 713
 714 (defun imap-shell-p (buffer)
 715   nil)
 716
 717 (defun imap-shell-open (name buffer server port)
 718   (let ((cmds (if (listp imap-shell-program) imap-shell-program
 719                 (list imap-shell-program)))
 720         cmd done)
 721     (while (and (not done) (setq cmd (pop cmds)))
 722       (message "imap: Opening IMAP connection with `%s'..." cmd)
 723       (setq imap-client-eol "\n")
 724       (let* ((port (or port imap-default-port))
 725              (coding-system-for-read imap-coding-system-for-read)
 726              (coding-system-for-write imap-coding-system-for-write)
 727              (process (start-process
 728                        name buffer shell-file-name shell-command-switch
 729                        (format-spec
 730                         cmd
 731                         (format-spec-make
 732                          ?s server
 733                          ?g imap-shell-host
 734                          ?p (number-to-string port)
 735                          ?l imap-default-user)))))
 736         (when process
 737           (while (and (memq (process-status process) '(open run))
 738                       (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
 739                       (goto-char (point-max))
 740                       (forward-line -1)
 741                       (not (imap-parse-greeting)))
 742             (accept-process-output process 1)
 743             (sit-for 1))
 744           (and imap-log
 745                (with-current-buffer (get-buffer-create imap-log-buffer)
 746                  (imap-disable-multibyte)
 747                  (buffer-disable-undo)
 748                  (goto-char (point-max))
 749                  (insert-buffer-substring buffer)))
 750           (erase-buffer)
 751           (when (memq (process-status process) '(open run))
 752             (setq done process)))))
 753     (if done
 754         (progn
 755           (message "imap: Opening IMAP connection with `%s'...done" cmd)
 756           done)
 757       (message "imap: Opening IMAP connection with `%s'...failed" cmd)
 758       nil)))
 759
 760 (defun imap-starttls-p (buffer)
 761   (imap-capability 'STARTTLS buffer))
 762
 763 (defun imap-starttls-open (name buffer server port)
 764   (let* ((port (or port imap-default-port))
 765          (coding-system-for-read imap-coding-system-for-read)
 766          (coding-system-for-write imap-coding-system-for-write)
 767          (process (starttls-open-stream name buffer server port))
 768          done tls-info)
 769     (message "imap: Connecting with STARTTLS...")
 770     (when process
 771       (while (and (memq (process-status process) '(open run))
 772                   (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
 773                   (goto-char (point-max))
 774                   (forward-line -1)
 775                   (not (imap-parse-greeting)))
 776         (accept-process-output process 1)
 777         (sit-for 1))
 778       (imap-send-command "STARTTLS")
 779       (while (and (memq (process-status process) '(open run))
 780                   (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
 781                   (goto-char (point-max))
 782                   (forward-line -1)
 783                   (not (re-search-forward "[0-9]+ OK.*\r?\n" nil t)))
 784         (accept-process-output process 1)
 785         (sit-for 1))
 786       (and imap-log
 787            (with-current-buffer (get-buffer-create imap-log-buffer)
 788              (buffer-disable-undo)
 789              (goto-char (point-max))
 790              (insert-buffer-substring buffer)))
 791       (when (and (setq tls-info (starttls-negotiate process))
 792                  (memq (process-status process) '(open run)))
 793         (setq done process)))
 794     (if (stringp tls-info)
 795         (message "imap: STARTTLS info: %s" tls-info))
 796     (message "imap: Connecting with STARTTLS...%s" (if done "done" "failed"))
 797     done))
 798
 799 ;; Server functions; authenticator stuff:
 800
 801 (defun imap-interactive-login (buffer loginfunc)
 802   "Login to server in BUFFER.
 803 LOGINFUNC is passed a username and a password, it should return t if
 804 it where successful authenticating itself to the server, nil otherwise.
 805 Returns t if login was successful, nil otherwise."
 806   (with-current-buffer buffer
 807     (make-local-variable 'imap-username)
 808     (make-local-variable 'imap-password)
 809     (let (user passwd ret)
 810       ;;      (condition-case ()
 811       (while (or (not user) (not passwd))
 812         (setq user (or imap-username
 813                        (read-from-minibuffer
 814                         (concat "IMAP username for " imap-server
 815                                 " (using stream `" (symbol-name imap-stream)
 816                                 "'): ")
 817                         (or user imap-default-user))))
 818         (setq passwd (or imap-password
 819                          (read-passwd
 820                           (concat "IMAP password for " user "@"
 821                                   imap-server " (using authenticator `"
 822                                   (symbol-name imap-auth) "'): "))))
 823         (when (and user passwd)
 824           (if (funcall loginfunc user passwd)
 825               (progn
 826                 (setq ret t
 827                       imap-username user)
 828                 (when (and (not imap-password)
 829                            (or imap-store-password
 830                                (y-or-n-p "Store password for this session? ")))
 831                   (setq imap-password passwd)))
 832             (message "Login failed...")
 833             (setq passwd nil)
 834             (setq imap-password nil)
 835             (sit-for 1))))
 836       ;;        (quit (with-current-buffer buffer
 837       ;;                (setq user nil
 838       ;;                      passwd nil)))
 839       ;;        (error (with-current-buffer buffer
 840       ;;                 (setq user nil
 841       ;;                       passwd nil))))
 842       ret)))
 843
 844 (defun imap-gssapi-auth-p (buffer)
 845   (eq imap-stream 'gssapi))
 846
 847 (defun imap-gssapi-auth (buffer)
 848   (message "imap: Authenticating using GSSAPI...%s"
 849            (if (eq imap-stream 'gssapi) "done" "failed"))
 850   (eq imap-stream 'gssapi))
 851
 852 (defun imap-kerberos4-auth-p (buffer)
 853   (and (imap-capability 'AUTH=KERBEROS_V4 buffer)
 854        (eq imap-stream 'kerberos4)))
 855
 856 (defun imap-kerberos4-auth (buffer)
 857   (message "imap: Authenticating using Kerberos 4...%s"
 858            (if (eq imap-stream 'kerberos4) "done" "failed"))
 859   (eq imap-stream 'kerberos4))
 860
 861 (defun imap-cram-md5-p (buffer)
 862   (imap-capability 'AUTH=CRAM-MD5 buffer))
 863
 864 (defun imap-cram-md5-auth (buffer)
 865   "Login to server using the AUTH CRAM-MD5 method."
 866   (message "imap: Authenticating using CRAM-MD5...")
 867   (let ((done (imap-interactive-login
 868                buffer
 869                (lambda (user passwd)
 870                  (imap-ok-p
 871                   (imap-send-command-wait
 872                    (list
 873                     "AUTHENTICATE CRAM-MD5"
 874                     (lambda (challenge)
 875                       (let* ((decoded (base64-decode-string challenge))
 876                              (hash (rfc2104-hash 'md5 64 16 passwd decoded))
 877                              (response (concat user " " hash))
 878                              (encoded (base64-encode-string response)))
 879                         encoded)))))))))
 880     (if done
 881         (message "imap: Authenticating using CRAM-MD5...done")
 882       (message "imap: Authenticating using CRAM-MD5...failed"))))
 883
 884 (defun imap-login-p (buffer)
 885   (and (not (imap-capability 'LOGINDISABLED buffer))
 886        (not (imap-capability 'X-LOGIN-CMD-DISABLED buffer))))
 887
 888 (defun imap-login-auth (buffer)
 889   "Login to server using the LOGIN command."
 890   (message "imap: Plaintext authentication...")
 891   (imap-interactive-login buffer
 892                           (lambda (user passwd)
 893                             (imap-ok-p (imap-send-command-wait
 894                                         (concat "LOGIN \"" user "\" \""
 895                                                 passwd "\""))))))
 896
 897 (defun imap-anonymous-p (buffer)
 898   t)
 899
 900 (defun imap-anonymous-auth (buffer)
 901   (message "imap: Logging in anonymously...")
 902   (with-current-buffer buffer
 903     (imap-ok-p (imap-send-command-wait
 904                 (concat "LOGIN anonymous \"" (concat (user-login-name) "@"
 905                                                      (system-name)) "\"")))))
 906
 907 (defun imap-digest-md5-p (buffer)
 908   (and (imap-capability 'AUTH=DIGEST-MD5 buffer)
 909        (condition-case ()
 910            (require 'digest-md5)
 911          (error nil))))
 912
 913 (defun imap-digest-md5-auth (buffer)
 914   "Login to server using the AUTH DIGEST-MD5 method."
 915   (message "imap: Authenticating using DIGEST-MD5...")
 916   (imap-interactive-login
 917    buffer
 918    (lambda (user passwd)
 919      (let ((tag
 920             (imap-send-command
 921              (list
 922               "AUTHENTICATE DIGEST-MD5"
 923               (lambda (challenge)
 924                 (digest-md5-parse-digest-challenge
 925                  (base64-decode-string challenge))
 926                 (let* ((digest-uri
 927                         (digest-md5-digest-uri
 928                          "imap" (digest-md5-challenge 'realm)))
 929                        (response
 930                         (digest-md5-digest-response
 931                          user passwd digest-uri)))
 932                   (base64-encode-string response 'no-line-break))))
 933              )))
 934        (if (not (eq (imap-wait-for-tag tag) 'INCOMPLETE))
 935            nil
 936          (setq imap-continuation nil)
 937          (imap-send-command-1 "")
 938          (imap-ok-p (imap-wait-for-tag tag)))))))
 939
 940 ;; Server functions:
 941
 942 (defun imap-open-1 (buffer)
 943   (with-current-buffer buffer
 944     (erase-buffer)
 945     (setq imap-current-mailbox nil
 946           imap-current-message nil
 947           imap-state 'initial
 948           imap-process (condition-case ()
 949                            (funcall (nth 2 (assq imap-stream
 950                                                  imap-stream-alist))
 951                                     "imap" buffer imap-server imap-port)
 952                          ((error quit) nil)))
 953     (when imap-process
 954       (set-process-filter imap-process 'imap-arrival-filter)
 955       (set-process-sentinel imap-process 'imap-sentinel)
 956       (while (and (eq imap-state 'initial)
 957                   (memq (process-status imap-process) '(open run)))
 958         (message "Waiting for response from %s..." imap-server)
 959         (accept-process-output imap-process 1))
 960       (message "Waiting for response from %s...done" imap-server)
 961       (and (memq (process-status imap-process) '(open run))
 962            imap-process))))
 963
 964 (defun imap-open (server &optional port stream auth buffer)
 965   "Open a IMAP connection to host SERVER at PORT returning a buffer.
 966 If PORT is unspecified, a default value is used (143 except
 967 for SSL which use 993).
 968 STREAM indicates the stream to use, see `imap-streams' for available
 969 streams.  If nil, it choices the best stream the server is capable of.
 970 AUTH indicates authenticator to use, see `imap-authenticators' for
 971 available authenticators.  If nil, it choices the best stream the
 972 server is capable of.
 973 BUFFER can be a buffer or a name of a buffer, which is created if
 974 necessary.  If nil, the buffer name is generated."
 975   (setq buffer (or buffer (format " *imap* %s:%d" server (or port 0))))
 976   (with-current-buffer (get-buffer-create buffer)
 977     (if (imap-opened buffer)
 978         (imap-close buffer))
 979     (mapcar 'make-local-variable imap-local-variables)
 980     (imap-disable-multibyte)
 981     (buffer-disable-undo)
 982     (setq imap-server (or server imap-server))
 983     (setq imap-port (or port imap-port))
 984     (setq imap-auth (or auth imap-auth))
 985     (setq imap-stream (or stream imap-stream))
 986     (message "imap: Connecting to %s..." imap-server)
 987     (if (null (let ((imap-stream (or imap-stream imap-default-stream)))
 988                 (imap-open-1 buffer)))
 989         (progn
 990           (message "imap: Connecting to %s...failed" imap-server)
 991           nil)
 992       (when (null imap-stream)
 993         ;; Need to choose stream.
 994         (let ((streams imap-streams))
 995           (while (setq stream (pop streams))
 996             ;; OK to use this stream?
 997             (when (funcall (nth 1 (assq stream imap-stream-alist)) buffer)
 998               ;; Stream changed?
 999               (if (not (eq imap-default-stream stream))
1000                   (with-current-buffer (get-buffer-create
1001                                         (generate-new-buffer-name " *temp*"))
1002                     (mapcar 'make-local-variable imap-local-variables)
1003                     (imap-disable-multibyte)
1004                     (buffer-disable-undo)
1005                     (setq imap-server (or server imap-server))
1006                     (setq imap-port (or port imap-port))
1007                     (setq imap-auth (or auth imap-auth))
1008                     (message "imap: Reconnecting with stream `%s'..." stream)
1009                     (if (null (let ((imap-stream stream))
1010                                 (imap-open-1 (current-buffer))))
1011                         (progn
1012                           (kill-buffer (current-buffer))
1013                           (message
1014                            "imap: Reconnecting with stream `%s'...failed"
1015                            stream))
1016                       ;; We're done, kill the first connection
1017                       (imap-close buffer)
1018                       (kill-buffer buffer)
1019                       (rename-buffer buffer)
1020                       (message "imap: Reconnecting with stream `%s'...done"
1021                                stream)
1022                       (setq imap-stream stream)
1023                       (setq imap-capability nil)
1024                       (setq streams nil)))
1025                 ;; We're done
1026                 (message "imap: Connecting to %s...done" imap-server)
1027                 (setq imap-stream stream)
1028                 (setq imap-capability nil)
1029                 (setq streams nil))))))
1030       (when (imap-opened buffer)
1031         (setq imap-mailbox-data (make-vector imap-mailbox-prime 0)))
1032       (when imap-stream
1033         buffer))))
1034
1035 (defun imap-opened (&optional buffer)
1036   "Return non-nil if connection to imap server in BUFFER is open.
1037 If BUFFER is nil then the current buffer is used."
1038   (and (setq buffer (get-buffer (or buffer (current-buffer))))
1039        (buffer-live-p buffer)
1040        (with-current-buffer buffer
1041          (and imap-process
1042               (memq (process-status imap-process) '(open run))))))
1043
1044 (defun imap-authenticate (&optional user passwd buffer)
1045   "Authenticate to server in BUFFER, using current buffer if nil.
1046 It uses the authenticator specified when opening the server.  If the
1047 authenticator requires username/passwords, they are queried from the
1048 user and optionally stored in the buffer.  If USER and/or PASSWD is
1049 specified, the user will not be questioned and the username and/or
1050 password is remembered in the buffer."
1051   (with-current-buffer (or buffer (current-buffer))
1052     (if (not (eq imap-state 'nonauth))
1053         (or (eq imap-state 'auth)
1054             (eq imap-state 'select)
1055             (eq imap-state 'examine))
1056       (make-local-variable 'imap-username)
1057       (make-local-variable 'imap-password)
1058       (if user (setq imap-username user))
1059       (if passwd (setq imap-password passwd))
1060       (if imap-auth
1061           (and (funcall (nth 2 (assq imap-auth
1062                                      imap-authenticator-alist)) buffer)
1063                (setq imap-state 'auth))
1064         ;; Choose authenticator.
1065         (let ((auths imap-authenticators)
1066               auth)
1067           (while (setq auth (pop auths))
1068             ;; OK to use authenticator?
1069             (when (funcall (nth 1 (assq auth imap-authenticator-alist)) buffer)
1070               (message "imap: Authenticating to `%s' using `%s'..."
1071                        imap-server auth)
1072               (setq imap-auth auth)
1073               (if (funcall (nth 2 (assq auth imap-authenticator-alist)) buffer)
1074                   (progn
1075                     (message "imap: Authenticating to `%s' using `%s'...done"
1076                              imap-server auth)
1077                     (setq auths nil))
1078                 (message "imap: Authenticating to `%s' using `%s'...failed"
1079                          imap-server auth)))))
1080         imap-state))))
1081
1082 (defun imap-close (&optional buffer)
1083   "Close connection to server in BUFFER.
1084 If BUFFER is nil, the current buffer is used."
1085   (with-current-buffer (or buffer (current-buffer))
1086     (when (imap-opened)
1087       (condition-case nil
1088           (imap-send-command-wait "LOGOUT")
1089         (quit nil)))
1090     (when (and imap-process
1091                (memq (process-status imap-process) '(open run)))
1092       (delete-process imap-process))
1093     (setq imap-current-mailbox nil
1094           imap-current-message nil
1095           imap-process nil)
1096     (erase-buffer)
1097     t))
1098
1099 (defun imap-capability (&optional identifier buffer)
1100   "Return a list of identifiers which server in BUFFER support.
1101 If IDENTIFIER, return non-nil if it's among the servers capabilities.
1102 If BUFFER is nil, the current buffer is assumed."
1103   (with-current-buffer (or buffer (current-buffer))
1104     (unless imap-capability
1105       (unless (imap-ok-p (imap-send-command-wait "CAPABILITY"))
1106         (setq imap-capability '(IMAP2))))
1107     (if identifier
1108         (memq (intern (upcase (symbol-name identifier))) imap-capability)
1109       imap-capability)))
1110
1111 (defun imap-id (&optional list-of-values buffer)
1112   "Identify client to server in BUFFER, and return server identity.
1113 LIST-OF-VALUES is nil, or a plist with identifier and value
1114 strings to send to the server to identify the client.
1115
1116 Return a list of identifiers which server in BUFFER support, or
1117 nil if it doesn't support ID or returns no information.
1118
1119 If BUFFER is nil, the current buffer is assumed."
1120   (with-current-buffer (or buffer (current-buffer))
1121     (when (and (imap-capability 'ID)
1122                (imap-ok-p (imap-send-command-wait
1123                            (if (null list-of-values)
1124                                "ID NIL"
1125                              (concat "ID (" (mapconcat (lambda (el)
1126                                                          (concat "\"" el "\""))
1127                                                        list-of-values
1128                                                        " ") ")")))))
1129       imap-id)))
1130
1131 (defun imap-namespace (&optional buffer)
1132   "Return a namespace hierarchy at server in BUFFER.
1133 If BUFFER is nil, the current buffer is assumed."
1134   (with-current-buffer (or buffer (current-buffer))
1135     (unless imap-namespace
1136       (when (imap-capability 'NAMESPACE)
1137         (imap-send-command-wait "NAMESPACE")))
1138     imap-namespace))
1139
1140 (defun imap-send-command-wait (command &optional buffer)
1141   (imap-wait-for-tag (imap-send-command command buffer) buffer))
1142
1143 \f
1144 ;; Mailbox functions:
1145
1146 (defun imap-mailbox-put (propname value &optional mailbox buffer)
1147   (with-current-buffer (or buffer (current-buffer))
1148     (if imap-mailbox-data
1149         (put (intern (or mailbox imap-current-mailbox) imap-mailbox-data)
1150              propname value)
1151       (error "Imap-mailbox-data is nil, prop %s value %s mailbox %s buffer %s"
1152              propname value mailbox (current-buffer)))
1153     t))
1154
1155 (defsubst imap-mailbox-get-1 (propname &optional mailbox)
1156   (get (intern-soft (or mailbox imap-current-mailbox) imap-mailbox-data)
1157        propname))
1158
1159 (defun imap-mailbox-get (propname &optional mailbox buffer)
1160   (let ((mailbox (imap-utf7-encode mailbox)))
1161     (with-current-buffer (or buffer (current-buffer))
1162       (imap-mailbox-get-1 propname (or mailbox imap-current-mailbox)))))
1163
1164 (defun imap-mailbox-map-1 (func &optional mailbox-decoder buffer)
1165   (with-current-buffer (or buffer (current-buffer))
1166     (let (result)
1167       (mapatoms
1168        (lambda (s)
1169          (push (funcall func (if mailbox-decoder
1170                                  (funcall mailbox-decoder (symbol-name s))
1171                                (symbol-name s))) result))
1172        imap-mailbox-data)
1173       result)))
1174
1175 (defun imap-mailbox-map (func &optional buffer)
1176   "Map a function across each mailbox in `imap-mailbox-data', returning a list.
1177 Function should take a mailbox name (a string) as
1178 the only argument."
1179   (imap-mailbox-map-1 func 'imap-utf7-decode buffer))
1180
1181 (defun imap-current-mailbox (&optional buffer)
1182   (with-current-buffer (or buffer (current-buffer))
1183     (imap-utf7-decode imap-current-mailbox)))
1184
1185 (defun imap-current-mailbox-p-1 (mailbox &optional examine)
1186   (and (string= mailbox imap-current-mailbox)
1187        (or (and examine
1188                 (eq imap-state 'examine))
1189            (and (not examine)
1190                 (eq imap-state 'selected)))))
1191
1192 (defun imap-current-mailbox-p (mailbox &optional examine buffer)
1193   (with-current-buffer (or buffer (current-buffer))
1194     (imap-current-mailbox-p-1 (imap-utf7-encode mailbox) examine)))
1195
1196 (defun imap-mailbox-select-1 (mailbox &optional examine)
1197   "Select MAILBOX on server in BUFFER.
1198 If EXAMINE is non-nil, do a read-only select."
1199   (if (imap-current-mailbox-p-1 mailbox examine)
1200       imap-current-mailbox
1201     (setq imap-current-mailbox mailbox)
1202     (if (imap-ok-p (imap-send-command-wait
1203                     (concat (if examine "EXAMINE" "SELECT") " \""
1204                             mailbox "\"")))
1205         (progn
1206           (setq imap-message-data (make-vector imap-message-prime 0)
1207                 imap-state (if examine 'examine 'selected))
1208           imap-current-mailbox)
1209       ;; Failed SELECT/EXAMINE unselects current mailbox
1210       (setq imap-current-mailbox nil))))
1211
1212 (defun imap-mailbox-select (mailbox &optional examine buffer)
1213   (with-current-buffer (or buffer (current-buffer))
1214     (imap-utf7-decode
1215      (imap-mailbox-select-1 (imap-utf7-encode mailbox) examine))))
1216
1217 (defun imap-mailbox-examine-1 (mailbox &optional buffer)
1218   (with-current-buffer (or buffer (current-buffer))
1219     (imap-mailbox-select-1 mailbox 'examine)))
1220
1221 (defun imap-mailbox-examine (mailbox &optional buffer)
1222   "Examine MAILBOX on server in BUFFER."
1223   (imap-mailbox-select mailbox 'examine buffer))
1224
1225 (defun imap-mailbox-unselect (&optional buffer)
1226   "Close current folder in BUFFER, without expunging articles."
1227   (with-current-buffer (or buffer (current-buffer))
1228     (when (or (eq imap-state 'auth)
1229               (and (imap-capability 'UNSELECT)
1230                    (imap-ok-p (imap-send-command-wait "UNSELECT")))
1231               (and (imap-ok-p
1232                     (imap-send-command-wait (concat "EXAMINE \""
1233                                                     imap-current-mailbox
1234                                                     "\"")))
1235                    (imap-ok-p (imap-send-command-wait "CLOSE"))))
1236       (setq imap-current-mailbox nil
1237             imap-message-data nil
1238             imap-state 'auth)
1239       t)))
1240
1241 (defun imap-mailbox-expunge (&optional asynch buffer)
1242   "Expunge articles in current folder in BUFFER.
1243 If ASYNCH, do not wait for succesful completion of the command.
1244 If BUFFER is nil the current buffer is assumed."
1245   (with-current-buffer (or buffer (current-buffer))
1246     (when (and imap-current-mailbox (not (eq imap-state 'examine)))
1247       (if asynch
1248           (imap-send-command "EXPUNGE")
1249       (imap-ok-p (imap-send-command-wait "EXPUNGE"))))))
1250
1251 (defun imap-mailbox-close (&optional asynch buffer)
1252   "Expunge articles and close current folder in BUFFER.
1253 If ASYNCH, do not wait for succesful completion of the command.
1254 If BUFFER is nil the current buffer is assumed."
1255   (with-current-buffer (or buffer (current-buffer))
1256     (when imap-current-mailbox
1257       (if asynch
1258           (imap-add-callback (imap-send-command "CLOSE")
1259                              `(lambda (tag status)
1260                                 (message "IMAP mailbox `%s' closed... %s"
1261                                          imap-current-mailbox status)
1262                                 (when (eq ,imap-current-mailbox
1263                                           imap-current-mailbox)
1264                                   ;; Don't wipe out data if another mailbox
1265                                   ;; was selected...
1266                                   (setq imap-current-mailbox nil
1267                                         imap-message-data nil
1268                                         imap-state 'auth))))
1269         (when (imap-ok-p (imap-send-command-wait "CLOSE"))
1270           (setq imap-current-mailbox nil
1271                 imap-message-data nil
1272                 imap-state 'auth)))
1273       t)))
1274
1275 (defun imap-mailbox-create-1 (mailbox)
1276   (imap-ok-p (imap-send-command-wait (list "CREATE \"" mailbox "\""))))
1277
1278 (defun imap-mailbox-create (mailbox &optional buffer)
1279   "Create MAILBOX on server in BUFFER.
1280 If BUFFER is nil the current buffer is assumed."
1281   (with-current-buffer (or buffer (current-buffer))
1282     (imap-mailbox-create-1 (imap-utf7-encode mailbox))))
1283
1284 (defun imap-mailbox-delete (mailbox &optional buffer)
1285   "Delete MAILBOX on server in BUFFER.
1286 If BUFFER is nil the current buffer is assumed."
1287   (let ((mailbox (imap-utf7-encode mailbox)))
1288     (with-current-buffer (or buffer (current-buffer))
1289       (imap-ok-p
1290        (imap-send-command-wait (list "DELETE \"" mailbox "\""))))))
1291
1292 (defun imap-mailbox-rename (oldname newname &optional buffer)
1293   "Rename mailbox OLDNAME to NEWNAME on server in BUFFER.
1294 If BUFFER is nil the current buffer is assumed."
1295   (let ((oldname (imap-utf7-encode oldname))
1296         (newname (imap-utf7-encode newname)))
1297     (with-current-buffer (or buffer (current-buffer))
1298       (imap-ok-p
1299        (imap-send-command-wait (list "RENAME \"" oldname "\" "
1300                                      "\"" newname "\""))))))
1301
1302 (defun imap-mailbox-lsub (&optional root reference add-delimiter buffer)
1303   "Return a list of subscribed mailboxes on server in BUFFER.
1304 If ROOT is non-nil, only list matching mailboxes.  If ADD-DELIMITER is
1305 non-nil, a hierarchy delimiter is added to root.  REFERENCE is a
1306 implementation-specific string that has to be passed to lsub command."
1307   (with-current-buffer (or buffer (current-buffer))
1308     ;; Make sure we know the hierarchy separator for root's hierarchy
1309     (when (and add-delimiter (null (imap-mailbox-get-1 'delimiter root)))
1310       (imap-send-command-wait (concat "LIST \"" reference "\" \""
1311                                       (imap-utf7-encode root) "\"")))
1312     ;; clear list data (NB not delimiter and other stuff)
1313     (imap-mailbox-map-1 (lambda (mailbox)
1314                           (imap-mailbox-put 'lsub nil mailbox)))
1315     (when (imap-ok-p
1316            (imap-send-command-wait
1317             (concat "LSUB \"" reference "\" \"" (imap-utf7-encode root)
1318                     (and add-delimiter (imap-mailbox-get-1 'delimiter root))
1319                     "%\"")))
1320       (let (out)
1321         (imap-mailbox-map-1 (lambda (mailbox)
1322                               (when (imap-mailbox-get-1 'lsub mailbox)
1323                                 (push (imap-utf7-decode mailbox) out))))
1324         (nreverse out)))))
1325
1326 (defun imap-mailbox-list (root &optional reference add-delimiter buffer)
1327   "Return a list of mailboxes matching ROOT on server in BUFFER.
1328 If ADD-DELIMITER is non-nil, a hierarchy delimiter is added to
1329 root.  REFERENCE is a implementation-specific string that has to be
1330 passed to list command."
1331   (with-current-buffer (or buffer (current-buffer))
1332     ;; Make sure we know the hierarchy separator for root's hierarchy
1333     (when (and add-delimiter (null (imap-mailbox-get-1 'delimiter root)))
1334       (imap-send-command-wait (concat "LIST \"" reference "\" \""
1335                                       (imap-utf7-encode root) "\"")))
1336     ;; clear list data (NB not delimiter and other stuff)
1337     (imap-mailbox-map-1 (lambda (mailbox)
1338                           (imap-mailbox-put 'list nil mailbox)))
1339     (when (imap-ok-p
1340            (imap-send-command-wait
1341             (concat "LIST \"" reference "\" \"" (imap-utf7-encode root)
1342                     (and add-delimiter (imap-mailbox-get-1 'delimiter root))
1343                     "%\"")))
1344       (let (out)
1345         (imap-mailbox-map-1 (lambda (mailbox)
1346                               (when (imap-mailbox-get-1 'list mailbox)
1347                                 (push (imap-utf7-decode mailbox) out))))
1348         (nreverse out)))))
1349
1350 (defun imap-mailbox-subscribe (mailbox &optional buffer)
1351   "Send the SUBSCRIBE command on the mailbox to server in BUFFER.
1352 Returns non-nil if successful."
1353   (with-current-buffer (or buffer (current-buffer))
1354     (imap-ok-p (imap-send-command-wait (concat "SUBSCRIBE \""
1355                                                (imap-utf7-encode mailbox)
1356                                                "\"")))))
1357
1358 (defun imap-mailbox-unsubscribe (mailbox &optional buffer)
1359   "Send the SUBSCRIBE command on the mailbox to server in BUFFER.
1360 Returns non-nil if successful."
1361   (with-current-buffer (or buffer (current-buffer))
1362     (imap-ok-p (imap-send-command-wait (concat "UNSUBSCRIBE "
1363                                                (imap-utf7-encode mailbox)
1364                                                "\"")))))
1365
1366 (defun imap-mailbox-status (mailbox items &optional buffer)
1367   "Get status items ITEM in MAILBOX from server in BUFFER.
1368 ITEMS can be a symbol or a list of symbols, valid symbols are one of
1369 the STATUS data items -- ie 'messages, 'recent, 'uidnext, 'uidvalidity
1370 or 'unseen.  If ITEMS is a list of symbols, a list of values is
1371 returned, if ITEMS is a symbol only its value is returned."
1372   (with-current-buffer (or buffer (current-buffer))
1373     (when (imap-ok-p
1374            (imap-send-command-wait (list "STATUS \""
1375                                          (imap-utf7-encode mailbox)
1376                                          "\" "
1377                                          (upcase
1378                                           (format "%s"
1379                                                   (if (listp items)
1380                                                       items
1381                                                     (list items)))))))
1382       (if (listp items)
1383           (mapcar (lambda (item)
1384                     (imap-mailbox-get item mailbox))
1385                   items)
1386         (imap-mailbox-get items mailbox)))))
1387
1388 (defun imap-mailbox-status-asynch (mailbox items &optional buffer)
1389   "Send status item request ITEM on MAILBOX to server in BUFFER.
1390 ITEMS can be a symbol or a list of symbols, valid symbols are one of
1391 the STATUS data items -- ie 'messages, 'recent, 'uidnext, 'uidvalidity
1392 or 'unseen.  The IMAP command tag is returned."
1393   (with-current-buffer (or buffer (current-buffer))
1394     (imap-send-command (list "STATUS \""
1395                              (imap-utf7-encode mailbox)
1396                              "\" "
1397                              (format "%s"
1398                                      (if (listp items)
1399                                          items
1400                                        (list items)))))))
1401
1402 (defun imap-mailbox-acl-get (&optional mailbox buffer)
1403   "Get ACL on mailbox from server in BUFFER."
1404   (let ((mailbox (imap-utf7-encode mailbox)))
1405     (with-current-buffer (or buffer (current-buffer))
1406       (when (imap-ok-p
1407              (imap-send-command-wait (list "GETACL \""
1408                                            (or mailbox imap-current-mailbox)
1409                                            "\"")))
1410         (imap-mailbox-get-1 'acl (or mailbox imap-current-mailbox))))))
1411
1412 (defun imap-mailbox-acl-set (identifier rights &optional mailbox buffer)
1413   "Change/set ACL for IDENTIFIER to RIGHTS in MAILBOX from server in BUFFER."
1414   (let ((mailbox (imap-utf7-encode mailbox)))
1415     (with-current-buffer (or buffer (current-buffer))
1416       (imap-ok-p
1417        (imap-send-command-wait (list "SETACL \""
1418                                      (or mailbox imap-current-mailbox)
1419                                      "\" "
1420                                      identifier
1421                                      " "
1422                                      rights))))))
1423
1424 (defun imap-mailbox-acl-delete (identifier &optional mailbox buffer)
1425   "Removes any <identifier,rights> pair for IDENTIFIER in MAILBOX from server in BUFFER."
1426   (let ((mailbox (imap-utf7-encode mailbox)))
1427     (with-current-buffer (or buffer (current-buffer))
1428       (imap-ok-p
1429        (imap-send-command-wait (list "DELETEACL \""
1430                                      (or mailbox imap-current-mailbox)
1431                                      "\" "
1432                                      identifier))))))
1433
1434 \f
1435 ;; Message functions:
1436
1437 (defun imap-current-message (&optional buffer)
1438   (with-current-buffer (or buffer (current-buffer))
1439     imap-current-message))
1440
1441 (defun imap-list-to-message-set (list)
1442   (mapconcat (lambda (item)
1443                (number-to-string item))
1444              (if (listp list)
1445                  list
1446                (list list))
1447              ","))
1448
1449 (defun imap-range-to-message-set (range)
1450   (mapconcat
1451    (lambda (item)
1452      (if (consp item)
1453          (format "%d:%d"
1454                  (car item) (cdr item))
1455        (format "%d" item)))
1456    (if (and (listp range) (not (listp (cdr range))))
1457        (list range) ;; make (1 . 2) into ((1 . 2))
1458      range)
1459    ","))
1460
1461 (defun imap-fetch-asynch (uids props &optional nouidfetch buffer)
1462   (with-current-buffer (or buffer (current-buffer))
1463     (imap-send-command (format "%sFETCH %s %s" (if nouidfetch "" "UID ")
1464                                (if (listp uids)
1465                                    (imap-list-to-message-set uids)
1466                                  uids)
1467                                props))))
1468
1469 (defun imap-fetch (uids props &optional receive nouidfetch buffer)
1470   "Fetch properties PROPS from message set UIDS from server in BUFFER.
1471 UIDS can be a string, number or a list of numbers.  If RECEIVE
1472 is non-nil return theese properties."
1473   (with-current-buffer (or buffer (current-buffer))
1474     (when (imap-ok-p (imap-send-command-wait
1475                       (format "%sFETCH %s %s" (if nouidfetch "" "UID ")
1476                               (if (listp uids)
1477                                   (imap-list-to-message-set uids)
1478                                 uids)
1479                               props)))
1480       (if (or (null receive) (stringp uids))
1481           t
1482         (if (listp uids)
1483             (mapcar (lambda (uid)
1484                       (if (listp receive)
1485                           (mapcar (lambda (prop)
1486                                     (imap-message-get uid prop))
1487                                   receive)
1488                         (imap-message-get uid receive)))
1489                     uids)
1490           (imap-message-get uids receive))))))
1491
1492 (defun imap-message-put (uid propname value &optional buffer)
1493   (with-current-buffer (or buffer (current-buffer))
1494     (if imap-message-data
1495         (put (intern (number-to-string uid) imap-message-data)
1496              propname value)
1497       (error "Imap-message-data is nil, uid %s prop %s value %s buffer %s"
1498              uid propname value (current-buffer)))
1499     t))
1500
1501 (defun imap-message-get (uid propname &optional buffer)
1502   (with-current-buffer (or buffer (current-buffer))
1503     (get (intern-soft (number-to-string uid) imap-message-data)
1504          propname)))
1505
1506 (defun imap-message-map (func propname &optional buffer)
1507   "Map a function across each mailbox in `imap-message-data', returning a list."
1508   (with-current-buffer (or buffer (current-buffer))
1509     (let (result)
1510       (mapatoms
1511        (lambda (s)
1512          (push (funcall func (get s 'UID) (get s propname)) result))
1513        imap-message-data)
1514       result)))
1515
1516 (defmacro imap-message-envelope-date (uid &optional buffer)
1517   `(with-current-buffer (or ,buffer (current-buffer))
1518      (elt (imap-message-get ,uid 'ENVELOPE) 0)))
1519
1520 (defmacro imap-message-envelope-subject (uid &optional buffer)
1521   `(with-current-buffer (or ,buffer (current-buffer))
1522      (elt (imap-message-get ,uid 'ENVELOPE) 1)))
1523
1524 (defmacro imap-message-envelope-from (uid &optional buffer)
1525   `(with-current-buffer (or ,buffer (current-buffer))
1526      (elt (imap-message-get ,uid 'ENVELOPE) 2)))
1527
1528 (defmacro imap-message-envelope-sender (uid &optional buffer)
1529   `(with-current-buffer (or ,buffer (current-buffer))
1530      (elt (imap-message-get ,uid 'ENVELOPE) 3)))
1531
1532 (defmacro imap-message-envelope-reply-to (uid &optional buffer)
1533   `(with-current-buffer (or ,buffer (current-buffer))
1534      (elt (imap-message-get ,uid 'ENVELOPE) 4)))
1535
1536 (defmacro imap-message-envelope-to (uid &optional buffer)
1537   `(with-current-buffer (or ,buffer (current-buffer))
1538      (elt (imap-message-get ,uid 'ENVELOPE) 5)))
1539
1540 (defmacro imap-message-envelope-cc (uid &optional buffer)
1541   `(with-current-buffer (or ,buffer (current-buffer))
1542      (elt (imap-message-get ,uid 'ENVELOPE) 6)))
1543
1544 (defmacro imap-message-envelope-bcc (uid &optional buffer)
1545   `(with-current-buffer (or ,buffer (current-buffer))
1546      (elt (imap-message-get ,uid 'ENVELOPE) 7)))
1547
1548 (defmacro imap-message-envelope-in-reply-to (uid &optional buffer)
1549   `(with-current-buffer (or ,buffer (current-buffer))
1550      (elt (imap-message-get ,uid 'ENVELOPE) 8)))
1551
1552 (defmacro imap-message-envelope-message-id (uid &optional buffer)
1553   `(with-current-buffer (or ,buffer (current-buffer))
1554      (elt (imap-message-get ,uid 'ENVELOPE) 9)))
1555
1556 (defmacro imap-message-body (uid &optional buffer)
1557   `(with-current-buffer (or ,buffer (current-buffer))
1558      (imap-message-get ,uid 'BODY)))
1559
1560 (defun imap-search (predicate &optional buffer)
1561   (with-current-buffer (or buffer (current-buffer))
1562     (imap-mailbox-put 'search 'dummy)
1563     (when (imap-ok-p (imap-send-command-wait (concat "UID SEARCH " predicate)))
1564       (if (eq (imap-mailbox-get-1 'search imap-current-mailbox) 'dummy)
1565           (progn
1566             (message "Missing SEARCH response to a SEARCH command (server not RFC compliant)...")
1567             nil)
1568         (imap-mailbox-get-1 'search imap-current-mailbox)))))
1569
1570 (defun imap-message-flag-permanent-p (flag &optional mailbox buffer)
1571   "Return t iff FLAG can be permanently (between IMAP sessions) saved on articles, in MAILBOX on server in BUFFER."
1572   (with-current-buffer (or buffer (current-buffer))
1573     (or (member "\\*" (imap-mailbox-get 'permanentflags mailbox))
1574         (member flag (imap-mailbox-get 'permanentflags mailbox)))))
1575
1576 (defun imap-message-flags-set (articles flags &optional silent buffer)
1577   (when (and articles flags)
1578     (with-current-buffer (or buffer (current-buffer))
1579       (imap-ok-p (imap-send-command-wait
1580                   (concat "UID STORE " articles
1581                           " FLAGS" (if silent ".SILENT") " (" flags ")"))))))
1582
1583 (defun imap-message-flags-del (articles flags &optional silent buffer)
1584   (when (and articles flags)
1585     (with-current-buffer (or buffer (current-buffer))
1586       (imap-ok-p (imap-send-command-wait
1587                   (concat "UID STORE " articles
1588                           " -FLAGS" (if silent ".SILENT") " (" flags ")"))))))
1589
1590 (defun imap-message-flags-add (articles flags &optional silent buffer)
1591   (when (and articles flags)
1592     (with-current-buffer (or buffer (current-buffer))
1593       (imap-ok-p (imap-send-command-wait
1594                   (concat "UID STORE " articles
1595                           " +FLAGS" (if silent ".SILENT") " (" flags ")"))))))
1596
1597 (defun imap-message-copyuid-1 (mailbox)
1598   (if (imap-capability 'UIDPLUS)
1599       (list (nth 0 (imap-mailbox-get-1 'copyuid mailbox))
1600             (string-to-number (nth 2 (imap-mailbox-get-1 'copyuid mailbox))))
1601     (let ((old-mailbox imap-current-mailbox)
1602           (state imap-state)
1603           (imap-message-data (make-vector 2 0)))
1604       (when (imap-mailbox-examine-1 mailbox)
1605         (prog1
1606             (and (imap-fetch "*" "UID")
1607                  (list (imap-mailbox-get-1 'uidvalidity mailbox)
1608                        (apply 'max (imap-message-map
1609                                     (lambda (uid prop) uid) 'UID))))
1610           (if old-mailbox
1611               (imap-mailbox-select old-mailbox (eq state 'examine))
1612             (imap-mailbox-unselect)))))))
1613
1614 (defun imap-message-copyuid (mailbox &optional buffer)
1615   (with-current-buffer (or buffer (current-buffer))
1616     (imap-message-copyuid-1 (imap-utf7-decode mailbox))))
1617
1618 (defun imap-message-copy (articles mailbox
1619                                    &optional dont-create no-copyuid buffer)
1620   "Copy ARTICLES (a string message set) to MAILBOX on server in
1621 BUFFER, creating mailbox if it doesn't exist.  If dont-create is
1622 non-nil, it will not create a mailbox.  On success, return a list with
1623 the UIDVALIDITY of the mailbox the article(s) was copied to as the
1624 first element, rest of list contain the saved articles' UIDs."
1625   (when articles
1626     (with-current-buffer (or buffer (current-buffer))
1627       (let ((mailbox (imap-utf7-encode mailbox)))
1628         (if (let ((cmd (concat "UID COPY " articles " \"" mailbox "\""))
1629                   (imap-current-target-mailbox mailbox))
1630               (if (imap-ok-p (imap-send-command-wait cmd))
1631                   t
1632                 (when (and (not dont-create)
1633                            ;; removed because of buggy Oracle server
1634                            ;; that doesn't send TRYCREATE tags (which
1635                            ;; is a MUST according to specifications):
1636                            ;;(imap-mailbox-get-1 'trycreate mailbox)
1637                            (imap-mailbox-create-1 mailbox))
1638                   (imap-ok-p (imap-send-command-wait cmd)))))
1639             (or no-copyuid
1640                 (imap-message-copyuid-1 mailbox)))))))
1641
1642 (defun imap-message-appenduid-1 (mailbox)
1643   (if (imap-capability 'UIDPLUS)
1644       (imap-mailbox-get-1 'appenduid mailbox)
1645     (let ((old-mailbox imap-current-mailbox)
1646           (state imap-state)
1647           (imap-message-data (make-vector 2 0)))
1648       (when (imap-mailbox-examine-1 mailbox)
1649         (prog1
1650             (and (imap-fetch "*" "UID")
1651                  (list (imap-mailbox-get-1 'uidvalidity mailbox)
1652                        (apply 'max (imap-message-map
1653                                     (lambda (uid prop) uid) 'UID))))
1654           (if old-mailbox
1655               (imap-mailbox-select old-mailbox (eq state 'examine))
1656             (imap-mailbox-unselect)))))))
1657
1658 (defun imap-message-appenduid (mailbox &optional buffer)
1659   (with-current-buffer (or buffer (current-buffer))
1660     (imap-message-appenduid-1 (imap-utf7-encode mailbox))))
1661
1662 (defun imap-message-append (mailbox article &optional flags date-time buffer)
1663   "Append ARTICLE (a buffer) to MAILBOX on server in BUFFER.
1664 FLAGS and DATE-TIME is currently not used.  Return a cons holding
1665 uidvalidity of MAILBOX and UID the newly created article got, or nil
1666 on failure."
1667   (let ((mailbox (imap-utf7-encode mailbox)))
1668     (with-current-buffer (or buffer (current-buffer))
1669       (and (let ((imap-current-target-mailbox mailbox))
1670              (imap-ok-p
1671               (imap-send-command-wait
1672                (list "APPEND \"" mailbox "\" "  article))))
1673            (imap-message-appenduid-1 mailbox)))))
1674
1675 (defun imap-body-lines (body)
1676   "Return number of lines in article by looking at the mime bodystructure BODY."
1677   (if (listp body)
1678       (if (stringp (car body))
1679           (cond ((and (string= (upcase (car body)) "TEXT")
1680                       (numberp (nth 7 body)))
1681                  (nth 7 body))
1682                 ((and (string= (upcase (car body)) "MESSAGE")
1683                       (numberp (nth 9 body)))
1684                  (nth 9 body))
1685                 (t 0))
1686         (apply '+ (mapcar 'imap-body-lines body)))
1687     0))
1688
1689 (defun imap-envelope-from (from)
1690   "Return a from string line."
1691   (and from
1692        (concat (aref from 0)
1693                (if (aref from 0) " <")
1694                (aref from 2)
1695                "@"
1696                (aref from 3)
1697                (if (aref from 0) ">"))))
1698
1699 \f
1700 ;; Internal functions.
1701
1702 (defun imap-add-callback (tag func)
1703   (setq imap-callbacks (append (list (cons tag func)) imap-callbacks)))
1704
1705 (defun imap-send-command-1 (cmdstr)
1706   (setq cmdstr (concat cmdstr imap-client-eol))
1707   (and imap-log
1708        (with-current-buffer (get-buffer-create imap-log-buffer)
1709          (imap-disable-multibyte)
1710          (buffer-disable-undo)
1711          (goto-char (point-max))
1712          (insert cmdstr)))
1713   (process-send-string imap-process cmdstr))
1714
1715 (defun imap-send-command (command &optional buffer)
1716   (with-current-buffer (or buffer (current-buffer))
1717     (if (not (listp command)) (setq command (list command)))
1718     (let ((tag (setq imap-tag (1+ imap-tag)))
1719           cmd cmdstr)
1720       (setq cmdstr (concat (number-to-string imap-tag) " "))
1721       (while (setq cmd (pop command))
1722         (cond ((stringp cmd)
1723                (setq cmdstr (concat cmdstr cmd)))
1724               ((bufferp cmd)
1725                (let ((eol imap-client-eol)
1726                      (calcfirst imap-calculate-literal-size-first)
1727                      size)
1728                  (with-current-buffer cmd
1729                    (if calcfirst
1730                        (setq size (buffer-size)))
1731                    (when (not (equal eol "\r\n"))
1732                      ;; XXX modifies buffer!
1733                      (goto-char (point-min))
1734                      (while (search-forward "\r\n" nil t)
1735                        (replace-match eol)))
1736                    (if (not calcfirst)
1737                        (setq size (buffer-size))))
1738                  (setq cmdstr
1739                        (concat cmdstr (format "{%d}" size))))
1740                (unwind-protect
1741                    (progn
1742                      (imap-send-command-1 cmdstr)
1743                      (setq cmdstr nil)
1744                      (if (not (eq (imap-wait-for-tag tag) 'INCOMPLETE))
1745                          (setq command nil) ;; abort command if no cont-req
1746                        (let ((process imap-process)
1747                              (stream imap-stream)
1748                              (eol imap-client-eol))
1749                          (with-current-buffer cmd
1750                            (and imap-log
1751                                 (with-current-buffer (get-buffer-create
1752                                                       imap-log-buffer)
1753                                   (imap-disable-multibyte)
1754                                   (buffer-disable-undo)
1755                                   (goto-char (point-max))
1756                                   (insert-buffer-substring cmd)))
1757                            (process-send-region process (point-min)
1758                                                 (point-max)))
1759                          (process-send-string process imap-client-eol))))
1760                  (setq imap-continuation nil)))
1761               ((functionp cmd)
1762                (imap-send-command-1 cmdstr)
1763                (setq cmdstr nil)
1764                (unwind-protect
1765                    (if (not (eq (imap-wait-for-tag tag) 'INCOMPLETE))
1766                        (setq command nil) ;; abort command if no cont-req
1767                      (setq command (cons (funcall cmd imap-continuation)
1768                                          command)))
1769                  (setq imap-continuation nil)))
1770               (t
1771                (error "Unknown command type"))))
1772       (if cmdstr
1773           (imap-send-command-1 cmdstr))
1774       tag)))
1775
1776 (defun imap-wait-for-tag (tag &optional buffer)
1777   (with-current-buffer (or buffer (current-buffer))
1778     (let (imap-have-messaged)
1779       (while (and (null imap-continuation)
1780                   (memq (process-status imap-process) '(open run))
1781                   (< imap-reached-tag tag))
1782         (let ((len (/ (point-max) 1024))
1783               message-log-max)
1784           (unless (< len 10)
1785             (setq imap-have-messaged t)
1786             (message "imap read: %dk" len))
1787           (accept-process-output imap-process
1788                                  (truncate imap-read-timeout)
1789                                  (truncate (* (- imap-read-timeout
1790                                                  (truncate imap-read-timeout))
1791                                               1000)))))
1792       ;; A process can die _before_ we have processed everything it
1793       ;; has to say.  Moreover, this can happen in between the call to
1794       ;; accept-process-output and the call to process-status in an
1795       ;; iteration of the loop above.
1796       (when (and (null imap-continuation)
1797                  (< imap-reached-tag tag))
1798         (accept-process-output imap-process 0 0))
1799       (when imap-have-messaged
1800         (message ""))
1801       (and (memq (process-status imap-process) '(open run))
1802            (or (assq tag imap-failed-tags)
1803                (if imap-continuation
1804                    'INCOMPLETE
1805                  'OK))))))
1806
1807 (defun imap-sentinel (process string)
1808   (delete-process process))
1809
1810 (defun imap-find-next-line ()
1811   "Return point at end of current line, taking into account literals.
1812 Return nil if no complete line has arrived."
1813   (when (re-search-forward (concat imap-server-eol "\\|{\\([0-9]+\\)}"
1814                                    imap-server-eol)
1815                            nil t)
1816     (if (match-string 1)
1817         (if (< (point-max) (+ (point) (string-to-number (match-string 1))))
1818             nil
1819           (goto-char (+ (point) (string-to-number (match-string 1))))
1820           (imap-find-next-line))
1821       (point))))
1822
1823 (defun imap-arrival-filter (proc string)
1824   "IMAP process filter."
1825   ;; Sometimes, we are called even though the process has died.
1826   ;; Better abstain from doing stuff in that case.
1827   (when (buffer-name (process-buffer proc))
1828     (with-current-buffer (process-buffer proc)
1829       (goto-char (point-max))
1830       (insert string)
1831       (and imap-log
1832            (with-current-buffer (get-buffer-create imap-log-buffer)
1833              (imap-disable-multibyte)
1834              (buffer-disable-undo)
1835              (goto-char (point-max))
1836              (insert string)))
1837       (let (end)
1838         (goto-char (point-min))
1839         (while (setq end (imap-find-next-line))
1840           (save-restriction
1841             (narrow-to-region (point-min) end)
1842             (delete-backward-char (length imap-server-eol))
1843             (goto-char (point-min))
1844             (unwind-protect
1845                 (cond ((eq imap-state 'initial)
1846                        (imap-parse-greeting))
1847                       ((or (eq imap-state 'auth)
1848                            (eq imap-state 'nonauth)
1849                            (eq imap-state 'selected)
1850                            (eq imap-state 'examine))
1851                        (imap-parse-response))
1852                       (t
1853                        (message "Unknown state %s in arrival filter"
1854                                 imap-state)))
1855               (delete-region (point-min) (point-max)))))))))
1856
1857 \f
1858 ;; Imap parser.
1859
1860 (defsubst imap-forward ()
1861   (or (eobp) (forward-char)))
1862
1863 ;;   number          = 1*DIGIT
1864 ;;                       ; Unsigned 32-bit integer
1865 ;;                       ; (0 <= n < 4,294,967,296)
1866
1867 (defsubst imap-parse-number ()
1868   (when (looking-at "[0-9]+")
1869     (prog1
1870         (string-to-number (match-string 0))
1871       (goto-char (match-end 0)))))
1872
1873 ;;   literal         = "{" number "}" CRLF *CHAR8
1874 ;;                       ; Number represents the number of CHAR8s
1875
1876 (defsubst imap-parse-literal ()
1877   (when (looking-at "{\\([0-9]+\\)}\r\n")
1878     (let ((pos (match-end 0))
1879           (len (string-to-number (match-string 1))))
1880       (if (< (point-max) (+ pos len))
1881           nil
1882         (goto-char (+ pos len))
1883         (buffer-substring pos (+ pos len))))))
1884
1885 ;;   string          = quoted / literal
1886 ;;
1887 ;;   quoted          = DQUOTE *QUOTED-CHAR DQUOTE
1888 ;;
1889 ;;   QUOTED-CHAR     = <any TEXT-CHAR except quoted-specials> /
1890 ;;                     "\" quoted-specials
1891 ;;
1892 ;;   quoted-specials = DQUOTE / "\"
1893 ;;
1894 ;;   TEXT-CHAR       = <any CHAR except CR and LF>
1895
1896 (defsubst imap-parse-string ()
1897   (cond ((eq (char-after) ?\")
1898          (forward-char 1)
1899          (let ((p (point)) (name ""))
1900            (skip-chars-forward "^\"\\\\")
1901            (setq name (buffer-substring p (point)))
1902            (while (eq (char-after) ?\\)
1903              (setq p (1+ (point)))
1904              (forward-char 2)
1905              (skip-chars-forward "^\"\\\\")
1906              (setq name (concat name (buffer-substring p (point)))))
1907            (forward-char 1)
1908            name))
1909         ((eq (char-after) ?{)
1910          (imap-parse-literal))))
1911
1912 ;;   nil             = "NIL"
1913
1914 (defsubst imap-parse-nil ()
1915   (if (looking-at "NIL")
1916       (goto-char (match-end 0))))
1917
1918 ;;   nstring         = string / nil
1919
1920 (defsubst imap-parse-nstring ()
1921   (or (imap-parse-string)
1922       (and (imap-parse-nil)
1923            nil)))
1924
1925 ;;   astring         = atom / string
1926 ;;
1927 ;;   atom            = 1*ATOM-CHAR
1928 ;;
1929 ;;   ATOM-CHAR       = <any CHAR except atom-specials>
1930 ;;
1931 ;;   atom-specials   = "(" / ")" / "{" / SP / CTL / list-wildcards /
1932 ;;                     quoted-specials
1933 ;;
1934 ;;   list-wildcards  = "%" / "*"
1935 ;;
1936 ;;   quoted-specials = DQUOTE / "\"
1937
1938 (defsubst imap-parse-astring ()
1939   (or (imap-parse-string)
1940       (buffer-substring (point)
1941                         (if (re-search-forward "[(){ \r\n%*\"\\]" nil t)
1942                             (goto-char (1- (match-end 0)))
1943                           (end-of-line)
1944                           (point)))))
1945
1946 ;;   address         = "(" addr-name SP addr-adl SP addr-mailbox SP
1947 ;;                      addr-host ")"
1948 ;;
1949 ;;   addr-adl        = nstring
1950 ;;                       ; Holds route from [RFC-822] route-addr if
1951 ;;                       ; non-nil
1952 ;;
1953 ;;   addr-host       = nstring
1954 ;;                       ; nil indicates [RFC-822] group syntax.
1955 ;;                       ; Otherwise, holds [RFC-822] domain name
1956 ;;
1957 ;;   addr-mailbox    = nstring
1958 ;;                       ; nil indicates end of [RFC-822] group; if
1959 ;;                       ; non-nil and addr-host is nil, holds
1960 ;;                       ; [RFC-822] group name.
1961 ;;                       ; Otherwise, holds [RFC-822] local-part
1962 ;;                       ; after removing [RFC-822] quoting
1963 ;;
1964 ;;   addr-name       = nstring
1965 ;;                       ; If non-nil, holds phrase from [RFC-822]
1966 ;;                       ; mailbox after removing [RFC-822] quoting
1967 ;;
1968
1969 (defsubst imap-parse-address ()
1970   (let (address)
1971     (when (eq (char-after) ?\()
1972       (imap-forward)
1973       (setq address (vector (prog1 (imap-parse-nstring)
1974                               (imap-forward))
1975                             (prog1 (imap-parse-nstring)
1976                               (imap-forward))
1977                             (prog1 (imap-parse-nstring)
1978                               (imap-forward))
1979                             (imap-parse-nstring)))
1980       (when (eq (char-after) ?\))
1981         (imap-forward)
1982         address))))
1983
1984 ;;   address-list    = "(" 1*address ")" / nil
1985 ;;
1986 ;;   nil             = "NIL"
1987
1988 (defsubst imap-parse-address-list ()
1989   (if (eq (char-after) ?\()
1990       (let (address addresses)
1991         (imap-forward)
1992         (while (and (not (eq (char-after) ?\)))
1993                     ;; next line for MS Exchange bug
1994                     (progn (and (eq (char-after) ? ) (imap-forward)) t)
1995                     (setq address (imap-parse-address)))
1996           (setq addresses (cons address addresses)))
1997         (when (eq (char-after) ?\))
1998           (imap-forward)
1999           (nreverse addresses)))
2000     (assert (imap-parse-nil) t "In imap-parse-address-list")))
2001
2002 ;;   mailbox         = "INBOX" / astring
2003 ;;                       ; INBOX is case-insensitive.  All case variants of
2004 ;;                       ; INBOX (e.g. "iNbOx") MUST be interpreted as INBOX
2005 ;;                       ; not as an astring.  An astring which consists of
2006 ;;                       ; the case-insensitive sequence "I" "N" "B" "O" "X"
2007 ;;                       ; is considered to be INBOX and not an astring.
2008 ;;                       ;  Refer to section 5.1 for further
2009 ;;                       ; semantic details of mailbox names.
2010
2011 (defsubst imap-parse-mailbox ()
2012   (let ((mailbox (imap-parse-astring)))
2013     (if (string-equal "INBOX" (upcase mailbox))
2014         "INBOX"
2015       mailbox)))
2016
2017 ;;   greeting        = "*" SP (resp-cond-auth / resp-cond-bye) CRLF
2018 ;;
2019 ;;   resp-cond-auth  = ("OK" / "PREAUTH") SP resp-text
2020 ;;                       ; Authentication condition
2021 ;;
2022 ;;   resp-cond-bye   = "BYE" SP resp-text
2023
2024 (defun imap-parse-greeting ()
2025   "Parse a IMAP greeting."
2026   (cond ((looking-at "\\* OK ")
2027          (setq imap-state 'nonauth))
2028         ((looking-at "\\* PREAUTH ")
2029          (setq imap-state 'auth))
2030         ((looking-at "\\* BYE ")
2031          (setq imap-state 'closed))))
2032
2033 ;;   response        = *(continue-req / response-data) response-done
2034 ;;
2035 ;;   continue-req    = "+" SP (resp-text / base64) CRLF
2036 ;;
2037 ;;   response-data   = "*" SP (resp-cond-state / resp-cond-bye /
2038 ;;                     mailbox-data / message-data / capability-data) CRLF
2039 ;;
2040 ;;   response-done   = response-tagged / response-fatal
2041 ;;
2042 ;;   response-fatal  = "*" SP resp-cond-bye CRLF
2043 ;;                       ; Server closes connection immediately
2044 ;;
2045 ;;   response-tagged = tag SP resp-cond-state CRLF
2046 ;;
2047 ;;   resp-cond-state = ("OK" / "NO" / "BAD") SP resp-text
2048 ;;                       ; Status condition
2049 ;;
2050 ;;   resp-cond-bye   = "BYE" SP resp-text
2051 ;;
2052 ;;   mailbox-data    =  "FLAGS" SP flag-list /
2053 ;;                      "LIST" SP mailbox-list /
2054 ;;                      "LSUB" SP mailbox-list /
2055 ;;                      "SEARCH" *(SP nz-number) /
2056 ;;                      "STATUS" SP mailbox SP "("
2057 ;;                            [status-att SP number *(SP status-att SP number)] ")" /
2058 ;;                      number SP "EXISTS" /
2059 ;;                      number SP "RECENT"
2060 ;;
2061 ;;   message-data    = nz-number SP ("EXPUNGE" / ("FETCH" SP msg-att))
2062 ;;
2063 ;;   capability-data = "CAPABILITY" *(SP capability) SP "IMAP4rev1"
2064 ;;                     *(SP capability)
2065 ;;                       ; IMAP4rev1 servers which offer RFC 1730
2066 ;;                       ; compatibility MUST list "IMAP4" as the first
2067 ;;                       ; capability.
2068
2069 (defun imap-parse-response ()
2070   "Parse a IMAP command response."
2071   (let (token)
2072     (case (setq token (read (current-buffer)))
2073       (+ (setq imap-continuation
2074                (or (buffer-substring (min (point-max) (1+ (point)))
2075                                      (point-max))
2076                    t)))
2077       (* (case (prog1 (setq token (read (current-buffer)))
2078                  (imap-forward))
2079            (OK         (imap-parse-resp-text))
2080            (NO         (imap-parse-resp-text))
2081            (BAD        (imap-parse-resp-text))
2082            (BYE        (imap-parse-resp-text))
2083            (FLAGS      (imap-mailbox-put 'flags (imap-parse-flag-list)))
2084            (LIST       (imap-parse-data-list 'list))
2085            (LSUB       (imap-parse-data-list 'lsub))
2086            (SEARCH     (imap-mailbox-put
2087                         'search
2088                         (read (concat "(" (buffer-substring (point) (point-max)) ")"))))
2089            (STATUS     (imap-parse-status))
2090            (CAPABILITY (setq imap-capability
2091                                (read (concat "(" (upcase (buffer-substring
2092                                                           (point) (point-max)))
2093                                              ")"))))
2094            (ID         (setq imap-id (read (buffer-substring (point)
2095                                                              (point-max)))))
2096            (ACL        (imap-parse-acl))
2097            (t       (case (prog1 (read (current-buffer))
2098                             (imap-forward))
2099                       (EXISTS  (imap-mailbox-put 'exists token))
2100                       (RECENT  (imap-mailbox-put 'recent token))
2101                       (EXPUNGE t)
2102                       (FETCH   (imap-parse-fetch token))
2103                       (t       (message "Garbage: %s" (buffer-string)))))))
2104       (t (let (status)
2105            (if (not (integerp token))
2106                (message "Garbage: %s" (buffer-string))
2107              (case (prog1 (setq status (read (current-buffer)))
2108                      (imap-forward))
2109                (OK  (progn
2110                       (setq imap-reached-tag (max imap-reached-tag token))
2111                       (imap-parse-resp-text)))
2112                (NO  (progn
2113                       (setq imap-reached-tag (max imap-reached-tag token))
2114                       (save-excursion
2115                         (imap-parse-resp-text))
2116                       (let (code text)
2117                         (when (eq (char-after) ?\[)
2118                           (setq code (buffer-substring (point)
2119                                                        (search-forward "]")))
2120                           (imap-forward))
2121                         (setq text (buffer-substring (point) (point-max)))
2122                         (push (list token status code text)
2123                               imap-failed-tags))))
2124                (BAD (progn
2125                       (setq imap-reached-tag (max imap-reached-tag token))
2126                       (save-excursion
2127                         (imap-parse-resp-text))
2128                       (let (code text)
2129                         (when (eq (char-after) ?\[)
2130                           (setq code (buffer-substring (point)
2131                                                        (search-forward "]")))
2132                           (imap-forward))
2133                         (setq text (buffer-substring (point) (point-max)))
2134                         (push (list token status code text) imap-failed-tags)
2135                         (error "Internal error, tag %s status %s code %s text %s"
2136                                token status code text))))
2137                (t   (message "Garbage: %s" (buffer-string))))
2138              (when (assq token imap-callbacks)
2139                (funcall (cdr (assq token imap-callbacks)) token status)
2140                (setq imap-callbacks
2141                      (imap-remassoc token imap-callbacks)))))))))
2142
2143 ;;   resp-text       = ["[" resp-text-code "]" SP] text
2144 ;;
2145 ;;   text            = 1*TEXT-CHAR
2146 ;;
2147 ;;   TEXT-CHAR       = <any CHAR except CR and LF>
2148
2149 (defun imap-parse-resp-text ()
2150   (imap-parse-resp-text-code))
2151
2152 ;;   resp-text-code  = "ALERT" /
2153 ;;                     "BADCHARSET [SP "(" astring *(SP astring) ")" ] /
2154 ;;                     "NEWNAME" SP string SP string /
2155 ;;                     "PARSE" /
2156 ;;                     "PERMANENTFLAGS" SP "("
2157 ;;                               [flag-perm *(SP flag-perm)] ")" /
2158 ;;                     "READ-ONLY" /
2159 ;;                     "READ-WRITE" /
2160 ;;                     "TRYCREATE" /
2161 ;;                     "UIDNEXT" SP nz-number /
2162 ;;                     "UIDVALIDITY" SP nz-number /
2163 ;;                     "UNSEEN" SP nz-number /
2164 ;;                     resp-text-atom [SP 1*<any TEXT-CHAR except "]">]
2165 ;;
2166 ;;   resp_code_apnd  = "APPENDUID" SPACE nz_number SPACE uniqueid
2167 ;;
2168 ;;   resp_code_copy  = "COPYUID" SPACE nz_number SPACE set SPACE set
2169 ;;
2170 ;;   set             = sequence-num / (sequence-num ":" sequence-num) /
2171 ;;                        (set "," set)
2172 ;;                          ; Identifies a set of messages.  For message
2173 ;;                          ; sequence numbers, these are consecutive
2174 ;;                          ; numbers from 1 to the number of messages in
2175 ;;                          ; the mailbox
2176 ;;                          ; Comma delimits individual numbers, colon
2177 ;;                          ; delimits between two numbers inclusive.
2178 ;;                          ; Example: 2,4:7,9,12:* is 2,4,5,6,7,9,12,13,
2179 ;;                          ; 14,15 for a mailbox with 15 messages.
2180 ;;
2181 ;;   sequence-num    = nz-number / "*"
2182 ;;                          ; * is the largest number in use.  For message
2183 ;;                          ; sequence numbers, it is the number of messages
2184 ;;                          ; in the mailbox.  For unique identifiers, it is
2185 ;;                          ; the unique identifier of the last message in
2186 ;;                          ; the mailbox.
2187 ;;
2188 ;;   flag-perm       = flag / "\*"
2189 ;;
2190 ;;   flag            = "\Answered" / "\Flagged" / "\Deleted" /
2191 ;;                     "\Seen" / "\Draft" / flag-keyword / flag-extension
2192 ;;                       ; Does not include "\Recent"
2193 ;;
2194 ;;   flag-extension  = "\" atom
2195 ;;                       ; Future expansion.  Client implementations
2196 ;;                       ; MUST accept flag-extension flags.  Server
2197 ;;                       ; implementations MUST NOT generate
2198 ;;                       ; flag-extension flags except as defined by
2199 ;;                       ; future standard or standards-track
2200 ;;                       ; revisions of this specification.
2201 ;;
2202 ;;   flag-keyword    = atom
2203 ;;
2204 ;;   resp-text-atom  = 1*<any ATOM-CHAR except "]">
2205
2206 (defun imap-parse-resp-text-code ()
2207   ;; xxx next line for stalker communigate pro 3.3.1 bug
2208   (when (looking-at " \\[")
2209     (imap-forward))
2210   (when (eq (char-after) ?\[)
2211     (imap-forward)
2212     (cond ((search-forward "PERMANENTFLAGS " nil t)
2213            (imap-mailbox-put 'permanentflags (imap-parse-flag-list)))
2214           ((search-forward "UIDNEXT \\([0-9]+\\)" nil t)
2215            (imap-mailbox-put 'uidnext (match-string 1)))
2216           ((search-forward "UNSEEN " nil t)
2217            (imap-mailbox-put 'first-unseen (read (current-buffer))))
2218           ((looking-at "UIDVALIDITY \\([0-9]+\\)")
2219            (imap-mailbox-put 'uidvalidity (match-string 1)))
2220           ((search-forward "READ-ONLY" nil t)
2221            (imap-mailbox-put 'read-only t))
2222           ((search-forward "NEWNAME " nil t)
2223            (let (oldname newname)
2224              (setq oldname (imap-parse-string))
2225              (imap-forward)
2226              (setq newname (imap-parse-string))
2227              (imap-mailbox-put 'newname newname oldname)))
2228           ((search-forward "TRYCREATE" nil t)
2229            (imap-mailbox-put 'trycreate t imap-current-target-mailbox))
2230           ((looking-at "APPENDUID \\([0-9]+\\) \\([0-9]+\\)")
2231            (imap-mailbox-put 'appenduid
2232                              (list (match-string 1)
2233                                    (string-to-number (match-string 2)))
2234                              imap-current-target-mailbox))
2235           ((looking-at "COPYUID \\([0-9]+\\) \\([0-9,:]+\\) \\([0-9,:]+\\)")
2236            (imap-mailbox-put 'copyuid (list (match-string 1)
2237                                             (match-string 2)
2238                                             (match-string 3))
2239                              imap-current-target-mailbox))
2240           ((search-forward "ALERT] " nil t)
2241            (message "Imap server %s information: %s" imap-server
2242                     (buffer-substring (point) (point-max)))))))
2243
2244 ;;   mailbox-list    = "(" [mbx-list-flags] ")" SP
2245 ;;                      (DQUOTE QUOTED-CHAR DQUOTE / nil) SP mailbox
2246 ;;
2247 ;;   mbx-list-flags  = *(mbx-list-oflag SP) mbx-list-sflag
2248 ;;                     *(SP mbx-list-oflag) /
2249 ;;                     mbx-list-oflag *(SP mbx-list-oflag)
2250 ;;
2251 ;;   mbx-list-oflag  = "\Noinferiors" / flag-extension
2252 ;;                       ; Other flags; multiple possible per LIST response
2253 ;;
2254 ;;   mbx-list-sflag  = "\Noselect" / "\Marked" / "\Unmarked"
2255 ;;                       ; Selectability flags; only one per LIST response
2256 ;;
2257 ;;   QUOTED-CHAR     = <any TEXT-CHAR except quoted-specials> /
2258 ;;                     "\" quoted-specials
2259 ;;
2260 ;;   quoted-specials = DQUOTE / "\"
2261
2262 (defun imap-parse-data-list (type)
2263   (let (flags delimiter mailbox)
2264     (setq flags (imap-parse-flag-list))
2265     (when (looking-at " NIL\\| \"\\\\?\\(.\\)\"")
2266       (setq delimiter (match-string 1))
2267       (goto-char (1+ (match-end 0)))
2268       (when (setq mailbox (imap-parse-mailbox))
2269         (imap-mailbox-put type t mailbox)
2270         (imap-mailbox-put 'list-flags flags mailbox)
2271         (imap-mailbox-put 'delimiter delimiter mailbox)))))
2272
2273 ;;  msg_att         ::= "(" 1#("ENVELOPE" SPACE envelope /
2274 ;;                      "FLAGS" SPACE "(" #(flag / "\Recent") ")" /
2275 ;;                      "INTERNALDATE" SPACE date_time /
2276 ;;                      "RFC822" [".HEADER" / ".TEXT"] SPACE nstring /
2277 ;;                      "RFC822.SIZE" SPACE number /
2278 ;;                      "BODY" ["STRUCTURE"] SPACE body /
2279 ;;                      "BODY" section ["<" number ">"] SPACE nstring /
2280 ;;                      "UID" SPACE uniqueid) ")"
2281 ;;
2282 ;;  date_time       ::= <"> date_day_fixed "-" date_month "-" date_year
2283 ;;                      SPACE time SPACE zone <">
2284 ;;
2285 ;;  section         ::= "[" [section_text / (nz_number *["." nz_number]
2286 ;;                      ["." (section_text / "MIME")])] "]"
2287 ;;
2288 ;;  section_text    ::= "HEADER" / "HEADER.FIELDS" [".NOT"]
2289 ;;                      SPACE header_list / "TEXT"
2290 ;;
2291 ;;  header_fld_name ::= astring
2292 ;;
2293 ;;  header_list     ::= "(" 1#header_fld_name ")"
2294
2295 (defsubst imap-parse-header-list ()
2296   (when (eq (char-after) ?\()
2297     (let (strlist)
2298       (while (not (eq (char-after) ?\)))
2299         (imap-forward)
2300         (push (imap-parse-astring) strlist))
2301       (imap-forward)
2302       (nreverse strlist))))
2303
2304 (defsubst imap-parse-fetch-body-section ()
2305   (let ((section
2306          (buffer-substring (point) (1- (re-search-forward "[] ]" nil t)))))
2307     (if (eq (char-before) ? )
2308         (prog1
2309             (mapconcat 'identity (cons section (imap-parse-header-list)) " ")
2310           (search-forward "]" nil t))
2311       section)))
2312
2313 (defun imap-parse-fetch (response)
2314   (when (eq (char-after) ?\()
2315     (let (uid flags envelope internaldate rfc822 rfc822header rfc822text
2316               rfc822size body bodydetail bodystructure flags-empty)
2317       (while (not (eq (char-after) ?\)))
2318         (imap-forward)
2319         (let ((token (read (current-buffer))))
2320           (imap-forward)
2321           (cond ((eq token 'UID)
2322                  (setq uid (condition-case ()
2323                                (read (current-buffer))
2324                              (error))))
2325                 ((eq token 'FLAGS)
2326                  (setq flags (imap-parse-flag-list))
2327                  (if (not flags)
2328                      (setq flags-empty 't)))
2329                 ((eq token 'ENVELOPE)
2330                  (setq envelope (imap-parse-envelope)))
2331                 ((eq token 'INTERNALDATE)
2332                  (setq internaldate (imap-parse-string)))
2333                 ((eq token 'RFC822)
2334                  (setq rfc822 (imap-parse-nstring)))
2335                 ((eq token 'RFC822.HEADER)
2336                  (setq rfc822header (imap-parse-nstring)))
2337                 ((eq token 'RFC822.TEXT)
2338                  (setq rfc822text (imap-parse-nstring)))
2339                 ((eq token 'RFC822.SIZE)
2340                  (setq rfc822size (read (current-buffer))))
2341                 ((eq token 'BODY)
2342                  (if (eq (char-before) ?\[)
2343                      (push (list
2344                             (upcase (imap-parse-fetch-body-section))
2345                             (and (eq (char-after) ?<)
2346                                  (buffer-substring (1+ (point))
2347                                                    (search-forward ">" nil t)))
2348                             (progn (imap-forward)
2349                                    (imap-parse-nstring)))
2350                            bodydetail)
2351                    (setq body (imap-parse-body))))
2352                 ((eq token 'BODYSTRUCTURE)
2353                  (setq bodystructure (imap-parse-body))))))
2354       (when uid
2355         (setq imap-current-message uid)
2356         (imap-message-put uid 'UID uid)
2357         (and (or flags flags-empty) (imap-message-put uid 'FLAGS flags))
2358         (and envelope (imap-message-put uid 'ENVELOPE envelope))
2359         (and internaldate (imap-message-put uid 'INTERNALDATE internaldate))
2360         (and rfc822 (imap-message-put uid 'RFC822 rfc822))
2361         (and rfc822header (imap-message-put uid 'RFC822.HEADER rfc822header))
2362         (and rfc822text (imap-message-put uid 'RFC822.TEXT rfc822text))
2363         (and rfc822size (imap-message-put uid 'RFC822.SIZE rfc822size))
2364         (and body (imap-message-put uid 'BODY body))
2365         (and bodydetail (imap-message-put uid 'BODYDETAIL bodydetail))
2366         (and bodystructure (imap-message-put uid 'BODYSTRUCTURE bodystructure))
2367         (run-hooks 'imap-fetch-data-hook)))))
2368
2369 ;;   mailbox-data    =  ...
2370 ;;                      "STATUS" SP mailbox SP "("
2371 ;;                            [status-att SP number
2372 ;;                            *(SP status-att SP number)] ")"
2373 ;;                      ...
2374 ;;
2375 ;;   status-att      = "MESSAGES" / "RECENT" / "UIDNEXT" / "UIDVALIDITY" /
2376 ;;                     "UNSEEN"
2377
2378 (defun imap-parse-status ()
2379   (let ((mailbox (imap-parse-mailbox)))
2380     (if (eq (char-after) ? )
2381         (forward-char))
2382     (when (and mailbox (eq (char-after) ?\())
2383       (while (and (not (eq (char-after) ?\)))
2384                   (or (forward-char) t)
2385                   (looking-at "\\([A-Za-z]+\\) "))
2386         (let ((token (match-string 1)))
2387           (goto-char (match-end 0))
2388           (cond ((string= token "MESSAGES")
2389                  (imap-mailbox-put 'messages (read (current-buffer)) mailbox))
2390                 ((string= token "RECENT")
2391                  (imap-mailbox-put 'recent (read (current-buffer)) mailbox))
2392                 ((string= token "UIDNEXT")
2393                  (and (looking-at "[0-9]+")
2394                       (imap-mailbox-put 'uidnext (match-string 0) mailbox)
2395                       (goto-char (match-end 0))))
2396                 ((string= token "UIDVALIDITY")
2397                  (and (looking-at "[0-9]+")
2398                       (imap-mailbox-put 'uidvalidity (match-string 0) mailbox)
2399                       (goto-char (match-end 0))))
2400                 ((string= token "UNSEEN")
2401                  (imap-mailbox-put 'unseen (read (current-buffer)) mailbox))
2402                 (t
2403                  (message "Unknown status data %s in mailbox %s ignored"
2404                           token mailbox)
2405                  (read (current-buffer)))))))))
2406
2407 ;;   acl_data        ::= "ACL" SPACE mailbox *(SPACE identifier SPACE
2408 ;;                        rights)
2409 ;;
2410 ;;   identifier      ::= astring
2411 ;;
2412 ;;   rights          ::= astring
2413
2414 (defun imap-parse-acl ()
2415   (let ((mailbox (imap-parse-mailbox))
2416         identifier rights acl)
2417     (while (eq (char-after) ?\ )
2418       (imap-forward)
2419       (setq identifier (imap-parse-astring))
2420       (imap-forward)
2421       (setq rights (imap-parse-astring))
2422       (setq acl (append acl (list (cons identifier rights)))))
2423     (imap-mailbox-put 'acl acl mailbox)))
2424
2425 ;;   flag-list       = "(" [flag *(SP flag)] ")"
2426 ;;
2427 ;;   flag            = "\Answered" / "\Flagged" / "\Deleted" /
2428 ;;                     "\Seen" / "\Draft" / flag-keyword / flag-extension
2429 ;;                       ; Does not include "\Recent"
2430 ;;
2431 ;;   flag-keyword    = atom
2432 ;;
2433 ;;   flag-extension  = "\" atom
2434 ;;                       ; Future expansion.  Client implementations
2435 ;;                       ; MUST accept flag-extension flags.  Server
2436 ;;                       ; implementations MUST NOT generate
2437 ;;                       ; flag-extension flags except as defined by
2438 ;;                       ; future standard or standards-track
2439 ;;                       ; revisions of this specification.
2440
2441 (defun imap-parse-flag-list ()
2442   (let (flag-list start)
2443     (assert (eq (char-after) ?\() nil "In imap-parse-flag-list")
2444     (while (and (not (eq (char-after) ?\)))
2445                 (setq start (progn
2446                               (imap-forward)
2447                               ;; next line for Courier IMAP bug.
2448                               (skip-chars-forward " ")
2449                               (point)))
2450                 (> (skip-chars-forward "^ )" (point-at-eol)) 0))
2451       (push (buffer-substring start (point)) flag-list))
2452     (assert (eq (char-after) ?\)) nil "In imap-parse-flag-list")
2453     (imap-forward)
2454     (nreverse flag-list)))
2455
2456 ;;   envelope        = "(" env-date SP env-subject SP env-from SP env-sender SP
2457 ;;                     env-reply-to SP env-to SP env-cc SP env-bcc SP
2458 ;;                     env-in-reply-to SP env-message-id ")"
2459 ;;
2460 ;;   env-bcc         = "(" 1*address ")" / nil
2461 ;;
2462 ;;   env-cc          = "(" 1*address ")" / nil
2463 ;;
2464 ;;   env-date        = nstring
2465 ;;
2466 ;;   env-from        = "(" 1*address ")" / nil
2467 ;;
2468 ;;   env-in-reply-to = nstring
2469 ;;
2470 ;;   env-message-id  = nstring
2471 ;;
2472 ;;   env-reply-to    = "(" 1*address ")" / nil
2473 ;;
2474 ;;   env-sender      = "(" 1*address ")" / nil
2475 ;;
2476 ;;   env-subject     = nstring
2477 ;;
2478 ;;   env-to          = "(" 1*address ")" / nil
2479
2480 (defun imap-parse-envelope ()
2481   (when (eq (char-after) ?\()
2482     (imap-forward)
2483     (vector (prog1 (imap-parse-nstring) ;; date
2484               (imap-forward))
2485             (prog1 (imap-parse-nstring) ;; subject
2486               (imap-forward))
2487             (prog1 (imap-parse-address-list) ;; from
2488               (imap-forward))
2489             (prog1 (imap-parse-address-list) ;; sender
2490               (imap-forward))
2491             (prog1 (imap-parse-address-list) ;; reply-to
2492               (imap-forward))
2493             (prog1 (imap-parse-address-list) ;; to
2494               (imap-forward))
2495             (prog1 (imap-parse-address-list) ;; cc
2496               (imap-forward))
2497             (prog1 (imap-parse-address-list) ;; bcc
2498               (imap-forward))
2499             (prog1 (imap-parse-nstring) ;; in-reply-to
2500               (imap-forward))
2501             (prog1 (imap-parse-nstring) ;; message-id
2502               (imap-forward)))))
2503
2504 ;;   body-fld-param  = "(" string SP string *(SP string SP string) ")" / nil
2505
2506 (defsubst imap-parse-string-list ()
2507   (cond ((eq (char-after) ?\() ;; body-fld-param
2508          (let (strlist str)
2509            (imap-forward)
2510            (while (setq str (imap-parse-string))
2511              (push str strlist)
2512              ;; buggy stalker communigate pro 3.0 doesn't print SPC
2513              ;; between body-fld-param's sometimes
2514              (or (eq (char-after) ?\")
2515                  (imap-forward)))
2516            (nreverse strlist)))
2517         ((imap-parse-nil)
2518          nil)))
2519
2520 ;;   body-extension  = nstring / number /
2521 ;;                      "(" body-extension *(SP body-extension) ")"
2522 ;;                       ; Future expansion.  Client implementations
2523 ;;                       ; MUST accept body-extension fields.  Server
2524 ;;                       ; implementations MUST NOT generate
2525 ;;                       ; body-extension fields except as defined by
2526 ;;                       ; future standard or standards-track
2527 ;;                       ; revisions of this specification.
2528
2529 (defun imap-parse-body-extension ()
2530   (if (eq (char-after) ?\()
2531       (let (b-e)
2532         (imap-forward)
2533         (push (imap-parse-body-extension) b-e)
2534         (while (eq (char-after) ?\ )
2535           (imap-forward)
2536           (push (imap-parse-body-extension) b-e))
2537         (assert (eq (char-after) ?\)) nil "In imap-parse-body-extension")
2538         (imap-forward)
2539         (nreverse b-e))
2540     (or (imap-parse-number)
2541         (imap-parse-nstring))))
2542
2543 ;;   body-ext-1part  = body-fld-md5 [SP body-fld-dsp [SP body-fld-lang
2544 ;;                     *(SP body-extension)]]
2545 ;;                       ; MUST NOT be returned on non-extensible
2546 ;;                       ; "BODY" fetch
2547 ;;
2548 ;;   body-ext-mpart  = body-fld-param [SP body-fld-dsp [SP body-fld-lang
2549 ;;                     *(SP body-extension)]]
2550 ;;                       ; MUST NOT be returned on non-extensible
2551 ;;                       ; "BODY" fetch
2552
2553 (defsubst imap-parse-body-ext ()
2554   (let (ext)
2555     (when (eq (char-after) ?\ ) ;; body-fld-dsp
2556       (imap-forward)
2557       (let (dsp)
2558         (if (eq (char-after) ?\()
2559             (progn
2560               (imap-forward)
2561               (push (imap-parse-string) dsp)
2562               (imap-forward)
2563               (push (imap-parse-string-list) dsp)
2564               (imap-forward))
2565           (assert (imap-parse-nil) t "In imap-parse-body-ext"))
2566         (push (nreverse dsp) ext))
2567       (when (eq (char-after) ?\ ) ;; body-fld-lang
2568         (imap-forward)
2569         (if (eq (char-after) ?\()
2570             (push (imap-parse-string-list) ext)
2571           (push (imap-parse-nstring) ext))
2572         (while (eq (char-after) ?\ ) ;; body-extension
2573           (imap-forward)
2574           (setq ext (append (imap-parse-body-extension) ext)))))
2575     ext))
2576
2577 ;;   body            = "(" body-type-1part / body-type-mpart ")"
2578 ;;
2579 ;;   body-ext-1part  = body-fld-md5 [SP body-fld-dsp [SP body-fld-lang
2580 ;;                     *(SP body-extension)]]
2581 ;;                       ; MUST NOT be returned on non-extensible
2582 ;;                       ; "BODY" fetch
2583 ;;
2584 ;;   body-ext-mpart  = body-fld-param [SP body-fld-dsp [SP body-fld-lang
2585 ;;                     *(SP body-extension)]]
2586 ;;                       ; MUST NOT be returned on non-extensible
2587 ;;                       ; "BODY" fetch
2588 ;;
2589 ;;   body-fields     = body-fld-param SP body-fld-id SP body-fld-desc SP
2590 ;;                     body-fld-enc SP body-fld-octets
2591 ;;
2592 ;;   body-fld-desc   = nstring
2593 ;;
2594 ;;   body-fld-dsp    = "(" string SP body-fld-param ")" / nil
2595 ;;
2596 ;;   body-fld-enc    = (DQUOTE ("7BIT" / "8BIT" / "BINARY" / "BASE64"/
2597 ;;                     "QUOTED-PRINTABLE") DQUOTE) / string
2598 ;;
2599 ;;   body-fld-id     = nstring
2600 ;;
2601 ;;   body-fld-lang   = nstring / "(" string *(SP string) ")"
2602 ;;
2603 ;;   body-fld-lines  = number
2604 ;;
2605 ;;   body-fld-md5    = nstring
2606 ;;
2607 ;;   body-fld-octets = number
2608 ;;
2609 ;;   body-fld-param  = "(" string SP string *(SP string SP string) ")" / nil
2610 ;;
2611 ;;   body-type-1part = (body-type-basic / body-type-msg / body-type-text)
2612 ;;                     [SP body-ext-1part]
2613 ;;
2614 ;;   body-type-basic = media-basic SP body-fields
2615 ;;                       ; MESSAGE subtype MUST NOT be "RFC822"
2616 ;;
2617 ;;   body-type-msg   = media-message SP body-fields SP envelope
2618 ;;                     SP body SP body-fld-lines
2619 ;;
2620 ;;   body-type-text  = media-text SP body-fields SP body-fld-lines
2621 ;;
2622 ;;   body-type-mpart = 1*body SP media-subtype
2623 ;;                     [SP body-ext-mpart]
2624 ;;
2625 ;;   media-basic     = ((DQUOTE ("APPLICATION" / "AUDIO" / "IMAGE" /
2626 ;;                     "MESSAGE" / "VIDEO") DQUOTE) / string) SP media-subtype
2627 ;;                       ; Defined in [MIME-IMT]
2628 ;;
2629 ;;   media-message   = DQUOTE "MESSAGE" DQUOTE SP DQUOTE "RFC822" DQUOTE
2630 ;;                      ; Defined in [MIME-IMT]
2631 ;;
2632 ;;   media-subtype   = string
2633 ;;                       ; Defined in [MIME-IMT]
2634 ;;
2635 ;;   media-text      = DQUOTE "TEXT" DQUOTE SP media-subtype
2636 ;;                       ; Defined in [MIME-IMT]
2637
2638 (defun imap-parse-body ()
2639   (let (body)
2640     (when (eq (char-after) ?\()
2641       (imap-forward)
2642       (if (eq (char-after) ?\()
2643           (let (subbody)
2644             (while (and (eq (char-after) ?\()
2645                         (setq subbody (imap-parse-body)))
2646              ;; buggy stalker communigate pro 3.0 insert a SPC between
2647               ;; parts in multiparts
2648               (when (and (eq (char-after) ?\ )
2649                          (eq (char-after (1+ (point))) ?\())
2650                 (imap-forward))
2651               (push subbody body))
2652             (imap-forward)
2653             (push (imap-parse-string) body) ;; media-subtype
2654             (when (eq (char-after) ?\ ) ;; body-ext-mpart:
2655               (imap-forward)
2656               (if (eq (char-after) ?\() ;; body-fld-param
2657                   (push (imap-parse-string-list) body)
2658                 (push (and (imap-parse-nil) nil) body))
2659               (setq body
2660                     (append (imap-parse-body-ext) body))) ;; body-ext-...
2661             (assert (eq (char-after) ?\)) nil "In imap-parse-body")
2662             (imap-forward)
2663             (nreverse body))
2664
2665         (push (imap-parse-string) body) ;; media-type
2666         (imap-forward)
2667         (push (imap-parse-string) body) ;; media-subtype
2668         (imap-forward)
2669         ;; next line for Sun SIMS bug
2670         (and (eq (char-after) ? ) (imap-forward))
2671         (if (eq (char-after) ?\() ;; body-fld-param
2672             (push (imap-parse-string-list) body)
2673           (push (and (imap-parse-nil) nil) body))
2674         (imap-forward)
2675         (push (imap-parse-nstring) body) ;; body-fld-id
2676         (imap-forward)
2677         (push (imap-parse-nstring) body) ;; body-fld-desc
2678         (imap-forward)
2679         ;; next `or' for Sun SIMS bug, it regard body-fld-enc as a
2680         ;; nstring and return nil instead of defaulting back to 7BIT
2681         ;; as the standard says.
2682         (push (or (imap-parse-nstring) "7BIT") body) ;; body-fld-enc
2683         (imap-forward)
2684         (push (imap-parse-number) body) ;; body-fld-octets
2685
2686    ;; ok, we're done parsing the required parts, what comes now is one
2687         ;; of three things:
2688         ;;
2689         ;; envelope       (then we're parsing body-type-msg)
2690         ;; body-fld-lines (then we're parsing body-type-text)
2691         ;; body-ext-1part (then we're parsing body-type-basic)
2692         ;;
2693   ;; the problem is that the two first are in turn optionally followed
2694 ;; by the third.  So we parse the first two here (if there are any)...
2695
2696         (when (eq (char-after) ?\ )
2697           (imap-forward)
2698           (let (lines)
2699             (cond ((eq (char-after) ?\() ;; body-type-msg:
2700                    (push (imap-parse-envelope) body) ;; envelope
2701                    (imap-forward)
2702                    (push (imap-parse-body) body) ;; body
2703                    ;; buggy stalker communigate pro 3.0 doesn't print
2704                    ;; number of lines in message/rfc822 attachment
2705                    (if (eq (char-after) ?\))
2706                        (push 0 body)
2707                      (imap-forward)
2708                      (push (imap-parse-number) body))) ;; body-fld-lines
2709                   ((setq lines (imap-parse-number)) ;; body-type-text:
2710                    (push lines body)) ;; body-fld-lines
2711                   (t
2712                    (backward-char))))) ;; no match...
2713
2714         ;; ...and then parse the third one here...
2715
2716         (when (eq (char-after) ?\ ) ;; body-ext-1part:
2717           (imap-forward)
2718           (push (imap-parse-nstring) body) ;; body-fld-md5
2719           (setq body (append (imap-parse-body-ext) body))) ;; body-ext-1part..
2720
2721         (assert (eq (char-after) ?\)) nil "In imap-parse-body 2")
2722         (imap-forward)
2723         (nreverse body)))))
2724
2725 (when imap-debug                        ; (untrace-all)
2726   (require 'trace)
2727   (buffer-disable-undo (get-buffer-create imap-debug-buffer))
2728   (mapcar (lambda (f) (trace-function-background f imap-debug-buffer))
2729           '(
2730             imap-utf7-encode
2731             imap-utf7-decode
2732             imap-error-text
2733             imap-kerberos4s-p
2734             imap-kerberos4-open
2735             imap-ssl-p
2736             imap-ssl-open
2737             imap-network-p
2738             imap-network-open
2739             imap-interactive-login
2740             imap-kerberos4a-p
2741             imap-kerberos4-auth
2742             imap-cram-md5-p
2743             imap-cram-md5-auth
2744             imap-login-p
2745             imap-login-auth
2746             imap-anonymous-p
2747             imap-anonymous-auth
2748             imap-open-1
2749             imap-open
2750             imap-opened
2751             imap-authenticate
2752             imap-close
2753             imap-capability
2754             imap-namespace
2755             imap-send-command-wait
2756             imap-mailbox-put
2757             imap-mailbox-get
2758             imap-mailbox-map-1
2759             imap-mailbox-map
2760             imap-current-mailbox
2761             imap-current-mailbox-p-1
2762             imap-current-mailbox-p
2763             imap-mailbox-select-1
2764             imap-mailbox-select
2765             imap-mailbox-examine-1
2766             imap-mailbox-examine
2767             imap-mailbox-unselect
2768             imap-mailbox-expunge
2769             imap-mailbox-close
2770             imap-mailbox-create-1
2771             imap-mailbox-create
2772             imap-mailbox-delete
2773             imap-mailbox-rename
2774             imap-mailbox-lsub
2775             imap-mailbox-list
2776             imap-mailbox-subscribe
2777             imap-mailbox-unsubscribe
2778             imap-mailbox-status
2779             imap-mailbox-acl-get
2780             imap-mailbox-acl-set
2781             imap-mailbox-acl-delete
2782             imap-current-message
2783             imap-list-to-message-set
2784             imap-fetch-asynch
2785             imap-fetch
2786             imap-message-put
2787             imap-message-get
2788             imap-message-map
2789             imap-search
2790             imap-message-flag-permanent-p
2791             imap-message-flags-set
2792             imap-message-flags-del
2793             imap-message-flags-add
2794             imap-message-copyuid-1
2795             imap-message-copyuid
2796             imap-message-copy
2797             imap-message-appenduid-1
2798             imap-message-appenduid
2799             imap-message-append
2800             imap-body-lines
2801             imap-envelope-from
2802             imap-send-command-1
2803             imap-send-command
2804             imap-wait-for-tag
2805             imap-sentinel
2806             imap-find-next-line
2807             imap-arrival-filter
2808             imap-parse-greeting
2809             imap-parse-response
2810             imap-parse-resp-text
2811             imap-parse-resp-text-code
2812             imap-parse-data-list
2813             imap-parse-fetch
2814             imap-parse-status
2815             imap-parse-acl
2816             imap-parse-flag-list
2817             imap-parse-envelope
2818             imap-parse-body-extension
2819             imap-parse-body
2820             )))
2821
2822 (provide 'imap)
2823
2824 ;;; imap.el ends here