From: Albert Krewinkel <tarleb@moltkeplatz.de>
To: ding@gnus.org
Cc: Albert Krewinkel <tarleb@moltkeplatz.de>
Subject: [PATCH 2/2] sieve-manage.el: adapt sieve-manage to SASL simplification
Date: Sat, 26 Oct 2013 12:54:41 +0200 [thread overview]
Message-ID: <1382784881-16736-3-git-send-email-tarleb@moltkeplatz.de> (raw)
In-Reply-To: <1382784881-16736-1-git-send-email-tarleb@moltkeplatz.de>
---
lisp/ChangeLog | 18 ++++
lisp/sieve-manage.el | 238 ++++++++++++++++++++-------------------------------
2 files changed, 111 insertions(+), 145 deletions(-)
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 8cce6da..2aa0fc4 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,23 @@
2013-10-26 Albert Krewinkel <tarleb@moltkeplatz.de>
+ * sieve-manage.el (sieve-sasl-auth): Use new sasl-authenticate
+ function.
+ (sieve-auth-credentials, sieve-sasl-initial-response)
+ (sieve-sasl-send-response, sieve-sasl-result-data)
+ (sieve-sasl-receive-result, sieve-manage-read-auth-response) : New
+ functions used by sieve-sasl-auth.
+ (sieve-manage-authenticator-alist)
+ (sieve-manage-cram-md5-p, sieve-manage-cram-md5-auth)
+ (sieve-manage-digest-md5-p, sieve-manage-digest-md5-auth)
+ (sieve-manage-scram-md5-p, sieve-manage-scram-md5-auth)
+ (sieve-manage-ntlm-p, sieve-manage-ntlm-auth, sieve-manage-plain-p)
+ (sieve-manage-plain-auth, sieve-manage-login-p)
+ (sieve-manage-login-auth): Remove.
+ (sieve-manage-open, sieve-manage-authenticate): Small fixes to make
+ things work with the new code.
+
+2013-10-26 Albert Krewinkel <tarleb@moltkeplatz.de>
+
* sasl.el (sasl-authenticate): New function for simpler inclusion of
SASL authentiction in protocols.
(define-sasl-mechanism): New method to register a SASL mechanism.
diff --git a/lisp/sieve-manage.el b/lisp/sieve-manage.el
index 4221276..cc5489d 100644
--- a/lisp/sieve-manage.el
+++ b/lisp/sieve-manage.el
@@ -43,6 +43,9 @@
;; `sieve-manage-close'
;; close a server connection.
;;
+;; `sieve-manage-authenticate'
+;; authenticate to the server using SASL
+;;
;; `sieve-manage-listscripts'
;; `sieve-manage-deletescript'
;; `sieve-manage-getscript'
@@ -81,9 +84,8 @@
(eval-when-compile
(require 'cl) ; caddr
- (require 'sasl)
(require 'starttls))
-(autoload 'sasl-find-mechanism "sasl")
+(require 'sasl)
(autoload 'auth-source-search "auth-source")
;; User customizable variables:
@@ -108,31 +110,15 @@
:type 'string
:group 'sieve-manage)
-(defcustom sieve-manage-authenticators '(digest-md5
- cram-md5
- scram-md5
- ntlm
- plain
- login)
+(defcustom sieve-manage-authenticators '(DIGEST-MD5
+ CRAM-MD5
+ SCRAM-MD5
+ NTLM
+ PLAIN
+ LOGIN)
"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)
- (digest-md5 sieve-manage-digest-md5-p sieve-manage-digest-md5-auth)
- (scram-md5 sieve-manage-scram-md5-p sieve-manage-scram-md5-auth)
- (ntlm sieve-manage-ntlm-p sieve-manage-ntlm-auth)
- (plain sieve-manage-plain-p sieve-manage-plain-auth)
- (login sieve-manage-login-p sieve-manage-login-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 actual authentication."
- :group 'sieve-manage)
-
(defcustom sieve-manage-default-port "sieve"
"Default port number or service name for managesieve protocol."
:type '(choice integer string)
@@ -220,122 +206,87 @@ Return the buffer associated with the connection."
(sieve-manage-drop-next-answer))
(current-buffer))))
+
+;;; SASL Authentication
+;;; ;;;;;;;;;;;;;;;;;;;
+
+(defun sieve-auth-credentials ()
+ "Get the user credentials in form of a `(user . passwd)' cons."
+ (let ((auth-info (car (auth-source-search :host sieve-manage-server
+ :port "sieve"
+ :max 1
+ :create t))))
+ (let ((user (or (plist-get auth-info :user) ""))
+ (secret (or (plist-get auth-info :secret) "")))
+ (cons user
+ ;; `secret' can be a function, but we want a (fresh) string
+ (copy-sequence (if (functionp secret)
+ (funcall secret)
+ secret))))))
+
+(defun sieve-sasl-initial-response (client data)
+ "Send the initial SASL response.
+Sending this command signals the begin of the SASL authentication
+process."
+ (flet ((quote-string (str)
+ (if (null str) "" (format "\"%s\"" str))))
+ (let ((authstr (quote-string
+ (and data (base64-encode-string data 'no-line-break))))
+ (mechstr (quote-string
+ (sasl-mechanism-name (sasl-client-mechanism client)))))
+ (sieve-manage-send (format "AUTHENTICATE %s %s" mechstr authstr)))))
+
+(defun sieve-sasl-send-response (rsp)
+ "Send the response to a SASL challenge"
+ (sieve-manage-send
+ (if (null rsp) "\"\"" (format "\"%s\"" (base64-encode-string rsp t)))))
+
+(defun sieve-sasl-result-data (response)
+ (when response
+ (string-match "^SASL \"\\([^\"]+\\)\"" response)
+ (base64-decode-string (match-string 1 response))))
+
+(defun sieve-sasl-receive-result ()
+ (let ((response (sieve-manage-read-auth-response)))
+ (if (listp response)
+ (if (sieve-manage-ok-p response)
+ (sieve-sasl-result-data (cadr response))
+ (error "SASL authentication failed: %s" (caddr response)))
+ response)))
+
;; Authenticators
-(defun sieve-sasl-auth (buffer mech)
- "Login to server using the SASL MECH method."
- (message "sieve: Authenticating using %s..." mech)
+(defun sieve-sasl-auth (buffer mechanism)
+ "Login to server using the given SASL `mechanism'."
+ (message "sieve: Authenticating using SASL %s..." mechanism)
(with-current-buffer buffer
- (let* ((auth-info (auth-source-search :host sieve-manage-server
- :port "sieve"
- :max 1
- :create t))
- (user-name (or (plist-get (nth 0 auth-info) :user) ""))
- (user-password (or (plist-get (nth 0 auth-info) :secret) ""))
- (user-password (if (functionp user-password)
- (funcall user-password)
- user-password))
- (client (sasl-make-client (sasl-find-mechanism (list mech))
- user-name "sieve" sieve-manage-server))
- (sasl-read-passphrase
- ;; We *need* to copy the password, because sasl will modify it
- ;; somehow.
- `(lambda (prompt) ,(copy-sequence 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))
-
-(defun sieve-manage-cram-md5-auth (buffer)
- "Login to managesieve server using the CRAM-MD5 SASL method."
- (sieve-sasl-auth buffer "CRAM-MD5"))
-
-(defun sieve-manage-digest-md5-p (buffer)
- (sieve-manage-capability "SASL" "DIGEST-MD5" buffer))
-
-(defun sieve-manage-digest-md5-auth (buffer)
- "Login to managesieve server using the DIGEST-MD5 SASL method."
- (sieve-sasl-auth buffer "DIGEST-MD5"))
-
-(defun sieve-manage-scram-md5-p (buffer)
- (sieve-manage-capability "SASL" "SCRAM-MD5" buffer))
-
-(defun sieve-manage-scram-md5-auth (buffer)
- "Login to managesieve server using the SCRAM-MD5 SASL method."
- (sieve-sasl-auth buffer "SCRAM-MD5"))
-
-(defun sieve-manage-ntlm-p (buffer)
- (sieve-manage-capability "SASL" "NTLM" buffer))
-
-(defun sieve-manage-ntlm-auth (buffer)
- "Login to managesieve server using the NTLM SASL method."
- (sieve-sasl-auth buffer "NTLM"))
-
-(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."
- (sieve-sasl-auth buffer "PLAIN"))
-
-(defun sieve-manage-login-p (buffer)
- (sieve-manage-capability "SASL" "LOGIN" buffer))
-
-(defun sieve-manage-login-auth (buffer)
- "Login to managesieve server using the LOGIN SASL method."
- (sieve-sasl-auth buffer "LOGIN"))
-
-;; Managesieve API
+ (let ((creds (sieve-auth-credentials)))
+ (sasl-authenticate (car creds) (cdr creds)
+ (list mechanism)
+ sieve-manage-server
+ "sieve"
+ :send-response 'sieve-sasl-send-response
+ :send-initial-response 'sieve-sasl-initial-response
+ :receive-challenge 'sieve-sasl-receive-result))
+ (message "sieve: Authenticating using SASL %s...done" mechanism)))
+
+(defun sieve-manage-read-auth-response ()
+ (let (rsp)
+ (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)
+ rsp))
+
+
+;;; Managesieve API
+;;; ===============
(defun sieve-manage-open (server &optional port stream auth buffer)
"Open a network connection to a managesieve SERVER (string).
@@ -364,10 +315,9 @@ to work in."
;; Choose authenticator
(when (and (null sieve-manage-auth)
(not (eq sieve-manage-state 'auth)))
- (dolist (auth sieve-manage-authenticators)
- (when (funcall (nth 1 (assq auth sieve-manage-authenticator-alist))
- buffer)
- (setq sieve-manage-auth auth)
+ (dolist (auth (mapcar 'symbol-name sieve-manage-authenticators))
+ (when (sieve-manage-capability "SASL" auth (current-buffer))
+ (setq sieve-manage-auth (intern auth))
(return)))
(unless sieve-manage-auth
(error "Couldn't figure out authenticator for server")))
@@ -379,9 +329,7 @@ to work in."
Return `sieve-manage-state' value."
(with-current-buffer (or buffer (current-buffer))
(if (eq sieve-manage-state 'nonauth)
- (when (funcall (nth 2 (assq sieve-manage-auth
- sieve-manage-authenticator-alist))
- (current-buffer))
+ (when (sieve-sasl-auth (current-buffer) sieve-manage-auth)
(setq sieve-manage-state 'auth))
sieve-manage-state)))
--
1.8.4.rc3
next prev parent reply other threads:[~2013-10-26 10:54 UTC|newest]
Thread overview: 5+ messages / expand[flat|nested] mbox.gz Atom feed top
2013-10-26 10:54 [PATCH 0/2] Simpler authentication with SASL Albert Krewinkel
2013-10-26 10:54 ` [PATCH 1/2] sasl.el: simplify authentication with SASL, make code more lispy Albert Krewinkel
2013-10-26 10:54 ` Albert Krewinkel [this message]
2013-10-28 7:02 ` [PATCH 0/2] Simpler authentication with SASL Daiki Ueno
2013-10-29 14:21 ` Albert Krewinkel
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=1382784881-16736-3-git-send-email-tarleb@moltkeplatz.de \
--to=tarleb@moltkeplatz.de \
--cc=ding@gnus.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for NNTP newsgroup(s).