X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fsieve-manage.el;h=72f22e76b8f864906156569b6ce15ebea0a787ae;hp=63588b8347574ad1d82404c3d3df5d62867265e2;hb=829fe7e073a13eaf991e04e90b1e731b1ccce0c2;hpb=f6db07e52113cabea621d024b5863eac23df46ba diff --git a/lisp/sieve-manage.el b/lisp/sieve-manage.el index 63588b834..72f22e76b 100644 --- a/lisp/sieve-manage.el +++ b/lisp/sieve-manage.el @@ -1,24 +1,24 @@ -;;; sieve-manage.el --- Implementation of the managesive protocol in elisp -;; Copyright (C) 2001, 2003, 2004 Free Software Foundation, Inc. +;;; sieve-manage.el --- Implementation of the managesieve protocol in elisp + +;; Copyright (C) 2001-2015 Free Software Foundation, Inc. ;; Author: Simon Josefsson +;; Albert Krewinkel ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; 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 2, or (at your option) -;; any later version. +;; 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 +;; 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; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -43,7 +43,6 @@ ;; `sieve-manage-close' ;; close a server connection. ;; -;; `sieve-manage-authenticate' ;; `sieve-manage-listscripts' ;; `sieve-manage-deletescript' ;; `sieve-manage-getscript' @@ -51,14 +50,11 @@ ;; ;; and that's it. Example of a managesieve session in *scratch*: ;; -;; (setq my-buf (sieve-manage-open "my.server.com")) -;; " *sieve* my.server.com:2000*" -;; -;; (sieve-manage-authenticate "myusername" "mypassword" my-buf) -;; 'auth +;; (with-current-buffer (sieve-manage-open "mail.example.com") +;; (sieve-manage-authenticate) +;; (sieve-manage-listscripts)) ;; -;; (sieve-manage-listscripts my-buf) -;; ("vacation" "testscript" ("splitmail") "badscript") +;; => ((active . "main") "vacation") ;; ;; References: ;; @@ -71,16 +67,20 @@ ;; 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: -(require 'password) +(if (locate-library "password-cache") + (require 'password-cache) + (require 'password)) + (eval-when-compile + (require 'cl) ; caddr (require 'sasl) (require 'starttls)) -(eval-and-compile - (autoload 'sasl-find-mechanism "sasl") - (autoload 'starttls-open-stream "starttls")) +(autoload 'sasl-find-mechanism "sasl") +(autoload 'auth-source-search "auth-source") ;; User customizable variables: @@ -91,34 +91,18 @@ (defcustom sieve-manage-log "*sieve-manage-log*" "Name of buffer for managesieve session trace." - :type 'string) - -(defcustom sieve-manage-default-user (user-login-name) - "Default username to use." - :type 'string) + :type 'string + :group 'sieve-manage) (defcustom sieve-manage-server-eol "\r\n" "The EOL string sent from the server." - :type 'string) + :type 'string + :group 'sieve-manage) (defcustom sieve-manage-client-eol "\r\n" "The EOL string we send to the server." - :type 'string) - -(defcustom sieve-manage-streams '(network starttls shell) - "Priority of streams to consider when opening connection to server.") - -(defcustom sieve-manage-stream-alist - '((network sieve-manage-network-p sieve-manage-network-open) - (shell sieve-manage-shell-p sieve-manage-shell-open) - (starttls sieve-manage-starttls-p sieve-manage-starttls-open)) - "Definition of network streams. - -\(NAME CHECK OPEN) - -NAME names the stream, CHECK is a function returning non-nil if the -server support the stream and OPEN is a function for opening the -stream.") + :type 'string + :group 'sieve-manage) (defcustom sieve-manage-authenticators '(digest-md5 cram-md5 @@ -126,7 +110,12 @@ stream.") ntlm plain login) - "Priority of authenticators to consider when authenticating to server.") + "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) + :group 'sieve-manage) (defcustom sieve-manage-authenticator-alist '((cram-md5 sieve-manage-cram-md5-p sieve-manage-cram-md5-auth) @@ -141,11 +130,22 @@ stream.") 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.") - -(defcustom sieve-manage-default-port 2000 - "Default port number for managesieve protocol." - :type 'integer) +for doing the actual authentication." + :type '(repeat (list (symbol :tag "Name") (function :tag "Check function") + (function :tag "Authentication function"))) + :group 'sieve-manage) + +(defcustom sieve-manage-default-port "sieve" + "Default port number or service name for managesieve protocol." + :type '(choice integer string) + :version "24.4" + :group 'sieve-manage) + +(defcustom sieve-manage-default-stream 'network + "Default stream type to use for `sieve-manage'." + :version "24.1" + :type 'symbol + :group 'sieve-manage) ;; Internal variables: @@ -153,21 +153,16 @@ for doing the actual authentication.") sieve-manage-port sieve-manage-auth sieve-manage-stream - sieve-manage-username - sieve-manage-password sieve-manage-process sieve-manage-client-eol sieve-manage-server-eol sieve-manage-capability)) -(defconst sieve-manage-default-stream 'network) (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-username nil) -(defvar sieve-manage-password nil) (defvar sieve-manage-state 'closed "Managesieve state. Valid states are `closed', `initial', `nonauth', and `auth'.") @@ -175,68 +170,23 @@ Valid states are `closed', `initial', `nonauth', and `auth'.") (defvar sieve-manage-capability nil) ;; Internal utility functions - -(defsubst sieve-manage-disable-multibyte () - "Enable multibyte in the current buffer." - (when (fboundp 'set-buffer-multibyte) - (set-buffer-multibyte nil))) - -;; Uses the dynamically bound `reason' variable. -(defvar reason) -(defun sieve-manage-interactive-login (buffer loginfunc) - "Login to server in BUFFER. -LOGINFUNC is passed a username and a password, it should return t if -it where sucessful authenticating itself to the server, nil otherwise. -Returns t if login was successful, nil otherwise." - (with-current-buffer buffer - (make-variable-buffer-local 'sieve-manage-username) - (make-variable-buffer-local 'sieve-manage-password) - (let (user passwd ret reason passwd-key) - (condition-case () - (while (or (not user) (not passwd)) - (setq user (or sieve-manage-username - (read-from-minibuffer - (concat "Managesieve username for " - sieve-manage-server ": ") - (or user sieve-manage-default-user))) - passwd-key (concat "managesieve:" user "@" sieve-manage-server - ":" sieve-manage-port) - passwd (or sieve-manage-password - (password-read (concat "Managesieve password for " - user "@" sieve-manage-server - ": ") - passwd-key))) - (when (y-or-n-p "Store password for this session? ") - (password-cache-add passwd-key (copy-sequence passwd))) - (when (and user passwd) - (if (funcall loginfunc user passwd) - (setq ret t - sieve-manage-username user) - (if reason - (message "Login failed (reason given: %s)..." reason) - (message "Login failed...")) - (password-cache-remove passwd-key) - (setq sieve-manage-password nil) - (setq passwd nil) - (setq reason nil) - (sit-for 1)))) - (quit (with-current-buffer buffer - (password-cache-remove passwd-key) - (setq user nil - passwd nil - sieve-manage-password nil))) - (error (with-current-buffer buffer - (password-cache-remove passwd-key) - (setq user nil - passwd nil - sieve-manage-password nil)))) - ret))) +(autoload 'mm-enable-multibyte "mm-util") + +(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) + (mm-enable-multibyte) + (buffer-disable-undo) + (current-buffer))) (defun sieve-manage-erase (&optional p buffer) (let ((buffer (or buffer (current-buffer)))) (and sieve-manage-log (with-current-buffer (get-buffer-create sieve-manage-log) - (sieve-manage-disable-multibyte) + (mm-enable-multibyte) (buffer-disable-undo) (goto-char (point-max)) (insert-buffer-substring buffer (with-current-buffer buffer @@ -245,138 +195,105 @@ Returns t if login was successful, nil otherwise." (point-max))))))) (delete-region (point-min) (or p (point-max)))) -(defun sieve-manage-open-1 (buffer) +(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 - sieve-manage-process - (condition-case () - (funcall (nth 2 (assq sieve-manage-stream - sieve-manage-stream-alist)) - "sieve" buffer sieve-manage-server sieve-manage-port) - ((error quit) nil))) - (when sieve-manage-process - (while (and (eq sieve-manage-state 'initial) - (memq (process-status sieve-manage-process) '(open run))) - (message "Waiting for response from %s..." sieve-manage-server) - (accept-process-output sieve-manage-process 1)) - (message "Waiting for response from %s...done" sieve-manage-server) - (and (memq (process-status sieve-manage-process) '(open run)) - sieve-manage-process)))) - -;; Streams - -(defun sieve-manage-network-p (buffer) - t) - -(defun sieve-manage-network-open (name buffer server port) - (let* ((port (or port sieve-manage-default-port)) - (coding-system-for-read sieve-manage-coding-system-for-read) - (coding-system-for-write sieve-manage-coding-system-for-write) - (process (open-network-stream name buffer server port))) - (when process - (while (and (memq (process-status process) '(open run)) - (set-buffer buffer) ;; XXX "blue moon" nntp.el bug - (goto-char (point-min)) - (not (sieve-manage-parse-greeting-1))) - (accept-process-output process 1) - (sit-for 1)) - (sieve-manage-erase nil buffer) - (when (memq (process-status process) '(open run)) - process)))) - -(defun imap-starttls-p (buffer) - ;; (and (imap-capability 'STARTTLS buffer) - (condition-case () - (progn - (require 'starttls) - (call-process "starttls")) - (error nil))) - -(defun imap-starttls-open (name buffer server port) - (let* ((port (or port sieve-manage-default-port)) - (coding-system-for-read sieve-manage-coding-system-for-read) - (coding-system-for-write sieve-manage-coding-system-for-write) - (process (starttls-open-stream name buffer server port)) - done) - (when process - (while (and (memq (process-status process) '(open run)) - (set-buffer buffer) ;; XXX "blue moon" nntp.el bug - (goto-char (point-min)) - (not (sieve-manage-parse-greeting-1))) - (accept-process-output process 1) - (sit-for 1)) - (sieve-manage-erase nil buffer) - (sieve-manage-send "STARTTLS") - (starttls-negotiate process)) - (when (memq (process-status process) '(open run)) - process))) + (setq sieve-manage-state 'initial) + (destructuring-bind (proc . props) + (open-protocol-stream + "SIEVE" buffer server port + :type stream + :capability-command "CAPABILITY\r\n" + :end-of-command "^\\(OK\\|NO\\).*\n" + :success "^OK.*\n" + :return-list t + :starttls-function + (lambda (capabilities) + (when (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 (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." (message "sieve: Authenticating using %s..." mech) - (if (sieve-manage-interactive-login - buffer - (lambda (user passwd) - (let (client step tag data rsp) - (setq client (sasl-make-client (sasl-find-mechanism (list mech)) - user "sieve" sieve-manage-server)) - (setq sasl-read-passphrase (function (lambda (prompt) passwd))) - (setq step (sasl-next-step client nil)) - (setq tag - (sieve-manage-send - (concat - "AUTHENTICATE \"" - mech - "\"" - (and (sasl-step-data step) - (concat - " \"" - (base64-encode-string - (sasl-step-data step) - 'no-line-break) - "\""))))) - (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 (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 - (error "Server not ready for SASL data: %s" data) - ;; The authentication process is finished. - (throw 'done t))) - (unless (stringp rsp) - (apply 'error "Server aborted SASL authentication: %s %s %s" - 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) - "\"") - ""))))))) - (message "sieve: Authenticating using %s...done" mech) - (message "sieve: Authenticating using %s...failed" 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 (plist-get (nth 0 auth-info) :secret) "")) + (user-password (if (functionp user-password) + (funcall user-password) + user-password)) + (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 + (error "Server not ready for SASL data: %s" data) + ;; The authentication process is finished. + (throw 'done t))) + (unless (stringp rsp) + (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) + "\"") + "")))) + (message "sieve: Login using %s...done" mech)))) (defun sieve-manage-cram-md5-p (buffer) (sieve-manage-capability "SASL" "CRAM-MD5" buffer)) @@ -424,69 +341,51 @@ Returns t if login was successful, nil otherwise." (defun sieve-manage-open (server &optional port stream auth buffer) "Open a network connection to a managesieve SERVER (string). -Optional variable PORT is port number (integer) on remote server. -Optional variable STREAM is any of `sieve-manage-streams' (a symbol). -Optional variable AUTH indicates authenticator to use, see -`sieve-manage-authenticators' for available authenticators. If nil, chooses -the best stream the server is capable of. -Optional variable BUFFER is buffer (buffer, or string naming buffer) +Optional argument PORT is port number (integer) on remote server. +Optional argument STREAM is any of `sieve-manage-streams' (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 buffer (or buffer (format " *sieve* %s:%d" server (or port 2000)))) - (with-current-buffer (get-buffer-create buffer) - (mapc 'make-variable-buffer-local sieve-manage-local-variables) - (sieve-manage-disable-multibyte) - (buffer-disable-undo) - (setq sieve-manage-server (or server sieve-manage-server)) - (setq sieve-manage-port (or port sieve-manage-port)) - (setq sieve-manage-stream (or stream sieve-manage-stream)) + (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)) (message "sieve: Connecting to %s..." sieve-manage-server) - (if (let ((sieve-manage-stream - (or sieve-manage-stream sieve-manage-default-stream))) - (sieve-manage-open-1 buffer)) - ;; Choose stream. - (let (stream-changed) - (message "sieve: Connecting to %s...done" sieve-manage-server) - (when (null sieve-manage-stream) - (let ((streams sieve-manage-streams)) - (while (setq stream (pop streams)) - (if (funcall (nth 1 (assq stream - sieve-manage-stream-alist)) buffer) - (setq stream-changed - (not (eq (or sieve-manage-stream - sieve-manage-default-stream) - stream)) - sieve-manage-stream stream - streams nil))) - (unless sieve-manage-stream - (error "Couldn't figure out a stream for server")))) - (when stream-changed - (message "sieve: Reconnecting with stream `%s'..." - sieve-manage-stream) - (sieve-manage-close buffer) - (if (sieve-manage-open-1 buffer) - (message "sieve: Reconnecting with stream `%s'...done" - sieve-manage-stream) - (message "sieve: Reconnecting with stream `%s'...failed" - sieve-manage-stream)) - (setq sieve-manage-capability nil)) - (if (sieve-manage-opened buffer) - ;; Choose authenticator - (when (and (null sieve-manage-auth) - (not (eq sieve-manage-state 'auth))) - (let ((auths sieve-manage-authenticators)) - (while (setq auth (pop auths)) - (if (funcall (nth 1 (assq - auth - sieve-manage-authenticator-alist)) - buffer) - (setq sieve-manage-auth auth - auths nil))) - (unless sieve-manage-auth - (error "Couldn't figure out authenticator for server")))))) - (message "sieve: Connecting to %s...failed" sieve-manage-server)) - (when (sieve-manage-opened buffer) + (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))) + (dolist (auth sieve-manage-authenticators) + (when (funcall (nth 1 (assq auth sieve-manage-authenticator-alist)) + buffer) + (setq sieve-manage-auth auth) + (return))) + (unless sieve-manage-auth + (error "Couldn't figure out authenticator for server"))) (sieve-manage-erase) - buffer))) + (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. @@ -511,32 +410,19 @@ If BUFFER is nil, the current buffer is used." (sieve-manage-erase) t)) -(defun sieve-manage-authenticate (&optional user passwd buffer) - "Authenticate to server in BUFFER, using current buffer if nil. -It uses the authenticator specified when opening the server. If the -authenticator requires username/passwords, they are queried from the -user and optionally stored in the buffer. If USER and/or PASSWD is -specified, the user will not be questioned and the username and/or -password is remembered in the buffer." - (with-current-buffer (or buffer (current-buffer)) - (if (not (eq sieve-manage-state 'nonauth)) - (eq sieve-manage-state 'auth) - (make-variable-buffer-local 'sieve-manage-username) - (make-variable-buffer-local 'sieve-manage-password) - (if user (setq sieve-manage-username user)) - (if passwd (setq sieve-manage-password passwd)) - (if (funcall (nth 2 (assq sieve-manage-auth - sieve-manage-authenticator-alist)) buffer) - (setq sieve-manage-state 'auth))))) - (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 returns 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 - (if (null value) - (nth 1 (assoc name sieve-manage-capability)) - (when (string-match value (nth 1 (assoc name sieve-manage-capability))) - (nth 1 (assoc 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)) @@ -548,15 +434,14 @@ password is remembered in the buffer." (sieve-manage-send (format "HAVESPACE \"%s\" %s" name size)) (sieve-manage-parse-okno))) -(eval-and-compile - (if (fboundp 'string-bytes) - (defalias 'sieve-string-bytes 'string-bytes) - (defalias 'sieve-string-bytes 'length))) - (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 - (sieve-string-bytes content) + ;; Here we assume that the coding-system will + ;; replace each char with a single byte. + ;; This is always the case if `content' is + ;; a unibyte string. + (length content) sieve-manage-client-eol content)) (sieve-manage-parse-okno))) @@ -581,12 +466,22 @@ password is remembered in the buffer." ;; 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 50)) + 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")) -(defsubst sieve-manage-forward () - (or (eobp) (forward-char))) - (defun sieve-manage-is-okno () (when (looking-at (concat "^\\(OK\\|NO\\)\\( (\\([^)]+\\))\\)?\\( \\(.*\\)\\)?" @@ -608,28 +503,22 @@ password is remembered in the buffer." (sieve-manage-erase) rsp)) -(defun sieve-manage-parse-capability-1 () - "Accept a managesieve greeting." - (let (str) - (while (setq str (sieve-manage-is-string)) - (if (eq (char-after) ? ) - (progn - (sieve-manage-forward) - (push (list str (sieve-manage-is-string)) - sieve-manage-capability)) - (push (list str) sieve-manage-capability)) - (forward-line))) - (when (re-search-forward (concat "^OK" sieve-manage-server-eol) nil t) - (setq sieve-manage-state 'nonauth))) - -(defalias 'sieve-manage-parse-greeting-1 'sieve-manage-parse-capability-1) +(defun sieve-manage-parse-capability (str) + "Parse managesieve capability string `STR'. +Set variable `sieve-manage-capability' to " + (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)) + ((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)) @@ -676,7 +565,7 @@ password is remembered in the buffer." (setq cmdstr (concat cmdstr sieve-manage-client-eol)) (and sieve-manage-log (with-current-buffer (get-buffer-create sieve-manage-log) - (sieve-manage-disable-multibyte) + (mm-enable-multibyte) (buffer-disable-undo) (goto-char (point-max)) (insert cmdstr)))