From: Simon Josefsson Date: Thu, 1 Nov 2001 00:50:22 +0000 (+0000) Subject: 2001-11-01 Simon Josefsson X-Git-Url: https://cgit.sxemacs.org/?a=commitdiff_plain;h=74b3d8c1c16d0f18e5213d097f79232ebf4aeb1a;p=gnus 2001-11-01 Simon Josefsson * gnus-group.el (gnus-group-mode-map): Bind "D u" to `gnus-sieve-update' and "D g" to `gnus-sieve-generate'. (Functions has autoload cookies, so no `require' should be necessary.) * sieve.el, sieve-mode.el, sieve-manage.el, gnus-sieve.el: New files. --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 2d28e6a5e..e151f0c15 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,12 @@ +2001-11-01 Simon Josefsson + + * gnus-group.el (gnus-group-mode-map): Bind "D u" to + `gnus-sieve-update' and "D g" to `gnus-sieve-generate'. (Functions + has autoload cookies, so no `require' should be necessary.) + + * sieve.el, sieve-mode.el, sieve-manage.el, gnus-sieve.el: New + files. + 2001-10-31 Simon Josefsson * gnus-cus.el (gnus-group-parameters): Support integer `display' diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el index d1507b5fd..94d11841f 100644 --- a/lisp/gnus-group.el +++ b/lisp/gnus-group.el @@ -592,6 +592,10 @@ simple manner.") "r" gnus-group-mark-regexp "U" gnus-group-unmark-all-groups) + (gnus-define-keys (gnus-group-sieve-map "D" gnus-group-mode-map) + "u" gnus-sieve-update + "g" gnus-sieve-generate) + (gnus-define-keys (gnus-group-group-map "G" gnus-group-mode-map) "d" gnus-group-make-directory-group "h" gnus-group-make-help-group diff --git a/lisp/gnus-sieve.el b/lisp/gnus-sieve.el new file mode 100644 index 000000000..e3477de6e --- /dev/null +++ b/lisp/gnus-sieve.el @@ -0,0 +1,236 @@ +;;; gnus-sieve.el --- Utilities to manage sieve scripts for Gnus +;; Copyright (C) 2001 Free Software Foundation, Inc. + +;; Author: NAGY Andras , +;; Simon Josefsson + +;; This file is not part of GNU Emacs, but the same permissions apply. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; Gnus glue to generate complete Sieve scripts from Gnus Group +;; Parameters with "if" test predicates. + +;;; Code: + +(require 'gnus) +(require 'gnus-sum) +(require 'format-spec) +(autoload 'sieve-mode "sieve-mode") +(eval-when-compile + (require 'sieve)) + +;; Variables + +(defgroup gnus-sieve nil + "Manage sieve scripts in Gnus." + :group 'gnus) + +(defcustom gnus-sieve-file "~/.sieve" + "Path to your Sieve script." + :type 'file + :group 'gnus-sieve) + +(defcustom gnus-sieve-region-start "\n## Begin Gnus Sieve Script\n" + "Line indicating the start of the autogenerated region in +your Sieve script." + :type 'string + :group 'gnus-sieve) + +(defcustom gnus-sieve-region-end "\n## End Gnus Sieve Script\n" + "Line indicating the end of the autogenerated region in +your Sieve script." + :type 'string + :group 'gnus-sieve) + +(defcustom gnus-sieve-select-method nil + "Which select method we generate the Sieve script for. + +For example: \"nnimap:mailbox\"" + :group 'gnus-sieve) + +(defcustom gnus-sieve-crosspost nil + "Whether the generated Sieve script should do crossposting." + :type 'bool + :group 'gnus-sieve) + +(defcustom gnus-sieve-update-shell-command "echo put %f | sieveshell %s" + "Shell command to execute after updating your Sieve script. The following +formatting characters are recognized: + +%f Script's file name (gnus-sieve-file) +%s Server name (from gnus-sieve-select-method)" + :type 'string + :group 'gnus-sieve) + +;;;###autoload +(defun gnus-sieve-update () + "Update the Sieve script in gnus-sieve-file, by replacing the region +between gnus-sieve-region-start and gnus-sieve-region-end with +\(gnus-sieve-script gnus-sieve-select-method gnus-sieve-crosspost\), then +execute gnus-sieve-update-shell-command. +See the documentation for these variables and functions for details." + (interactive) + (gnus-sieve-generate) + (save-buffer) + (shell-command + (format-spec gnus-sieve-update-shell-command + (format-spec-make ?f gnus-sieve-file + ?s (or (cadr (gnus-server-get-method + nil gnus-sieve-select-method)) + ""))))) + +;;;###autoload +(defun gnus-sieve-generate () + "Generate the Sieve script in gnus-sieve-file, by replacing the region +between gnus-sieve-region-start and gnus-sieve-region-end with +\(gnus-sieve-script gnus-sieve-select-method gnus-sieve-crosspost\). +See the documentation for these variables and functions for details." + (interactive) + (require 'sieve) + (find-file gnus-sieve-file) + (goto-char (point-min)) + (if (re-search-forward + (concat (regexp-quote gnus-sieve-region-start) "\\(.\\|\n\\)*" + (regexp-quote gnus-sieve-region-end)) nil t) + (delete-region (match-beginning 0) (match-end 0)) + (insert sieve-template)) + (insert gnus-sieve-region-start + (gnus-sieve-script gnus-sieve-select-method gnus-sieve-crosspost) + gnus-sieve-region-end) + (sieve-mode)) + +(defun gnus-sieve-guess-rule-for-article () + "Guess a sieve rule based on RFC822 article in buffer. +Return NIL if no rule could be guessed." + (when (message-fetch-field "sender") + `(sieve address "sender" ,(regexp-quote (message-fetch-field "sender"))))) + +(defun gnus-sieve-article-add-rule () + (interactive) + (gnus-summary-select-article nil 'force) + (with-current-buffer gnus-original-article-buffer + (let ((rule (gnus-sieve-guess-rule-for-article)) + (info (gnus-get-info gnus-newsgroup-name))) + (if (null rule) + (error "Could not guess rule for article.") + (gnus-info-set-params info (cons rule (gnus-info-params info))) + (message "Added rule in group %s for article: %s" gnus-newsgroup-name + rule))))) + +;; Internals + +;; FIXME: do proper quoting of " etc +(defun gnus-sieve-string-list (list) + "Convert an elisp string list to a Sieve string list. + +For example: +\(gnus-sieve-string-list '(\"to\" \"cc\")) + => \"[\\\"to\\\", \\\"cc\\\"]\" +" + (concat "[\"" (mapconcat 'identity list "\", \"") "\"]")) + +(defun gnus-sieve-test-list (list) + "Convert an elisp test list to a Sieve test list. + +For example: +\(gnus-sieve-test-list '((address \"sender\" \"boss@company.com\") (size :over 4K))) + => \"(address \\\"sender\\\" \\\"boss@company.com\\\", size :over 4K)\"" + (concat "(" (mapconcat 'gnus-sieve-test list ", ") ")")) + +;; FIXME: do proper quoting +(defun gnus-sieve-test-token (token) + "Convert an elisp test token to a Sieve test token. + +For example: +\(gnus-sieve-test-token 'address) + => \"address\" + +\(gnus-sieve-test-token \"sender\") + => \"\\\"sender\\\"\" + +\(gnus-sieve-test-token '(\"to\" \"cc\")) + => \"[\\\"to\\\", \\\"cc\\\"]\"" + (cond + ((symbolp token) ;; Keyword + (symbol-name token)) + + ((stringp token) ;; String + (concat "\"" token "\"")) + + ((and (listp token) ;; String list + (stringp (car token))) + (gnus-sieve-string-list token)) + + ((and (listp token) ;; Test list + (listp (car token))) + (gnus-sieve-test-list token)))) + +(defun gnus-sieve-test (test) + "Convert an elisp test to a Sieve test. + +For example: +\(gnus-sieve-test '(address \"sender\" \"sieve-admin@extundo.com\")) + => \"address \\\"sender\\\" \\\"sieve-admin@extundo.com\\\"\" + +\(gnus-sieve-test '(anyof ((header :contains (\"to\" \"cc\") \"my@address.com\") + (size :over 100K)))) + => \"anyof (header :contains [\\\"to\\\", \\\"cc\\\"] \\\"my@address.com\\\", + size :over 100K)\"" + (mapconcat 'gnus-sieve-test-token test " ")) + +(defun gnus-sieve-script (&optional method crosspost) + "Generate a Sieve script based on groups with select method METHOD +\(or all groups if nil\). Only groups having a `sieve' parameter are +considered. This parameter should contain an elisp test +\(see the documentation of gnus-sieve-test for details\). For each +such group, a Sieve IF control structure is generated, having the +test as the condition and { fileinto \"group.name\"; } as the body. + +If CROSSPOST is non-nil, concatenate these conditionals +sequencially, otherwsie with `elsif', causing a match on one group the +other tests to be skipped. + +For example: If the INBOX.list.sieve group has the + + (sieve address \"sender\" \"sieve-admin@extundo.com\") + +group parameter, (gnus-sieve-script) results in: + + if address \"sender\" \"sieve-admin@extundo.com\" { + fileinto \"INBOX.list.sieve\"; + } + +This is returned as a string." + (let* ((newsrc (cdr gnus-newsrc-alist)) + script) + (dolist (info newsrc) + (when (or (not method) + (gnus-server-equal method (gnus-info-method info))) + (let* ((group (gnus-info-group info)) + (spec (gnus-group-find-parameter group 'sieve t))) + (when spec + (push (concat "if " (gnus-sieve-test spec) " {\n\t" + "fileinto \"" (gnus-group-real-name group) + "\";\n}") + script))))) + (mapconcat 'identity script (if crosspost "\n" "\nels")))) + +(provide 'gnus-sieve) + +;;; gnus-sieve.el ends here diff --git a/lisp/sieve-manage.el b/lisp/sieve-manage.el new file mode 100644 index 000000000..25ae53947 --- /dev/null +++ b/lisp/sieve-manage.el @@ -0,0 +1,619 @@ +;;; sieve-manage.el --- Implementation of the managesive protocol in elisp +;; Copyright (C) 2001 Free Software Foundation, Inc. + +;; Author: Simon Josefsson + +;; This file is not part of GNU Emacs, but the same permissions apply. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; This library provides an elisp API for the managesieve network +;; protocol. +;; +;; Currently only the CRAM-MD5 authentication mechanism is supported. +;; +;; The API should be fairly obvious for anyone familiar with the +;; managesieve protocol, interface functions include: +;; +;; `sieve-manage-open' +;; open connection to managesieve server, returning a buffer to be +;; used by all other API functions. +;; +;; `sieve-manage-opened' +;; check if a server is open or not +;; +;; `sieve-manage-close' +;; close a server connection. +;; +;; `sieve-manage-authenticate' +;; `sieve-manage-listscripts' +;; performs managesieve protocol actions +;; +;; and that's it. Example of a managesieve session in *scratch*: +;; +;; (setq my-buf (sieve-manage-open "my.server.com")) +;; " *sieve* my.server.com:2000*" +;; +;; (sieve-manage-authenticate "myusername" "mypassword" my-buf) +;; 'auth +;; +;; (sieve-manage-listscripts my-buf) +;; ("vacation" "testscript" ("splitmail") "badscript") +;; +;; References: +;; +;; draft-martin-managesieve-02.txt, +;; "A Protocol for Remotely Managing Sieve Scripts", +;; by Tim Martin. +;; +;; Release history: +;; +;; 2001-10-31 Committed to Oort Gnus. +;; +;; $Id: sieve-manage.el,v 1.9 2001/06/30 19:00:00 jas Exp $ + +;;; Code: + +(require 'rfc2104) +(or (fboundp 'md5) + (require 'md5)) +(eval-and-compile + (autoload 'starttls-open-stream "starttls")) + +;; User customizable variables: + +(defgroup sieve-manage nil + "Low-level Managesieve protocol issues." + :group 'mail + :prefix "sieve-") + +(defcustom sieve-manage-log "*sieve-manage-log*" + "Name of buffer for managesieve session trace." + :type 'string) + +(defcustom sieve-manage-default-user (user-login-name) + "Default username to use." + :type 'string) + +(defcustom sieve-manage-server-eol "\r\n" + "The EOL string sent from the server." + :type 'string) + +(defcustom sieve-manage-client-eol "\r\n" + "The EOL string we send to the server." + :type 'string) + +(defcustom sieve-manage-streams '(network starttls shell) + "Priority of streams to consider when opening connection to server.") + +(defcustom sieve-manage-stream-alist + '((network sieve-manage-network-p sieve-manage-network-open) + (shell sieve-manage-shell-p sieve-manage-shell-open) + (starttls sieve-manage-starttls-p sieve-manage-starttls-open)) + "Definition of network streams. + +(NAME CHECK OPEN) + +NAME names the stream, CHECK is a function returning non-nil if the +server support the stream and OPEN is a function for opening the +stream.") + +(defcustom sieve-manage-authenticators '(cram-md5 plain) + "Priority of authenticators to consider when authenticating to server.") + +(defcustom sieve-manage-authenticator-alist + '((cram-md5 sieve-manage-cram-md5-p sieve-manage-cram-md5-auth) + (plain sieve-manage-plain-p sieve-manage-plain-auth)) + "Definition of authenticators. + +(NAME CHECK AUTHENTICATE) + +NAME names the authenticator. CHECK is a function returning non-nil if +the server support the authenticator and AUTHENTICATE is a function +for doing the actuall authentification.") + +(defcustom sieve-manage-default-port 2000 + "Default port number for managesieve protocol." + :type 'integer) + +;; Internal variables: + +(defconst sieve-manage-local-variables '(sieve-manage-server + sieve-manage-port + sieve-manage-auth + sieve-manage-stream + sieve-manage-username + sieve-manage-password + sieve-manage-process + sieve-manage-client-eol + sieve-manage-server-eol + sieve-manage-capability)) +(defconst sieve-manage-default-stream 'network) +(defconst sieve-manage-coding-system-for-read 'binary) +(defconst sieve-manage-coding-system-for-write 'binary) +(defvar sieve-manage-stream nil) +(defvar sieve-manage-auth nil) +(defvar sieve-manage-server nil) +(defvar sieve-manage-port nil) +(defvar sieve-manage-username nil) +(defvar sieve-manage-password nil) +(defvar sieve-manage-state 'closed + "Managesieve state. +Valid states are `closed', `initial', `nonauth', and `auth'.") +(defvar sieve-manage-process nil) +(defvar sieve-manage-capability nil) + +;; Internal utility functions + +(defsubst sieve-manage-disable-multibyte () + "Enable multibyte in the current buffer." + (when (fboundp 'set-buffer-multibyte) + (set-buffer-multibyte nil))) + +(defun sieve-manage-read-passwd (prompt &rest args) + "Read a password using PROMPT. +If ARGS, PROMPT is used as an argument to `format'." + (let ((prompt (if args + (apply 'format prompt args) + prompt))) + (funcall (if (or (fboundp 'read-passwd) + (and (load "subr" t) + (fboundp 'read-passwd)) + (and (load "passwd" t) + (fboundp 'read-passwd))) + 'read-passwd + (autoload 'ange-ftp-read-passwd "ange-ftp") + 'ange-ftp-read-passwd) + prompt))) + + +;; Uses the dynamically bound `reason' variable. +(defvar reason) +(defun sieve-manage-interactive-login (buffer loginfunc) + "Login to server in BUFFER. +LOGINFUNC is passed a username and a password, it should return t if +it where sucessful authenticating itself to the server, nil otherwise. +Returns t if login was successful, nil otherwise." + (with-current-buffer buffer + (make-variable-buffer-local 'sieve-manage-username) + (make-variable-buffer-local 'sieve-manage-password) + (let (user passwd ret reason) + ;; (condition-case () + (while (or (not user) (not passwd)) + (setq user (or sieve-manage-username + (read-from-minibuffer + (concat "Managesieve username for " + sieve-manage-server ": ") + (or user sieve-manage-default-user)))) + (setq passwd (or sieve-manage-password + (sieve-manage-read-passwd + (concat "Managesieve password for " user "@" + sieve-manage-server ": ")))) + (when (and user passwd) + (if (funcall loginfunc user passwd) + (progn + (setq ret t + sieve-manage-username user) + (if (and (not sieve-manage-password) + (y-or-n-p "Store password for this session? ")) + (setq sieve-manage-password passwd))) + (if reason + (message "Login failed (reason given: %s)..." reason) + (message "Login failed...")) + (setq reason nil) + (setq passwd nil) + (sit-for 1)))) + ;; (quit (with-current-buffer buffer + ;; (setq user nil + ;; passwd nil))) + ;; (error (with-current-buffer buffer + ;; (setq user nil + ;; passwd nil)))) + ret))) + +(defun sieve-manage-erase (&optional p buffer) + (let ((buffer (or buffer (current-buffer)))) + (and sieve-manage-log + (with-current-buffer (get-buffer-create sieve-manage-log) + (sieve-manage-disable-multibyte) + (buffer-disable-undo) + (goto-char (point-max)) + (insert-buffer-substring buffer (with-current-buffer buffer + (point-min)) + (or p (with-current-buffer buffer + (point-max))))))) + (delete-region (point-min) (or p (point-max)))) + +(defun sieve-manage-open-1 (buffer) + (with-current-buffer buffer + (sieve-manage-erase) + (setq sieve-manage-state 'initial + sieve-manage-process + (condition-case () + (funcall (nth 2 (assq sieve-manage-stream + sieve-manage-stream-alist)) + "sieve" buffer sieve-manage-server sieve-manage-port) + ((error quit) nil))) + (when sieve-manage-process + (while (and (eq sieve-manage-state 'initial) + (memq (process-status sieve-manage-process) '(open run))) + (message "Waiting for response from %s..." sieve-manage-server) + (accept-process-output sieve-manage-process 1)) + (message "Waiting for response from %s...done" sieve-manage-server) + (and (memq (process-status sieve-manage-process) '(open run)) + sieve-manage-process)))) + +;; Streams + +(defun sieve-manage-network-p (buffer) + t) + +(defun sieve-manage-network-open (name buffer server port) + (let* ((port (or port sieve-manage-default-port)) + (coding-system-for-read sieve-manage-coding-system-for-read) + (coding-system-for-write sieve-manage-coding-system-for-write) + (process (open-network-stream name buffer server port))) + (when process + (while (and (memq (process-status process) '(open run)) + (set-buffer buffer) ;; XXX "blue moon" nntp.el bug + (goto-char (point-min)) + (not (sieve-manage-parse-greeting-1))) + (accept-process-output process 1) + (sit-for 1)) + (sieve-manage-erase nil buffer) + (when (memq (process-status process) '(open run)) + process)))) + +(defun imap-starttls-p (buffer) + ;; (and (imap-capability 'STARTTLS buffer) + (condition-case () + (progn + (require 'starttls) + (call-process "starttls")) + (error nil))) + +(defun imap-starttls-open (name buffer server port) + (let* ((port (or port sieve-manage-default-port)) + (coding-system-for-read sieve-manage-coding-system-for-read) + (coding-system-for-write sieve-manage-coding-system-for-write) + (process (starttls-open-stream name buffer server port)) + done) + (when process + (while (and (memq (process-status process) '(open run)) + (set-buffer buffer) ;; XXX "blue moon" nntp.el bug + (goto-char (point-min)) + (not (sieve-manage-parse-greeting-1))) + (accept-process-output process 1) + (sit-for 1)) + (sieve-manage-erase nil buffer) + (sieve-manage-send "STARTTLS") + (starttls-negotiate process)) + (when (memq (process-status process) '(open run)) + process))) + +;; Authenticators + +(defun sieve-manage-plain-p (buffer) + (sieve-manage-capability "SASL" "PLAIN" buffer)) + +(defun sieve-manage-plain-auth (buffer) + "Login to managesieve server using the PLAIN SASL method." + (let* ((done (sieve-manage-interactive-login + buffer + (lambda (user passwd) + (sieve-manage-send (concat "AUTHENTICATE \"PLAIN\" \"" + (base64-encode-string + (concat (char-to-string 0) + user + (char-to-string 0) + passwd)) + "\"")) + (let ((rsp (sieve-manage-parse-okno))) + (if (sieve-manage-ok-p rsp) + t + (setq reason (cdr-safe rsp)) + nil)))))) + (if done + (message "sieve: Authenticating using PLAIN...done") + (message "sieve: Authenticating using PLAIN...failed")))) + +(defun sieve-manage-cram-md5-p (buffer) + (sieve-manage-capability "SASL" "CRAM-MD5" buffer)) + +(defun sieve-manage-cram-md5-auth (buffer) + "Login to managesieve server using the CRAM-MD5 SASL method." + (message "sieve: Authenticating using CRAM-MD5...") + (let* ((done (sieve-manage-interactive-login + buffer + (lambda (user passwd) + (sieve-manage-send "AUTHENTICATE \"CRAM-MD5\" \"\"") + (sieve-manage-send + (concat + "\"" + (base64-encode-string + (concat + user " " + (rfc2104-hash 'md5 64 16 passwd + (base64-decode-string + (prog1 + (sieve-manage-parse-string) + (sieve-manage-erase)))))) + "\"")) + (let ((rsp (sieve-manage-parse-okno))) + (if (sieve-manage-ok-p rsp) + t + (setq reason (cdr-safe rsp)) + nil)))))) + (if done + (message "sieve: Authenticating using CRAM-MD5...done") + (message "sieve: Authenticating using CRAM-MD5...failed")))) + +;; Managesieve API + +(defun sieve-manage-open (server &optional port stream auth buffer) + "Open a network connection to a managesieve SERVER (string). +Optional variable PORT is port number (integer) on remote server. +Optional variable STREAM is any of `sieve-manage-streams' (a symbol). +Optional variable AUTH indicates authenticator to use, see +`sieve-manage-authenticators' for available authenticators. If nil, chooses +the best stream the server is capable of. +Optional variable BUFFER is buffer (buffer, or string naming buffer) +to work in." + (setq buffer (or buffer (format " *sieve* %s:%d" server (or port 2000)))) + (with-current-buffer (get-buffer-create buffer) + (mapcar 'make-variable-buffer-local sieve-manage-local-variables) + (sieve-manage-disable-multibyte) + (buffer-disable-undo) + (setq sieve-manage-server (or server sieve-manage-server)) + (setq sieve-manage-port (or port sieve-manage-port)) + (setq sieve-manage-stream (or stream sieve-manage-stream)) + (message "sieve: Connecting to %s..." sieve-manage-server) + (if (let ((sieve-manage-stream + (or sieve-manage-stream sieve-manage-default-stream))) + (sieve-manage-open-1 buffer)) + ;; Choose stream. + (let (stream-changed) + (message "sieve: Connecting to %s...done" sieve-manage-server) + (when (null sieve-manage-stream) + (let ((streams sieve-manage-streams)) + (while (setq stream (pop streams)) + (if (funcall (nth 1 (assq stream + sieve-manage-stream-alist)) buffer) + (setq stream-changed + (not (eq (or sieve-manage-stream + sieve-manage-default-stream) + stream)) + sieve-manage-stream stream + streams nil))) + (unless sieve-manage-stream + (error "Couldn't figure out a stream for server")))) + (when stream-changed + (message "sieve: Reconnecting with stream `%s'..." + sieve-manage-stream) + (sieve-manage-close buffer) + (if (sieve-manage-open-1 buffer) + (message "sieve: Reconnecting with stream `%s'...done" + sieve-manage-stream) + (message "sieve: Reconnecting with stream `%s'...failed" + sieve-manage-stream)) + (setq sieve-manage-capability nil)) + (if (sieve-manage-opened buffer) + ;; Choose authenticator + (when (and (null sieve-manage-auth) + (not (eq sieve-manage-state 'auth))) + (let ((auths sieve-manage-authenticators)) + (while (setq auth (pop auths)) + (if (funcall (nth 1 (assq + auth + sieve-manage-authenticator-alist)) + buffer) + (setq sieve-manage-auth auth + auths nil))) + (unless sieve-manage-auth + (error "Couldn't figure out authenticator for server")))))) + (message "sieve: Connecting to %s...failed" sieve-manage-server)) + (when (sieve-manage-opened buffer) + (sieve-manage-erase) + buffer))) + +(defun sieve-manage-opened (&optional buffer) + "Return non-nil if connection to managesieve server in BUFFER is open. +If BUFFER is nil then the current buffer is used." + (and (setq buffer (get-buffer (or buffer (current-buffer)))) + (buffer-live-p buffer) + (with-current-buffer buffer + (and sieve-manage-process + (memq (process-status sieve-manage-process) '(open run)))))) + +(defun sieve-manage-close (&optional buffer) + "Close connection to managesieve server in BUFFER. +If BUFFER is nil, the current buffer is used." + (with-current-buffer (or buffer (current-buffer)) + (when (sieve-manage-opened) + (sieve-manage-send "LOGOUT") + (sit-for 1)) + (when (and sieve-manage-process + (memq (process-status sieve-manage-process) '(open run))) + (delete-process sieve-manage-process)) + (setq sieve-manage-process nil) + (sieve-manage-erase) + t)) + +(defun sieve-manage-authenticate (&optional user passwd buffer) + "Authenticate to server in BUFFER, using current buffer if nil. +It uses the authenticator specified when opening the server. If the +authenticator requires username/passwords, they are queried from the +user and optionally stored in the buffer. If USER and/or PASSWD is +specified, the user will not be questioned and the username and/or +password is remembered in the buffer." + (with-current-buffer (or buffer (current-buffer)) + (if (not (eq sieve-manage-state 'nonauth)) + (eq sieve-manage-state 'auth) + (make-variable-buffer-local 'sieve-manage-username) + (make-variable-buffer-local 'sieve-manage-password) + (if user (setq sieve-manage-username user)) + (if passwd (setq sieve-manage-password passwd)) + (if (funcall (nth 2 (assq sieve-manage-auth + sieve-manage-authenticator-alist)) buffer) + (setq sieve-manage-state 'auth))))) + +(defun sieve-manage-capability (&optional name value buffer) + (with-current-buffer (or buffer (current-buffer)) + (if (null name) + sieve-manage-capability + (if (null value) + (nth 1 (assoc name sieve-manage-capability)) + (when (string-match value (nth 1 (assoc name sieve-manage-capability))) + (nth 1 (assoc name sieve-manage-capability))))))) + +(defun sieve-manage-listscripts (&optional buffer) + (with-current-buffer (or buffer (current-buffer)) + (sieve-manage-send "LISTSCRIPTS") + (sieve-manage-parse-listscripts))) + +(defun sieve-manage-havespace (name size &optional buffer) + (with-current-buffer (or buffer (current-buffer)) + (sieve-manage-send (format "HAVESPACE \"%s\" %s" name size)) + (sieve-manage-parse-okno))) + +(defun sieve-string-bytes (str) + (if (fboundp 'string-bytes) + (string-bytes str) + (length str))) + +(defun sieve-manage-putscript (name content &optional buffer) + (with-current-buffer (or buffer (current-buffer)) + (sieve-manage-send (format "PUTSCRIPT \"%s\" {%d+}%s%s" name + (sieve-string-bytes content) + sieve-manage-client-eol content)) + (sieve-manage-parse-okno))) + +(defun sieve-manage-getscript (name output-buffer &optional buffer) + (with-current-buffer (or buffer (current-buffer)) + (sieve-manage-send (format "GETSCRIPT \"%s\"" name)) + (let ((script (sieve-manage-parse-string))) + (sieve-manage-parse-crlf) + (with-current-buffer output-buffer + (insert script)) + (sieve-manage-parse-okno)))) + +(defun sieve-manage-setactive (name &optional buffer) + (with-current-buffer (or buffer (current-buffer)) + (sieve-manage-send (format "SETACTIVE \"%s\"" name)) + (sieve-manage-parse-okno))) + +;; Protocol parsing routines + +(defun sieve-manage-ok-p (rsp) + (string= (downcase (or (car-safe rsp) "")) "ok")) + +(defsubst sieve-manage-forward () + (or (eobp) (forward-char))) + +(defun sieve-manage-is-okno () + (when (looking-at (concat + "^\\(OK\\|NO\\)\\( (\\([^)]+\\))\\)?\\( \\(.*\\)\\)?" + sieve-manage-server-eol)) + (list (match-string 1) (match-string 3) (match-string 5)))) + +(defun sieve-manage-parse-okno () + (let (rsp) + (while (null rsp) + (accept-process-output (get-buffer-process (current-buffer)) 1) + (goto-char (point-min)) + (setq rsp (sieve-manage-is-okno))) + (sieve-manage-erase) + rsp)) + +(defun sieve-manage-parse-capability-1 () + "Accept a managesieve greeting." + (let (str) + (while (setq str (sieve-manage-is-string)) + (if (eq (char-after) ? ) + (progn + (sieve-manage-forward) + (push (list str (sieve-manage-is-string)) + sieve-manage-capability)) + (push (list str) sieve-manage-capability)) + (forward-line))) + (when (re-search-forward (concat "^OK" sieve-manage-server-eol) nil t) + (setq sieve-manage-state 'nonauth))) + +(defalias 'sieve-manage-parse-greeting-1 'sieve-manage-parse-capability-1) + +(defun sieve-manage-is-string () + (cond ((looking-at "\"\\([^\"]+\\)\"") + (prog1 + (match-string 1) + (goto-char (match-end 0)))) + ((looking-at (concat "{\\([0-9]+\\)}" sieve-manage-server-eol)) + (let ((pos (match-end 0)) + (len (string-to-number (match-string 1)))) + (if (< (point-max) (+ pos len)) + nil + (goto-char (+ pos len)) + (buffer-substring pos (+ pos len))))))) + +(defun sieve-manage-parse-string () + (let (rsp) + (while (null rsp) + (accept-process-output (get-buffer-process (current-buffer)) 1) + (goto-char (point-min)) + (setq rsp (sieve-manage-is-string))) + (sieve-manage-erase (point)) + rsp)) + +(defun sieve-manage-parse-crlf () + (when (looking-at sieve-manage-server-eol) + (sieve-manage-erase (match-end 0)))) + +(defun sieve-manage-parse-listscripts () + (let (tmp rsp data) + (while (null rsp) + (while (null (or (setq rsp (sieve-manage-is-okno)) + (setq tmp (sieve-manage-is-string)))) + (accept-process-output (get-buffer-process (current-buffer)) 1) + (goto-char (point-min))) + (when tmp + (while (not (looking-at (concat "\\( ACTIVE\\)?" + sieve-manage-server-eol))) + (accept-process-output (get-buffer-process (current-buffer)) 1) + (goto-char (point-min))) + (if (match-string 1) + (push (cons 'active tmp) data) + (push tmp data)) + (goto-char (match-end 0)) + (setq tmp nil))) + (sieve-manage-erase) + (if (sieve-manage-ok-p rsp) + data + rsp))) + +(defun sieve-manage-send (cmdstr) + (setq cmdstr (concat cmdstr sieve-manage-client-eol)) + (and sieve-manage-log + (with-current-buffer (get-buffer-create sieve-manage-log) + (sieve-manage-disable-multibyte) + (buffer-disable-undo) + (goto-char (point-max)) + (insert cmdstr))) + (process-send-string sieve-manage-process cmdstr)) + +(provide 'sieve-manage) + +;; sieve-manage.el ends here diff --git a/lisp/sieve-mode.el b/lisp/sieve-mode.el new file mode 100644 index 000000000..3b461e19a --- /dev/null +++ b/lisp/sieve-mode.el @@ -0,0 +1,153 @@ +;;; sieve-mode.el --- Sieve code editing commands for Emacs +;; Copyright (C) 2001 Free Software Foundation, Inc. + +;; Author: Simon Josefsson + +;; This file is not part of GNU Emacs, but the same permissions apply. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; This file contain editing mode functions and font-lock support for +;; editing Sieve scripts. It sets up C-mode with support for +;; sieve-style #-comments and a lightly hacked syntax table. It was +;; strongly influenced by awk-mode.el. +;; +;; Put something similar to the following in your .emacs to use this file: +;; +;; (load "~/lisp/sieve") +;; (setq auto-mode-alist (cons '("\\.siv\\'" . sieve-mode) auto-mode-alist)) +;; +;; References: +;; +;; RFC 3028, +;; "Sieve: A Mail Filtering Language", +;; by Tim Showalter. +;; +;; Release history: +;; +;; 2001-03-02 version 1.0 posted to gnu.emacs.sources +;; version 1.1 change file extension into ".siv" (official one) +;; added keymap and menubar to hook into sieve-manage +;; 2001-10-31 version 1.2 committed to Oort Gnus +;; +;; $Id: sieve-mode.el,v 1.7 2001/03/07 17:47:23 jas Exp $ + +;;; Code: + +(autoload 'sieve-manage "sieve-manage") +(autoload 'sieve-upload "sieve-manage") +(require 'easymenu) +(eval-when-compile + (require 'font-lock)) + +(defgroup sieve nil + "Sieve." + :group 'languages) + +(defcustom sieve-mode-hook nil + "Hook run in sieve mode buffers." + :group 'sieve + :type 'hook) + +;; Font-lock + +(defconst sieve-font-lock-keywords + (eval-when-compile + (list + ;; control commands + (cons (regexp-opt '("require" "if" "else" "elsif" "stop")) + 'font-lock-keyword-face) + ;; action commands + (cons (regexp-opt '("fileinto" "redirect" "reject" "keep" "discard")) + 'font-lock-keyword-face) + ;; test commands + (cons (regexp-opt '("address" "allof" "anyof" "exists" "false" + "true" "header" "not" "size" "envelope")) + 'font-lock-builtin-face) + (cons "\\Sw+:\\sw+" 'font-lock-constant-face)))) + +;; Syntax table + +(defvar sieve-mode-syntax-table nil + "Syntax table in use in sieve-mode buffers.") + +(if sieve-mode-syntax-table + () + (setq sieve-mode-syntax-table (make-syntax-table)) + (modify-syntax-entry ?\\ "\\" sieve-mode-syntax-table) + (modify-syntax-entry ?\n "> " sieve-mode-syntax-table) + (modify-syntax-entry ?\f "> " sieve-mode-syntax-table) + (modify-syntax-entry ?\# "< " sieve-mode-syntax-table) + (modify-syntax-entry ?/ "." sieve-mode-syntax-table) + (modify-syntax-entry ?* "." sieve-mode-syntax-table) + (modify-syntax-entry ?+ "." sieve-mode-syntax-table) + (modify-syntax-entry ?- "." sieve-mode-syntax-table) + (modify-syntax-entry ?= "." sieve-mode-syntax-table) + (modify-syntax-entry ?% "." sieve-mode-syntax-table) + (modify-syntax-entry ?< "." sieve-mode-syntax-table) + (modify-syntax-entry ?> "." sieve-mode-syntax-table) + (modify-syntax-entry ?& "." sieve-mode-syntax-table) + (modify-syntax-entry ?| "." sieve-mode-syntax-table) + (modify-syntax-entry ?_ "_" sieve-mode-syntax-table) + (modify-syntax-entry ?\' "\"" sieve-mode-syntax-table)) + +;; Key map definition + +(defvar sieve-mode-map + (let ((map (make-sparse-keymap))) + (define-key map "\C-c\C-l" 'sieve-upload) + (define-key map "\C-c\C-m" 'sieve-manage) + map) + "Key map used in sieve mode.") + +;; Menu definition + +(defvar sieve-mode-menu nil + "Menubar used in sieve mode.") + +;; Code for Sieve editing mode. + +;;;###autoload +(define-derived-mode sieve-mode c-mode "Sieve" + "Major mode for editing Sieve code. +This is much like C mode except for the syntax of comments. Its keymap +inherits from C mode's and it has the same variables for customizing +indentation. It has its own abbrev table and its own syntax table. + +Turning on Sieve mode runs `sieve-mode-hook'." + (set (make-local-variable 'paragraph-start) (concat "$\\|" page-delimiter)) + (set (make-local-variable 'paragraph-separate) paragraph-start) + (set (make-local-variable 'comment-start) "#") + (set (make-local-variable 'comment-end) "") + ;;(set (make-local-variable 'comment-start-skip) "\\(^\\|\\s-\\);?#+ *") + (set (make-local-variable 'comment-start-skip) "#+ *") + (set (make-local-variable 'font-lock-defaults) + '(sieve-font-lock-keywords nil nil ((?_ . "w")))) + (easy-menu-add-item nil nil sieve-mode-menu)) + +;; Menu + +(easy-menu-define sieve-mode-menu sieve-mode-map + "Sieve Menu." + '("Sieve" + ["Upload script" sieve-upload t] + ["Manage scripts on server" sieve-manage t])) + +(provide 'sieve-mode) + +;; sieve-mode.el ends here diff --git a/lisp/sieve.el b/lisp/sieve.el new file mode 100644 index 000000000..78f95b8f9 --- /dev/null +++ b/lisp/sieve.el @@ -0,0 +1,349 @@ +;;; sieve.el --- Utilities to manage sieve scripts +;; Copyright (C) 2001 Free Software Foundation, Inc. + +;; Author: Simon Josefsson + +;; This file is not part of GNU Emacs, but the same permissions apply. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; This file contain utilities to facilate upload, download and +;; general management of sieve scripts. Currently only the +;; Managesieve protocol is supported (using sieve-manage.el), but when +;; (useful) alternatives become available, they might be supported as +;; well. +;; +;; The cursor navigation was inspired by biff-mode by Franklin Lee. +;; +;; Release history: +;; +;; 2001-10-31 Committed to Oort Gnus. +;; +;; $Id: sieve.el,v 1.15 2001/08/17 11:20:15 jas Exp $ +;; +;; Todo: +;; +;; * Namespace? This file contains `sieve-manage' and +;; `sieve-manage-mode', but there is a sieve-manage.el file as well. +;; Can't think of a good solution though, this file need a *-mode, +;; and naming it `sieve-mode' would collide with sieve-mode.el. One +;; solution would be to come up with some better name that this file +;; can use that doesn't have the managesieve specific "manage" in +;; it. sieve-dired? i dunno. we could copy all off sieve.el into +;; sieve-manage.el too, but I'd like to separate the interface from +;; the protocol implementation since the backends are likely to +;; change (well). +;; +;; * Define servers? We could have a customize buffer to create a server, +;; with authentication/stream/etc parameters, much like Gnus, and then +;; only use names of defined servers when interacting with M-x sieve-*. +;; Right now you can't use STARTTLS, which sieve-manage.el provides + +;;; Code: + +(require 'easy-mmode) +(require 'sieve-manage) +(require 'sieve-mode) + +;; User customizable variables: + +(defgroup sieve nil + "Manage sieve scripts." + :group 'tools) + +(defcustom sieve-new-script "" + "Name of name script indicator." + :type 'string + :group 'sieve) + +(defcustom sieve-buffer "*sieve*" + "Name of sieve management buffer." + :type 'string + :group 'sieve) + +(defcustom sieve-template "\ +require \"fileinto\"; + +# Example script (remove comment character '#' to make it effective!): +# +# if header :contains \"from\" \"coyote\" { +# discard; +# } elsif header :contains [\"subject\"] [\"$$$\"] { +# discard; +# } else { +# fileinto \"INBOX\"; +# } +" + "Template sieve script." + :type 'string + :group 'sieve) + +;; Internal variables: + +(defvar sieve-manage-buffer nil) +(defvar sieve-buffer-header-end nil) + +;; Sieve-manage mode: + +(defvar sieve-manage-mode-map nil + "Keymap for `sieve-manage-mode'.") + +(if sieve-manage-mode-map + () + (setq sieve-manage-mode-map (make-sparse-keymap)) + (suppress-keymap sieve-manage-mode-map) + ;; various + (define-key sieve-manage-mode-map "?" 'sieve-help) + (define-key sieve-manage-mode-map "h" 'sieve-help) + (define-key sieve-manage-mode-map "q" 'sieve-bury-buffer) + ;; activating + (define-key sieve-manage-mode-map "m" 'sieve-activate) + (define-key sieve-manage-mode-map "u" 'sieve-deactivate) + (define-key sieve-manage-mode-map "\M-\C-?" 'sieve-deactivate-all) + ;; navigation keys + (define-key sieve-manage-mode-map "\C-p" 'sieve-prev-line) + (define-key sieve-manage-mode-map [up] 'sieve-prev-line) + (define-key sieve-manage-mode-map "\C-n" 'sieve-next-line) + (define-key sieve-manage-mode-map [down] 'sieve-next-line) + (define-key sieve-manage-mode-map " " 'sieve-next-line) + (define-key sieve-manage-mode-map "n" 'sieve-next-line) + (define-key sieve-manage-mode-map "p" 'sieve-prev-line) + (define-key sieve-manage-mode-map "\C-m" 'sieve-edit-script) + (define-key sieve-manage-mode-map "f" 'sieve-edit-script) + (define-key sieve-manage-mode-map "o" 'sieve-edit-script-other-window) + (define-key sieve-manage-mode-map "r" 'sieve-remove) + (define-key sieve-manage-mode-map [mouse-2] 'sieve-edit-script) + (define-key sieve-manage-mode-map [(down-mouse-3)] 'sieve-menu)) + +(define-derived-mode sieve-manage-mode fundamental-mode "SIEVE" + "Mode used for sieve script management." + (setq mode-name "SIEVE") + (buffer-disable-undo (current-buffer)) + (setq truncate-lines t)) + +(put 'sieve-manage-mode 'mode-class 'special) + +(easy-menu-define sieve-manage-mode-menu sieve-manage-mode-map + "Sieve Menu." + '("Manage Sieve" + ["Edit script" sieve-edit-script t] + ["Activate script" sieve-activate t] + ["Deactivate script" sieve-deactivate t])) + +;; This is necessary to allow correct handling of \\[cvs-mode-diff-map] +;; in substitute-command-keys. +;(fset 'sieve-manage-mode-map sieve-manage-mode-map) + +;; Commands used in sieve-manage mode: + +(defun sieve-activate (&optional pos) + (interactive "d") + (let ((name (sieve-script-at-point)) err) + (unless name + (error "No sieve script at point")) + (setq err (sieve-manage-setactive name sieve-manage-buffer)) + (if (sieve-manage-ok-p err) + (message "Script %s activated." name) + (message "Failed to activate script %s: %s" name (nth 2 err))) + (sieve-refresh-scriptlist))) + +(defun sieve-edit-script (&optional pos) + (interactive "d") + (let ((name (sieve-script-at-point))) + (unless name + (error "No sieve script at point")) + (if (not (string-equal name sieve-new-script)) + (let ((newbuf (generate-new-buffer name)) + err) + (setq err (sieve-manage-getscript name newbuf sieve-manage-buffer)) + (switch-to-buffer newbuf) + (unless (sieve-manage-ok-p err) + (error "Sieve download failed: %s" err))) + (switch-to-buffer (get-buffer-create "template.siv")) + (insert sieve-template)) + (sieve-mode) + (message "Press C-c C-l to upload script to server."))) + +(defun sieve-next-line (&optional arg) + (interactive) + (unless arg + (setq arg 1)) + (if (save-excursion + (forward-line arg) + (sieve-script-at-point)) + (sieve-change-region + (forward-line arg)) + (message "End of list"))) + +(defun sieve-prev-line (&optional arg) + (interactive) + (unless arg + (setq arg -1)) + (if (save-excursion + (forward-line arg) + (sieve-script-at-point)) + (sieve-change-region + (forward-line arg)) + (message "Beginning of list"))) + +(defun sieve-help () + "Display help for various sieve commands." + (interactive) + (if (eq last-command 'sieve-help) + ;; would need minor-mode for log-edit-mode + (describe-function 'sieve-mode) + (message (substitute-command-keys + "`\\[sieve-help]':help `\\[cvs-mode-add]':add `\\[sieve-remove]':remove")))) + +(defun sieve-bury-buffer (buf &optional mainbuf) + "Hide the buffer BUF that was temporarily popped up. +BUF is assumed to be a temporary buffer used from the buffer MAINBUF." + (interactive (list (current-buffer))) + (save-current-buffer + (let ((win (if (eq buf (window-buffer (selected-window))) (selected-window) + (get-buffer-window buf t)))) + (when win + (if (window-dedicated-p win) + (condition-case () + (delete-window win) + (error (iconify-frame (window-frame win)))) + (if (and mainbuf (get-buffer-window mainbuf)) + (delete-window win))))) + (with-current-buffer buf + (bury-buffer (unless (and (eq buf (window-buffer (selected-window))) + (not (window-dedicated-p (selected-window)))) + buf))) + (when mainbuf + (let ((mainwin (or (get-buffer-window mainbuf) + (get-buffer-window mainbuf 'visible)))) + (when mainwin (select-window mainwin)))))) + +;; Create buffer: + +(defun sieve-setup-buffer (server port) + (setq buffer-read-only nil) + (erase-buffer) + (buffer-disable-undo) + (insert "\ +Server : " server ":" (or port "2000") " + +") + (set (make-local-variable 'sieve-buffer-header-end) + (point-max))) + +(defun sieve-script-at-point (&optional pos) + "Return name of sieve script at point POS, or nil." + (interactive "d") + (get-char-property (or pos (point)) 'script-name)) + +(defmacro sieve-change-region (&rest body) + "Turns off sieve-region before executing BODY, then re-enables it after. +Used to bracket operations which move point in the sieve-buffer." + `(progn + (sieve-highlight nil) + ,@body + (sieve-highlight t))) +(put 'sieve-change-region 'lisp-indent-function 0) + +(eval-and-compile + (defalias 'sieve-make-overlay (if (fboundp 'make-overlay) + 'make-overlay + 'make-extent)) + (defalias 'sieve-overlay-put (if (fboundp 'overlay-put) + 'overlay-put + 'set-extent-property)) + (defalias 'sieve-overlays-at (if (fboundp 'overlays-at) + 'overlays-at + 'extents-at))) + +(defun sieve-highlight (on) + "Turn ON or off highlighting on the current language overlay." + (sieve-overlay-put (car (sieve-overlays-at (point))) + 'face (if on 'highlight 'default))) + +(defun sieve-insert-scripts (scripts) + "Format and insert LANGUAGE-LIST strings into current buffer at point." + (while scripts + (let ((p (point)) + (ext nil) + (script (pop scripts))) + (if (consp script) + (insert (format " ACTIVE %s" (cdr script))) + (insert (format " %s" script))) + (setq ext (sieve-make-overlay p (point))) + (sieve-overlay-put ext 'mouse-face 'highlight) + (sieve-overlay-put ext 'script-name (if (consp script) + (cdr script) + script)) + (insert "\n")))) + +(defun sieve-open-server (server &optional port) + ;; open server + (set (make-local-variable 'sieve-manage-buffer) + (sieve-manage-open server)) + ;; authenticate + (sieve-manage-authenticate nil nil sieve-manage-buffer)) + +(defun sieve-refresh-scriptlist () + (interactive) + (with-current-buffer sieve-buffer + (setq buffer-read-only nil) + (delete-region (or sieve-buffer-header-end (point-max)) (point-max)) + (goto-char (point-max)) + ;; get list of script names and print them + (let ((scripts (sieve-manage-listscripts sieve-manage-buffer))) + (if (null scripts) + (insert (format (concat "No scripts on server, press RET on %s to " + "create a new script.\n") sieve-new-script)) + (insert (format (concat "%d script%s on server, press RET on a script " + "name edits it, or\npress RET on %s to create " + "a new script.\n") (length scripts) + (if (eq (length scripts) 1) "" "s") + sieve-new-script))) + (save-excursion + (sieve-insert-scripts (list sieve-new-script)) + (sieve-insert-scripts scripts))) + (sieve-highlight t) + (setq buffer-read-only t))) + +;;;###autoload +(defun sieve-manage (server &optional port) + (interactive "sServer: ") + (switch-to-buffer (get-buffer-create sieve-buffer)) + (sieve-manage-mode) + (sieve-setup-buffer server port) + (if (sieve-open-server server port) + (sieve-refresh-scriptlist) + (message "Could not open server %s" server))) + +;;;###autoload +(defun sieve-upload (&optional name) + (interactive) + (unless name + (setq name (buffer-name))) + (when (or (get-buffer sieve-buffer) (call-interactively 'sieve-manage)) + (let ((script (buffer-string)) err) + (with-current-buffer (get-buffer sieve-buffer) + (setq err (sieve-manage-putscript name script sieve-manage-buffer)) + (if (sieve-manage-ok-p err) + (message (concat "Sieve upload done. Use `C-c RET' to manage scripts.")) + (message "Sieve upload failed: %s" (nth 2 err))))))) + +(provide 'sieve) + +;; sieve.el ends here