cgit.sxemacs.org Git - gnus/blob - lisp/sieve-manage.el

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