621 lines
22 KiB
EmacsLisp
621 lines
22 KiB
EmacsLisp
;;; sieve-manage.el --- Implementation of the managesieve protocol in elisp -*- lexical-binding:t -*-
|
|
|
|
;; Copyright (C) 2001-2024 Free Software Foundation, Inc.
|
|
|
|
;; Author: Simon Josefsson <simon@josefsson.org>
|
|
;; Albert Krewinkel <tarleb@moltkeplatz.de>
|
|
|
|
;; This file is part of GNU Emacs.
|
|
|
|
;; GNU Emacs is free software: you can redistribute it and/or modify
|
|
;; it under the terms of the GNU General Public License as published by
|
|
;; the Free Software Foundation, either version 3 of the License, or
|
|
;; (at your option) any later version.
|
|
|
|
;; GNU Emacs is distributed in the hope that it will be useful,
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;; GNU General Public License for more details.
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
|
|
|
;;; Commentary:
|
|
|
|
;; This library provides an elisp API for the managesieve network
|
|
;; protocol.
|
|
;;
|
|
;; It uses the SASL library for authentication, which means it
|
|
;; supports DIGEST-MD5, CRAM-MD5, SCRAM-MD5, NTLM, PLAIN and LOGIN
|
|
;; methods. STARTTLS is not well tested, but should be easy to get to
|
|
;; work if someone wants.
|
|
;;
|
|
;; The API should be fairly obvious for anyone familiar with the
|
|
;; managesieve protocol, interface functions include:
|
|
;;
|
|
;; `sieve-manage-open'
|
|
;; open connection to managesieve server, returning a buffer to be
|
|
;; used by all other API functions.
|
|
;;
|
|
;; `sieve-manage-opened'
|
|
;; check if a server is open or not
|
|
;;
|
|
;; `sieve-manage-close'
|
|
;; close a server connection.
|
|
;;
|
|
;; `sieve-manage-listscripts'
|
|
;; `sieve-manage-deletescript'
|
|
;; `sieve-manage-getscript'
|
|
;; performs managesieve protocol actions
|
|
;;
|
|
;; and that's it. Example of a managesieve session in *scratch*:
|
|
;;
|
|
;; (with-current-buffer (sieve-manage-open "mail.example.com")
|
|
;; (sieve-manage-authenticate)
|
|
;; (sieve-manage-listscripts))
|
|
;;
|
|
;; => ((active . "main") "vacation")
|
|
;;
|
|
;; References:
|
|
;;
|
|
;; draft-martin-managesieve-02.txt,
|
|
;; "A Protocol for Remotely Managing Sieve Scripts",
|
|
;; by Tim Martin.
|
|
;;
|
|
;; Release history:
|
|
;;
|
|
;; 2001-10-31 Committed to Oort Gnus.
|
|
;; 2002-07-27 Added DELETESCRIPT. Suggested by Ned Ludd.
|
|
;; 2002-08-03 Use SASL library.
|
|
;; 2013-06-05 Enabled STARTTLS support, fixed bit rot.
|
|
|
|
;;; Code:
|
|
|
|
(if (locate-library "password-cache")
|
|
(require 'password-cache)
|
|
(require 'password))
|
|
|
|
(eval-when-compile (require 'cl-lib))
|
|
(require 'sasl)
|
|
(autoload 'sasl-find-mechanism "sasl")
|
|
(autoload 'auth-source-search "auth-source")
|
|
(autoload 'auth-info-password "auth-source")
|
|
|
|
;; User customizable variables:
|
|
|
|
(defgroup sieve-manage nil
|
|
"Low-level Managesieve protocol issues."
|
|
:group 'mail
|
|
:prefix "sieve-")
|
|
|
|
(defcustom sieve-manage-log "*sieve-manage-log*"
|
|
"Name of buffer for managesieve session trace."
|
|
:type 'string)
|
|
|
|
(defcustom sieve-manage-server-eol "\r\n"
|
|
"The EOL string sent from the server."
|
|
:type 'string)
|
|
|
|
(defcustom sieve-manage-client-eol "\r\n"
|
|
"The EOL string we send to the server."
|
|
:type 'string)
|
|
|
|
(defcustom sieve-manage-authenticators '(digest-md5
|
|
cram-md5
|
|
scram-md5
|
|
ntlm
|
|
plain
|
|
login)
|
|
"Priority of authenticators to consider when authenticating to server."
|
|
;; FIXME Improve this. It's not `set'.
|
|
;; It's like (repeat (choice (const ...))), where each choice can
|
|
;; only appear once.
|
|
:type '(repeat symbol))
|
|
|
|
(defcustom sieve-manage-authenticator-alist
|
|
'((cram-md5 sieve-manage-cram-md5-p sieve-manage-cram-md5-auth)
|
|
(digest-md5 sieve-manage-digest-md5-p sieve-manage-digest-md5-auth)
|
|
(scram-md5 sieve-manage-scram-md5-p sieve-manage-scram-md5-auth)
|
|
(ntlm sieve-manage-ntlm-p sieve-manage-ntlm-auth)
|
|
(plain sieve-manage-plain-p sieve-manage-plain-auth)
|
|
(login sieve-manage-login-p sieve-manage-login-auth))
|
|
"Definition of authenticators.
|
|
|
|
\(NAME CHECK AUTHENTICATE)
|
|
|
|
NAME names the authenticator. CHECK is a function returning non-nil if
|
|
the server support the authenticator and AUTHENTICATE is a function
|
|
for doing the actual authentication."
|
|
:type '(repeat (list (symbol :tag "Name") (function :tag "Check function")
|
|
(function :tag "Authentication function"))))
|
|
|
|
(defcustom sieve-manage-default-port "sieve"
|
|
"Default port number or service name for managesieve protocol."
|
|
:type '(choice natnum string)
|
|
:version "24.4")
|
|
|
|
(defcustom sieve-manage-default-stream 'network
|
|
"Default stream type to use for `sieve-manage'."
|
|
:version "24.1"
|
|
:type 'symbol)
|
|
|
|
(defcustom sieve-manage-ignore-starttls nil
|
|
"Ignore STARTTLS even if STARTTLS capability is provided."
|
|
:version "26.1"
|
|
:type 'boolean)
|
|
|
|
;; Internal variables:
|
|
|
|
(defconst sieve-manage-local-variables '(sieve-manage-server
|
|
sieve-manage-port
|
|
sieve-manage-auth
|
|
sieve-manage-stream
|
|
sieve-manage-process
|
|
sieve-manage-client-eol
|
|
sieve-manage-server-eol
|
|
sieve-manage-capability))
|
|
(defconst sieve-manage-coding-system-for-read 'binary)
|
|
(defconst sieve-manage-coding-system-for-write 'binary)
|
|
(defvar sieve-manage-stream nil)
|
|
(defvar sieve-manage-auth nil)
|
|
(defvar sieve-manage-server nil)
|
|
(defvar sieve-manage-port nil)
|
|
(defvar sieve-manage-state 'closed
|
|
"Managesieve state.
|
|
Valid states are `closed', `initial', `nonauth', and `auth'.")
|
|
(defvar sieve-manage-process nil)
|
|
(defvar sieve-manage-capability nil)
|
|
|
|
;; Internal utility functions
|
|
(defun sieve-manage--append-to-log (&rest args)
|
|
"Append ARGS to sieve-manage log buffer.
|
|
|
|
ARGS can be a string or a list of strings.
|
|
The buffer to use for logging is specified via `sieve-manage-log'.
|
|
If it is nil, logging is disabled."
|
|
(when sieve-manage-log
|
|
(with-current-buffer (or (get-buffer sieve-manage-log)
|
|
(with-current-buffer
|
|
(get-buffer-create sieve-manage-log)
|
|
(set-buffer-multibyte nil)
|
|
(buffer-disable-undo)))
|
|
(goto-char (point-max))
|
|
(apply #'insert args))))
|
|
|
|
(defun sieve-manage--message (format-string &rest args)
|
|
"Wrapper around `message' which also logs to sieve manage log.
|
|
|
|
See `sieve-manage--append-to-log'."
|
|
(let ((ret (apply #'message
|
|
(concat "sieve-manage: " format-string)
|
|
args)))
|
|
(sieve-manage--append-to-log ret "\n")
|
|
ret))
|
|
|
|
(defun sieve-manage--error (format-string &rest args)
|
|
"Wrapper around `error' which also logs to sieve manage log.
|
|
|
|
See `sieve-manage--append-to-log'."
|
|
(let ((msg (apply #'format
|
|
(concat "sieve-manage/ERROR: " format-string)
|
|
args)))
|
|
(sieve-manage--append-to-log msg "\n")
|
|
(error msg)))
|
|
|
|
(defun sieve-manage-encode (utf8-string)
|
|
"Convert UTF8-STRING to managesieve protocol octets."
|
|
(encode-coding-string utf8-string 'raw-text t))
|
|
|
|
(defun sieve-manage-decode (octets &optional buffer)
|
|
"Convert managesieve protocol OCTETS to utf-8 string.
|
|
|
|
If optional BUFFER is non-nil, insert decoded string into BUFFER."
|
|
(when octets
|
|
;; eol type unix is required to preserve "\r\n"
|
|
(decode-coding-string octets 'utf-8-unix t buffer)))
|
|
|
|
(defun sieve-manage-make-process-buffer ()
|
|
(with-current-buffer
|
|
(generate-new-buffer (format " *sieve %s:%s*"
|
|
sieve-manage-server
|
|
sieve-manage-port))
|
|
(mapc #'make-local-variable sieve-manage-local-variables)
|
|
(set-buffer-multibyte nil)
|
|
(setq-local after-change-functions nil)
|
|
(buffer-disable-undo)
|
|
(current-buffer)))
|
|
|
|
(defun sieve-manage-erase (&optional p buffer)
|
|
(with-current-buffer (or buffer (current-buffer))
|
|
(let* ((start (point-min))
|
|
(end (or p (point-max)))
|
|
(logdata (buffer-substring-no-properties start end)))
|
|
(sieve-manage--append-to-log logdata)
|
|
(delete-region start end)
|
|
logdata)))
|
|
|
|
(defun sieve-manage-open-server (server port &optional stream buffer)
|
|
"Open network connection to SERVER on PORT.
|
|
Return the buffer associated with the connection."
|
|
(with-current-buffer buffer
|
|
(sieve-manage-erase)
|
|
(setq sieve-manage-state 'initial)
|
|
(pcase-let ((`(,proc . ,props)
|
|
(open-network-stream
|
|
"SIEVE" buffer server port
|
|
:type stream
|
|
;; eol type unix is required to preserve "\r\n"
|
|
:coding 'raw-text-unix
|
|
:capability-command "CAPABILITY\r\n"
|
|
:end-of-command "^\\(OK\\|NO\\).*\n"
|
|
:success "^OK.*\n"
|
|
:return-list t
|
|
:starttls-function
|
|
(lambda (capabilities)
|
|
(when (and (not sieve-manage-ignore-starttls)
|
|
(string-match "\\bSTARTTLS\\b" capabilities))
|
|
"STARTTLS\r\n")))))
|
|
(setq sieve-manage-process proc)
|
|
(setq sieve-manage-capability
|
|
(sieve-manage-parse-capability (plist-get props :capabilities)))
|
|
;; Ignore new capabilities issues after successful STARTTLS
|
|
(when (or sieve-manage-ignore-starttls
|
|
(and (memq stream '(nil network starttls))
|
|
(eq (plist-get props :type) 'tls)))
|
|
(sieve-manage-drop-next-answer))
|
|
(current-buffer))))
|
|
|
|
;; Authenticators
|
|
(defun sieve-sasl-auth (buffer mech)
|
|
"Login to server using the SASL MECH method."
|
|
(sieve-manage--message "Authenticating using %s..." mech)
|
|
(with-current-buffer buffer
|
|
(let* ((auth-info (auth-source-search :host sieve-manage-server
|
|
:port "sieve"
|
|
:max 1
|
|
:create t))
|
|
(user-name (or (plist-get (nth 0 auth-info) :user) ""))
|
|
(user-password (or (auth-info-password (nth 0 auth-info)) ""))
|
|
(client (sasl-make-client (sasl-find-mechanism (list mech))
|
|
user-name "sieve" sieve-manage-server))
|
|
(sasl-read-passphrase
|
|
;; We *need* to copy the password, because sasl will modify it
|
|
;; somehow.
|
|
(lambda (_prompt) (copy-sequence user-password)))
|
|
(step (sasl-next-step client nil))
|
|
(_tag (sieve-manage-send
|
|
(concat
|
|
"AUTHENTICATE \""
|
|
mech
|
|
"\""
|
|
(and (sasl-step-data step)
|
|
(concat
|
|
" \""
|
|
(base64-encode-string
|
|
(sasl-step-data step)
|
|
'no-line-break)
|
|
"\"")))))
|
|
data rsp)
|
|
(catch 'done
|
|
(while t
|
|
(setq rsp nil)
|
|
(goto-char (point-min))
|
|
(while (null (or (progn
|
|
(setq rsp (sieve-manage-is-string))
|
|
(if (not (and rsp (looking-at
|
|
sieve-manage-server-eol)))
|
|
(setq rsp nil)
|
|
(goto-char (match-end 0))
|
|
rsp))
|
|
(setq rsp (sieve-manage-is-okno))))
|
|
(accept-process-output sieve-manage-process 1)
|
|
(goto-char (point-min)))
|
|
(sieve-manage-erase)
|
|
(when (sieve-manage-ok-p rsp)
|
|
(when (and (cadr rsp)
|
|
(string-match "^SASL \"\\([^\"]+\\)\"" (cadr rsp)))
|
|
(sasl-step-set-data
|
|
step (base64-decode-string (match-string 1 (cadr rsp)))))
|
|
(if (and (setq step (sasl-next-step client step))
|
|
(setq data (sasl-step-data step)))
|
|
;; We got data for server but it's finished
|
|
(sieve-manage--error
|
|
"Server not ready for SASL data: %s" data)
|
|
;; The authentication process is finished.
|
|
(sieve-manage--message "Logged in as %s using %s"
|
|
user-name mech)
|
|
(throw 'done t)))
|
|
(unless (stringp rsp)
|
|
(sieve-manage--error
|
|
"Server aborted SASL authentication: %s" (caddr rsp)))
|
|
(sasl-step-set-data step (base64-decode-string rsp))
|
|
(setq step (sasl-next-step client step))
|
|
(sieve-manage-send
|
|
(if (sasl-step-data step)
|
|
(concat "\""
|
|
(base64-encode-string (sasl-step-data step)
|
|
'no-line-break)
|
|
"\"")
|
|
"")))))))
|
|
|
|
(defun sieve-manage-cram-md5-p (buffer)
|
|
(sieve-manage-capability "SASL" "CRAM-MD5" buffer))
|
|
|
|
(defun sieve-manage-cram-md5-auth (buffer)
|
|
"Login to managesieve server using the CRAM-MD5 SASL method."
|
|
(sieve-sasl-auth buffer "CRAM-MD5"))
|
|
|
|
(defun sieve-manage-digest-md5-p (buffer)
|
|
(sieve-manage-capability "SASL" "DIGEST-MD5" buffer))
|
|
|
|
(defun sieve-manage-digest-md5-auth (buffer)
|
|
"Login to managesieve server using the DIGEST-MD5 SASL method."
|
|
(sieve-sasl-auth buffer "DIGEST-MD5"))
|
|
|
|
(defun sieve-manage-scram-md5-p (buffer)
|
|
(sieve-manage-capability "SASL" "SCRAM-MD5" buffer))
|
|
|
|
(defun sieve-manage-scram-md5-auth (buffer)
|
|
"Login to managesieve server using the SCRAM-MD5 SASL method."
|
|
(sieve-sasl-auth buffer "SCRAM-MD5"))
|
|
|
|
(defun sieve-manage-ntlm-p (buffer)
|
|
(sieve-manage-capability "SASL" "NTLM" buffer))
|
|
|
|
(defun sieve-manage-ntlm-auth (buffer)
|
|
"Login to managesieve server using the NTLM SASL method."
|
|
(sieve-sasl-auth buffer "NTLM"))
|
|
|
|
(defun sieve-manage-plain-p (buffer)
|
|
(sieve-manage-capability "SASL" "PLAIN" buffer))
|
|
|
|
(defun sieve-manage-plain-auth (buffer)
|
|
"Login to managesieve server using the PLAIN SASL method."
|
|
(sieve-sasl-auth buffer "PLAIN"))
|
|
|
|
(defun sieve-manage-login-p (buffer)
|
|
(sieve-manage-capability "SASL" "LOGIN" buffer))
|
|
|
|
(defun sieve-manage-login-auth (buffer)
|
|
"Login to managesieve server using the LOGIN SASL method."
|
|
(sieve-sasl-auth buffer "LOGIN"))
|
|
|
|
;; Managesieve API
|
|
|
|
(defun sieve-manage-open (server &optional port stream auth buffer)
|
|
"Open a network connection to a managesieve SERVER (string).
|
|
Optional argument PORT is port number (integer) on remote server.
|
|
Optional argument STREAM is any of `sieve-manage-stream' (a symbol).
|
|
Optional argument AUTH indicates authenticator to use, see
|
|
`sieve-manage-authenticators' for available authenticators.
|
|
If nil, chooses the best stream the server is capable of.
|
|
Optional argument BUFFER is buffer (buffer, or string naming buffer)
|
|
to work in."
|
|
(setq sieve-manage-port (or port sieve-manage-default-port))
|
|
(with-current-buffer (or buffer (sieve-manage-make-process-buffer))
|
|
(setq sieve-manage-server (or server
|
|
sieve-manage-server)
|
|
sieve-manage-stream (or stream
|
|
sieve-manage-stream
|
|
sieve-manage-default-stream)
|
|
sieve-manage-auth (or auth
|
|
sieve-manage-auth))
|
|
(sieve-manage--message "Connecting to %s..." sieve-manage-server)
|
|
(sieve-manage-open-server sieve-manage-server
|
|
sieve-manage-port
|
|
sieve-manage-stream
|
|
(current-buffer))
|
|
(when (sieve-manage-opened (current-buffer))
|
|
;; Choose authenticator
|
|
(when (and (null sieve-manage-auth)
|
|
(not (eq sieve-manage-state 'auth)))
|
|
(cl-dolist (auth sieve-manage-authenticators)
|
|
(when (funcall (nth 1 (assq auth sieve-manage-authenticator-alist))
|
|
buffer)
|
|
(setq sieve-manage-auth auth)
|
|
(cl-return)))
|
|
(unless sieve-manage-auth
|
|
(sieve-manage--error
|
|
"Couldn't figure out authenticator for server")))
|
|
(sieve-manage-erase)
|
|
(current-buffer))))
|
|
|
|
(defun sieve-manage-authenticate (&optional buffer)
|
|
"Authenticate on server in BUFFER.
|
|
Return `sieve-manage-state' value."
|
|
(with-current-buffer (or buffer (current-buffer))
|
|
(if (eq sieve-manage-state 'nonauth)
|
|
(when (funcall (nth 2 (assq sieve-manage-auth
|
|
sieve-manage-authenticator-alist))
|
|
(current-buffer))
|
|
(setq sieve-manage-state 'auth))
|
|
sieve-manage-state)))
|
|
|
|
(defun sieve-manage-opened (&optional buffer)
|
|
"Return non-nil if connection to managesieve server in BUFFER is open.
|
|
If BUFFER is nil then the current buffer is used."
|
|
(and (setq buffer (get-buffer (or buffer (current-buffer))))
|
|
(buffer-live-p buffer)
|
|
(with-current-buffer buffer
|
|
(and sieve-manage-process
|
|
(memq (process-status sieve-manage-process) '(open run))))))
|
|
|
|
(defun sieve-manage-close (&optional buffer)
|
|
"Close connection to managesieve server in BUFFER.
|
|
If BUFFER is nil, the current buffer is used."
|
|
(with-current-buffer (or buffer (current-buffer))
|
|
(when (sieve-manage-opened)
|
|
(sieve-manage-send "LOGOUT")
|
|
(sit-for 1))
|
|
(when (and sieve-manage-process
|
|
(memq (process-status sieve-manage-process) '(open run)))
|
|
(delete-process sieve-manage-process))
|
|
(setq sieve-manage-process nil)
|
|
(sieve-manage-erase)
|
|
t))
|
|
|
|
(defun sieve-manage-capability (&optional name value buffer)
|
|
"Check if capability NAME of server BUFFER match VALUE.
|
|
If it does, return the server value of NAME. If not return nil.
|
|
If VALUE is nil, do not check VALUE and return server value.
|
|
If NAME is nil, return the full server list of capabilities."
|
|
(with-current-buffer (or buffer (current-buffer))
|
|
(if (null name)
|
|
sieve-manage-capability
|
|
(let ((server-value (cadr (assoc name sieve-manage-capability))))
|
|
(when (or (null value)
|
|
(and server-value
|
|
(string-match value server-value)))
|
|
server-value)))))
|
|
|
|
(defun sieve-manage-listscripts (&optional buffer)
|
|
(with-current-buffer (or buffer (current-buffer))
|
|
(sieve-manage-send "LISTSCRIPTS")
|
|
(sieve-manage-parse-listscripts)))
|
|
|
|
(defun sieve-manage-havespace (name size &optional buffer)
|
|
(with-current-buffer (or buffer (current-buffer))
|
|
(sieve-manage-send (format "HAVESPACE \"%s\" %s" name size))
|
|
(sieve-manage-parse-okno)))
|
|
|
|
(defun sieve-manage-putscript (name content &optional buffer)
|
|
(with-current-buffer (or buffer (current-buffer))
|
|
(sieve-manage-send (format "PUTSCRIPT \"%s\" {%d+}%s%s" name
|
|
(length (sieve-manage-encode content))
|
|
sieve-manage-client-eol content))
|
|
(sieve-manage-parse-okno)))
|
|
|
|
(defun sieve-manage-deletescript (name &optional buffer)
|
|
(with-current-buffer (or buffer (current-buffer))
|
|
(sieve-manage-send (format "DELETESCRIPT \"%s\"" name))
|
|
(sieve-manage-parse-okno)))
|
|
|
|
(defun sieve-manage-getscript (name output-buffer &optional buffer)
|
|
(with-current-buffer (or buffer (current-buffer))
|
|
(sieve-manage-send (format "GETSCRIPT \"%s\"" name))
|
|
(sieve-manage-decode (sieve-manage-parse-string)
|
|
output-buffer)
|
|
(sieve-manage-parse-crlf)
|
|
(sieve-manage-parse-okno)))
|
|
|
|
(defun sieve-manage-setactive (name &optional buffer)
|
|
(with-current-buffer (or buffer (current-buffer))
|
|
(sieve-manage-send (format "SETACTIVE \"%s\"" name))
|
|
(sieve-manage-parse-okno)))
|
|
|
|
;; Protocol parsing routines
|
|
|
|
(defun sieve-manage-wait-for-answer ()
|
|
(let ((pattern "^\\(OK\\|NO\\).*\n")
|
|
pos)
|
|
(while (not pos)
|
|
(setq pos (search-forward-regexp pattern nil t))
|
|
(goto-char (point-min))
|
|
(sleep-for 0.05))
|
|
pos))
|
|
|
|
(defun sieve-manage-drop-next-answer ()
|
|
(sieve-manage-wait-for-answer)
|
|
(sieve-manage-erase))
|
|
|
|
(defun sieve-manage-ok-p (rsp)
|
|
(string= (downcase (or (car-safe rsp) "")) "ok"))
|
|
|
|
(defun sieve-manage-no-p (rsp)
|
|
(string= (downcase (or (car-safe rsp) "")) "no"))
|
|
|
|
(defun sieve-manage-is-okno ()
|
|
(when (looking-at (concat
|
|
"^\\(OK\\|NO\\)\\( (\\([^)]+\\))\\)?\\( \\(.*\\)\\)?"
|
|
sieve-manage-server-eol))
|
|
(let ((status (match-string 1))
|
|
(resp-code (match-string 3))
|
|
(response (match-string 5)))
|
|
(when response
|
|
(goto-char (match-beginning 5))
|
|
(setq response (sieve-manage-is-string)))
|
|
(list status resp-code response))))
|
|
|
|
(defun sieve-manage-parse-okno ()
|
|
(let (rsp)
|
|
(while (null rsp)
|
|
(accept-process-output (get-buffer-process (current-buffer)) 1)
|
|
(goto-char (point-min))
|
|
(setq rsp (sieve-manage-is-okno)))
|
|
(sieve-manage-erase)
|
|
rsp))
|
|
|
|
(defun sieve-manage-parse-capability (str)
|
|
"Parse managesieve capability string `STR'.
|
|
Return alist of capabilities, suitable for assignment
|
|
to local variable `sieve-manage-capability'."
|
|
(let ((capas (delq nil
|
|
(mapcar #'split-string-and-unquote
|
|
(split-string str "\n")))))
|
|
(when (string= "OK" (caar (last capas)))
|
|
(setq sieve-manage-state 'nonauth))
|
|
capas))
|
|
|
|
(defun sieve-manage-is-string ()
|
|
(cond ((looking-at "\"\\([^\"]+\\)\"")
|
|
(prog1
|
|
(match-string 1)
|
|
(goto-char (match-end 0))))
|
|
((looking-at (concat "{\\([0-9]+\\+?\\)}" sieve-manage-server-eol))
|
|
(let ((pos (match-end 0))
|
|
(len (string-to-number (match-string 1))))
|
|
(if (< (point-max) (+ pos len))
|
|
nil
|
|
(goto-char (+ pos len))
|
|
(buffer-substring pos (+ pos len)))))))
|
|
|
|
(defun sieve-manage-parse-string ()
|
|
(let (rsp)
|
|
(while (null rsp)
|
|
(accept-process-output (get-buffer-process (current-buffer)) 1)
|
|
(goto-char (point-min))
|
|
(unless (setq rsp (sieve-manage-is-string))
|
|
(when (sieve-manage-no-p (sieve-manage-is-okno))
|
|
;; simple `error' is enough since `sieve-manage-erase'
|
|
;; already adds the server response to the log
|
|
(error (sieve-manage-erase)))))
|
|
(sieve-manage-erase (point))
|
|
rsp))
|
|
|
|
(defun sieve-manage-parse-crlf ()
|
|
(when (looking-at sieve-manage-server-eol)
|
|
(sieve-manage-erase (match-end 0))))
|
|
|
|
(defun sieve-manage-parse-listscripts ()
|
|
(let (tmp rsp data)
|
|
(while (null rsp)
|
|
(while (null (or (setq rsp (sieve-manage-is-okno))
|
|
(setq tmp (sieve-manage-decode
|
|
(sieve-manage-is-string)))))
|
|
(accept-process-output (get-buffer-process (current-buffer)) 1)
|
|
(goto-char (point-min)))
|
|
(when tmp
|
|
(while (not (looking-at (concat "\\( ACTIVE\\)?"
|
|
sieve-manage-server-eol)))
|
|
(accept-process-output (get-buffer-process (current-buffer)) 1)
|
|
(goto-char (point-min)))
|
|
(if (match-string 1)
|
|
(push (cons 'active tmp) data)
|
|
(push tmp data))
|
|
(goto-char (match-end 0))
|
|
(setq tmp nil)))
|
|
(sieve-manage-erase)
|
|
(if (sieve-manage-ok-p rsp)
|
|
data
|
|
rsp)))
|
|
|
|
(defun sieve-manage-send (cmdstr)
|
|
(setq cmdstr (sieve-manage-encode
|
|
(concat cmdstr sieve-manage-client-eol)))
|
|
(sieve-manage--append-to-log cmdstr)
|
|
(process-send-string sieve-manage-process cmdstr))
|
|
|
|
(provide 'sieve-manage)
|
|
|
|
;;; sieve-manage.el ends here
|