;;; sieve-manage.el --- Implementation of the managesive protocol in elisp
-;; Copyright (C) 2001, 2003 Free Software Foundation, Inc.
+
+;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007,
+;; 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Simon Josefsson <simon@josefsson.org>
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; 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.
+;; the Free Software Foundation, either version 3 of the License, 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
+;; 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.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
+;; For Emacs < 22.2.
+(eval-and-compile
+ (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
+
+(if (locate-library "password-cache")
+ (require 'password-cache)
+ (require 'password))
+
(eval-when-compile
(require 'sasl)
(require 'starttls))
-(eval-and-compile
- (autoload 'sasl-find-mechanism "sasl")
- (autoload 'starttls-open-stream "starttls"))
+(autoload 'sasl-find-mechanism "sasl")
+(autoload 'starttls-open-stream "starttls")
;; User customizable variables:
(defcustom sieve-manage-log "*sieve-manage-log*"
"Name of buffer for managesieve session trace."
- :type 'string)
+ :type 'string
+ :group 'sieve-manage)
(defcustom sieve-manage-default-user (user-login-name)
"Default username to use."
- :type 'string)
+ :type 'string
+ :group 'sieve-manage)
(defcustom sieve-manage-server-eol "\r\n"
"The EOL string sent from the server."
- :type 'string)
+ :type 'string
+ :group 'sieve-manage)
(defcustom sieve-manage-client-eol "\r\n"
"The EOL string we send to the server."
- :type 'string)
+ :type 'string
+ :group 'sieve-manage)
(defcustom sieve-manage-streams '(network starttls shell)
- "Priority of streams to consider when opening connection to server.")
+ "Priority of streams to consider when opening connection to server."
+ :group 'sieve-manage)
(defcustom sieve-manage-stream-alist
'((network sieve-manage-network-p sieve-manage-network-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.")
+stream."
+ :group 'sieve-manage)
(defcustom sieve-manage-authenticators '(digest-md5
cram-md5
ntlm
plain
login)
- "Priority of authenticators to consider when authenticating to server.")
+ "Priority of authenticators to consider when authenticating to server."
+ :group 'sieve-manage)
(defcustom sieve-manage-authenticator-alist
'((cram-md5 sieve-manage-cram-md5-p sieve-manage-cram-md5-auth)
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 actual authentication.")
+for doing the actual authentication."
+ :group 'sieve-manage)
(defcustom sieve-manage-default-port 2000
"Default port number for managesieve protocol."
- :type 'integer)
+ :type 'integer
+ :group 'sieve-manage)
;; Internal variables:
;; Internal utility functions
-(defsubst sieve-manage-disable-multibyte ()
+(defmacro 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)))
+ (unless (featurep 'xemacs)
+ '(set-buffer-multibyte nil)))
+(declare-function password-read "password-cache" (prompt &optional key))
+(declare-function password-cache-add "password-cache" (key password))
+(declare-function password-cache-remove "password-cache" (key))
;; 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.
+it was successful 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))))
+ (make-local-variable 'sieve-manage-username)
+ (make-local-variable 'sieve-manage-password)
+ (let (user passwd ret reason passwd-key)
+ (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)))
+ passwd-key (concat "managesieve:" user "@" sieve-manage-server
+ ":" sieve-manage-port)
+ passwd (or sieve-manage-password
+ (password-read (concat "Managesieve password for "
+ user "@" sieve-manage-server
+ ": ")
+ passwd-key)))
+ (when (y-or-n-p "Store password for this session? ")
+ (password-cache-add passwd-key (copy-sequence passwd)))
+ (when (and user passwd)
+ (if (funcall loginfunc user passwd)
+ (setq ret t
+ sieve-manage-username user)
+ (if reason
+ (message "Login failed (reason given: %s)..." reason)
+ (message "Login failed..."))
+ (password-cache-remove passwd-key)
+ (setq sieve-manage-password nil)
+ (setq passwd nil)
+ (setq reason nil)
+ (sit-for 1))))
+ (quit (with-current-buffer buffer
+ (password-cache-remove passwd-key)
+ (setq user nil
+ passwd nil
+ sieve-manage-password nil)))
+ (error (with-current-buffer buffer
+ (password-cache-remove passwd-key)
+ (setq user nil
+ passwd nil
+ sieve-manage-password nil))))
ret)))
(defun sieve-manage-erase (&optional p buffer)
(when (memq (process-status process) '(open run))
process))))
-(defun imap-starttls-p (buffer)
- ;; (and (imap-capability 'STARTTLS buffer)
+(defun sieve-manage-starttls-p (buffer)
(condition-case ()
(progn
(require 'starttls)
(call-process "starttls"))
(error nil)))
-(defun imap-starttls-open (name buffer server port)
+(defun sieve-manage-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)
(defun sieve-sasl-auth (buffer mech)
"Login to server using the SASL MECH method."
(message "sieve: Authenticating using %s..." mech)
- (if (sieve-manage-interactive-login
+ (if (sieve-manage-interactive-login
buffer
(lambda (user passwd)
(let (client step tag data rsp)
(sieve-manage-erase)
(when (sieve-manage-ok-p rsp)
(when (string-match "^SASL \"\\([^\"]+\\)\"" (cadr rsp))
- (sasl-step-set-data
+ (sasl-step-set-data
step (base64-decode-string (match-string 1 (cadr rsp)))))
(if (and (setq step (sasl-next-step client step))
(setq data (sasl-step-data step)))
(setq step (sasl-next-step client step))
(sieve-manage-send
(if (sasl-step-data step)
- (concat "\""
- (base64-encode-string (sasl-step-data step)
+ (concat "\""
+ (base64-encode-string (sasl-step-data step)
'no-line-break)
"\"")
"")))))))
(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)
+Optional argument PORT is port number (integer) on remote server.
+Optional argument STREAM is any of `sieve-manage-streams' (a symbol).
+Optional argument AUTH indicates authenticator to use, see
+`sieve-manage-authenticators' for available authenticators.
+If nil, chooses the best stream the server is capable of.
+Optional argument 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)
+ (mapc 'make-local-variable sieve-manage-local-variables)
(sieve-manage-disable-multibyte)
(buffer-disable-undo)
(setq sieve-manage-server (or server sieve-manage-server))
(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)
+ (make-local-variable 'sieve-manage-username)
+ (make-local-variable '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-send (format "HAVESPACE \"%s\" %s" name size))
(sieve-manage-parse-okno)))
-(eval-and-compile
- (if (fboundp 'string-bytes)
- (defalias 'sieve-string-bytes 'string-bytes)
- (defalias 'sieve-string-bytes 'length)))
-
(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)
+ ;; Here we assume that the coding-system will
+ ;; replace each char with a single byte.
+ ;; This is always the case if `content' is
+ ;; a unibyte string.
+ (length content)
sieve-manage-client-eol content))
(sieve-manage-parse-okno)))
sieve-manage-capability))
(push (list str) sieve-manage-capability))
(forward-line)))
- (when (re-search-forward (concat "^OK" sieve-manage-server-eol) nil t)
+ (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)
(prog1
(match-string 1)
(goto-char (match-end 0))))
- ((looking-at (concat "{\\([0-9]+\\)}" sieve-manage-server-eol))
+ ((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))
projects / gnus / blobdiff