From ac2369bd6f7c55448f2925148db6b09394f90c56 Mon Sep 17 00:00:00 2001 From: Russell Sim Date: Tue, 29 Oct 2013 09:13:45 +1100 Subject: [PATCH] Added connection-tenant method A new method connection-tenant, returns the connections tenant as an object. This commit also fixes some problems with the keystone authentication function and adds more test coverage. Change-Id: I9b753a7c6e68be45cf1797e5966ac1ff2e2fca2f --- keystone.lisp | 33 ++++++++++++++++++++++---- tests/keystone.lisp | 58 ++++++++++++++++++++++++++++++++++++++++++++- 2 files changed, 85 insertions(+), 6 deletions(-) diff --git a/keystone.lisp b/keystone.lisp index 92bcb44..c3539e7 100644 --- a/keystone.lisp +++ b/keystone.lisp @@ -46,14 +46,30 @@ connection-token-expires connection-token-issued-at connection-token-valid-p + connection-tenant + connection-service-catalog + + ;; Resource Methods resource-id resource-name resource-connection + resource-description + + ;; Resource Slots + id + name + enabled + description + + ;; Tenant Methods + tenant tenant-id tenant-name tenant-enabled tenant-description list-tenants + + ;; User Methods user-id user-name user-tenant @@ -64,6 +80,8 @@ get-user delete-user list-users + + ;; Role Methods role-id role-name role-enabled @@ -87,9 +105,8 @@ (endpoint :initarg :endpoint :initform :public-url :reader connection-endpoint) - (token :initarg :password) + (token) (user) - (tenant) (metadata) (service-catalog :reader connection-service-catalog) (url :initarg :url @@ -160,7 +177,7 @@ with underscores to hyphens." (:documentation "Authenticate and retrieve a token.")) (defmethod authenticate ((connection connection-v2)) - (with-slots (url token user service-catalog metadata tenant) connection + (with-slots (url token user service-catalog metadata) 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 @@ -174,7 +191,6 @@ with underscores to hyphens." (let ((access (assoc* :access (decode-json stream)))) (setf user (assoc* :user access)) (setf service-catalog (assoc* :service-catalog access)) - (setf tenant (assoc* :tenant access)) (setf metadata (assoc* :metadata access)) (setf token (assoc* :token access))))) connection) @@ -190,7 +206,7 @@ with underscores to hyphens." at.")) (defmethod connection-token-issued-at ((connection connection-v2)) - (parse-timestring (assoc* :issued--at (slot-value connection 'token)))) + (parse-timestring (assoc* :issued-at (slot-value connection 'token)))) (defgeneric connection-token-expires (connection) (:documentation "Return the time when the CONNECTION's token will @@ -208,6 +224,13 @@ valid.")) (connection-token-expires connection) (now))) +(defmethod connection-tenant ((connection connection-v2)) + "Return the current connections TENANT." + (apply #'make-instance + 'tenant-v2 + :connection connection + (alist-plist (assoc* :tenant (slot-value connection 'token))))) + (defmethod resource-authentication-headers ((resource connection-v2)) `(("x-auth-token" . ,(connection-token-id resource)))) diff --git a/tests/keystone.lisp b/tests/keystone.lisp index 1289dae..f82aaa9 100644 --- a/tests/keystone.lisp +++ b/tests/keystone.lisp @@ -62,7 +62,7 @@ object." (let ((connection (connection-fixture))) (setf (slot-value connection 'cl-keystone-client::token) - '((:issued--at . "2013-10-13T06:01:36.315343") + '((:issued-at . "2013-10-13T06:01:36.315343") (:expires . "2013-10-14T06:01:36Z"))) (is (timestamp= (connection-token-expires connection) @@ -119,6 +119,62 @@ from the keystone server." (is (string-equal (getf status :uri) "/v2.0/tokens"))))) +(test authentication + "Test that authentication correctly initialises the connection object." + (with-mock-http-stream (mock-stream) + (mock-response mock-stream + 200 + :content "{\"access\": {\"token\": {\"issued_at\": \"2013-10-28T21:31:34.158770\", \"expires\": \"2013-10-29T21:31:34Z\", \"id\": \"MIINUAYJKoZIhvcNAQ==\", \"tenant\": {\"description\": null, \"enabled\": true, \"id\": \"36215f8\", \"name\": \"admin\"}}, \"serviceCatalog\": [{\"endpoints\": [{\"adminURL\": \"http://192.168.1.9:8774/v2/36215f8\", \"region\": \"RegionOne\", \"internalURL\": \"http://192.168.1.9:8774/v2/36215f8\", \"id\": \"53ad66f\", \"publicURL\": \"http://192.168.1.9:8774/v2/36215f8\"}], \"endpoints_links\": [], \"type\": \"compute\", \"name\": \"nova\"}, {\"endpoints\": [{\"adminURL\": \"http://192.168.1.9:35357/v2.0\", \"region\": \"RegionOne\", \"internalURL\": \"http://192.168.1.9:5000/v2.0\", \"id\": \"1d6a58b\", \"publicURL\": \"http://192.168.1.9:5000/v2.0\"}], \"endpoints_links\": [], \"type\": \"identity\", \"name\": \"keystone\"}], \"user\": {\"username\": \"admin\", \"roles_links\": [], \"id\": \"717a936\", \"roles\": [{\"name\": \"admin\"}], \"name\": \"admin\"}, \"metadata\": {\"is_admin\": 0, \"roles\": [\"a0dfe95\"]}}}") + (let ((connection + (authenticate (make-instance 'connection-v2 + :tenant-name "test" + :url "http://test:5000" + :username "test" + :password "test")))) + (is (equal (connection-token-id connection) + "MIINUAYJKoZIhvcNAQ==")) + (is (equal (connection-service-catalog connection) + '(((:endpoints + ((:admin-url . "http://192.168.1.9:8774/v2/36215f8") + (:region . "RegionOne") + (:internal-url . "http://192.168.1.9:8774/v2/36215f8") + (:id . "53ad66f") + (:public-url . "http://192.168.1.9:8774/v2/36215f8"))) + (:endpoints-links) + (:type . "compute") + (:name . "nova")) + ((:endpoints + ((:admin-url . "http://192.168.1.9:35357/v2.0") + (:region . "RegionOne") + (:internal-url . "http://192.168.1.9:5000/v2.0") + (:id . "1d6a58b") + (:public-url . "http://192.168.1.9:5000/v2.0"))) + (:endpoints-links) + (:type . "identity") + (:name . "keystone"))))) + (with-slots (id name enabled description) + (connection-tenant connection) + (is (equal (list id name enabled description) + (list "36215f8" "admin" t nil)))) + (is (timestamp= + (connection-token-expires connection) + (encode-timestamp 0 34 31 21 29 10 2013 + :timezone +utc-zone+))) + (is (timestamp= + (connection-token-issued-at connection) + (encode-timestamp 158770000 34 31 21 28 10 2013 + :timezone +utc-zone+)))) + (destructuring-bind (status headers content) + (read-mock-request mock-stream) + (is (equal content + "{\"auth\":{\"passwordCredentials\":{\"username\":\"test\",\"password\":\"test\"},\"tenantName\":\"test\"}}")) + (is (string-equal "application/json" + (header-value :content-type headers))) + (is (string-equal "test:5000" + (header-value :host headers))) + (is (eql (getf status :method) :post)) + (is (string-equal (getf status :uri) "/v2.0/tokens"))))) + (test list-tenants "Test the parsing of a tenants list response." (with-mock-http-stream (mock-stream)