Added token validity predicate
CONNECTION-TOKEN-VALID-P will return T if the token expires in the future. Change-Id: I27d1aa0fa8dfee736a5c0ebd4fca2bd22c62ba9b
This commit is contained in:
parent
d475acbde1
commit
6ab023dbd1
|
@ -6,7 +6,8 @@
|
||||||
#:chunga
|
#:chunga
|
||||||
#:drakma
|
#:drakma
|
||||||
#:trivial-gray-streams
|
#:trivial-gray-streams
|
||||||
#:flexi-streams)
|
#:flexi-streams
|
||||||
|
#:local-time)
|
||||||
:description "OpenStack client libraries tests"
|
:description "OpenStack client libraries tests"
|
||||||
:components
|
:components
|
||||||
((:file "keystone"
|
((:file "keystone"
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
(defsystem cl-openstack-client
|
(defsystem cl-openstack-client
|
||||||
:author "Julien Danjou <julien@danjou.info>"
|
:author "Julien Danjou <julien@danjou.info>"
|
||||||
:depends-on (#:drakma #:cl-json)
|
:depends-on (#:drakma #:cl-json #:local-time)
|
||||||
:description "OpenStack client libraries"
|
:description "OpenStack client libraries"
|
||||||
:components
|
:components
|
||||||
((:file "keystone")))
|
((:file "keystone")))
|
||||||
|
|
|
@ -1,5 +1,9 @@
|
||||||
(defpackage cl-keystone-client
|
(defpackage cl-keystone-client
|
||||||
(:use cl cl-json drakma)
|
(:use cl cl-json drakma)
|
||||||
|
(:import-from :local-time
|
||||||
|
:parse-timestring
|
||||||
|
:timestamp>
|
||||||
|
:now)
|
||||||
(:export connection-v2
|
(:export connection-v2
|
||||||
authenticate
|
authenticate
|
||||||
keystone-error
|
keystone-error
|
||||||
|
@ -11,7 +15,9 @@
|
||||||
connection-password
|
connection-password
|
||||||
connection-url
|
connection-url
|
||||||
connection-token-id
|
connection-token-id
|
||||||
connection-token-expires))
|
connection-token-expires
|
||||||
|
connection-token-issued-at
|
||||||
|
connection-token-valid-p))
|
||||||
|
|
||||||
(in-package :cl-keystone-client)
|
(in-package :cl-keystone-client)
|
||||||
|
|
||||||
|
@ -121,9 +127,25 @@ to STREAM (or to *JSON-OUTPUT*)."
|
||||||
(defmethod connection-token-id ((connection connection-v2))
|
(defmethod connection-token-id ((connection connection-v2))
|
||||||
(cdr (assoc :id (slot-value connection 'token))))
|
(cdr (assoc :id (slot-value connection 'token))))
|
||||||
|
|
||||||
|
(defgeneric connection-token-issued-at (connection)
|
||||||
|
(:documentation "Return the time the CONNECTION's token was issued
|
||||||
|
at."))
|
||||||
|
|
||||||
|
(defmethod connection-token-issued-at ((connection connection-v2))
|
||||||
|
(parse-timestring (cdr (assoc :issued--at (slot-value connection 'token)))))
|
||||||
|
|
||||||
(defgeneric connection-token-expires (connection)
|
(defgeneric connection-token-expires (connection)
|
||||||
(:documentation "Retrieve token expiration for CONNECTION."))
|
(:documentation "Return the time when the CONNECTION's token will
|
||||||
|
expire."))
|
||||||
|
|
||||||
(defmethod connection-token-expires ((connection connection-v2))
|
(defmethod connection-token-expires ((connection connection-v2))
|
||||||
(cdr (assoc :expires (slot-value connection 'token))))
|
(parse-timestring (cdr (assoc :expires (slot-value connection 'token)))))
|
||||||
|
|
||||||
|
(defgeneric connection-token-valid-p (connection)
|
||||||
|
(:documentation "Return T if the CONNECTION's token is still
|
||||||
|
valid."))
|
||||||
|
|
||||||
|
(defmethod connection-token-valid-p ((connection connection-v2))
|
||||||
|
(timestamp>
|
||||||
|
(connection-token-expires connection)
|
||||||
|
(now)))
|
||||||
|
|
|
@ -4,6 +4,14 @@
|
||||||
trivial-gray-streams
|
trivial-gray-streams
|
||||||
cl-openstack-client-test
|
cl-openstack-client-test
|
||||||
cl-keystone-client)
|
cl-keystone-client)
|
||||||
|
(:import-from :local-time
|
||||||
|
:encode-timestamp
|
||||||
|
:timestamp-to-unix
|
||||||
|
:timestamp=
|
||||||
|
:timestamp+
|
||||||
|
:format-timestring
|
||||||
|
:now
|
||||||
|
:+utc-zone+)
|
||||||
(:import-from :cl-ppcre
|
(:import-from :cl-ppcre
|
||||||
:regex-replace-all)
|
:regex-replace-all)
|
||||||
(:import-from :flexi-streams
|
(:import-from :flexi-streams
|
||||||
|
@ -21,6 +29,20 @@
|
||||||
|
|
||||||
(in-suite keystone)
|
(in-suite keystone)
|
||||||
|
|
||||||
|
(defparameter +keystone-format+
|
||||||
|
;; same as +ISO-8601-FORMAT+ except with non nano seconds.
|
||||||
|
'((:year 4) #\- (:month 2) #\- (:day 2) #\T
|
||||||
|
(:hour 2) #\: (:min 2) #\: (:sec 2)
|
||||||
|
:gmt-offset-or-z))
|
||||||
|
|
||||||
|
(defun connection-fixture (&key
|
||||||
|
(url "http://localhost:5000")
|
||||||
|
(username "demo")
|
||||||
|
(password "demo"))
|
||||||
|
(make-instance 'connection-v2 :url url
|
||||||
|
:password password
|
||||||
|
:username username))
|
||||||
|
|
||||||
(defclass mock-http-stream (fundamental-binary-input-stream
|
(defclass mock-http-stream (fundamental-binary-input-stream
|
||||||
fundamental-binary-output-stream
|
fundamental-binary-output-stream
|
||||||
fundamental-character-input-stream
|
fundamental-character-input-stream
|
||||||
|
@ -73,6 +95,40 @@
|
||||||
:username "test"
|
:username "test"
|
||||||
:password "test")))
|
:password "test")))
|
||||||
|
|
||||||
|
(test token-expiry-conversion
|
||||||
|
"Test that the token expiry is correctly converted to a local-time
|
||||||
|
object."
|
||||||
|
(let ((connection (connection-fixture)))
|
||||||
|
(setf (slot-value connection 'cl-keystone-client::token)
|
||||||
|
'((:issued--at . "2013-10-13T06:01:36.315343")
|
||||||
|
(:expires . "2013-10-14T06:01:36Z")))
|
||||||
|
(is (timestamp=
|
||||||
|
(connection-token-expires connection)
|
||||||
|
(encode-timestamp 0 36 1 6 14 10 2013
|
||||||
|
:timezone +utc-zone+)))
|
||||||
|
(is (timestamp=
|
||||||
|
(connection-token-issued-at connection)
|
||||||
|
(encode-timestamp 315343000 36 1 6 13 10 2013
|
||||||
|
:timezone +utc-zone+)))))
|
||||||
|
|
||||||
|
(test token-expired
|
||||||
|
"Test that the token expiry is detected correctly."
|
||||||
|
(let ((connection (connection-fixture)))
|
||||||
|
(setf (slot-value connection 'cl-keystone-client::token)
|
||||||
|
'((:expires . "2013-10-12T06:01:36Z")))
|
||||||
|
(is-false (connection-token-valid-p connection))))
|
||||||
|
|
||||||
|
(test token-valid
|
||||||
|
"Test the validity of a token is detected correctly."
|
||||||
|
(let ((connection (connection-fixture)))
|
||||||
|
(setf (slot-value connection 'cl-keystone-client::token)
|
||||||
|
`((:expires . ,(format-timestring
|
||||||
|
nil
|
||||||
|
(timestamp+ (now) 1 :minute)
|
||||||
|
:format +keystone-format+
|
||||||
|
:timezone +utc-zone+))))
|
||||||
|
(is-true (connection-token-valid-p connection))))
|
||||||
|
|
||||||
(test authentication-error-404
|
(test authentication-error-404
|
||||||
"Test that the correct condition is signalled when a 404 is returned
|
"Test that the correct condition is signalled when a 404 is returned
|
||||||
from the keystone server."
|
from the keystone server."
|
||||||
|
|
Loading…
Reference in New Issue