cgit.sxemacs.org Git - gnus/blob - lisp/imap.el

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