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

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