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

   1 ;;; imap.el --- imap library
   2 ;; Copyright (C) 1998,1999 Free Software Foundation, Inc.
   3
   4 ;; Author: Simon Josefsson <jas@pdc.kth.se>
   5 ;; Keywords: mail
   6
   7 ;; This file is part of GNU Emacs.
   8
   9 ;; GNU Emacs is free software; you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation; either version 2, or (at your option)
  12 ;; any later version.
  13
  14 ;; GNU Emacs is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  22 ;; Boston, MA 02111-1307, USA.
  23
  24 ;;; Commentary:
  25
  26 ;; imap.el is a elisp library providing an interface for talking to
  27 ;; IMAP servers.
  28 ;;
  29 ;; imap.el is roughly divided in two parts, one that parses IMAP
  30 ;; responses from the server and storing data into buffer-local
  31 ;; variables, and one for utility functions which send commands to
  32 ;; server, waits for an answer, and return information.  The latter
  33 ;; part is layered on top of the previous.
  34 ;;
  35 ;; The imap.el API consist of the following functions, other functions
  36 ;; in this file should not be called directly and the result of doing
  37 ;; so are at best undefined.
  38 ;;
  39 ;; Global commands:
  40 ;;
  41 ;; imap-open,       imap-opened,    imap-authenticate, imap-close,
  42 ;; imap-capability, imap-namespace, imap-error-text
  43 ;;
  44 ;; Mailbox commands:
  45 ;;
  46 ;; imap-mailbox-get,       imap-mailbox-map,         imap-current-mailbox,
  47 ;; imap-current-mailbox-p, imap-search,              imap-mailbox-select,
  48 ;; imap-mailbox-examine,   imap-mailbox-unselect,    imap-mailbox-expunge
  49 ;; imap-mailbox-close,     imap-mailbox-create,      imap-mailbox-delete
  50 ;; imap-mailbox-rename,    imap-mailbox-lsub,        imap-mailbox-list
  51 ;; imap-mailbox-subscribe, imap-mailbox-unsubscribe, imap-mailbox-status
  52 ;; imap-mailbox-acl-get,   imap-mailbox-acl-set,     imap-mailbox-acl-delete
  53 ;;
  54 ;; Message commands:
  55 ;;
  56 ;; imap-fetch-asynch,                 imap-fetch,
  57 ;; imap-current-message,              imap-list-to-message-set,
  58 ;; imap-message-get,                  imap-message-map
  59 ;; imap-message-envelope-date,        imap-message-envelope-subject,
  60 ;; imap-message-envelope-from,        imap-message-envelope-sender,
  61 ;; imap-message-envelope-reply-to,    imap-message-envelope-to,
  62 ;; imap-message-envelope-cc,          imap-message-envelope-bcc
  63 ;; imap-message-envelope-in-reply-to, imap-message-envelope-message-id
  64 ;; imap-message-body,                 imap-message-flag-permanent-p
  65 ;; imap-message-flags-set,            imap-message-flags-del
  66 ;; imap-message-flags-add,            imap-message-copyuid
  67 ;; imap-message-copy,                 imap-message-appenduid
  68 ;; imap-message-append,               imap-envelope-from
  69 ;; imap-body-lines
  70 ;;
  71 ;; It is my hope that theese commands should be pretty self
  72 ;; explanatory for someone that know IMAP.  All functions have
  73 ;; additional documentation on how to invoke them.
  74 ;;
  75 ;; imap.el support RFC1730/2060 (IMAP4/IMAP4rev1), implemented IMAP
  76 ;; extensions are RFC2195 (CRAM-MD5), RFC2086 (ACL), RFC2342
  77 ;; (NAMESPACE), RFC2359 (UIDPLUS), and the kerberos V4 part of RFC1731
  78 ;; (with use of external program `imtest').  It also take advantage
  79 ;; the UNSELECT extension in Cyrus IMAPD.
  80 ;;
  81 ;; Without the work of John McClary Prevost and Jim Radford this library
  82 ;; would not have seen the light of day.  Many thanks.
  83 ;;
  84 ;; This is a transcript of short interactive session for demonstration
  85 ;; purposes.
  86 ;;
  87 ;; (imap-open "my.mail.server")
  88 ;; => " *imap* my.mail.server:0"
  89 ;;
  90 ;; The rest are invoked with current buffer as the buffer returned by
  91 ;; `imap-open'.  It is possible to do all without this, but it would
  92 ;; look ugly here since `buffer' is always the last argument for all
  93 ;; imap.el API functions.
  94 ;;
  95 ;; (imap-authenticate "myusername" "mypassword")
  96 ;; => auth
  97 ;;
  98 ;; (imap-mailbox-lsub "*")
  99 ;; => ("INBOX.sentmail" "INBOX.private" "INBOX.draft" "INBOX.spam")
 100 ;;
 101 ;; (imap-mailbox-list "INBOX.n%")
 102 ;; => ("INBOX.namedroppers" "INBOX.nnimap" "INBOX.ntbugtraq")
 103 ;;
 104 ;; (imap-mailbox-select "INBOX.nnimap")
 105 ;; => "INBOX.nnimap"
 106 ;;
 107 ;; (imap-mailbox-get 'exists)
 108 ;; => 166
 109 ;;
 110 ;; (imap-mailbox-get 'uidvalidity)
 111 ;; => "908992622"
 112 ;;
 113 ;; (imap-search "FLAGGED SINCE 18-DEC-98")
 114 ;; => (235 236)
 115 ;;
 116 ;; (imap-fetch 235 "RFC822.PEEK" 'RFC822)
 117 ;; => "X-Sieve: cmu-sieve 1.3^M\nX-Username: <jas@pdc.kth.se>^M\r...."
 118 ;;
 119 ;; Todo:
 120 ;;
 121 ;; o Parse UIDs as strings? We need to overcome the 28 bit limit somehow.
 122 ;; o Don't use `read' at all (important places already fixed)
 123 ;; o Accept list of articles instead of message set string in most
 124 ;;   imap-message-* functions.
 125 ;; o Cyrus IMAPd 1.6.x `imtest' support in the imtest wrapper
 126 ;;
 127 ;; Revision history:
 128 ;;
 129 ;;  - this is unreleased software
 130 ;;
 131
 132 ;;; Code:
 133
 134 (eval-when-compile (require 'cl))
 135 (eval-and-compile
 136   (autoload 'open-ssl-stream "ssl")
 137   (autoload 'base64-decode-string "base64")
 138   (autoload 'base64-encode-string "base64")
 139   (autoload 'rfc2104-hash "rfc2104")
 140   (autoload 'md5 "md5")
 141   (autoload 'utf7-encode "utf7")
 142   (autoload 'utf7-decode "utf7")
 143   (autoload 'format-spec "format-spec")
 144   (autoload 'format-spec-make "format-spec"))
 145
 146 ;; User variables.
 147
 148 (defvar imap-imtest-program "imtest -kp %s %p"
 149   "How to call program for Kerberos 4 authentication.
 150 %s is replaced with server and %p with port to connect to.  The
 151 program should accept IMAP commands on stdin and return responses to
 152 stdout.")
 153
 154 (defvar imap-ssl-program '("openssl s_client -ssl3 -connect %s:%p"
 155                            "openssl s_client -ssl2 -connect %s:%p"
 156                            "s_client -ssl3 -connect %s:%p"
 157                            "s_client -ssl2 -connect %s:%p")
 158   "A string, or list of strings, containing commands for SSL connections.
 159 Within a string, %s is replaced with the server address and %p with
 160 port number on server.  The program should accept IMAP commands on
 161 stdin and return responses to stdout.")
 162
 163 (defvar imap-default-user (user-login-name)
 164   "Default username to use.")
 165
 166 (defvar imap-error nil
 167   "Error codes from the last command.")
 168
 169 ;; Various variables.
 170
 171 (defvar imap-fetch-data-hook nil
 172   "Hooks called after receiving each FETCH response.")
 173
 174 (defvar imap-streams '(kerberos4 ssl network)
 175   "Priority of streams to consider when opening connection to server.")
 176
 177 (defvar imap-stream-alist
 178   '((kerberos4 imap-kerberos4s-p imap-kerberos4-open)
 179     (ssl       imap-ssl-p        imap-ssl-open)
 180     (network   imap-network-p    imap-network-open))
 181   "Definition of network streams.
 182
 183 (NAME CHECK OPEN)
 184
 185 NAME names the stream, CHECK is a function returning non-nil if the
 186 server support the stream and OPEN is a function for opening the
 187 stream.")
 188
 189 (defvar imap-authenticators '(kerberos4 cram-md5 login anonymous)
 190   "Priority of authenticators to consider when authenticating to server.")
 191
 192 (defvar imap-authenticator-alist
 193   '((kerberos4 imap-kerberos4a-p imap-kerberos4-auth)
 194     (cram-md5  imap-cram-md5-p   imap-cram-md5-auth)
 195     (login     imap-login-p      imap-login-auth)
 196     (anonymous imap-anonymous-p  imap-anonymous-auth))
 197   "Definition of authenticators.
 198
 199 (NAME CHECK AUTHENTICATE)
 200
 201 NAME names the authenticator.  CHECK is a function returning non-nil if
 202 the server support the authenticator and AUTHENTICATE is a function
 203 for doing the actuall authentification.")
 204
 205 (defvar imap-utf7-p nil
 206   "If non-nil, do utf7 encoding/decoding of mailbox names.
 207 Since the UTF7 decoding currently only decodes into ISO-8859-1
 208 characters, you may disable this decoding if you need to access UTF7
 209 encoded mailboxes which doesn't translate into ISO-8859-1.")
 210
 211 ;; Internal constants.  Change theese and die.
 212
 213 (defconst imap-default-port 143)
 214 (defconst imap-default-ssl-port 993)
 215 (defconst imap-default-stream 'network)
 216 (defconst imap-coding-system-for-read 'binary)
 217 (defconst imap-coding-system-for-write 'binary)
 218 (defconst imap-local-variables '(imap-server
 219                                  imap-port
 220                                  imap-client-eol
 221                                  imap-server-eol
 222                                  imap-auth
 223                                  imap-stream
 224                                  imap-username
 225                                  imap-password
 226                                  imap-current-mailbox
 227                                  imap-current-target-mailbox
 228                                  imap-message-data
 229                                  imap-capability
 230                                  imap-namespace
 231                                  imap-state
 232                                  imap-reached-tag
 233                                  imap-failed-tags
 234                                  imap-tag
 235                                  imap-process
 236                                  imap-mailbox-data))
 237
 238 ;; Internal variables.
 239
 240 (defvar imap-stream nil)
 241 (defvar imap-auth nil)
 242 (defvar imap-server nil)
 243 (defvar imap-port nil)
 244 (defvar imap-username nil)
 245 (defvar imap-password nil)
 246 (defvar imap-state 'closed
 247   "IMAP state.
 248 Valid states are `closed', `initial', `nonauth', `auth', `selected'
 249 and `examine'.")
 250
 251 (defvar imap-server-eol "\r\n"
 252   "The EOL string sent from the server.")
 253
 254 (defvar imap-client-eol "\r\n"
 255   "The EOL string we send to the server.")
 256
 257 (defvar imap-current-mailbox nil
 258   "Current mailbox name.")
 259
 260 (defvar imap-current-target-mailbox nil
 261   "Current target mailbox for COPY and APPEND commands.")
 262
 263 (defvar imap-mailbox-data nil
 264   "Obarray with mailbox data.")
 265
 266 (defvar imap-mailbox-prime 997
 267   "Length of imap-mailbox-data.")
 268
 269 (defvar imap-current-message nil
 270   "Current message number.")
 271
 272 (defvar imap-message-data nil
 273   "Obarray with message data.")
 274
 275 (defvar imap-message-prime 997
 276   "Length of imap-message-data.")
 277
 278 (defvar imap-capability nil
 279   "Capability for server.")
 280
 281 (defvar imap-namespace nil
 282   "Namespace for current server.")
 283
 284 (defvar imap-reached-tag 0
 285   "Lower limit on command tags that have been parsed.")
 286
 287 (defvar imap-failed-tags nil
 288   "Alist of tags that failed.
 289 Each element is a list with four elements; tag (a integer), response
 290 state (a symbol, `OK', `NO' or `BAD'), response code (a string), and
 291 human readable response text (a string).")
 292
 293 (defvar imap-tag 0
 294   "Command tag number.")
 295
 296 (defvar imap-process nil
 297   "Process.")
 298
 299 (defvar imap-continuation nil
 300   "Non-nil indicates that the server emitted a continuation request.
 301 The actually value is really the text on the continuation line.")
 302
 303 (defvar imap-log nil
 304   "Imap session trace.")
 305
 306 (defvar imap-debug nil                  ;"*imap-debug*"
 307   "Random debug spew.")
 308
 309 \f
 310 ;; Utility functions:
 311
 312 (defsubst imap-disable-multibyte ()
 313   "Enable multibyte in the current buffer."
 314   (when (fboundp 'set-buffer-multibyte)
 315     (set-buffer-multibyte nil)))
 316
 317 (defun imap-read-passwd (prompt &rest args)
 318   "Read a password using PROMPT.
 319 If ARGS, PROMPT is used as an argument to `format'."
 320   (let ((prompt (if args
 321                     (apply 'format prompt args)
 322                   prompt)))
 323     (funcall (if (or (fboundp 'read-passwd)
 324                      (and (load "subr" t)
 325                           (fboundp 'read-passwd))
 326                      (and (load "passwd" t)
 327                           (fboundp 'read-passwd)))
 328                  'read-passwd
 329                (autoload 'ange-ftp-read-passwd "ange-ftp")
 330                'ange-ftp-read-passwd)
 331              prompt)))
 332
 333 (defsubst imap-utf7-encode (string)
 334   (if imap-utf7-p
 335       (and string
 336            (condition-case ()
 337                (utf7-encode string t)
 338              (error (message
 339                      "imap: Could not UTF7 encode `%s', using it unencoded..."
 340                      string)
 341                     string)))
 342     string))
 343
 344 (defsubst imap-utf7-decode (string)
 345   (if imap-utf7-p
 346       (and string
 347            (condition-case ()
 348                (utf7-decode string t)
 349              (error (message
 350                      "imap: Could not UTF7 decode `%s', using it undecoded..."
 351                      string)
 352                     string)))
 353     string))
 354
 355 (defsubst imap-ok-p (status)
 356   (if (eq status 'OK)
 357       t
 358     (setq imap-error status)
 359     nil))
 360
 361 (defun imap-error-text (&optional buffer)
 362   (with-current-buffer (or buffer (current-buffer))
 363     (nth 3 (car imap-failed-tags))))
 364
 365 \f
 366 ;; Server functions; stream stuff:
 367
 368 (defun imap-kerberos4s-p (buffer)
 369   (imap-capability 'AUTH=KERBEROS_V4 buffer))
 370
 371 (defun imap-kerberos4-open (name buffer server port)
 372   (message "Opening Kerberized IMAP connection...")
 373   (let* ((port (or port imap-default-port))
 374          (coding-system-for-read imap-coding-system-for-read)
 375          (coding-system-for-write imap-coding-system-for-write)
 376          (process (start-process
 377                    name buffer shell-file-name shell-command-switch
 378                    (format-spec
 379                     imap-imtest-program
 380                     (format-spec-make ?s server ?p (number-to-string port))))))
 381     (when process
 382       (with-current-buffer buffer
 383         (setq imap-client-eol "\n")
 384         ;; Result of authentication is a string: __Full privacy protection__
 385         (while (and (memq (process-status process) '(open run))
 386                     (goto-char (point-min))
 387                     (not (and (imap-parse-greeting)
 388                               (re-search-forward "__\\(.*\\)__\n" nil t))))
 389           (accept-process-output process 1)
 390           (sit-for 1))
 391         (and imap-log
 392              (with-current-buffer (get-buffer-create imap-log)
 393                (imap-disable-multibyte)
 394                (buffer-disable-undo)
 395                (goto-char (point-max))
 396                (insert-buffer-substring buffer)))
 397         (let ((response (match-string 1)))
 398           (erase-buffer)
 399           (message "Kerberized IMAP connection: %s" response)
 400           (if (and response (let ((case-fold-search nil))
 401                               (not (string-match "failed" response))))
 402               process
 403             (if (memq (process-status process) '(open run))
 404                 (imap-send-command-wait "LOGOUT"))
 405             (delete-process process)
 406             nil))))))
 407
 408 (defun imap-ssl-p (buffer)
 409   nil)
 410
 411 (defun imap-ssl-open (name buffer server port)
 412   "Open a SSL connection to server."
 413   (let ((cmds (if (listp imap-ssl-program) imap-ssl-program
 414                 (list imap-ssl-program)))
 415         cmd done)
 416     (while (and (not done) (setq cmd (pop cmds)))
 417       (message "imap: Opening SSL connection with `%s'..." cmd)
 418       (let* ((port (or port imap-default-ssl-port))
 419              (coding-system-for-read imap-coding-system-for-read)
 420              (coding-system-for-write imap-coding-system-for-write)
 421              (ssl-program-name shell-file-name)
 422              (ssl-program-arguments
 423               (list shell-command-switch
 424                     (format-spec cmd (format-spec-make
 425                                       ?s server
 426                                       ?p (number-to-string port)))))
 427              process)
 428         (when (setq process (ignore-errors (open-ssl-stream
 429                                             name buffer server port)))
 430           (with-current-buffer buffer
 431             (goto-char (point-min))
 432             (while (and (memq (process-status process) '(open run))
 433                         (goto-char (point-max))
 434                         (forward-line -1)
 435                         (not (imap-parse-greeting)))
 436               (accept-process-output process 1)
 437               (sit-for 1))
 438             (and imap-log
 439                  (with-current-buffer (get-buffer-create imap-log)
 440                    (imap-disable-multibyte)
 441                    (buffer-disable-undo)
 442                    (goto-char (point-max))
 443                    (insert-buffer-substring buffer)))
 444             (erase-buffer)
 445             (when (memq (process-status process) '(open run))
 446               (setq done process))))))
 447     (if done
 448         (progn
 449           (message "imap: Opening SSL connection with `%s'...done" cmd)
 450           done)
 451       (message "imap: Failed opening SSL connection")
 452       nil)))
 453
 454 (defun imap-network-p (buffer)
 455   t)
 456
 457 (defun imap-network-open (name buffer server port)
 458   (let* ((port (or port imap-default-port))
 459          (coding-system-for-read imap-coding-system-for-read)
 460          (coding-system-for-write imap-coding-system-for-write)
 461          (process (open-network-stream name buffer server port)))
 462     (when process
 463       (while (and (memq (process-status process) '(open run))
 464                   (goto-char (point-min))
 465                   (not (imap-parse-greeting)))
 466         (accept-process-output process 1)
 467         (sit-for 1))
 468       (and imap-log
 469            (with-current-buffer (get-buffer-create imap-log)
 470              (imap-disable-multibyte)
 471              (buffer-disable-undo)
 472              (goto-char (point-max))
 473              (insert-buffer-substring buffer)))
 474       (when (memq (process-status process) '(open run))
 475         process))))
 476
 477 ;; Server functions; authenticator stuff:
 478
 479 (defun imap-interactive-login (buffer loginfunc)
 480   "Login to server in BUFFER.
 481 LOGINFUNC is passed a username and a password, it should return t if
 482 it where sucessful authenticating itself to the server, nil otherwise.
 483 Returns t if login was successful, nil otherwise."
 484   (with-current-buffer buffer
 485     (make-variable-buffer-local 'imap-username)
 486     (make-variable-buffer-local 'imap-password)
 487     (let (user passwd ret)
 488       ;;      (condition-case ()
 489       (while (or (not user) (not passwd))
 490         (setq user (or imap-username
 491                        (read-from-minibuffer
 492                         (concat "IMAP username for " imap-server ": ")
 493                         (or user imap-default-user))))
 494         (setq passwd (or imap-password
 495                          (imap-read-passwd
 496                           (concat "IMAP password for " user "@"
 497                                   imap-server ": "))))
 498         (when (and user passwd)
 499           (if (funcall loginfunc user passwd)
 500               (progn
 501                 (setq ret t
 502                       imap-username user)
 503                 (if (and (not imap-password)
 504                          (y-or-n-p "Store password for this session? "))
 505                     (setq imap-password passwd)))
 506             (message "Login failed...")
 507             (setq passwd nil)
 508             (sit-for 1))))
 509       ;;        (quit (with-current-buffer buffer
 510       ;;                (setq user nil
 511       ;;                      passwd nil)))
 512       ;;        (error (with-current-buffer buffer
 513       ;;                 (setq user nil
 514       ;;                       passwd nil))))
 515       ret)))
 516
 517 (defun imap-kerberos4a-p (buffer)
 518   (imap-capability 'AUTH=KERBEROS_V4 buffer))
 519
 520 (defun imap-kerberos4-auth (buffer)
 521   (eq imap-stream 'kerberos4))
 522
 523 (defun imap-cram-md5-p (buffer)
 524   (imap-capability 'AUTH=CRAM-MD5 buffer))
 525
 526 (defun imap-cram-md5-auth (buffer)
 527   "Login to server using the AUTH CRAM-MD5 method."
 528   (imap-interactive-login
 529    buffer
 530    (lambda (user passwd)
 531      (imap-ok-p
 532       (imap-send-command-wait
 533        (list
 534         "AUTHENTICATE CRAM-MD5"
 535         (lambda (challenge)
 536           (let* ((decoded (base64-decode-string challenge))
 537                  (hash (rfc2104-hash 'md5 64 16 passwd decoded))
 538                  (response (concat user " " hash))
 539                  (encoded (base64-encode-string response)))
 540             encoded))))))))
 541
 542 (defun imap-login-p (buffer)
 543   (not (imap-capability 'X-LOGIN-CMD-DISABLED buffer)))
 544
 545 (defun imap-login-auth (buffer)
 546   "Login to server using the LOGIN command."
 547   (imap-interactive-login buffer
 548                           (lambda (user passwd)
 549                             (imap-ok-p (imap-send-command-wait
 550                                         (concat "LOGIN \"" user "\" \""
 551                                                 passwd "\""))))))
 552
 553 (defun imap-anonymous-p (buffer)
 554   t)
 555
 556 (defun imap-anonymous-auth (buffer)
 557   (with-current-buffer buffer
 558     (imap-ok-p (imap-send-command-wait
 559                 (concat "LOGIN anonymous \"" (concat (user-login-name) "@"
 560                                                      (system-name)) "\"")))))
 561
 562 ;; Server functions:
 563
 564 (defun imap-open-1 (buffer)
 565   (with-current-buffer buffer
 566     (erase-buffer)
 567     (setq imap-current-mailbox nil
 568           imap-current-message nil
 569           imap-state 'initial
 570           imap-process (condition-case ()
 571                            (funcall (nth 2 (assq imap-stream
 572                                                  imap-stream-alist))
 573                                     "imap" buffer imap-server imap-port)
 574                          ((error quit) nil)))
 575     (when imap-process
 576       (set-process-filter imap-process 'imap-arrival-filter)
 577       (set-process-sentinel imap-process 'imap-sentinel)
 578       (while (and (eq imap-state 'initial)
 579                   (memq (process-status imap-process) '(open run)))
 580         (message "Waiting for response from %s..." imap-server)
 581         (accept-process-output imap-process 1))
 582       (message "Waiting for response from %s...done" imap-server)
 583       (and (memq (process-status imap-process) '(open run))
 584            imap-process))))
 585
 586 (defun imap-open (server &optional port stream auth buffer)
 587   "Open a IMAP connection to host SERVER at PORT returning a buffer.
 588 If PORT is unspecified, a default value is used (143 except
 589 for SSL which use 993).
 590 STREAM indicates the stream to use, see `imap-streams' for available
 591 streams.  If nil, it choices the best stream the server is capable of.
 592 AUTH indicates authenticator to use, see `imap-authenticators' for
 593 available authenticators.  If nil, it choices the best stream the
 594 server is capable of.
 595 BUFFER can be a buffer or a name of a buffer, which is created if
 596 necessery.  If nil, the buffer name is generated."
 597   (setq buffer (or buffer (format " *imap* %s:%d" server (or port 0))))
 598   (with-current-buffer (get-buffer-create buffer)
 599     (if (imap-opened buffer)
 600         (imap-close buffer))
 601     (mapcar 'make-variable-buffer-local imap-local-variables)
 602     (imap-disable-multibyte)
 603     (buffer-disable-undo)
 604     (setq imap-server (or server imap-server))
 605     (setq imap-port (or port imap-port))
 606     (setq imap-auth (or auth imap-auth))
 607     (setq imap-stream (or stream imap-stream))
 608     (when (let ((imap-stream (or imap-stream imap-default-stream)))
 609             (imap-open-1 buffer))
 610       ;; Choose stream.
 611       (let (stream-changed)
 612         (when (null imap-stream)
 613           (let ((streams imap-streams))
 614             (while (setq stream (pop streams))
 615               (if (funcall (nth 1 (assq stream imap-stream-alist)) buffer)
 616                   (setq stream-changed (not (eq (or imap-stream
 617                                                     imap-default-stream)
 618                                                 stream))
 619                         imap-stream stream
 620                         streams nil)))
 621             (unless imap-stream