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