Mercurial > emacs
comparison lisp/gnus/sieve-manage.el @ 56927:55fd4f77387a after-merge-gnus-5_10
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Merge from emacs--gnus--5.10, gnus--rel--5.10
Patches applied:
* miles@gnu.org--gnu-2004/emacs--gnus--5.10--base-0
tag of miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-464
* miles@gnu.org--gnu-2004/emacs--gnus--5.10--patch-1
Import from CVS branch gnus-5_10-branch
* miles@gnu.org--gnu-2004/emacs--gnus--5.10--patch-2
Merge from lorentey@elte.hu--2004/emacs--multi-tty--0, emacs--cvs-trunk--0
* miles@gnu.org--gnu-2004/emacs--gnus--5.10--patch-3
Merge from gnus--rel--5.10
* miles@gnu.org--gnu-2004/emacs--gnus--5.10--patch-4
Merge from gnus--rel--5.10
* miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-18
Update from CVS
* miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-19
Remove autoconf-generated files from archive
* miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-20
Update from CVS
author | Miles Bader <miles@gnu.org> |
---|---|
date | Sat, 04 Sep 2004 13:13:48 +0000 |
parents | |
children | 0d1a48b1ca68 |
comparison
equal
deleted
inserted
replaced
56926:f8e248e9a717 | 56927:55fd4f77387a |
---|---|
1 ;;; sieve-manage.el --- Implementation of the managesive protocol in elisp | |
2 ;; Copyright (C) 2001, 2003 Free Software Foundation, Inc. | |
3 | |
4 ;; Author: Simon Josefsson <simon@josefsson.org> | |
5 | |
6 ;; This file is part of GNU Emacs. | |
7 | |
8 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
9 ;; it under the terms of the GNU General Public License as published by | |
10 ;; the Free Software Foundation; either version 2, or (at your option) | |
11 ;; any later version. | |
12 | |
13 ;; GNU Emacs is distributed in the hope that it will be useful, | |
14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
16 ;; GNU General Public License for more details. | |
17 | |
18 ;; You should have received a copy of the GNU General Public License | |
19 ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
20 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
21 ;; Boston, MA 02111-1307, USA. | |
22 | |
23 ;;; Commentary: | |
24 | |
25 ;; This library provides an elisp API for the managesieve network | |
26 ;; protocol. | |
27 ;; | |
28 ;; Currently only the CRAM-MD5 authentication mechanism is supported. | |
29 ;; | |
30 ;; The API should be fairly obvious for anyone familiar with the | |
31 ;; managesieve protocol, interface functions include: | |
32 ;; | |
33 ;; `sieve-manage-open' | |
34 ;; open connection to managesieve server, returning a buffer to be | |
35 ;; used by all other API functions. | |
36 ;; | |
37 ;; `sieve-manage-opened' | |
38 ;; check if a server is open or not | |
39 ;; | |
40 ;; `sieve-manage-close' | |
41 ;; close a server connection. | |
42 ;; | |
43 ;; `sieve-manage-authenticate' | |
44 ;; `sieve-manage-listscripts' | |
45 ;; `sieve-manage-deletescript' | |
46 ;; `sieve-manage-getscript' | |
47 ;; performs managesieve protocol actions | |
48 ;; | |
49 ;; and that's it. Example of a managesieve session in *scratch*: | |
50 ;; | |
51 ;; (setq my-buf (sieve-manage-open "my.server.com")) | |
52 ;; " *sieve* my.server.com:2000*" | |
53 ;; | |
54 ;; (sieve-manage-authenticate "myusername" "mypassword" my-buf) | |
55 ;; 'auth | |
56 ;; | |
57 ;; (sieve-manage-listscripts my-buf) | |
58 ;; ("vacation" "testscript" ("splitmail") "badscript") | |
59 ;; | |
60 ;; References: | |
61 ;; | |
62 ;; draft-martin-managesieve-02.txt, | |
63 ;; "A Protocol for Remotely Managing Sieve Scripts", | |
64 ;; by Tim Martin. | |
65 ;; | |
66 ;; Release history: | |
67 ;; | |
68 ;; 2001-10-31 Committed to Oort Gnus. | |
69 ;; 2002-07-27 Added DELETESCRIPT. Suggested by Ned Ludd. | |
70 | |
71 ;;; Code: | |
72 | |
73 (require 'rfc2104) | |
74 (or (fboundp 'md5) | |
75 (require 'md5)) | |
76 (eval-and-compile | |
77 (autoload 'starttls-open-stream "starttls") | |
78 (autoload 'starttls-negotiate "starttls")) | |
79 | |
80 ;; User customizable variables: | |
81 | |
82 (defgroup sieve-manage nil | |
83 "Low-level Managesieve protocol issues." | |
84 :group 'mail | |
85 :prefix "sieve-") | |
86 | |
87 (defcustom sieve-manage-log "*sieve-manage-log*" | |
88 "Name of buffer for managesieve session trace." | |
89 :type 'string) | |
90 | |
91 (defcustom sieve-manage-default-user (user-login-name) | |
92 "Default username to use." | |
93 :type 'string) | |
94 | |
95 (defcustom sieve-manage-server-eol "\r\n" | |
96 "The EOL string sent from the server." | |
97 :type 'string) | |
98 | |
99 (defcustom sieve-manage-client-eol "\r\n" | |
100 "The EOL string we send to the server." | |
101 :type 'string) | |
102 | |
103 (defcustom sieve-manage-streams '(network starttls shell) | |
104 "Priority of streams to consider when opening connection to server.") | |
105 | |
106 (defcustom sieve-manage-stream-alist | |
107 '((network sieve-manage-network-p sieve-manage-network-open) | |
108 (shell sieve-manage-shell-p sieve-manage-shell-open) | |
109 (starttls sieve-manage-starttls-p sieve-manage-starttls-open)) | |
110 "Definition of network streams. | |
111 | |
112 \(NAME CHECK OPEN) | |
113 | |
114 NAME names the stream, CHECK is a function returning non-nil if the | |
115 server support the stream and OPEN is a function for opening the | |
116 stream.") | |
117 | |
118 (defcustom sieve-manage-authenticators '(cram-md5 plain) | |
119 "Priority of authenticators to consider when authenticating to server.") | |
120 | |
121 (defcustom sieve-manage-authenticator-alist | |
122 '((cram-md5 sieve-manage-cram-md5-p sieve-manage-cram-md5-auth) | |
123 (plain sieve-manage-plain-p sieve-manage-plain-auth)) | |
124 "Definition of authenticators. | |
125 | |
126 \(NAME CHECK AUTHENTICATE) | |
127 | |
128 NAME names the authenticator. CHECK is a function returning non-nil if | |
129 the server support the authenticator and AUTHENTICATE is a function | |
130 for doing the actual authentication.") | |
131 | |
132 (defcustom sieve-manage-default-port 2000 | |
133 "Default port number for managesieve protocol." | |
134 :type 'integer) | |
135 | |
136 ;; Internal variables: | |
137 | |
138 (defconst sieve-manage-local-variables '(sieve-manage-server | |
139 sieve-manage-port | |
140 sieve-manage-auth | |
141 sieve-manage-stream | |
142 sieve-manage-username | |
143 sieve-manage-password | |
144 sieve-manage-process | |
145 sieve-manage-client-eol | |
146 sieve-manage-server-eol | |
147 sieve-manage-capability)) | |
148 (defconst sieve-manage-default-stream 'network) | |
149 (defconst sieve-manage-coding-system-for-read 'binary) | |
150 (defconst sieve-manage-coding-system-for-write 'binary) | |
151 (defvar sieve-manage-stream nil) | |
152 (defvar sieve-manage-auth nil) | |
153 (defvar sieve-manage-server nil) | |
154 (defvar sieve-manage-port nil) | |
155 (defvar sieve-manage-username nil) | |
156 (defvar sieve-manage-password nil) | |
157 (defvar sieve-manage-state 'closed | |
158 "Managesieve state. | |
159 Valid states are `closed', `initial', `nonauth', and `auth'.") | |
160 (defvar sieve-manage-process nil) | |
161 (defvar sieve-manage-capability nil) | |
162 | |
163 ;; Internal utility functions | |
164 | |
165 (defsubst sieve-manage-disable-multibyte () | |
166 "Enable multibyte in the current buffer." | |
167 (when (fboundp 'set-buffer-multibyte) | |
168 (set-buffer-multibyte nil))) | |
169 | |
170 ;; Uses the dynamically bound `reason' variable. | |
171 (defvar reason) | |
172 (defun sieve-manage-interactive-login (buffer loginfunc) | |
173 "Login to server in BUFFER. | |
174 LOGINFUNC is passed a username and a password, it should return t if | |
175 it where sucessful authenticating itself to the server, nil otherwise. | |
176 Returns t if login was successful, nil otherwise." | |
177 (with-current-buffer buffer | |
178 (make-variable-buffer-local 'sieve-manage-username) | |
179 (make-variable-buffer-local 'sieve-manage-password) | |
180 (let (user passwd ret reason) | |
181 ;; (condition-case () | |
182 (while (or (not user) (not passwd)) | |
183 (setq user (or sieve-manage-username | |
184 (read-from-minibuffer | |
185 (concat "Managesieve username for " | |
186 sieve-manage-server ": ") | |
187 (or user sieve-manage-default-user)))) | |
188 (setq passwd (or sieve-manage-password | |
189 (read-passwd | |
190 (concat "Managesieve password for " user "@" | |
191 sieve-manage-server ": ")))) | |
192 (when (and user passwd) | |
193 (if (funcall loginfunc user passwd) | |
194 (progn | |
195 (setq ret t | |
196 sieve-manage-username user) | |
197 (if (and (not sieve-manage-password) | |
198 (y-or-n-p "Store password for this session? ")) | |
199 (setq sieve-manage-password passwd))) | |
200 (if reason | |
201 (message "Login failed (reason given: %s)..." reason) | |
202 (message "Login failed...")) | |
203 (setq reason nil) | |
204 (setq passwd nil) | |
205 (sit-for 1)))) | |
206 ;; (quit (with-current-buffer buffer | |
207 ;; (setq user nil | |
208 ;; passwd nil))) | |
209 ;; (error (with-current-buffer buffer | |
210 ;; (setq user nil | |
211 ;; passwd nil)))) | |
212 ret))) | |
213 | |
214 (defun sieve-manage-erase (&optional p buffer) | |
215 (let ((buffer (or buffer (current-buffer)))) | |
216 (and sieve-manage-log | |
217 (with-current-buffer (get-buffer-create sieve-manage-log) | |
218 (sieve-manage-disable-multibyte) | |
219 (buffer-disable-undo) | |
220 (goto-char (point-max)) | |
221 (insert-buffer-substring buffer (with-current-buffer buffer | |
222 (point-min)) | |
223 (or p (with-current-buffer buffer | |
224 (point-max))))))) | |
225 (delete-region (point-min) (or p (point-max)))) | |
226 | |
227 (defun sieve-manage-open-1 (buffer) | |
228 (with-current-buffer buffer | |
229 (sieve-manage-erase) | |
230 (setq sieve-manage-state 'initial | |
231 sieve-manage-process | |
232 (condition-case () | |
233 (funcall (nth 2 (assq sieve-manage-stream | |
234 sieve-manage-stream-alist)) | |
235 "sieve" buffer sieve-manage-server sieve-manage-port) | |
236 ((error quit) nil))) | |
237 (when sieve-manage-process | |
238 (while (and (eq sieve-manage-state 'initial) | |
239 (memq (process-status sieve-manage-process) '(open run))) | |
240 (message "Waiting for response from %s..." sieve-manage-server) | |
241 (accept-process-output sieve-manage-process 1)) | |
242 (message "Waiting for response from %s...done" sieve-manage-server) | |
243 (and (memq (process-status sieve-manage-process) '(open run)) | |
244 sieve-manage-process)))) | |
245 | |
246 ;; Streams | |
247 | |
248 (defun sieve-manage-network-p (buffer) | |
249 t) | |
250 | |
251 (defun sieve-manage-network-open (name buffer server port) | |
252 (let* ((port (or port sieve-manage-default-port)) | |
253 (coding-system-for-read sieve-manage-coding-system-for-read) | |
254 (coding-system-for-write sieve-manage-coding-system-for-write) | |
255 (process (open-network-stream name buffer server port))) | |
256 (when process | |
257 (while (and (memq (process-status process) '(open run)) | |
258 (set-buffer buffer) ;; XXX "blue moon" nntp.el bug | |
259 (goto-char (point-min)) | |
260 (not (sieve-manage-parse-greeting-1))) | |
261 (accept-process-output process 1) | |
262 (sit-for 1)) | |
263 (sieve-manage-erase nil buffer) | |
264 (when (memq (process-status process) '(open run)) | |
265 process)))) | |
266 | |
267 (defun imap-starttls-p (buffer) | |
268 ;; (and (imap-capability 'STARTTLS buffer) | |
269 (condition-case () | |
270 (progn | |
271 (require 'starttls) | |
272 (call-process "starttls")) | |
273 (error nil))) | |
274 | |
275 (defun imap-starttls-open (name buffer server port) | |
276 (let* ((port (or port sieve-manage-default-port)) | |
277 (coding-system-for-read sieve-manage-coding-system-for-read) | |
278 (coding-system-for-write sieve-manage-coding-system-for-write) | |
279 (process (starttls-open-stream name buffer server port)) | |
280 done) | |
281 (when process | |
282 (while (and (memq (process-status process) '(open run)) | |
283 (set-buffer buffer) ;; XXX "blue moon" nntp.el bug | |
284 (goto-char (point-min)) | |
285 (not (sieve-manage-parse-greeting-1))) | |
286 (accept-process-output process 1) | |
287 (sit-for 1)) | |
288 (sieve-manage-erase nil buffer) | |
289 (sieve-manage-send "STARTTLS") | |
290 (starttls-negotiate process)) | |
291 (when (memq (process-status process) '(open run)) | |
292 process))) | |
293 | |
294 ;; Authenticators | |
295 | |
296 (defun sieve-manage-plain-p (buffer) | |
297 (sieve-manage-capability "SASL" "PLAIN" buffer)) | |
298 | |
299 (defun sieve-manage-plain-auth (buffer) | |
300 "Login to managesieve server using the PLAIN SASL method." | |
301 (let* ((done (sieve-manage-interactive-login | |
302 buffer | |
303 (lambda (user passwd) | |
304 (sieve-manage-send (concat "AUTHENTICATE \"PLAIN\" \"" | |
305 (base64-encode-string | |
306 (concat (char-to-string 0) | |
307 user | |
308 (char-to-string 0) | |
309 passwd)) | |
310 "\"")) | |
311 (let ((rsp (sieve-manage-parse-okno))) | |
312 (if (sieve-manage-ok-p rsp) | |
313 t | |
314 (setq reason (cdr-safe rsp)) | |
315 nil)))))) | |
316 (if done | |
317 (message "sieve: Authenticating using PLAIN...done") | |
318 (message "sieve: Authenticating using PLAIN...failed")))) | |
319 | |
320 (defun sieve-manage-cram-md5-p (buffer) | |
321 (sieve-manage-capability "SASL" "CRAM-MD5" buffer)) | |
322 | |
323 (defun sieve-manage-cram-md5-auth (buffer) | |
324 "Login to managesieve server using the CRAM-MD5 SASL method." | |
325 (message "sieve: Authenticating using CRAM-MD5...") | |
326 (let* ((done (sieve-manage-interactive-login | |
327 buffer | |
328 (lambda (user passwd) | |
329 (sieve-manage-send "AUTHENTICATE \"CRAM-MD5\"") | |
330 (sieve-manage-send | |
331 (concat | |
332 "\"" | |
333 (base64-encode-string | |
334 (concat | |
335 user " " | |
336 (rfc2104-hash 'md5 64 16 passwd | |
337 (base64-decode-string | |
338 (prog1 | |
339 (sieve-manage-parse-string) | |
340 (sieve-manage-erase)))))) | |
341 "\"")) | |
342 (let ((rsp (sieve-manage-parse-okno))) | |
343 (if (sieve-manage-ok-p rsp) | |
344 t | |
345 (setq reason (cdr-safe rsp)) | |
346 nil)))))) | |
347 (if done | |
348 (message "sieve: Authenticating using CRAM-MD5...done") | |
349 (message "sieve: Authenticating using CRAM-MD5...failed")))) | |
350 | |
351 ;; Managesieve API | |
352 | |
353 (defun sieve-manage-open (server &optional port stream auth buffer) | |
354 "Open a network connection to a managesieve SERVER (string). | |
355 Optional variable PORT is port number (integer) on remote server. | |
356 Optional variable STREAM is any of `sieve-manage-streams' (a symbol). | |
357 Optional variable AUTH indicates authenticator to use, see | |
358 `sieve-manage-authenticators' for available authenticators. If nil, chooses | |
359 the best stream the server is capable of. | |
360 Optional variable BUFFER is buffer (buffer, or string naming buffer) | |
361 to work in." | |
362 (setq buffer (or buffer (format " *sieve* %s:%d" server (or port 2000)))) | |
363 (with-current-buffer (get-buffer-create buffer) | |
364 (mapcar 'make-variable-buffer-local sieve-manage-local-variables) | |
365 (sieve-manage-disable-multibyte) | |
366 (buffer-disable-undo) | |
367 (setq sieve-manage-server (or server sieve-manage-server)) | |
368 (setq sieve-manage-port (or port sieve-manage-port)) | |
369 (setq sieve-manage-stream (or stream sieve-manage-stream)) | |
370 (message "sieve: Connecting to %s..." sieve-manage-server) | |
371 (if (let ((sieve-manage-stream | |
372 (or sieve-manage-stream sieve-manage-default-stream))) | |
373 (sieve-manage-open-1 buffer)) | |
374 ;; Choose stream. | |
375 (let (stream-changed) | |
376 (message "sieve: Connecting to %s...done" sieve-manage-server) | |
377 (when (null sieve-manage-stream) | |
378 (let ((streams sieve-manage-streams)) | |
379 (while (setq stream (pop streams)) | |
380 (if (funcall (nth 1 (assq stream | |
381 sieve-manage-stream-alist)) buffer) | |
382 (setq stream-changed | |
383 (not (eq (or sieve-manage-stream | |
384 sieve-manage-default-stream) | |
385 stream)) | |
386 sieve-manage-stream stream | |
387 streams nil))) | |
388 (unless sieve-manage-stream | |
389 (error "Couldn't figure out a stream for server")))) | |
390 (when stream-changed | |
391 (message "sieve: Reconnecting with stream `%s'..." | |
392 sieve-manage-stream) | |
393 (sieve-manage-close buffer) | |
394 (if (sieve-manage-open-1 buffer) | |
395 (message "sieve: Reconnecting with stream `%s'...done" | |
396 sieve-manage-stream) | |
397 (message "sieve: Reconnecting with stream `%s'...failed" | |
398 sieve-manage-stream)) | |
399 (setq sieve-manage-capability nil)) | |
400 (if (sieve-manage-opened buffer) | |
401 ;; Choose authenticator | |
402 (when (and (null sieve-manage-auth) | |
403 (not (eq sieve-manage-state 'auth))) | |
404 (let ((auths sieve-manage-authenticators)) | |
405 (while (setq auth (pop auths)) | |
406 (if (funcall (nth 1 (assq | |
407 auth | |
408 sieve-manage-authenticator-alist)) | |
409 buffer) | |
410 (setq sieve-manage-auth auth | |
411 auths nil))) | |
412 (unless sieve-manage-auth | |
413 (error "Couldn't figure out authenticator for server")))))) | |
414 (message "sieve: Connecting to %s...failed" sieve-manage-server)) | |
415 (when (sieve-manage-opened buffer) | |
416 (sieve-manage-erase) | |
417 buffer))) | |
418 | |
419 (defun sieve-manage-opened (&optional buffer) | |
420 "Return non-nil if connection to managesieve server in BUFFER is open. | |
421 If BUFFER is nil then the current buffer is used." | |
422 (and (setq buffer (get-buffer (or buffer (current-buffer)))) | |
423 (buffer-live-p buffer) | |
424 (with-current-buffer buffer | |
425 (and sieve-manage-process | |
426 (memq (process-status sieve-manage-process) '(open run)))))) | |
427 | |
428 (defun sieve-manage-close (&optional buffer) | |
429 "Close connection to managesieve server in BUFFER. | |
430 If BUFFER is nil, the current buffer is used." | |
431 (with-current-buffer (or buffer (current-buffer)) | |
432 (when (sieve-manage-opened) | |
433 (sieve-manage-send "LOGOUT") | |
434 (sit-for 1)) | |
435 (when (and sieve-manage-process | |
436 (memq (process-status sieve-manage-process) '(open run))) | |
437 (delete-process sieve-manage-process)) | |
438 (setq sieve-manage-process nil) | |
439 (sieve-manage-erase) | |
440 t)) | |
441 | |
442 (defun sieve-manage-authenticate (&optional user passwd buffer) | |
443 "Authenticate to server in BUFFER, using current buffer if nil. | |
444 It uses the authenticator specified when opening the server. If the | |
445 authenticator requires username/passwords, they are queried from the | |
446 user and optionally stored in the buffer. If USER and/or PASSWD is | |
447 specified, the user will not be questioned and the username and/or | |
448 password is remembered in the buffer." | |
449 (with-current-buffer (or buffer (current-buffer)) | |
450 (if (not (eq sieve-manage-state 'nonauth)) | |
451 (eq sieve-manage-state 'auth) | |
452 (make-variable-buffer-local 'sieve-manage-username) | |
453 (make-variable-buffer-local 'sieve-manage-password) | |
454 (if user (setq sieve-manage-username user)) | |
455 (if passwd (setq sieve-manage-password passwd)) | |
456 (if (funcall (nth 2 (assq sieve-manage-auth | |
457 sieve-manage-authenticator-alist)) buffer) | |
458 (setq sieve-manage-state 'auth))))) | |
459 | |
460 (defun sieve-manage-capability (&optional name value buffer) | |
461 (with-current-buffer (or buffer (current-buffer)) | |
462 (if (null name) | |
463 sieve-manage-capability | |
464 (if (null value) | |
465 (nth 1 (assoc name sieve-manage-capability)) | |
466 (when (string-match value (nth 1 (assoc name sieve-manage-capability))) | |
467 (nth 1 (assoc name sieve-manage-capability))))))) | |
468 | |
469 (defun sieve-manage-listscripts (&optional buffer) | |
470 (with-current-buffer (or buffer (current-buffer)) | |
471 (sieve-manage-send "LISTSCRIPTS") | |
472 (sieve-manage-parse-listscripts))) | |
473 | |
474 (defun sieve-manage-havespace (name size &optional buffer) | |
475 (with-current-buffer (or buffer (current-buffer)) | |
476 (sieve-manage-send (format "HAVESPACE \"%s\" %s" name size)) | |
477 (sieve-manage-parse-okno))) | |
478 | |
479 (eval-and-compile | |
480 (if (fboundp 'string-bytes) | |
481 (defalias 'sieve-string-bytes 'string-bytes) | |
482 (defalias 'sieve-string-bytes 'length))) | |
483 | |
484 (defun sieve-manage-putscript (name content &optional buffer) | |
485 (with-current-buffer (or buffer (current-buffer)) | |
486 (sieve-manage-send (format "PUTSCRIPT \"%s\" {%d+}%s%s" name | |
487 (sieve-string-bytes content) | |
488 sieve-manage-client-eol content)) | |
489 (sieve-manage-parse-okno))) | |
490 | |
491 (defun sieve-manage-deletescript (name &optional buffer) | |
492 (with-current-buffer (or buffer (current-buffer)) | |
493 (sieve-manage-send (format "DELETESCRIPT \"%s\"" name)) | |
494 (sieve-manage-parse-okno))) | |
495 | |
496 (defun sieve-manage-getscript (name output-buffer &optional buffer) | |
497 (with-current-buffer (or buffer (current-buffer)) | |
498 (sieve-manage-send (format "GETSCRIPT \"%s\"" name)) | |
499 (let ((script (sieve-manage-parse-string))) | |
500 (sieve-manage-parse-crlf) | |
501 (with-current-buffer output-buffer | |
502 (insert script)) | |
503 (sieve-manage-parse-okno)))) | |
504 | |
505 (defun sieve-manage-setactive (name &optional buffer) | |
506 (with-current-buffer (or buffer (current-buffer)) | |
507 (sieve-manage-send (format "SETACTIVE \"%s\"" name)) | |
508 (sieve-manage-parse-okno))) | |
509 | |
510 ;; Protocol parsing routines | |
511 | |
512 (defun sieve-manage-ok-p (rsp) | |
513 (string= (downcase (or (car-safe rsp) "")) "ok")) | |
514 | |
515 (defsubst sieve-manage-forward () | |
516 (or (eobp) (forward-char))) | |
517 | |
518 (defun sieve-manage-is-okno () | |
519 (when (looking-at (concat | |
520 "^\\(OK\\|NO\\)\\( (\\([^)]+\\))\\)?\\( \\(.*\\)\\)?" | |
521 sieve-manage-server-eol)) | |
522 (let ((status (match-string 1)) | |
523 (resp-code (match-string 3)) | |
524 (response (match-string 5))) | |
525 (when response | |
526 (goto-char (match-beginning 5)) | |
527 (setq response (sieve-manage-is-string))) | |
528 (list status resp-code response)))) | |
529 | |
530 (defun sieve-manage-parse-okno () | |
531 (let (rsp) | |
532 (while (null rsp) | |
533 (accept-process-output (get-buffer-process (current-buffer)) 1) | |
534 (goto-char (point-min)) | |
535 (setq rsp (sieve-manage-is-okno))) | |
536 (sieve-manage-erase) | |
537 rsp)) | |
538 | |
539 (defun sieve-manage-parse-capability-1 () | |
540 "Accept a managesieve greeting." | |
541 (let (str) | |
542 (while (setq str (sieve-manage-is-string)) | |
543 (if (eq (char-after) ? ) | |
544 (progn | |
545 (sieve-manage-forward) | |
546 (push (list str (sieve-manage-is-string)) | |
547 sieve-manage-capability)) | |
548 (push (list str) sieve-manage-capability)) | |
549 (forward-line))) | |
550 (when (re-search-forward (concat "^OK" sieve-manage-server-eol) nil t) | |
551 (setq sieve-manage-state 'nonauth))) | |
552 | |
553 (defalias 'sieve-manage-parse-greeting-1 'sieve-manage-parse-capability-1) | |
554 | |
555 (defun sieve-manage-is-string () | |
556 (cond ((looking-at "\"\\([^\"]+\\)\"") | |
557 (prog1 | |
558 (match-string 1) | |
559 (goto-char (match-end 0)))) | |
560 ((looking-at (concat "{\\([0-9]+\\)}" sieve-manage-server-eol)) | |
561 (let ((pos (match-end 0)) | |
562 (len (string-to-number (match-string 1)))) | |
563 (if (< (point-max) (+ pos len)) | |
564 nil | |
565 (goto-char (+ pos len)) | |
566 (buffer-substring pos (+ pos len))))))) | |
567 | |
568 (defun sieve-manage-parse-string () | |
569 (let (rsp) | |
570 (while (null rsp) | |
571 (accept-process-output (get-buffer-process (current-buffer)) 1) | |
572 (goto-char (point-min)) | |
573 (setq rsp (sieve-manage-is-string))) | |
574 (sieve-manage-erase (point)) | |
575 rsp)) | |
576 | |
577 (defun sieve-manage-parse-crlf () | |
578 (when (looking-at sieve-manage-server-eol) | |
579 (sieve-manage-erase (match-end 0)))) | |
580 | |
581 (defun sieve-manage-parse-listscripts () | |
582 (let (tmp rsp data) | |
583 (while (null rsp) | |
584 (while (null (or (setq rsp (sieve-manage-is-okno)) | |
585 (setq tmp (sieve-manage-is-string)))) | |
586 (accept-process-output (get-buffer-process (current-buffer)) 1) | |
587 (goto-char (point-min))) | |
588 (when tmp | |
589 (while (not (looking-at (concat "\\( ACTIVE\\)?" | |
590 sieve-manage-server-eol))) | |
591 (accept-process-output (get-buffer-process (current-buffer)) 1) | |
592 (goto-char (point-min))) | |
593 (if (match-string 1) | |
594 (push (cons 'active tmp) data) | |
595 (push tmp data)) | |
596 (goto-char (match-end 0)) | |
597 (setq tmp nil))) | |
598 (sieve-manage-erase) | |
599 (if (sieve-manage-ok-p rsp) | |
600 data | |
601 rsp))) | |
602 | |
603 (defun sieve-manage-send (cmdstr) | |
604 (setq cmdstr (concat cmdstr sieve-manage-client-eol)) | |
605 (and sieve-manage-log | |
606 (with-current-buffer (get-buffer-create sieve-manage-log) | |
607 (sieve-manage-disable-multibyte) | |
608 (buffer-disable-undo) | |
609 (goto-char (point-max)) | |
610 (insert cmdstr))) | |
611 (process-send-string sieve-manage-process cmdstr)) | |
612 | |
613 (provide 'sieve-manage) | |
614 | |
615 ;;; arch-tag: 321c4640-1371-4495-9baf-8ccb71dd5bd1 | |
616 ;; sieve-manage.el ends here |