;; `sieve-manage-close'
;; close a server connection.
;;
-;; `sieve-manage-authenticate'
;; `sieve-manage-listscripts'
;; `sieve-manage-deletescript'
;; `sieve-manage-getscript'
;;
;; 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")
(require 'starttls))
(autoload 'sasl-find-mechanism "sasl")
(autoload 'starttls-open-stream "starttls")
+(autoload 'auth-source-user-or-password "auth-source")
;; User customizable variables:
:type 'string
:group 'sieve-manage)
-(defcustom sieve-manage-default-user (user-login-name)
- "Default username to use."
- :type 'string
- :group 'sieve-manage)
-
(defcustom sieve-manage-server-eol "\r\n"
"The EOL string sent from the server."
:type 'string
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
(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'.")
(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 was successful authenticating itself to the server, nil otherwise.
-Returns t if login was successful, nil otherwise."
- (with-current-buffer buffer
- (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)
(let ((buffer (or buffer (current-buffer))))
(and sieve-manage-log
process)))
;; Authenticators
-
(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
- buffer
- (lambda (user passwd)
- (let (client step tag data rsp)
- (setq client (sasl-make-client (sasl-find-mechanism (list mech))
- user "sieve" sieve-manage-server))
- (setq sasl-read-passphrase (function (lambda (prompt) passwd)))
- (setq step (sasl-next-step client nil))
- (setq tag
- (sieve-manage-send
- (concat
- "AUTHENTICATE \""
- mech
- "\""
- (and (sasl-step-data step)
- (concat
- " \""
- (base64-encode-string
- (sasl-step-data step)
- 'no-line-break)
- "\"")))))
- (catch 'done
- (while t
- (setq rsp nil)
- (goto-char (point-min))
- (while (null (or (progn
- (setq rsp (sieve-manage-is-string))
- (if (not (and rsp (looking-at
- sieve-manage-server-eol)))
- (setq rsp nil)
- (goto-char (match-end 0))
- rsp))
- (setq rsp (sieve-manage-is-okno))))
- (accept-process-output sieve-manage-process 1)
- (goto-char (point-min)))
- (sieve-manage-erase)
- (when (sieve-manage-ok-p rsp)
- (when (string-match "^SASL \"\\([^\"]+\\)\"" (cadr rsp))
- (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)))
- ;; We got data for server but it's finished
- (error "Server not ready for SASL data: %s" data)
- ;; The authentication process is finished.
- (throw 'done t)))
- (unless (stringp rsp)
- (apply 'error "Server aborted SASL authentication: %s %s %s"
- rsp))
- (sasl-step-set-data step (base64-decode-string rsp))
- (setq step (sasl-next-step client step))
- (sieve-manage-send
- (if (sasl-step-data step)
- (concat "\""
- (base64-encode-string (sasl-step-data step)
- 'no-line-break)
- "\"")
- "")))))))
- (message "sieve: Authenticating using %s...done" mech)
- (message "sieve: Authenticating using %s...failed" mech)))
+ (with-current-buffer buffer
+ (let* ((user-password (auth-source-user-or-password
+ '("login" "password")
+ sieve-manage-server
+ "sieve" nil t))
+ (client (sasl-make-client (sasl-find-mechanism (list mech))
+ (car user-password) "sieve" sieve-manage-server))
+ (sasl-read-passphrase
+ ;; We *need* to copy the password, because sasl will modify it
+ ;; somehow.
+ `(lambda (prompt) ,(copy-sequence (cadr user-password))))
+ (step (sasl-next-step client nil))
+ (tag (sieve-manage-send
+ (concat
+ "AUTHENTICATE \""
+ mech
+ "\""
+ (and (sasl-step-data step)
+ (concat
+ " \""
+ (base64-encode-string
+ (sasl-step-data step)
+ 'no-line-break)
+ "\"")))))
+ data rsp)
+ (catch 'done
+ (while t
+ (setq rsp nil)
+ (goto-char (point-min))
+ (while (null (or (progn
+ (setq rsp (sieve-manage-is-string))
+ (if (not (and rsp (looking-at
+ sieve-manage-server-eol)))
+ (setq rsp nil)
+ (goto-char (match-end 0))
+ rsp))
+ (setq rsp (sieve-manage-is-okno))))
+ (accept-process-output sieve-manage-process 1)
+ (goto-char (point-min)))
+ (sieve-manage-erase)
+ (when (sieve-manage-ok-p rsp)
+ (when (and (cadr rsp)
+ (string-match "^SASL \"\\([^\"]+\\)\"" (cadr rsp)))
+ (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)))
+ ;; We got data for server but it's finished
+ (error "Server not ready for SASL data: %s" data)
+ ;; The authentication process is finished.
+ (throw 'done t)))
+ (unless (stringp rsp)
+ (error "Server aborted SASL authentication: %s" (caddr rsp)))
+ (sasl-step-set-data step (base64-decode-string rsp))
+ (setq step (sasl-next-step client step))
+ (sieve-manage-send
+ (if (sasl-step-data step)
+ (concat "\""
+ (base64-encode-string (sasl-step-data step)
+ 'no-line-break)
+ "\"")
+ ""))))
+ (message "sieve: Login using %s...done" mech))))
(defun sieve-manage-cram-md5-p (buffer)
(sieve-manage-capability "SASL" "CRAM-MD5" buffer))
(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-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-authenticator-alist)) buffer)
- (setq sieve-manage-state 'auth)))))
-
(defun sieve-manage-capability (&optional name value buffer)
"Check if capability NAME of server BUFFER match VALUE.
If it does, return the server value of NAME. If not returns nil.
projects / emacs.git / commitdiff