From mboxrd@z Thu Jan 1 00:00:00 1970 X-Msuck: nntp://news.gmane.io/gmane.emacs.gnus.general/83819 Path: news.gmane.org!not-for-mail From: Albert Krewinkel Newsgroups: gmane.emacs.gnus.general Subject: [PATCH 2/2] sieve-manage.el: adapt sieve-manage to SASL simplification Date: Sat, 26 Oct 2013 12:54:41 +0200 Message-ID: <1382784881-16736-3-git-send-email-tarleb@moltkeplatz.de> References: <1382784881-16736-1-git-send-email-tarleb@moltkeplatz.de> NNTP-Posting-Host: plane.gmane.org X-Trace: ger.gmane.org 1382802137 15035 80.91.229.3 (26 Oct 2013 15:42:17 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Sat, 26 Oct 2013 15:42:17 +0000 (UTC) Cc: Albert Krewinkel To: ding@gnus.org Original-X-From: ding-owner+M32076@lists.math.uh.edu Sat Oct 26 17:42:20 2013 Return-path: Envelope-to: ding-account@gmane.org Original-Received: from util0.math.uh.edu ([129.7.128.18]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1Va60J-0004LC-RC for ding-account@gmane.org; Sat, 26 Oct 2013 17:42:20 +0200 Original-Received: from localhost ([127.0.0.1] helo=lists.math.uh.edu) by util0.math.uh.edu with smtp (Exim 4.63) (envelope-from ) id 1Va5zd-0001pE-8U; Sat, 26 Oct 2013 10:41:37 -0500 Original-Received: from mx1.math.uh.edu ([129.7.128.32]) by util0.math.uh.edu with esmtps (TLSv1:AES256-SHA:256) (Exim 4.63) (envelope-from ) id 1Va1Wa-0000fn-2g for ding@lists.math.uh.edu; Sat, 26 Oct 2013 05:55:20 -0500 Original-Received: from quimby.gnus.org ([80.91.231.51]) by mx1.math.uh.edu with esmtps (TLSv1:AES128-SHA:128) (Exim 4.76) (envelope-from ) id 1Va1WY-0007Kh-2O for ding@lists.math.uh.edu; Sat, 26 Oct 2013 05:55:20 -0500 Original-Received: from moltkeplatz.de ([85.214.95.47]) by quimby.gnus.org with esmtp (Exim 4.80) (envelope-from ) id 1Va1WW-0000aM-KY for ding@gnus.org; Sat, 26 Oct 2013 12:55:16 +0200 Original-Received: from caffelatte.fritz.box (dslb-178-003-097-186.pools.arcor-ip.net [178.3.97.186]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by moltkeplatz.de (Postfix) with ESMTPSA id C2B8D3200003; Sat, 26 Oct 2013 12:55:15 +0200 (CEST) X-Mailer: git-send-email 1.8.4.rc3 In-Reply-To: <1382784881-16736-1-git-send-email-tarleb@moltkeplatz.de> X-Spam-Score: -2.3 (--) List-ID: Precedence: bulk Xref: news.gmane.org gmane.emacs.gnus.general:83819 Archived-At: --- 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 + * 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 + * 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