git.chise.org Git - elisp/gnus.git-/blob - lisp/sieve-manage.el

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