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