* [PATCH 0/2] Simpler authentication with SASL
@ 2013-10-26 10:54 Albert Krewinkel
2013-10-26 10:54 ` [PATCH 1/2] sasl.el: simplify authentication with SASL, make code more lispy Albert Krewinkel
` (2 more replies)
0 siblings, 3 replies; 5+ messages in thread
From: Albert Krewinkel @ 2013-10-26 10:54 UTC (permalink / raw)
To: ding; +Cc: Albert Krewinkel
Hello,
even though gnus as an implementation of the SASL protocol, no part of
gnus other than managesieve makes use of it. A possible explanation
is that the current code is a transliteration of some Java program and
is rather awkward to use. This is an attempt to fix the situation.
SASL authenticating with the proposed code just requires three simple,
protocol specific functions. Sample usage of this method is
demonstrated in sieve-manage.el.
Please let me know what you think of the proposed changes. The
patches are also available at github (https://github.com/tarleb/gnus).
Cheers,
Albert
Albert Krewinkel (2):
sasl.el: simplify authentication with SASL, make code more lispy
sieve-manage.el: adapt sieve-manage to SASL simplification
lisp/ChangeLog | 34 +++
lisp/{sasl-cram.el => sasl-cram-md5.el} | 29 ++-
lisp/{sasl-digest.el => sasl-digest-md5.el} | 60 ++++--
lisp/sasl-ntlm.el | 24 +--
lisp/sasl.el | 312 ++++++++++++----------------
lisp/sieve-manage.el | 238 +++++++++------------
6 files changed, 323 insertions(+), 374 deletions(-)
rename lisp/{sasl-cram.el => sasl-cram-md5.el} (66%)
rename lisp/{sasl-digest.el => sasl-digest-md5.el} (74%)
--
1.8.4.rc3
^ permalink raw reply [flat|nested] 5+ messages in thread
* [PATCH 1/2] sasl.el: simplify authentication with SASL, make code more lispy
2013-10-26 10:54 [PATCH 0/2] Simpler authentication with SASL Albert Krewinkel
@ 2013-10-26 10:54 ` Albert Krewinkel
2013-10-26 10:54 ` [PATCH 2/2] sieve-manage.el: adapt sieve-manage to SASL simplification Albert Krewinkel
2013-10-28 7:02 ` [PATCH 0/2] Simpler authentication with SASL Daiki Ueno
2 siblings, 0 replies; 5+ messages in thread
From: Albert Krewinkel @ 2013-10-26 10:54 UTC (permalink / raw)
To: ding; +Cc: Albert Krewinkel
---
lisp/ChangeLog | 16 ++
lisp/{sasl-cram.el => sasl-cram-md5.el} | 29 ++-
lisp/{sasl-digest.el => sasl-digest-md5.el} | 60 ++++--
lisp/sasl-ntlm.el | 24 +--
lisp/sasl.el | 312 ++++++++++++----------------
5 files changed, 212 insertions(+), 229 deletions(-)
rename lisp/{sasl-cram.el => sasl-cram-md5.el} (66%)
rename lisp/{sasl-digest.el => sasl-digest-md5.el} (74%)
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index cf1d4ff..8cce6da 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,19 @@
+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.
+ (sasl-make-client, make-sasl-client): Later replaces the former.
+ (sasl-mechanisms): sasl-mechanisms now combines the functionality of
+ sasl-mechanisms and sasl-mechanisms-alist.
+ (sasl-mechanism-steps): Load authentication steps lazily.
+ (sasl-mechanisms-alist, sasl-make-mechanism, sasl-step-data)
+ (sasl-step-set-data,sasl-plain-steps,sasl-login-steps): Removed.
+ * sasl-cram.el: Rename to 'sasl-cram-md5.el', simplify challenge
+ handling.
+ * sasl-digest.el: Rename to 'sasl-digest-md5.el, simplify challenge
+ handling.
+
2013-10-23 Katsumi Yamaoka <yamaoka@jpl.org>
* mm-decode.el (mm-dissect-buffer): Revert last change.
diff --git a/lisp/sasl-cram.el b/lisp/sasl-cram-md5.el
similarity index 66%
rename from lisp/sasl-cram.el
rename to lisp/sasl-cram-md5.el
index 2a132a5..11d2bab 100644
--- a/lisp/sasl-cram.el
+++ b/lisp/sasl-cram-md5.el
@@ -27,23 +27,18 @@
(require 'sasl)
(require 'hmac-md5)
-(defconst sasl-cram-md5-steps
- '(ignore ;no initial response
- sasl-cram-md5-response))
-
-(defun sasl-cram-md5-response (client step)
- (let ((passphrase
- (sasl-read-passphrase
- (format "CRAM-MD5 passphrase for %s: "
- (sasl-client-name client)))))
- (unwind-protect
- (concat (sasl-client-name client) " "
- (encode-hex-string
- (hmac-md5 (sasl-step-data step) passphrase)))
- (fillarray passphrase 0))))
-
-(put 'sasl-cram 'sasl-mechanism
- (sasl-make-mechanism "CRAM-MD5" sasl-cram-md5-steps))
+(define-sasl-mechanism CRAM-MD5
+ (sasl-ignore ;no initial response
+ sasl-cram-md5-response))
+
+(defun sasl-cram-md5-response (client challenge)
+ (concat
+ (sasl-client-name client) " "
+ (encode-hex-string
+ (hmac-md5 challenge
+ (sasl-read-passphrase
+ (format "CRAM-MD5 passphrase for %s: "
+ (sasl-client-name client)))))))
(provide 'sasl-cram)
diff --git a/lisp/sasl-digest.el b/lisp/sasl-digest-md5.el
similarity index 74%
rename from lisp/sasl-digest.el
rename to lisp/sasl-digest-md5.el
index 6adbf44..9f38809 100644
--- a/lisp/sasl-digest.el
+++ b/lisp/sasl-digest-md5.el
@@ -31,15 +31,10 @@
;;
;; Passphrase should be longer than 16 bytes. (See RFC 2195)
-;;; Commentary:
(require 'sasl)
(require 'hmac-md5)
-(defvar sasl-digest-md5-nonce-count 1)
-(defvar sasl-digest-md5-unique-id-function
- sasl-unique-id-function)
-
(defvar sasl-digest-md5-syntax-table
(let ((table (make-syntax-table)))
(modify-syntax-entry ?= "." table)
@@ -47,10 +42,45 @@
table)
"A syntax table for parsing digest-challenge attributes.")
-(defconst sasl-digest-md5-steps
- '(ignore ;no initial response
- sasl-digest-md5-response
- ignore)) ;""
+
+(defvar sasl-digest-md5-nonce-count 1)
+(defvar sasl-digest-md5-unique-id-function
+ 'sasl-unique-id-function)
+(defvar sasl-unique-id-function 'sasl-unique-id-function)
+
+(defvar sasl-unique-id-char nil)
+
+;; stolen (and renamed) from message.el
+(defun sasl-unique-id-function ()
+ ;; Don't use microseconds from (current-time), they may be unsupported.
+ ;; Instead we use this randomly inited counter.
+ (setq sasl-unique-id-char
+ (% (1+ (or sasl-unique-id-char (logand (random) (1- (lsh 1 20)))))
+ ;; (current-time) returns 16-bit ints,
+ ;; and 2^16*25 just fits into 4 digits i base 36.
+ (* 25 25)))
+ (let ((tm (current-time)))
+ (concat
+ (sasl-unique-id-number-base36
+ (+ (car tm)
+ (lsh (% sasl-unique-id-char 25) 16)) 4)
+ (sasl-unique-id-number-base36
+ (+ (nth 1 tm)
+ (lsh (/ sasl-unique-id-char 25) 16)) 4))))
+
+(defun sasl-unique-id ()
+ "Compute a data string which must be different each time.
+It contain at least 64 bits of entropy."
+ (concat (funcall sasl-unique-id-function)(funcall sasl-unique-id-function)))
+
+(defun sasl-unique-id-number-base36 (num len)
+ (if (if (< len 0)
+ (<= num 0)
+ (= len 0))
+ ""
+ (concat (sasl-unique-id-number-base36 (/ num 36) (1- len))
+ (char-to-string (aref "zyxwvutsrqponmlkjihgfedcba9876543210"
+ (% num 36))))))
(defun sasl-digest-md5-parse-string (string)
"Parse STRING and return a property list.
@@ -109,9 +139,9 @@ charset algorithm cipher-opts auth-param)."
":00000000000000000000000000000000")))))))
(fillarray passphrase 0))))
-(defun sasl-digest-md5-response (client step)
+(defun sasl-digest-md5-response (client challenge)
(let* ((plist
- (sasl-digest-md5-parse-string (sasl-step-data step)))
+ (sasl-digest-md5-parse-string challenge))
(realm
(or (sasl-client-property client 'realm)
(plist-get plist 'realm))) ;need to check
@@ -149,9 +179,11 @@ charset algorithm cipher-opts auth-param)."
digest-uri
(plist-get plist 'authzid)))))
-(put 'sasl-digest 'sasl-mechanism
- (sasl-make-mechanism "DIGEST-MD5" sasl-digest-md5-steps))
+(define-sasl-mechanism DIGEST-MD5
+ (sasl-ignore ;no initial response
+ sasl-digest-md5-response
+ sasl-ignore))
-(provide 'sasl-digest)
+(provide 'sasl-digest-md5)
;;; sasl-digest.el ends here
diff --git a/lisp/sasl-ntlm.el b/lisp/sasl-ntlm.el
index 487a1d0..f16f693 100644
--- a/lisp/sasl-ntlm.el
+++ b/lisp/sasl-ntlm.el
@@ -33,14 +33,12 @@
(require 'sasl)
(require 'ntlm)
-(defconst sasl-ntlm-steps
- '(ignore ;nothing to do before making
- sasl-ntlm-request ;authentication request
- sasl-ntlm-response) ;response to challenge
- "A list of functions to be called in sequence for the NTLM
-authentication steps. They are called by `sasl-next-step'.")
+(define-sasl-mechanism NTLM
+ (sasl-ignore ;nothing to do before making
+ sasl-ntlm-request ;authentication request
+ sasl-ntlm-response)) ;response to challenge
-(defun sasl-ntlm-request (client step)
+(defun sasl-ntlm-request (client challenge)
"SASL step function to generate a NTLM authentication request to the server.
Called from `sasl-next-step'.
CLIENT is a vector [mechanism user service server sasl-client-properties]
@@ -48,19 +46,15 @@ STEP is a vector [<previous step function> <result of previous step function>]"
(let ((user (sasl-client-name client)))
(ntlm-build-auth-request user)))
-(defun sasl-ntlm-response (client step)
- "SASL step function to generate a NTLM response against the server
-challenge stored in the 2nd element of STEP. Called from `sasl-next-step'."
+(defun sasl-ntlm-response (client challenge)
+ "SASL step function to generate a NTLM response against the
+server `challenge'."
(let* ((user (sasl-client-name client))
(passphrase
- (sasl-read-passphrase (format "NTLM passphrase for %s: " user)))
- (challenge (sasl-step-data step)))
+ (sasl-read-passphrase (format "NTLM passphrase for %s: " user))))
(ntlm-build-auth-response challenge user
(ntlm-get-password-hashes passphrase))))
-(put 'sasl-ntlm 'sasl-mechanism
- (sasl-make-mechanism "NTLM" sasl-ntlm-steps))
-
(provide 'sasl-ntlm)
;;; sasl-ntlm.el ends here
diff --git a/lisp/sasl.el b/lisp/sasl.el
index a5efdd6..5fd94b1 100644
--- a/lisp/sasl.el
+++ b/lisp/sasl.el
@@ -3,6 +3,7 @@
;; Copyright (C) 2000, 2007-2013 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
+;; Albert Krewinkel <tarleb@moltkeplatz.de>
;; Keywords: SASL
;; This file is part of GNU Emacs.
@@ -34,237 +35,182 @@
;;; Code:
-(defvar sasl-mechanisms
- '("CRAM-MD5" "DIGEST-MD5" "PLAIN" "LOGIN" "ANONYMOUS"
- "NTLM" "SCRAM-MD5"))
+(eval-when-compile (require 'cl))
+(require 'hmac-md5)
-(defvar sasl-mechanism-alist
- '(("CRAM-MD5" sasl-cram)
- ("DIGEST-MD5" sasl-digest)
- ("PLAIN" sasl-plain)
- ("LOGIN" sasl-login)
- ("ANONYMOUS" sasl-anonymous)
- ("NTLM" sasl-ntlm)
- ("SCRAM-MD5" sasl-scram)))
+(defvar sasl-mechanisms '((PLAIN) (LOGIN) (DIGEST-MD5) (CRAM-MD5) (NTLM))
+ "Associative list of known SASL mechanisms and their respective steps.
-(defvar sasl-unique-id-function #'sasl-unique-id-function)
+If the list of steps of a mechanism is empty, the respective
+package `sasl-mech' should be required (replace 'mech' with the
+lower-case mechanism name.")
+
+;; SASL Error
(put 'sasl-error 'error-message "SASL error")
(put 'sasl-error 'error-conditions '(sasl-error error))
-
(defun sasl-error (datum)
(signal 'sasl-error (list datum)))
+
;;; @ SASL client
;;;
-(defun sasl-make-client (mechanism name service server)
- "Return a newly allocated SASL client.
-NAME is name of the authorization. SERVICE is name of the service desired.
-SERVER is the fully qualified host name of the server to authenticate to."
- (vector mechanism name service server (make-symbol "sasl-client-properties")))
-
-(defun sasl-client-mechanism (client)
- "Return the authentication mechanism driver of CLIENT."
- (aref client 0))
-
-(defun sasl-client-name (client)
- "Return the authorization name of CLIENT, a string."
- (aref client 1))
-
-(defun sasl-client-service (client)
- "Return the service name of CLIENT, a string."
- (aref client 2))
-
-(defun sasl-client-server (client)
- "Return the server name of CLIENT, a string."
- (aref client 3))
-
-(defun sasl-client-set-properties (client plist)
- "Destructively set the properties of CLIENT.
-The second argument PLIST is the new property list."
- (setplist (aref client 4) plist))
+;; A SASL client. `mechanism' and `name' are the SASL mechanism and the name
+;; used for authentication, respectively. `service' is name of the service
+;; desired. `server' is the fully qualified host name of the server to
+;; authenticate to. Additional information, like the name used for
+;; authorization, are safed in `properties' in form of a plist.
+(defstruct sasl-client
+ mechanism
+ name
+ service
+ server
+ properties)
(defun sasl-client-set-property (client property value)
"Add the given PROPERTY/VALUE to CLIENT."
- (put (aref client 4) property value))
+ (put (sasl-client-properties client) property value))
(defun sasl-client-property (client property)
"Return the value of the PROPERTY of CLIENT."
- (get (aref client 4) property))
-
-(defun sasl-client-properties (client)
- "Return the properties of CLIENT."
- (symbol-plist (aref client 4)))
+ (get (sasl-client-properties client) property))
;;; @ SASL mechanism
;;;
-
-(defun sasl-make-mechanism (name steps)
- "Make an authentication mechanism.
+(defmacro define-sasl-mechanism (name steps &optional provide)
+ "Register an authentication mechanism, safe in `sasl-mechanisms'.
NAME is a IANA registered SASL mechanism name.
-STEPS is list of continuation functions."
- (vector name
- (mapcar
- (lambda (step)
- (let ((symbol (make-symbol (symbol-name step))))
- (fset symbol (symbol-function step))
- symbol))
- steps)))
+STEPS is a list of continuation functions."
+ `(progn
+ (if (assoc ',name sasl-mechanisms)
+ (setf (cdr (assoc ',name sasl-mechanisms)) ',steps)
+ (add-to-list 'sasl-mechanisms (cons ',name ',steps) 'append))
+ ,(when provide
+ `(provide (intern (concat "sasl-" (downcase (symbol-name ',name))))))))
+
+(defun sasl-mechanism (mechanism-identifier)
+ "Get the mechanism identified by `mechanism-identifier'."
+ (assoc (if (stringp mechanism-identifier)
+ (intern (upcase mechanism-identifier))
+ mechanism-identifier)
+ sasl-mechanisms))
(defun sasl-mechanism-name (mechanism)
"Return name of MECHANISM, a string."
- (aref mechanism 0))
+ (symbol-name (car mechanism)))
(defun sasl-mechanism-steps (mechanism)
"Return the authentication steps of MECHANISM, a list of functions."
- (aref mechanism 1))
-
-(defun sasl-find-mechanism (mechanisms)
- "Retrieve an appropriate mechanism object from MECHANISMS hints."
- (let* ((sasl-mechanisms sasl-mechanisms)
- (mechanism
- (catch 'done
- (while sasl-mechanisms
- (if (member (car sasl-mechanisms) mechanisms)
- (throw 'done (nth 1 (assoc (car sasl-mechanisms)
- sasl-mechanism-alist))))
- (setq sasl-mechanisms (cdr sasl-mechanisms))))))
- (if mechanism
- (require mechanism))
- (get mechanism 'sasl-mechanism)))
-
-;;; @ SASL authentication step
-;;;
+ (require
+ (intern (concat "sasl-" (downcase (sasl-mechanism-name mechanism)))))
+ (cdr mechanism))
-(defun sasl-step-data (step)
- "Return the data which STEP holds, a string."
- (aref step 1))
-
-(defun sasl-step-set-data (step data)
- "Store DATA string to STEP."
- (aset step 1 data))
-
-(defun sasl-next-step (client step)
- "Evaluate the challenge and prepare an appropriate next response.
-The data type of the value and 2nd argument STEP is nil or opaque
-authentication step which holds the reference to the next action and
-the current challenge. At the first time STEP should be set to nil."
- (let* ((steps
- (sasl-mechanism-steps
- (sasl-client-mechanism client)))
- (function
- (if (vectorp step)
- (nth 1 (memq (aref step 0) steps))
- (car steps))))
- (if function
- (vector function (funcall function client step)))))
+(defun sasl-supported-mechanisms (acceptable)
+ "Return the intersection of supported and `acceptable' SASL mechanisms."
+ (remove nil (mapcar 'sasl-mechanism acceptable)))
+(defun sasl-find-mechanism (preferred-mechanisms)
+ "Retrieve the best available from a list of `preferred-mechanisms'."
+ (let ((mechanism (car (sasl-supported-mechanisms preferred-mechanisms))))
+ mechanism))
+
+
+;;; Utility Functions
+;;;
(defvar sasl-read-passphrase nil)
(defun sasl-read-passphrase (prompt)
- (if (not sasl-read-passphrase)
- (if (functionp 'read-passwd)
- (setq sasl-read-passphrase 'read-passwd)
- (if (load "passwd" t)
- (setq sasl-read-passphrase 'read-passwd)
- (autoload 'ange-ftp-read-passwd "ange-ftp")
- (setq sasl-read-passphrase 'ange-ftp-read-passwd))))
- (funcall sasl-read-passphrase prompt))
-
-(defun sasl-unique-id ()
- "Compute a data string which must be different each time.
-It contain at least 64 bits of entropy."
- (concat (funcall sasl-unique-id-function)(funcall sasl-unique-id-function)))
-
-(defvar sasl-unique-id-char nil)
-
-;; stolen (and renamed) from message.el
-(defun sasl-unique-id-function ()
- ;; Don't use microseconds from (current-time), they may be unsupported.
- ;; Instead we use this randomly inited counter.
- (setq sasl-unique-id-char
- (% (1+ (or sasl-unique-id-char (logand (random) (1- (lsh 1 20)))))
- ;; (current-time) returns 16-bit ints,
- ;; and 2^16*25 just fits into 4 digits i base 36.
- (* 25 25)))
- (let ((tm (current-time)))
- (concat
- (sasl-unique-id-number-base36
- (+ (car tm)
- (lsh (% sasl-unique-id-char 25) 16)) 4)
- (sasl-unique-id-number-base36
- (+ (nth 1 tm)
- (lsh (/ sasl-unique-id-char 25) 16)) 4))))
-
-(defun sasl-unique-id-number-base36 (num len)
- (if (if (< len 0)
- (<= num 0)
- (= len 0))
- ""
- (concat (sasl-unique-id-number-base36 (/ num 36) (1- len))
- (char-to-string (aref "zyxwvutsrqponmlkjihgfedcba9876543210"
- (% num 36))))))
+ (funcall (or sasl-read-passphrase 'passwd) prompt))
+
+(defun sasl-chain-steps (client steps chaining-fn &optional initial-challenge)
+ "Chain the SASL mechanism `steps' together using `chaining-fn'."
+ (let ((challenge initial-challenge))
+ (dolist (step steps)
+ (print step)
+ (setf challenge (funcall chaining-fn (funcall step client challenge))))))
+
+(defun* sasl-authenticate (name password mechanisms server service &rest spec
+ &key send-response
+ send-initial-response
+ receive-challenge
+ &allow-other-keys)
+ "Authenticate `name' against `server' for `service'.
+The first SASL mechanism, which is both supported and in
+`mechanisms', is used to authenticate the user. The list
+`mechanisms' should therefor be ordered by preference (highest
+preference first).
+
+The keyword arguments all are functions specifying the protocol
+specific parts of a SASL exchange. `send-initial-response' takes
+a `sasl-client' and the initial response and sends it to the
+server. `send-response' has the same arguments list, but is used
+for consequential responses. `receive-challenge' is an
+argument-less function returning the servers challenge/result.
+
+Error handling is the responsibility of the supplied functions
+and/or the calling function."
+ (let* ((mech (sasl-find-mechanism mechanisms))
+ (client (make-sasl-client :mechanism mech :name name
+ :service service
+ :server server
+ :properties nil))
+ (steps (sasl-mechanism-steps mech))
+ (sasl-read-passphrase (when password `(lambda (x) ,password))))
+ (let ((chaining-function
+ (lambda (response)
+ (funcall receive-challenge
+ (funcall send-response client response)))))
+ (sasl-chain-steps client (cdr steps) chaining-function
+ (funcall send-initial-response client
+ (funcall (car steps) client nil)))
+ (funcall receive-challenge))))
+
;;; PLAIN (RFC2595 Section 6)
-(defconst sasl-plain-steps
- '(sasl-plain-response))
-
-(defun sasl-plain-response (client step)
- (let ((passphrase
- (sasl-read-passphrase
- (format "PLAIN passphrase for %s: " (sasl-client-name client))))
- (authenticator-name
- (sasl-client-property
- client 'authenticator-name))
- (name (sasl-client-name client)))
- (unwind-protect
- (if (and authenticator-name
- (not (string= authenticator-name name)))
- (concat authenticator-name "\0" name "\0" passphrase)
- (concat "\0" name "\0" passphrase))
- (fillarray passphrase 0))))
-
-(put 'sasl-plain 'sasl-mechanism
- (sasl-make-mechanism "PLAIN" sasl-plain-steps))
-
-(provide 'sasl-plain)
+;;;
+(defun sasl-plain-response (client challenge)
+ (let ((passphrase-fn
+ (lambda ()
+ (sasl-read-passphrase
+ (format "PLAIN passphrase for %s: " (sasl-client-name client))))))
+ (let ((authenticator-name (sasl-client-property client 'authenticator-name))
+ (name (sasl-client-name client)))
+ (if (and authenticator-name
+ (not (string= authenticator-name name)))
+ (concat authenticator-name "\0" name "\0" (funcall passphrase-fn))
+ (concat "\0" name "\0" (funcall passphrase-fn))))))
+
+(define-sasl-mechanism PLAIN
+ (sasl-plain-response)
+ t)
+
;;; LOGIN (No specification exists)
-(defconst sasl-login-steps
- '(ignore ;no initial response
- sasl-login-response-1
- sasl-login-response-2))
-
-(defun sasl-login-response-1 (client step)
-;;; (unless (string-match "^Username:" (sasl-step-data step))
-;;; (sasl-error (format "Unexpected response: %s" (sasl-step-data step))))
+;;;
+(defun sasl-login-response-1 (client challenge)
(sasl-client-name client))
(defun sasl-login-response-2 (client step)
-;;; (unless (string-match "^Password:" (sasl-step-data step))
-;;; (sasl-error (format "Unexpected response: %s" (sasl-step-data step))))
(sasl-read-passphrase
(format "LOGIN passphrase for %s: " (sasl-client-name client))))
-(put 'sasl-login 'sasl-mechanism
- (sasl-make-mechanism "LOGIN" sasl-login-steps))
+(define-sasl-mechanism LOGIN
+ (sasl-ignore
+ sasl-login-response-1
+ sasl-login-response-2)
+ t)
-(provide 'sasl-login)
;;; ANONYMOUS (RFC2245)
-(defconst sasl-anonymous-steps
- '(ignore ;no initial response
- sasl-anonymous-response))
-
+;;;
(defun sasl-anonymous-response (client step)
(or (sasl-client-property client 'trace)
(sasl-client-name client)))
-(put 'sasl-anonymous 'sasl-mechanism
- (sasl-make-mechanism "ANONYMOUS" sasl-anonymous-steps))
-
-(provide 'sasl-anonymous)
+(define-sasl-mechanism ANONYMOUS
+ (sasl-ignore
+ sasl-anonymous-response)
+ t)
(provide 'sasl)
-
;;; sasl.el ends here
--
1.8.4.rc3
^ permalink raw reply [flat|nested] 5+ messages in thread
* [PATCH 2/2] sieve-manage.el: adapt sieve-manage to SASL simplification
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
2013-10-28 7:02 ` [PATCH 0/2] Simpler authentication with SASL Daiki Ueno
2 siblings, 0 replies; 5+ messages in thread
From: Albert Krewinkel @ 2013-10-26 10:54 UTC (permalink / raw)
To: ding; +Cc: Albert Krewinkel
---
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
^ permalink raw reply [flat|nested] 5+ messages in thread
* Re: [PATCH 0/2] Simpler authentication with SASL
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 ` [PATCH 2/2] sieve-manage.el: adapt sieve-manage to SASL simplification Albert Krewinkel
@ 2013-10-28 7:02 ` Daiki Ueno
2013-10-29 14:21 ` Albert Krewinkel
2 siblings, 1 reply; 5+ messages in thread
From: Daiki Ueno @ 2013-10-28 7:02 UTC (permalink / raw)
To: Albert Krewinkel; +Cc: ding
Albert Krewinkel <tarleb@moltkeplatz.de> writes:
> Please let me know what you think of the proposed changes. The
> patches are also available at github (https://github.com/tarleb/gnus).
Thanks for the patches. However, as sasl.el is also distributed as part
of Emacs (under lisp/net/), you can't simply rename the API functions.
Also, the 1/2 patch looks too large to review.
I'd suggest to work with Emacs rather than Gnus and do the things step
by step:
(1) write unit tests so not to break the core functionality
(2) refactor the code (without breaking the API), say, using
cl-defstruct; you can rename the constructor with :constructor
keyword
(3) add handy helper functions e.g. sasl-authenticate
Regards,
--
Daiki Ueno
^ permalink raw reply [flat|nested] 5+ messages in thread
* Re: [PATCH 0/2] Simpler authentication with SASL
2013-10-28 7:02 ` [PATCH 0/2] Simpler authentication with SASL Daiki Ueno
@ 2013-10-29 14:21 ` Albert Krewinkel
0 siblings, 0 replies; 5+ messages in thread
From: Albert Krewinkel @ 2013-10-29 14:21 UTC (permalink / raw)
To: Daiki Ueno; +Cc: ding
Thank you for your answer!
Daiki Ueno <ueno@gnu.org> writes:
> Thanks for the patches. However, as sasl.el is also distributed as part
> of Emacs (under lisp/net/), you can't simply rename the API functions.
Ah yes, I should have thought of that. Some quick searching reveals
that there are programs (e.g. the emacs jabber library) which rely on
the current SASL API. I'm going to prepare a new patch with smaller,
non-API-breaking changes.
> Also, the 1/2 patch looks too large to review.
>
> I'd suggest to work with Emacs rather than Gnus and do the things step
> by step:
>
> (1) write unit tests so not to break the core functionality
>
> (2) refactor the code (without breaking the API), say, using
> cl-defstruct; you can rename the constructor with :constructor
> keyword
>
> (3) add handy helper functions e.g. sasl-authenticate
That sounds reasonable, I will follow that path.
Thanks
--
Albert Krewinkel
PGP: ffb8 abfa 1fd7 dbd8 b608 c980 836b e330 4b5b 9312
^ permalink raw reply [flat|nested] 5+ messages in thread
end of thread, other threads:[~2013-10-29 14:21 UTC | newest]
Thread overview: 5+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
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 ` [PATCH 2/2] sieve-manage.el: adapt sieve-manage to SASL simplification Albert Krewinkel
2013-10-28 7:02 ` [PATCH 0/2] Simpler authentication with SASL Daiki Ueno
2013-10-29 14:21 ` Albert Krewinkel
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).