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