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