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, 2006, 2007,
   4 ;;   2008, 2009, 2010  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 (autoload 'sasl-find-mechanism "sasl")
  89 (autoload 'starttls-open-stream "starttls")
  90
  91 ;; User customizable variables:
  92
  93 (defgroup sieve-manage nil
  94   "Low-level Managesieve protocol issues."
  95   :group 'mail
  96   :prefix "sieve-")
  97
  98 (defcustom sieve-manage-log "*sieve-manage-log*"
  99   "Name of buffer for managesieve session trace."
 100   :type 'string
 101   :group 'sieve-manage)
 102
 103 (defcustom sieve-manage-default-user (user-login-name)
 104   "Default username to use."
 105   :type 'string
 106   :group 'sieve-manage)
 107
 108 (defcustom sieve-manage-server-eol "\r\n"
 109   "The EOL string sent from the server."
 110   :type 'string
 111   :group 'sieve-manage)
 112
 113 (defcustom sieve-manage-client-eol "\r\n"
 114   "The EOL string we send to the server."
 115   :type 'string
 116   :group 'sieve-manage)
 117
 118 (defcustom sieve-manage-streams '(network starttls shell)
 119   "Priority of streams to consider when opening connection to server."
 120   :group 'sieve-manage)
 121
 122 (defcustom sieve-manage-stream-alist
 123   '((network   sieve-manage-network-p          sieve-manage-network-open)
 124     (shell     sieve-manage-shell-p            sieve-manage-shell-open)
 125     (starttls  sieve-manage-starttls-p         sieve-manage-starttls-open))
 126   "Definition of network streams.
 127
 128 \(NAME CHECK OPEN)
 129
 130 NAME names the stream, CHECK is a function returning non-nil if the
 131 server support the stream and OPEN is a function for opening the
 132 stream."
 133   :group 'sieve-manage)
 134
 135 (defcustom sieve-manage-authenticators '(digest-md5
 136                                          cram-md5
 137                                          scram-md5
 138                                          ntlm
 139                                          plain
 140                                          login)
 141   "Priority of authenticators to consider when authenticating to server."
 142   :group 'sieve-manage)
 143
 144 (defcustom sieve-manage-authenticator-alist
 145   '((cram-md5   sieve-manage-cram-md5-p       sieve-manage-cram-md5-auth)
 146     (digest-md5 sieve-manage-digest-md5-p     sieve-manage-digest-md5-auth)
 147     (scram-md5  sieve-manage-scram-md5-p      sieve-manage-scram-md5-auth)
 148     (ntlm       sieve-manage-ntlm-p           sieve-manage-ntlm-auth)
 149     (plain      sieve-manage-plain-p          sieve-manage-plain-auth)
 150     (login      sieve-manage-login-p          sieve-manage-login-auth))
 151   "Definition of authenticators.
 152
 153 \(NAME CHECK AUTHENTICATE)
 154
 155 NAME names the authenticator.  CHECK is a function returning non-nil if
 156 the server support the authenticator and AUTHENTICATE is a function
 157 for doing the actual authentication."
 158   :group 'sieve-manage)
 159
 160 (defcustom sieve-manage-default-port 2000
 161   "Default port number for managesieve protocol."
 162   :type 'integer
 163   :group 'sieve-manage)
 164
 165 ;; Internal variables:
 166
 167 (defconst sieve-manage-local-variables '(sieve-manage-server
 168                                          sieve-manage-port
 169                                          sieve-manage-auth
 170                                          sieve-manage-stream
 171                                          sieve-manage-username
 172                                          sieve-manage-password
 173                                          sieve-manage-process
 174                                          sieve-manage-client-eol
 175                                          sieve-manage-server-eol
 176                                          sieve-manage-capability))
 177 (defconst sieve-manage-default-stream 'network)
 178 (defconst sieve-manage-coding-system-for-read 'binary)
 179 (defconst sieve-manage-coding-system-for-write 'binary)
 180 (defvar sieve-manage-stream nil)
 181 (defvar sieve-manage-auth nil)
 182 (defvar sieve-manage-server nil)
 183 (defvar sieve-manage-port nil)
 184 (defvar sieve-manage-username nil)
 185 (defvar sieve-manage-password nil)
 186 (defvar sieve-manage-state 'closed
 187   "Managesieve state.
 188 Valid states are `closed', `initial', `nonauth', and `auth'.")
 189 (defvar sieve-manage-process nil)
 190 (defvar sieve-manage-capability nil)
 191
 192 ;; Internal utility functions
 193
 194 (defmacro sieve-manage-disable-multibyte ()
 195   "Enable multibyte in the current buffer."
 196   (unless (featurep 'xemacs)
 197     '(set-buffer-multibyte nil)))
 198
 199 (declare-function password-read         "password-cache" (prompt &optional key))
 200 (declare-function password-cache-add    "password-cache" (key password))
 201 (declare-function password-cache-remove "password-cache" (key))
 202
 203 ;; Uses the dynamically bound `reason' variable.
 204 (defvar reason)
 205 (defun sieve-manage-interactive-login (buffer loginfunc)
 206   "Login to server in BUFFER.
 207 LOGINFUNC is passed a username and a password, it should return t if
 208 it was successful authenticating itself to the server, nil otherwise.
 209 Returns t if login was successful, nil otherwise."
 210   (with-current-buffer buffer
 211     (make-local-variable 'sieve-manage-username)
 212     (make-local-variable 'sieve-manage-password)
 213     (let (user passwd ret reason passwd-key)
 214       (condition-case ()
 215           (while (or (not user) (not passwd))
 216             (setq user (or sieve-manage-username
 217                            (read-from-minibuffer
 218                             (concat "Managesieve username for "
 219                                     sieve-manage-server ": ")
 220                             (or user sieve-manage-default-user)))
 221                   passwd-key (concat "managesieve:" user "@" sieve-manage-server
 222                                      ":" sieve-manage-port)
 223                   passwd (or sieve-manage-password
 224                              (password-read (concat "Managesieve password for "
 225                                                     user "@" sieve-manage-server
 226                                                     ": ")
 227                                             passwd-key)))
 228             (when (y-or-n-p "Store password for this session? ")
 229               (password-cache-add passwd-key (copy-sequence passwd)))
 230             (when (and user passwd)
 231               (if (funcall loginfunc user passwd)
 232                   (setq ret t
 233                         sieve-manage-username user)
 234                 (if reason
 235                     (message "Login failed (reason given: %s)..." reason)
 236                   (message "Login failed..."))
 237                 (password-cache-remove passwd-key)
 238                 (setq sieve-manage-password nil)
 239                 (setq passwd nil)
 240                 (setq reason nil)
 241                 (sit-for 1))))
 242         (quit (with-current-buffer buffer
 243                 (password-cache-remove passwd-key)
 244                 (setq user nil
 245                       passwd nil
 246                       sieve-manage-password nil)))
 247         (error (with-current-buffer buffer
 248                  (password-cache-remove passwd-key)
 249                  (setq user nil
 250                        passwd nil
 251                        sieve-manage-password nil))))
 252       ret)))
 253
 254 (defun sieve-manage-erase (&optional p buffer)
 255   (let ((buffer (or buffer (current-buffer))))
 256     (and sieve-manage-log
 257          (with-current-buffer (get-buffer-create sieve-manage-log)
 258            (sieve-manage-disable-multibyte)
 259            (buffer-disable-undo)
 260            (goto-char (point-max))
 261            (insert-buffer-substring buffer (with-current-buffer buffer
 262                                              (point-min))
 263                                     (or p (with-current-buffer buffer
 264                                             (point-max)))))))
 265   (delete-region (point-min) (or p (point-max))))
 266
 267 (defun sieve-manage-open-1 (buffer)
 268   (with-current-buffer buffer
 269     (sieve-manage-erase)
 270     (setq sieve-manage-state 'initial
 271           sieve-manage-process
 272           (condition-case ()
 273               (funcall (nth 2 (assq sieve-manage-stream
 274                                     sieve-manage-stream-alist))
 275                        "sieve" buffer sieve-manage-server sieve-manage-port)
 276             ((error quit) nil)))
 277     (when sieve-manage-process
 278       (while (and (eq sieve-manage-state 'initial)
 279                   (memq (process-status sieve-manage-process) '(open run)))
 280         (message "Waiting for response from %s..." sieve-manage-server)
 281         (accept-process-output sieve-manage-process 1))
 282       (message "Waiting for response from&n