Check for all required fields

Check that all required fields are supplied when the keystone connection
is created.  If they aren't then signal an error.  Tenant-id and
tenant-name aren't required for authentication, they will only be passed
if they exist.

Change-Id: I3f7d26029cf2060deee91f97a5fc2c580f70aaff
This commit is contained in:
Russell Sim 2013-10-13 17:10:39 +11:00
parent 84e1783379
commit d475acbde1
2 changed files with 72 additions and 37 deletions

View File

@ -17,12 +17,41 @@
(defclass connection ()
((username :initarg :username :reader connection-username)
(tenant-id :initarg :tenant-id :initform nil :reader connection-tenant-id)
(tenant-name :initarg :tenant-name :initform nil :reader connection-tenant-name)
(password :initarg :password :reader connection-password)
((username :initarg :username
:reader connection-username
:initform (error ":USERNAME is required when creating a connection."))
(tenant-id :initarg :tenant-id
:reader connection-tenant-id)
(tenant-name :initarg :tenant-name
:reader connection-tenant-name)
(password :initarg :password
:initform (error ":PASSWORD is required when creating a connection.")
:reader connection-password)
(token :initarg :password)
(url :initarg :url :reader connection-url)))
(url :initarg :url
:reader connection-url
:initform (error ":URL is required when creating a connection."))))
(defmethod encode-json ((connection connection)
&optional (stream json:*json-output*))
"Write the JSON representation (Object) of the keystone CONNECTION
to STREAM (or to *JSON-OUTPUT*)."
(with-slots (username password) connection
(with-explicit-encoder
(encode-json
`(:object
:auth
(:object
:password-credentials
(:object
:username ,username
:password ,password)
,@(cond
((slot-boundp connection 'tenant-id)
(list :tenant-id (connection-tenant-id connection)))
((slot-boundp connection 'tenant-name)
(list :tenant-name (connection-tenant-name connection))))))
stream))))
(defclass connection-v2 (connection)
((version :initform 2 :reader connection-version)))
@ -66,35 +95,25 @@
(:documentation "Authenticate and retrieve a token."))
(defmethod authenticate ((connection connection-v2))
(with-slots (url token username password tenant-id tenant-name) connection
(unless (or tenant-id tenant-name)
(error "No tenant-id nor tenant-name specified, cannot authenticate."))
(let ((tenant-prop (if tenant-id
(list "tenantId" tenant-id)
(list "tenantName" tenant-name))))
(multiple-value-bind (body status-code headers uri stream must-close reason-phrase)
(http-request (format nil "~a/v2.0/tokens" url)
:method :POST
:want-stream t
:stream *cached-stream*
:content-type "application/json"
:content
(with-explicit-encoder
(encode-json-to-string
`(:object "auth" (:object "passwordCredentials"
(:object "username" ,username
"password" ,password)
,@tenant-prop)))))
(declare (ignore must-close reason-phrase body))
(cond
((and (eql status-code 200)
(json-response-p headers))
(setf token
(cdr (assoc :token (cdr (assoc :access (decode-json stream)))))))
((json-response-p headers)
(json-error (decode-json stream)))
(t
(unknown-error uri status-code)))))))
(with-slots (url token) connection
(multiple-value-bind (body status-code headers uri stream must-close reason-phrase)
(http-request (format nil "~a/v2.0/tokens" url)
:method :POST
:want-stream t
:stream *cached-stream*
:content-type "application/json"
:content
(encode-json-to-string connection))
(declare (ignore must-close reason-phrase body))
(cond
((and (eql status-code 200)
(json-response-p headers))
(setf token
(cdr (assoc :token (cdr (assoc :access (decode-json stream)))))))
((json-response-p headers)
(json-error (decode-json stream)))
(t
(unknown-error uri status-code))))))
(defgeneric connection-token-id (connection)
(:documentation "Retrieve token id for CONNECTION."))

View File

@ -17,7 +17,7 @@
(in-package :cl-keystone-client-test)
(def-suite keystone :description "My Example Suite")
(def-suite keystone :description "Test the Openstack Keystone client.")
(in-suite keystone)
@ -54,8 +54,24 @@
(coerce '(#\Return #\Linefeed) 'string)))))
(test make-connection
"Make a connection object"
(is-true (make-instance 'connection-v2)))
"Make a connection testing required fields."
(is-true
(make-instance 'connection-v2
:username "test"
:password "test"
:url "test"))
(signals error
(make-instance 'connection-v2
:password "test"
:url "test"))
(signals error
(make-instance 'connection-v2
:username "test"
:url "test"))
(signals error
(make-instance 'connection-v2
:username "test"
:password "test")))
(test authentication-error-404
"Test that the correct condition is signalled when a 404 is returned