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

   1 ;;; sieve-manage.el --- Implementation of the managesive protocol in elisp
   2 ;; Copyright (C) 2001 Free Software Foundation, Inc.
   3
   4 ;; Author: Simon Josefsson <simon@josefsson.org>
   5
   6 ;; This file is not part of GNU Emacs, but the same permissions apply.
   7
   8 ;; GNU Emacs is free software; you can redistribute it and/or modify
   9 ;; it under the terms of the GNU General Public License as published by
  10 ;; the Free Software Foundation; either version 2, or (at your option)
  11 ;; any later version.
  12
  13 ;; GNU Emacs is distributed in the hope that it will be useful,
  14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;; GNU General Public License for more details.
  17
  18 ;; You should have received a copy of the GNU General Public License
  19 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  20 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  21 ;; Boston, MA 02111-1307, USA.
  22
  23 ;;; Commentary:
  24
  25 ;; This library provides an elisp API for the managesieve network
  26 ;; protocol.
  27 ;;
  28 ;; Currently only the CRAM-MD5 authentication mechanism is supported.
  29 ;;
  30 ;; The API should be fairly obvious for anyone familiar with the
  31 ;; managesieve protocol, interface functions include:
  32 ;;
  33 ;; `sieve-manage-open'
  34 ;; open connection to managesieve server, returning a buffer to be
  35 ;; used by all other API functions.
  36 ;;
  37 ;; `sieve-manage-opened'
  38 ;; check if a server is open or not
  39 ;;
  40 ;; `sieve-manage-close'
  41 ;; close a server connection.
  42 ;;
  43 ;; `sieve-manage-authenticate'
  44 ;; `sieve-manage-listscripts'
  45 ;; performs managesieve protocol actions
  46 ;;
  47 ;; and that's it.  Example of a managesieve session in *scratch*:
  48 ;;
  49 ;; (setq my-buf (sieve-manage-open "my.server.com"))
  50 ;; " *sieve* my.server.com:2000*"
  51 ;;
  52 ;; (sieve-manage-authenticate "myusername" "mypassword" my-buf)
  53 ;; 'auth
  54 ;;
  55 ;; (sieve-manage-listscripts my-buf)
  56 ;; ("vacation" "testscript" ("splitmail") "badscript")
  57 ;;
  58 ;; References:
  59 ;;
  60 ;; draft-martin-managesieve-02.txt,
  61 ;; "A Protocol for Remotely Managing Sieve Scripts",
  62 ;; by Tim Martin.
  63 ;;
  64 ;; Release history:
  65 ;;
  66 ;; 2001-10-31 Committed to Oort Gnus.
  67 ;;
  68 ;; $Id: sieve-manage.el,v 6.2 2001/11/01 01:18:11 zsh Exp $
  69
  70 ;;; Code:
  71
  72 (require 'rfc2104)
  73 (or (fboundp 'md5)
  74     (require 'md5))
  75 (eval-and-compile
  76   (autoload 'starttls-open-stream "starttls"))
  77
  78 ;; User customizable variables:
  79
  80 (defgroup sieve-manage nil
  81   "Low-level Managesieve protocol issues."
  82   :group 'mail
  83   :prefix "sieve-")
  84
  85 (defcustom sieve-manage-log "*sieve-manage-log*"
  86   "Name of buffer for managesieve session trace."
  87   :type 'string)
  88
  89 (defcustom sieve-manage-default-user (user-login-name)
  90   "Default username to use."
  91   :type 'string)
  92
  93 (defcustom sieve-manage-server-eol "\r\n"
  94   "The EOL string sent from the server."
  95   :type 'string)
  96
  97 (defcustom sieve-manage-client-eol "\r\n"
  98   "The EOL string we send to the server."
  99   :type 'string)
 100
 101 (defcustom sieve-manage-streams '(network starttls shell)
 102   "Priority of streams to consider when opening connection to server.")
 103
 104 (defcustom sieve-manage-stream-alist
 105   '((network   sieve-manage-network-p          sieve-manage-network-open)
 106     (shell     sieve-manage-shell-p            sieve-manage-shell-open)
 107     (starttls  sieve-manage-starttls-p         sieve-manage-starttls-open))
 108   "Definition of network streams.
 109
 110 \(NAME CHECK OPEN)
 111
 112 NAME names the stream, CHECK is a function returning non-nil if the
 113 server support the stream and OPEN is a function for opening the
 114 stream.")
 115
 116 (defcustom sieve-manage-authenticators '(cram-md5 plain)
 117   "Priority of authenticators to consider when authenticating to server.")
 118
 119 (defcustom sieve-manage-authenticator-alist
 120   '((cram-md5   sieve-manage-cram-md5-p       sieve-manage-cram-md5-auth)
 121     (plain      sieve-manage-plain-p          sieve-manage-plain-auth))
 122   "Definition of authenticators.
 123
 124 \(NAME CHECK AUTHENTICATE)
 125
 126 NAME names the authenticator.  CHECK is a function returning non-nil if
 127 the server support the authenticator and AUTHENTICATE is a function
 128 for doing the actual authentication.")
 129
 130 (defcustom sieve-manage-default-port 2000
 131   "Default port number for managesieve protocol."
 132   :type 'integer)
 133
 134 ;; Internal variables:
 135
 136 (defconst sieve-manage-local-variables '(sieve-manage-server
 137                                          sieve-manage-port
 138                                          sieve-manage-auth
 139                                          sieve-manage-stream
 140                                          sieve-manage-username
 141                                          sieve-manage-password
 142                                          sieve-manage-process
 143                                          sieve-manage-client-eol
 144                                          sieve-manage-server-eol
 145                                          sieve-manage-capability))
 146 (defconst sieve-manage-default-stream 'network)
 147 (defconst sieve-manage-coding-system-for-read 'binary)
 148 (defconst sieve-manage-coding-system-for-write 'binary)
 149 (defvar sieve-manage-stream nil)
 150 (defvar sieve-manage-auth nil)
 151 (defvar sieve-manage-server nil)
 152 (defvar sieve-manage-port nil)
 153 (defvar sieve-manage-username nil)
 154 (defvar sieve-manage-password nil)
 155 (defvar sieve-manage-state 'closed
 156   "Managesieve state.
 157 Valid states are `closed', `initial', `nonauth', and `auth'.")
 158 (defvar sieve-manage-process nil)
 159 (defvar sieve-manage-capability nil)
 160
 161 ;; Internal utility functions
 162
 163 (defsubst sieve-manage-disable-multibyte ()
 164   "Enable multibyte in the current buffer."
 165   (when (fboundp 'set-buffer-multibyte)
 166     (set-buffer-multibyte nil)))
 167
 168 (defun sieve-manage-read-passwd (prompt &rest args)
 169   "Read a password using PROMPT.
 170 If ARGS, PROMPT is used as an argument to `format'."
 171   (let ((prompt (if args
 172                     (apply 'format prompt args)
 173                   prompt)))
 174     (funcall (if (or (fboundp 'read-passwd)
 175                      (and (load "subr" t)
 176                           (fboundp 'read-passwd))
 177                      (and (load "passwd" t)
 178                           (fboundp 'read-passwd)))
 179                  'read-passwd
 180                (autoload 'ange-ftp-read-passwd "ange-ftp")
 181                'ange-ftp-read-passwd)
 182              prompt)))
 183
 184
 185 ;; Uses the dynamically bound `reason' variable.
 186 (defvar reason)
 187 (defun sieve-manage-interactive-login (buffer loginfunc)
 188   "Login to server in BUFFER.
 189 LOGINFUNC is passed a username and a password, it should return t if
 190 it where sucessful authenticating itself to the server, nil otherwise.
 191 Returns t if login was successful, nil otherwise."
 192   (with-current-buffer buffer
 193     (make-variable-buffer-local 'sieve-manage-username)
 194     (make-variable-buffer-local 'sieve-manage-password)
 195     (let (user passwd ret reason)
 196       ;;      (condition-case ()
 197       (while (or (not user) (not passwd))
 198         (setq user (or sieve-manage-username
 199                        (read-from-minibuffer
 200                         (concat "Managesieve username for "
 201                                 sieve-manage-server ": ")
 202                         (or user sieve-manage-default-user))))
 203         (setq passwd (or sieve-manage-password
 204                          (sieve-manage-read-passwd
 205                           (concat "Managesieve password for " user "@"
 206                                   sieve-manage-server ": "))))
 207         (when (and user passwd)
 208           (if (funcall loginfunc user passwd)
 209               (progn
 210                 (setq ret t
 211                       sieve-manage-username user)
 212                 (if (and (not sieve-manage-password)
 213                          (y-or-n-p "Store password for this session? "))
 214                     (setq sieve-manage-password passwd)))
 215             (if reason
 216                 (message "Login failed (reason given: %s)..." reason)
 217               (message "Login failed..."))
 218             (setq reason nil)
 219             (setq passwd nil)
 220             (sit-for 1))))
 221       ;;        (quit (with-current-buffer buffer
 222       ;;                (setq user nil
 223       ;;                      passwd nil)))
 224       ;;        (error (with-current-buffer buffer
 225       ;;                 (setq user nil
 226       ;;                       passwd nil))))
 227       ret)))
 228
 229 (defun sieve-manage-erase (&optional p buffer)
 230   (let ((buffer (or buffer (current-buffer))))
 231     (and sieve-manage-log