Implemented simple error handling behaviour
A KEYSTONE-ERROR condition will be signalled if the response code isn't 200 and the content type is application/json. In all other cases the url and the return code will be signalled as a standard error. Change-Id: If68c3bf3fb8836e0c8510aed3329720da4e154e5
This commit is contained in:
parent
f61d5083c5
commit
84e1783379
|
@ -1,7 +1,12 @@
|
||||||
(defsystem cl-openstack-client-test
|
(defsystem cl-openstack-client-test
|
||||||
:author "Julien Danjou <julien@danjou.info>"
|
:author "Julien Danjou <julien@danjou.info>"
|
||||||
:depends-on (#:cl-openstack-client
|
:depends-on (#:cl-openstack-client
|
||||||
#:fiveam)
|
#:fiveam
|
||||||
|
#:cl-ppcre
|
||||||
|
#:chunga
|
||||||
|
#:drakma
|
||||||
|
#:trivial-gray-streams
|
||||||
|
#:flexi-streams)
|
||||||
:description "OpenStack client libraries tests"
|
:description "OpenStack client libraries tests"
|
||||||
:components
|
:components
|
||||||
((:file "keystone"
|
((:file "keystone"
|
||||||
|
|
|
@ -2,6 +2,9 @@
|
||||||
(:use cl cl-json drakma)
|
(:use cl cl-json drakma)
|
||||||
(:export connection-v2
|
(:export connection-v2
|
||||||
authenticate
|
authenticate
|
||||||
|
keystone-error
|
||||||
|
error-code
|
||||||
|
error-message
|
||||||
connection-username
|
connection-username
|
||||||
connection-tenant-id
|
connection-tenant-id
|
||||||
connection-tenant-name
|
connection-tenant-name
|
||||||
|
@ -24,6 +27,40 @@
|
||||||
(defclass connection-v2 (connection)
|
(defclass connection-v2 (connection)
|
||||||
((version :initform 2 :reader connection-version)))
|
((version :initform 2 :reader connection-version)))
|
||||||
|
|
||||||
|
(defvar *cached-stream* nil)
|
||||||
|
|
||||||
|
(define-condition keystone-error (error)
|
||||||
|
((message
|
||||||
|
:initarg :message
|
||||||
|
:accessor error-message
|
||||||
|
:initform nil
|
||||||
|
:documentation "The error message returned by keystone.")
|
||||||
|
(code
|
||||||
|
:initarg :code
|
||||||
|
:accessor error-code
|
||||||
|
:initform nil
|
||||||
|
:documentation "The error code returned by keystone."))
|
||||||
|
(:report (lambda (condition stream)
|
||||||
|
(format stream "Keystone ERROR: ~A, ~A"
|
||||||
|
(error-code condition)
|
||||||
|
(error-message condition)))))
|
||||||
|
|
||||||
|
(defun json-error (json)
|
||||||
|
"Raise an error using the contents of a JSON error plist."
|
||||||
|
(let ((error-message (cdr (assoc :error json))))
|
||||||
|
(error 'keystone-error
|
||||||
|
:message (cdr (assoc :message error-message))
|
||||||
|
:code (cdr (assoc :code error-message)))))
|
||||||
|
|
||||||
|
(defun unknown-error (url status-code)
|
||||||
|
"Raise an error with the url and status code."
|
||||||
|
(error (format nil "ERROR: received response code of ~A when accessing ~A"
|
||||||
|
status-code url)))
|
||||||
|
|
||||||
|
(defun json-response-p (headers)
|
||||||
|
"Return true if the response content type is json."
|
||||||
|
(string-equal (cdr (assoc :content-type headers))
|
||||||
|
"application/json"))
|
||||||
|
|
||||||
(defgeneric authenticate (connection)
|
(defgeneric authenticate (connection)
|
||||||
(:documentation "Authenticate and retrieve a token."))
|
(:documentation "Authenticate and retrieve a token."))
|
||||||
|
@ -34,22 +71,30 @@
|
||||||
(error "No tenant-id nor tenant-name specified, cannot authenticate."))
|
(error "No tenant-id nor tenant-name specified, cannot authenticate."))
|
||||||
(let ((tenant-prop (if tenant-id
|
(let ((tenant-prop (if tenant-id
|
||||||
(list "tenantId" tenant-id)
|
(list "tenantId" tenant-id)
|
||||||
(list "tenantName" tenant-name))))
|
(list "tenantName" tenant-name))))
|
||||||
(multiple-value-bind (body status-code headers uri stream must-close reason-phrase)
|
(multiple-value-bind (body status-code headers uri stream must-close reason-phrase)
|
||||||
(http-request (format nil "~a/v2.0/tokens" url)
|
(http-request (format nil "~a/v2.0/tokens" url)
|
||||||
:method :POST
|
:method :POST
|
||||||
:want-stream t
|
:want-stream t
|
||||||
|
:stream *cached-stream*
|
||||||
:content-type "application/json"
|
:content-type "application/json"
|
||||||
:content
|
:content
|
||||||
(with-explicit-encoder
|
(with-explicit-encoder
|
||||||
(encode-json-to-string
|
(encode-json-to-string
|
||||||
`(:object "auth" (:object "passwordCredentials"
|
`(:object "auth" (:object "passwordCredentials"
|
||||||
(:object "username" ,username
|
(:object "username" ,username
|
||||||
"password" ,password)
|
"password" ,password)
|
||||||
,@tenant-prop)))))
|
,@tenant-prop)))))
|
||||||
(setf token
|
(declare (ignore must-close reason-phrase body))
|
||||||
(cdr (assoc :token (cdr (assoc :access (decode-json stream))))))))))
|
(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)
|
(defgeneric connection-token-id (connection)
|
||||||
(:documentation "Retrieve token id for CONNECTION."))
|
(:documentation "Retrieve token id for CONNECTION."))
|
||||||
|
|
|
@ -1,8 +1,19 @@
|
||||||
(defpackage cl-keystone-client-test
|
(defpackage cl-keystone-client-test
|
||||||
(:use fiveam
|
(:use fiveam
|
||||||
cl
|
cl
|
||||||
|
trivial-gray-streams
|
||||||
cl-openstack-client-test
|
cl-openstack-client-test
|
||||||
cl-keystone-client))
|
cl-keystone-client)
|
||||||
|
(:import-from :cl-ppcre
|
||||||
|
:regex-replace-all)
|
||||||
|
(:import-from :flexi-streams
|
||||||
|
:string-to-octets
|
||||||
|
:make-flexi-stream
|
||||||
|
:octets-to-string)
|
||||||
|
(:import-from :drakma
|
||||||
|
:+latin-1+)
|
||||||
|
(:import-from :chunga
|
||||||
|
:make-chunked-stream))
|
||||||
|
|
||||||
(in-package :cl-keystone-client-test)
|
(in-package :cl-keystone-client-test)
|
||||||
|
|
||||||
|
@ -10,6 +21,66 @@
|
||||||
|
|
||||||
(in-suite keystone)
|
(in-suite keystone)
|
||||||
|
|
||||||
|
(defclass mock-http-stream (fundamental-binary-input-stream
|
||||||
|
fundamental-binary-output-stream
|
||||||
|
fundamental-character-input-stream
|
||||||
|
fundamental-character-output-stream)
|
||||||
|
((mock-requests :accessor mock-request-stream
|
||||||
|
:initform nil)
|
||||||
|
(mock-responses-location :initform 0
|
||||||
|
:accessor mock-response-location)
|
||||||
|
(mock-responses :accessor mock-response-stream
|
||||||
|
:initform nil)))
|
||||||
|
|
||||||
|
(defmethod stream-read-byte ((stream mock-http-stream))
|
||||||
|
(if (<= (length (mock-response-stream stream))
|
||||||
|
(mock-response-location stream))
|
||||||
|
:eof
|
||||||
|
(prog1
|
||||||
|
(aref (mock-response-stream stream) (mock-response-location stream))
|
||||||
|
(incf (mock-response-location stream)))))
|
||||||
|
|
||||||
|
(defmethod stream-write-byte ((stream mock-http-stream) byte)
|
||||||
|
(push byte (mock-request-stream stream)))
|
||||||
|
|
||||||
|
(defmethod stream-write-char ((stream mock-http-stream) char)
|
||||||
|
(push char (mock-request-stream stream)))
|
||||||
|
|
||||||
|
(defmethod mock-response ((stream mock-http-stream) response)
|
||||||
|
(setf (mock-response-stream stream)
|
||||||
|
(string-to-octets
|
||||||
|
(regex-replace-all (string #\Newline)
|
||||||
|
response
|
||||||
|
(coerce '(#\Return #\Linefeed) 'string)))))
|
||||||
|
|
||||||
(test make-connection
|
(test make-connection
|
||||||
"Make a connection object"
|
"Make a connection object"
|
||||||
(is-true (make-instance 'connection-v2)))
|
(is-true (make-instance 'connection-v2)))
|
||||||
|
|
||||||
|
(test authentication-error-404
|
||||||
|
"Test that the correct condition is signalled when a 404 is returned
|
||||||
|
from the keystone server."
|
||||||
|
(let* ((mock-stream (make-instance 'mock-http-stream))
|
||||||
|
(cl-keystone-client::*cached-stream*
|
||||||
|
(make-flexi-stream (make-chunked-stream mock-stream)
|
||||||
|
:external-format +latin-1+)))
|
||||||
|
(mock-response mock-stream
|
||||||
|
"HTTP/1.1 404 Not Found
|
||||||
|
Vary: X-Auth-Token
|
||||||
|
Content-Type: application/json
|
||||||
|
Content-Length: 93
|
||||||
|
Date: Sat, 12 Oct 2013 23:03:22 GMT
|
||||||
|
Connection: close
|
||||||
|
|
||||||
|
{\"error\": {\"message\": \"The resource could not be found.\", \"code\": 404, \"title\": \"Not Found\"}}
|
||||||
|
")
|
||||||
|
(handler-case
|
||||||
|
(authenticate (make-instance 'connection-v2
|
||||||
|
:tenant-name "test"
|
||||||
|
:url "http://test"
|
||||||
|
:username "test"
|
||||||
|
:password "test"))
|
||||||
|
(keystone-error (keystone-error)
|
||||||
|
(is (eql (error-code keystone-error)
|
||||||
|
404))))
|
||||||
|
))
|
||||||
|
|
Loading…
Reference in New Issue