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