lisp/gnus/sieve-manage.el

   1 ;;; sieve-manage.el --- Implementation of the managesive protocol in elisp
   2
   3 ;; Copyright (C) 2001, 2002, 2003, 2004, 2005,
   4 ;;   2006 Free Software Foundation, Inc.
   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
  22 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  23 ;; Boston, MA 02110-1301, USA.
  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."
  91   :type 'string
  92   :group 'sieve-manage)
  93
  94 (defcustom sieve-manage-default-user (user-login-name)
  95   "Default username to use."
  96   :type 'string
  97   :group 'sieve-manage)
  98
  99 (defcustom sieve-manage-server-eol "\r\n"
 100   "The EOL string sent from the server."
 101   :type 'string
 102   :group 'sieve-manage)
 103
 104 (defcustom sieve-manage-client-eol "\r\n"
 105   "The EOL string we send to the server."
 106   :type 'string
 107   :group 'sieve-manage)
 108
 109 (defcustom sieve-manage-streams '(network starttls shell)
 110   "Priority of streams to consider when opening connection to server."
 111   :group 'sieve-manage)
 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
 123 stream."
 124   :group 'sieve-manage)
 125
 126 (defcustom sieve-manage-authenticators '(cram-md5 plain)
 127   "Priority of authenticators to consider when authenticating to server."
 128   :group 'sieve-manage)
 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
 139 for doing the actual authentication."
 140   :group 'sieve-manage)
 141
 142 (defcustom sieve-manage-default-port 2000
 143   "Default port number for managesieve protocol."
 144   :type 'integer
 145   :group 'sieve-manage)
 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
 189     (make-local-variable 'sieve-manage-username)
 190     (make-local-variable 'sieve-manage-password)
 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)
 375     (mapcar 'make-local-variable sieve-manage-local-variables)
 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)
 463       (make-local-variable 'sieve-manage-username)
 464       (make-local-variable 'sieve-manage-password)
 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