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