Commit | Line | Data |
---|---|---|
53964682 | 1 | ;;; sieve-manage.el --- Implementation of the managesieve protocol in elisp |
e84b4b86 | 2 | |
ba318903 | 3 | ;; Copyright (C) 2001-2014 Free Software Foundation, Inc. |
23f87bed MB |
4 | |
5 | ;; Author: Simon Josefsson <simon@josefsson.org> | |
8e16fb98 | 6 | ;; Albert Krewinkel <tarleb@moltkeplatz.de> |
23f87bed MB |
7 | |
8 | ;; This file is part of GNU Emacs. | |
9 | ||
5e809f55 | 10 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
23f87bed | 11 | ;; it under the terms of the GNU General Public License as published by |
5e809f55 GM |
12 | ;; the Free Software Foundation, either version 3 of the License, or |
13 | ;; (at your option) any later version. | |
23f87bed MB |
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 | |
5e809f55 | 17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
23f87bed MB |
18 | ;; GNU General Public License for more details. |
19 | ||
20 | ;; You should have received a copy of the GNU General Public License | |
5e809f55 | 21 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
23f87bed MB |
22 | |
23 | ;;; Commentary: | |
24 | ||
25 | ;; This library provides an elisp API for the managesieve network | |
26 | ;; protocol. | |
27 | ;; | |
01c52d31 MB |
28 | ;; It uses the SASL library for authentication, which means it |
29 | ;; supports DIGEST-MD5, CRAM-MD5, SCRAM-MD5, NTLM, PLAIN and LOGIN | |
30 | ;; methods. STARTTLS is not well tested, but should be easy to get to | |
31 | ;; work if someone wants. | |
23f87bed MB |
32 | ;; |
33 | ;; The API should be fairly obvious for anyone familiar with the | |
34 | ;; managesieve protocol, interface functions include: | |
35 | ;; | |
36 | ;; `sieve-manage-open' | |
37 | ;; open connection to managesieve server, returning a buffer to be | |
38 | ;; used by all other API functions. | |
39 | ;; | |
40 | ;; `sieve-manage-opened' | |
41 | ;; check if a server is open or not | |
42 | ;; | |
43 | ;; `sieve-manage-close' | |
44 | ;; close a server connection. | |
45 | ;; | |
23f87bed MB |
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 | ;; | |
fd9ba500 JD |
53 | ;; (with-current-buffer (sieve-manage-open "mail.example.com") |
54 | ;; (sieve-manage-authenticate) | |
55 | ;; (sieve-manage-listscripts)) | |
23f87bed | 56 | ;; |
fd9ba500 | 57 | ;; => ((active . "main") "vacation") |
23f87bed MB |
58 | ;; |
59 | ;; References: | |
60 | ;; | |
61 | ;; draft-martin-managesieve-02.txt, | |
62 | ;; "A Protocol for Remotely Managing Sieve Scripts", | |
63 | ;; by Tim Martin. | |
64 | ;; | |
65 | ;; Release history: | |
66 | ;; | |
67 | ;; 2001-10-31 Committed to Oort Gnus. | |
68 | ;; 2002-07-27 Added DELETESCRIPT. Suggested by Ned Ludd. | |
01c52d31 | 69 | ;; 2002-08-03 Use SASL library. |
8e16fb98 | 70 | ;; 2013-06-05 Enabled STARTTLS support, fixed bit rot. |
23f87bed MB |
71 | |
72 | ;;; Code: | |
73 | ||
f0b7f5a8 | 74 | ;; For Emacs <22.2 and XEmacs. |
1d1df709 GM |
75 | (eval-and-compile |
76 | (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) | |
87035689 MB |
77 | |
78 | (if (locate-library "password-cache") | |
79 | (require 'password-cache) | |
80 | (require 'password)) | |
81 | ||
01c52d31 | 82 | (eval-when-compile |
1d8ff0c6 | 83 | (require 'cl) ; caddr |
01c52d31 MB |
84 | (require 'sasl) |
85 | (require 'starttls)) | |
8abf1b22 | 86 | (autoload 'sasl-find-mechanism "sasl") |
b8e0f0cd | 87 | (autoload 'auth-source-search "auth-source") |
23f87bed MB |
88 | |
89 | ;; User customizable variables: | |
90 | ||
91 | (defgroup sieve-manage nil | |
92 | "Low-level Managesieve protocol issues." | |
93 | :group 'mail | |
94 | :prefix "sieve-") | |
95 | ||
96 | (defcustom sieve-manage-log "*sieve-manage-log*" | |
97 | "Name of buffer for managesieve session trace." | |
d0859c9a MB |
98 | :type 'string |
99 | :group 'sieve-manage) | |
23f87bed | 100 | |
23f87bed MB |
101 | (defcustom sieve-manage-server-eol "\r\n" |
102 | "The EOL string sent from the server." | |
d0859c9a MB |
103 | :type 'string |
104 | :group 'sieve-manage) | |
23f87bed MB |
105 | |
106 | (defcustom sieve-manage-client-eol "\r\n" | |
107 | "The EOL string we send to the server." | |
d0859c9a MB |
108 | :type 'string |
109 | :group 'sieve-manage) | |
23f87bed | 110 | |
01c52d31 MB |
111 | (defcustom sieve-manage-authenticators '(digest-md5 |
112 | cram-md5 | |
113 | scram-md5 | |
114 | ntlm | |
115 | plain | |
116 | login) | |
d0859c9a | 117 | "Priority of authenticators to consider when authenticating to server." |
9c5a5c77 GM |
118 | ;; FIXME Improve this. It's not `set'. |
119 | ;; It's like (repeat (choice (const ...))), where each choice can | |
120 | ;; only appear once. | |
121 | :type '(repeat symbol) | |
d0859c9a | 122 | :group 'sieve-manage) |
23f87bed MB |
123 | |
124 | (defcustom sieve-manage-authenticator-alist | |
125 | '((cram-md5 sieve-manage-cram-md5-p sieve-manage-cram-md5-auth) | |
01c52d31 MB |
126 | (digest-md5 sieve-manage-digest-md5-p sieve-manage-digest-md5-auth) |
127 | (scram-md5 sieve-manage-scram-md5-p sieve-manage-scram-md5-auth) | |
128 | (ntlm sieve-manage-ntlm-p sieve-manage-ntlm-auth) | |
129 | (plain sieve-manage-plain-p sieve-manage-plain-auth) | |
130 | (login sieve-manage-login-p sieve-manage-login-auth)) | |
23f87bed MB |
131 | "Definition of authenticators. |
132 | ||
133 | \(NAME CHECK AUTHENTICATE) | |
134 | ||
135 | NAME names the authenticator. CHECK is a function returning non-nil if | |
136 | the server support the authenticator and AUTHENTICATE is a function | |
d0859c9a | 137 | for doing the actual authentication." |
9c5a5c77 GM |
138 | :type '(repeat (list (symbol :tag "Name") (function :tag "Check function") |
139 | (function :tag "Authentication function"))) | |
d0859c9a | 140 | :group 'sieve-manage) |
23f87bed | 141 | |
4afd650a | 142 | (defcustom sieve-manage-default-port "sieve" |
6b7df8d3 | 143 | "Default port number or service name for managesieve protocol." |
4afd650a JD |
144 | :type '(choice integer string) |
145 | :version "24.4" | |
d0859c9a | 146 | :group 'sieve-manage) |
23f87bed | 147 | |
562f5ce5 | 148 | (defcustom sieve-manage-default-stream 'network |
8e16fb98 | 149 | "Default stream type to use for `sieve-manage'." |
2bed3f04 | 150 | :version "24.1" |
562f5ce5 G |
151 | :type 'symbol |
152 | :group 'sieve-manage) | |
153 | ||
23f87bed MB |
154 | ;; Internal variables: |
155 | ||
156 | (defconst sieve-manage-local-variables '(sieve-manage-server | |
157 | sieve-manage-port | |
158 | sieve-manage-auth | |
159 | sieve-manage-stream | |
23f87bed MB |
160 | sieve-manage-process |
161 | sieve-manage-client-eol | |
162 | sieve-manage-server-eol | |
163 | sieve-manage-capability)) | |
23f87bed MB |
164 | (defconst sieve-manage-coding-system-for-read 'binary) |
165 | (defconst sieve-manage-coding-system-for-write 'binary) | |
166 | (defvar sieve-manage-stream nil) | |
167 | (defvar sieve-manage-auth nil) | |
168 | (defvar sieve-manage-server nil) | |
169 | (defvar sieve-manage-port nil) | |
23f87bed MB |
170 | (defvar sieve-manage-state 'closed |
171 | "Managesieve state. | |
172 | Valid states are `closed', `initial', `nonauth', and `auth'.") | |
173 | (defvar sieve-manage-process nil) | |
174 | (defvar sieve-manage-capability nil) | |
175 | ||
176 | ;; Internal utility functions | |
5ad64ce6 GM |
177 | (autoload 'mm-enable-multibyte "mm-util") |
178 | ||
8e16fb98 AK |
179 | (defun sieve-manage-make-process-buffer () |
180 | (with-current-buffer | |
181 | (generate-new-buffer (format " *sieve %s:%s*" | |
182 | sieve-manage-server | |
183 | sieve-manage-port)) | |
184 | (mapc 'make-local-variable sieve-manage-local-variables) | |
185 | (mm-enable-multibyte) | |
186 | (buffer-disable-undo) | |
187 | (current-buffer))) | |
23f87bed | 188 | |
23f87bed MB |
189 | (defun sieve-manage-erase (&optional p buffer) |
190 | (let ((buffer (or buffer (current-buffer)))) | |
191 | (and sieve-manage-log | |
192 | (with-current-buffer (get-buffer-create sieve-manage-log) | |
8e16fb98 | 193 | (mm-enable-multibyte) |
23f87bed MB |
194 | (buffer-disable-undo) |
195 | (goto-char (point-max)) | |
196 | (insert-buffer-substring buffer (with-current-buffer buffer | |
197 | (point-min)) | |
198 | (or p (with-current-buffer buffer | |
199 | (point-max))))))) | |
200 | (delete-region (point-min) (or p (point-max)))) | |
201 | ||
8e16fb98 AK |
202 | (defun sieve-manage-open-server (server port &optional stream buffer) |
203 | "Open network connection to SERVER on PORT. | |
204 | Return the buffer associated with the connection." | |
23f87bed MB |
205 | (with-current-buffer buffer |
206 | (sieve-manage-erase) | |
8e16fb98 AK |
207 | (setq sieve-manage-state 'initial) |
208 | (destructuring-bind (proc . props) | |
209 | (open-protocol-stream | |
210 | "SIEVE" buffer server port | |
211 | :type stream | |
212 | :capability-command "CAPABILITY\r\n" | |
213 | :end-of-command "^\\(OK\\|NO\\).*\n" | |
214 | :success "^OK.*\n" | |
215 | :return-list t | |
216 | :starttls-function | |
9df2f513 SM |
217 | (lambda (capabilities) |
218 | (when (string-match "\\bSTARTTLS\\b" capabilities) | |
219 | "STARTTLS\r\n"))) | |
8e16fb98 AK |
220 | (setq sieve-manage-process proc) |
221 | (setq sieve-manage-capability | |
9df2f513 | 222 | (sieve-manage-parse-capability (plist-get props :capabilities))) |
8e16fb98 AK |
223 | ;; Ignore new capabilities issues after successful STARTTLS |
224 | (when (and (memq stream '(nil network starttls)) | |
9df2f513 | 225 | (eq (plist-get props :type) 'tls)) |
8e16fb98 AK |
226 | (sieve-manage-drop-next-answer)) |
227 | (current-buffer)))) | |
23f87bed MB |
228 | |
229 | ;; Authenticators | |
01c52d31 MB |
230 | (defun sieve-sasl-auth (buffer mech) |
231 | "Login to server using the SASL MECH method." | |
232 | (message "sieve: Authenticating using %s..." mech) | |
1d8e1f78 | 233 | (with-current-buffer buffer |
b8e0f0cd G |
234 | (let* ((auth-info (auth-source-search :host sieve-manage-server |
235 | :port "sieve" | |
a5057546 G |
236 | :max 1 |
237 | :create t)) | |
238 | (user-name (or (plist-get (nth 0 auth-info) :user) "")) | |
239 | (user-password (or (plist-get (nth 0 auth-info) :secret) "")) | |
b8e0f0cd G |
240 | (user-password (if (functionp user-password) |
241 | (funcall user-password) | |
242 | user-password)) | |
1d8e1f78 | 243 | (client (sasl-make-client (sasl-find-mechanism (list mech)) |
b8e0f0cd | 244 | user-name "sieve" sieve-manage-server)) |
1d8e1f78 JD |
245 | (sasl-read-passphrase |
246 | ;; We *need* to copy the password, because sasl will modify it | |
247 | ;; somehow. | |
b8e0f0cd | 248 | `(lambda (prompt) ,(copy-sequence user-password))) |
1d8e1f78 JD |
249 | (step (sasl-next-step client nil)) |
250 | (tag (sieve-manage-send | |
251 | (concat | |
252 | "AUTHENTICATE \"" | |
253 | mech | |
254 | "\"" | |
255 | (and (sasl-step-data step) | |
256 | (concat | |
257 | " \"" | |
258 | (base64-encode-string | |
259 | (sasl-step-data step) | |
260 | 'no-line-break) | |
261 | "\""))))) | |
262 | data rsp) | |
263 | (catch 'done | |
264 | (while t | |
265 | (setq rsp nil) | |
266 | (goto-char (point-min)) | |
267 | (while (null (or (progn | |
268 | (setq rsp (sieve-manage-is-string)) | |
269 | (if (not (and rsp (looking-at | |
270 | sieve-manage-server-eol))) | |
271 | (setq rsp nil) | |
272 | (goto-char (match-end 0)) | |
273 | rsp)) | |
274 | (setq rsp (sieve-manage-is-okno)))) | |
275 | (accept-process-output sieve-manage-process 1) | |
276 | (goto-char (point-min))) | |
277 | (sieve-manage-erase) | |
278 | (when (sieve-manage-ok-p rsp) | |
279 | (when (and (cadr rsp) | |
280 | (string-match "^SASL \"\\([^\"]+\\)\"" (cadr rsp))) | |
281 | (sasl-step-set-data | |
282 | step (base64-decode-string (match-string 1 (cadr rsp))))) | |
283 | (if (and (setq step (sasl-next-step client step)) | |
284 | (setq data (sasl-step-data step))) | |
285 | ;; We got data for server but it's finished | |
286 | (error "Server not ready for SASL data: %s" data) | |
287 | ;; The authentication process is finished. | |
288 | (throw 'done t))) | |
289 | (unless (stringp rsp) | |
290 | (error "Server aborted SASL authentication: %s" (caddr rsp))) | |
291 | (sasl-step-set-data step (base64-decode-string rsp)) | |
292 | (setq step (sasl-next-step client step)) | |
293 | (sieve-manage-send | |
294 | (if (sasl-step-data step) | |
295 | (concat "\"" | |
296 | (base64-encode-string (sasl-step-data step) | |
297 | 'no-line-break) | |
298 | "\"") | |
299 | "")))) | |
300 | (message "sieve: Login using %s...done" mech)))) | |
01c52d31 MB |
301 | |
302 | (defun sieve-manage-cram-md5-p (buffer) | |
303 | (sieve-manage-capability "SASL" "CRAM-MD5" buffer)) | |
304 | ||
305 | (defun sieve-manage-cram-md5-auth (buffer) | |
306 | "Login to managesieve server using the CRAM-MD5 SASL method." | |
307 | (sieve-sasl-auth buffer "CRAM-MD5")) | |
308 | ||
309 | (defun sieve-manage-digest-md5-p (buffer) | |
310 | (sieve-manage-capability "SASL" "DIGEST-MD5" buffer)) | |
311 | ||
312 | (defun sieve-manage-digest-md5-auth (buffer) | |
313 | "Login to managesieve server using the DIGEST-MD5 SASL method." | |
314 | (sieve-sasl-auth buffer "DIGEST-MD5")) | |
315 | ||
316 | (defun sieve-manage-scram-md5-p (buffer) | |
317 | (sieve-manage-capability "SASL" "SCRAM-MD5" buffer)) | |
318 | ||
319 | (defun sieve-manage-scram-md5-auth (buffer) | |
320 | "Login to managesieve server using the SCRAM-MD5 SASL method." | |
321 | (sieve-sasl-auth buffer "SCRAM-MD5")) | |
322 | ||
323 | (defun sieve-manage-ntlm-p (buffer) | |
324 | (sieve-manage-capability "SASL" "NTLM" buffer)) | |
325 | ||
326 | (defun sieve-manage-ntlm-auth (buffer) | |
327 | "Login to managesieve server using the NTLM SASL method." | |
328 | (sieve-sasl-auth buffer "NTLM")) | |
329 | ||
23f87bed MB |
330 | (defun sieve-manage-plain-p (buffer) |
331 | (sieve-manage-capability "SASL" "PLAIN" buffer)) | |
332 | ||
333 | (defun sieve-manage-plain-auth (buffer) | |
334 | "Login to managesieve server using the PLAIN SASL method." | |
01c52d31 | 335 | (sieve-sasl-auth buffer "PLAIN")) |
23f87bed | 336 | |
01c52d31 MB |
337 | (defun sieve-manage-login-p (buffer) |
338 | (sieve-manage-capability "SASL" "LOGIN" buffer)) | |
23f87bed | 339 | |
01c52d31 MB |
340 | (defun sieve-manage-login-auth (buffer) |
341 | "Login to managesieve server using the LOGIN SASL method." | |
342 | (sieve-sasl-auth buffer "LOGIN")) | |
23f87bed MB |
343 | |
344 | ;; Managesieve API | |
345 | ||
346 | (defun sieve-manage-open (server &optional port stream auth buffer) | |
347 | "Open a network connection to a managesieve SERVER (string). | |
56fd9faa JB |
348 | Optional argument PORT is port number (integer) on remote server. |
349 | Optional argument STREAM is any of `sieve-manage-streams' (a symbol). | |
350 | Optional argument AUTH indicates authenticator to use, see | |
351 | `sieve-manage-authenticators' for available authenticators. | |
352 | If nil, chooses the best stream the server is capable of. | |
353 | Optional argument BUFFER is buffer (buffer, or string naming buffer) | |
23f87bed | 354 | to work in." |
8e16fb98 AK |
355 | (setq sieve-manage-port (or port sieve-manage-default-port)) |
356 | (with-current-buffer (or buffer (sieve-manage-make-process-buffer)) | |
357 | (setq sieve-manage-server (or server | |
358 | sieve-manage-server) | |
359 | sieve-manage-stream (or stream | |
360 | sieve-manage-stream | |
361 | sieve-manage-default-stream) | |
362 | sieve-manage-auth (or auth | |
363 | sieve-manage-auth)) | |
23f87bed | 364 | (message "sieve: Connecting to %s..." sieve-manage-server) |
8e16fb98 AK |
365 | (sieve-manage-open-server sieve-manage-server |
366 | sieve-manage-port | |
367 | sieve-manage-stream | |
368 | (current-buffer)) | |
369 | (when (sieve-manage-opened (current-buffer)) | |
370 | ;; Choose authenticator | |
371 | (when (and (null sieve-manage-auth) | |
372 | (not (eq sieve-manage-state 'auth))) | |
373 | (dolist (auth sieve-manage-authenticators) | |
374 | (when (funcall (nth 1 (assq auth sieve-manage-authenticator-alist)) | |
375 | buffer) | |
376 | (setq sieve-manage-auth auth) | |
377 | (return))) | |
378 | (unless sieve-manage-auth | |
379 | (error "Couldn't figure out authenticator for server"))) | |
23f87bed | 380 | (sieve-manage-erase) |
8e16fb98 | 381 | (current-buffer)))) |
23f87bed | 382 | |
fd9ba500 JD |
383 | (defun sieve-manage-authenticate (&optional buffer) |
384 | "Authenticate on server in BUFFER. | |
385 | Return `sieve-manage-state' value." | |
386 | (with-current-buffer (or buffer (current-buffer)) | |
387 | (if (eq sieve-manage-state 'nonauth) | |
388 | (when (funcall (nth 2 (assq sieve-manage-auth | |
389 | sieve-manage-authenticator-alist)) | |
390 | (current-buffer)) | |
391 | (setq sieve-manage-state 'auth)) | |
392 | sieve-manage-state))) | |
393 | ||
23f87bed MB |
394 | (defun sieve-manage-opened (&optional buffer) |
395 | "Return non-nil if connection to managesieve server in BUFFER is open. | |
396 | If BUFFER is nil then the current buffer is used." | |
397 | (and (setq buffer (get-buffer (or buffer (current-buffer)))) | |
398 | (buffer-live-p buffer) | |
399 | (with-current-buffer buffer | |
400 | (and sieve-manage-process | |
401 | (memq (process-status sieve-manage-process) '(open run)))))) | |
402 | ||
403 | (defun sieve-manage-close (&optional buffer) | |
404 | "Close connection to managesieve server in BUFFER. | |
405 | If BUFFER is nil, the current buffer is used." | |
406 | (with-current-buffer (or buffer (current-buffer)) | |
407 | (when (sieve-manage-opened) | |
408 | (sieve-manage-send "LOGOUT") | |
409 | (sit-for 1)) | |
410 | (when (and sieve-manage-process | |
411 | (memq (process-status sieve-manage-process) '(open run))) | |
412 | (delete-process sieve-manage-process)) | |
413 | (setq sieve-manage-process nil) | |
414 | (sieve-manage-erase) | |
415 | t)) | |
416 | ||
23f87bed | 417 | (defun sieve-manage-capability (&optional name value buffer) |
6f7e2ffd JD |
418 | "Check if capability NAME of server BUFFER match VALUE. |
419 | If it does, return the server value of NAME. If not returns nil. | |
420 | If VALUE is nil, do not check VALUE and return server value. | |
421 | If NAME is nil, return the full server list of capabilities." | |
23f87bed MB |
422 | (with-current-buffer (or buffer (current-buffer)) |
423 | (if (null name) | |
424 | sieve-manage-capability | |
6f7e2ffd JD |
425 | (let ((server-value (cadr (assoc name sieve-manage-capability)))) |
426 | (when (or (null value) | |
427 | (and server-value | |
428 | (string-match value server-value))) | |
429 | server-value))))) | |
23f87bed MB |
430 | |
431 | (defun sieve-manage-listscripts (&optional buffer) | |
432 | (with-current-buffer (or buffer (current-buffer)) | |
433 | (sieve-manage-send "LISTSCRIPTS") | |
434 | (sieve-manage-parse-listscripts))) | |
435 | ||
436 | (defun sieve-manage-havespace (name size &optional buffer) | |
437 | (with-current-buffer (or buffer (current-buffer)) | |
438 | (sieve-manage-send (format "HAVESPACE \"%s\" %s" name size)) | |
439 | (sieve-manage-parse-okno))) | |
440 | ||
23f87bed MB |
441 | (defun sieve-manage-putscript (name content &optional buffer) |
442 | (with-current-buffer (or buffer (current-buffer)) | |
443 | (sieve-manage-send (format "PUTSCRIPT \"%s\" {%d+}%s%s" name | |
2136a8a7 SM |
444 | ;; Here we assume that the coding-system will |
445 | ;; replace each char with a single byte. | |
446 | ;; This is always the case if `content' is | |
447 | ;; a unibyte string. | |
448 | (length content) | |
23f87bed MB |
449 | sieve-manage-client-eol content)) |
450 | (sieve-manage-parse-okno))) | |
451 | ||
452 | (defun sieve-manage-deletescript (name &optional buffer) | |
453 | (with-current-buffer (or buffer (current-buffer)) | |
454 | (sieve-manage-send (format "DELETESCRIPT \"%s\"" name)) | |
455 | (sieve-manage-parse-okno))) | |
456 | ||
457 | (defun sieve-manage-getscript (name output-buffer &optional buffer) | |
458 | (with-current-buffer (or buffer (current-buffer)) | |
459 | (sieve-manage-send (format "GETSCRIPT \"%s\"" name)) | |
460 | (let ((script (sieve-manage-parse-string))) | |
461 | (sieve-manage-parse-crlf) | |
462 | (with-current-buffer output-buffer | |
463 | (insert script)) | |
464 | (sieve-manage-parse-okno)))) | |
465 | ||
466 | (defun sieve-manage-setactive (name &optional buffer) | |
467 | (with-current-buffer (or buffer (current-buffer)) | |
468 | (sieve-manage-send (format "SETACTIVE \"%s\"" name)) | |
469 | (sieve-manage-parse-okno))) | |
470 | ||
471 | ;; Protocol parsing routines | |
472 | ||
8e16fb98 AK |
473 | (defun sieve-manage-wait-for-answer () |
474 | (let ((pattern "^\\(OK\\|NO\\).*\n") | |
475 | pos) | |
476 | (while (not pos) | |
477 | (setq pos (search-forward-regexp pattern nil t)) | |
478 | (goto-char (point-min)) | |
479 | (sleep-for 0 50)) | |
480 | pos)) | |
481 | ||
482 | (defun sieve-manage-drop-next-answer () | |
483 | (sieve-manage-wait-for-answer) | |
484 | (sieve-manage-erase)) | |
485 | ||
23f87bed MB |
486 | (defun sieve-manage-ok-p (rsp) |
487 | (string= (downcase (or (car-safe rsp) "")) "ok")) | |
488 | ||
23f87bed MB |
489 | (defun sieve-manage-is-okno () |
490 | (when (looking-at (concat | |
491 | "^\\(OK\\|NO\\)\\( (\\([^)]+\\))\\)?\\( \\(.*\\)\\)?" | |
492 | sieve-manage-server-eol)) | |
493 | (let ((status (match-string 1)) | |
494 | (resp-code (match-string 3)) | |
495 | (response (match-string 5))) | |
496 | (when response | |
497 | (goto-char (match-beginning 5)) | |
498 | (setq response (sieve-manage-is-string))) | |
499 | (list status resp-code response)))) | |
500 | ||
501 | (defun sieve-manage-parse-okno () | |
502 | (let (rsp) | |
503 | (while (null rsp) | |
504 | (accept-process-output (get-buffer-process (current-buffer)) 1) | |
505 | (goto-char (point-min)) | |
506 | (setq rsp (sieve-manage-is-okno))) | |
507 | (sieve-manage-erase) | |
508 | rsp)) | |
509 | ||
8e16fb98 AK |
510 | (defun sieve-manage-parse-capability (str) |
511 | "Parse managesieve capability string `STR'. | |
512 | Set variable `sieve-manage-capability' to " | |
9df2f513 SM |
513 | (let ((capas (delq nil |
514 | (mapcar #'split-string-and-unquote | |
515 | (split-string str "\n"))))) | |
8e16fb98 AK |
516 | (when (string= "OK" (caar (last capas))) |
517 | (setq sieve-manage-state 'nonauth)) | |
518 | capas)) | |
23f87bed MB |
519 | |
520 | (defun sieve-manage-is-string () | |
521 | (cond ((looking-at "\"\\([^\"]+\\)\"") | |
522 | (prog1 | |
523 | (match-string 1) | |
524 | (goto-char (match-end 0)))) | |
64763fe3 | 525 | ((looking-at (concat "{\\([0-9]+\\+?\\)}" sieve-manage-server-eol)) |
23f87bed MB |
526 | (let ((pos (match-end 0)) |
527 | (len (string-to-number (match-string 1)))) | |
528 | (if (< (point-max) (+ pos len)) | |
529 | nil | |
530 | (goto-char (+ pos len)) | |
531 | (buffer-substring pos (+ pos len))))))) | |
532 | ||
533 | (defun sieve-manage-parse-string () | |
534 | (let (rsp) | |
535 | (while (null rsp) | |
536 | (accept-process-output (get-buffer-process (current-buffer)) 1) | |
537 | (goto-char (point-min)) | |
538 | (setq rsp (sieve-manage-is-string))) | |
539 | (sieve-manage-erase (point)) | |
540 | rsp)) | |
541 | ||
542 | (defun sieve-manage-parse-crlf () | |
543 | (when (looking-at sieve-manage-server-eol) | |
544 | (sieve-manage-erase (match-end 0)))) | |
545 | ||
546 | (defun sieve-manage-parse-listscripts () | |
547 | (let (tmp rsp data) | |
548 | (while (null rsp) | |
549 | (while (null (or (setq rsp (sieve-manage-is-okno)) | |
550 | (setq tmp (sieve-manage-is-string)))) | |
551 | (accept-process-output (get-buffer-process (current-buffer)) 1) | |
552 | (goto-char (point-min))) | |
553 | (when tmp | |
554 | (while (not (looking-at (concat "\\( ACTIVE\\)?" | |
555 | sieve-manage-server-eol))) | |
556 | (accept-process-output (get-buffer-process (current-buffer)) 1) | |
557 | (goto-char (point-min))) | |
558 | (if (match-string 1) | |
559 | (push (cons 'active tmp) data) | |
560 | (push tmp data)) | |
561 | (goto-char (match-end 0)) | |
562 | (setq tmp nil))) | |
563 | (sieve-manage-erase) | |
564 | (if (sieve-manage-ok-p rsp) | |
565 | data | |
566 | rsp))) | |
567 | ||
568 | (defun sieve-manage-send (cmdstr) | |
569 | (setq cmdstr (concat cmdstr sieve-manage-client-eol)) | |
570 | (and sieve-manage-log | |
571 | (with-current-buffer (get-buffer-create sieve-manage-log) | |
8e16fb98 | 572 | (mm-enable-multibyte) |
23f87bed MB |
573 | (buffer-disable-undo) |
574 | (goto-char (point-max)) | |
575 | (insert cmdstr))) | |
576 | (process-send-string sieve-manage-process cmdstr)) | |
577 | ||
578 | (provide 'sieve-manage) | |
579 | ||
23f87bed | 580 | ;; sieve-manage.el ends here |