220 lines
9.6 KiB
Common Lisp
220 lines
9.6 KiB
Common Lisp
(defpackage cl-openstack-client.test
|
|
(:use cl
|
|
trivial-gray-streams
|
|
fiveam)
|
|
(:import-from #:drakma
|
|
#:+latin-1+
|
|
#:header-value
|
|
#:read-http-headers)
|
|
(:import-from #:local-time
|
|
#:encode-timestamp
|
|
#:timestamp+
|
|
#:format-timestring
|
|
#:now)
|
|
(:import-from #:cl-keystone-client
|
|
#:connection-v2)
|
|
(:import-from #:cl-openstack-client
|
|
#:*http-stream*)
|
|
(:import-from #:flexi-streams
|
|
#:string-to-octets
|
|
#:make-flexi-stream
|
|
#:make-in-memory-input-stream
|
|
#:octets-to-string
|
|
#:octet)
|
|
(:import-from #:chunga
|
|
#:make-chunked-stream)
|
|
(:export tests
|
|
connection-fixture
|
|
with-mock-http-stream
|
|
make-mock-http-stream
|
|
read-mock-request
|
|
mock-http-stream))
|
|
|
|
(in-package :cl-openstack-client.test)
|
|
|
|
(def-suite tests
|
|
:description "cl-openstack-client tests")
|
|
|
|
(defun connection-fixture (&key
|
|
(url "http://localhost:5000")
|
|
(username "demo")
|
|
(password "demo"))
|
|
|
|
(let ((connection (make-instance 'connection-v2 :url url
|
|
:password password
|
|
:username username)))
|
|
(setf (slot-value connection 'cl-keystone-client::token)
|
|
`((:issued-at . ,(now))
|
|
(:expires . ,(timestamp+ (now) 24 :hour))
|
|
(:id
|
|
. "MIINUAYJKoZIhvcNAQ==")
|
|
(:tenant
|
|
(:description)
|
|
(:enabled . t)
|
|
(:id . "45ca25c")
|
|
(:name . "admin"))))
|
|
(setf (slot-value connection 'cl-keystone-client::service-catalog)
|
|
'(((:endpoints
|
|
((:admin-url . "http://192.168.1.9:8774/v2/45ca25c")
|
|
(:region . "RegionOne")
|
|
(:internal-url . "http://192.168.1.9:8774/v2/45ca25c")
|
|
(:id . "25210b1")
|
|
(:public-url . "http://192.168.1.9:8774/v2/45ca25c")))
|
|
(:endpoints-links) (:type . "compute") (:name . "nova"))
|
|
((:endpoints
|
|
((:admin-url . "http://192.168.1.9:8776/v2/45ca25c")
|
|
(:region . "RegionOne")
|
|
(:internal-url . "http://192.168.1.9:8776/v2/45ca25c")
|
|
(:id . "46d0cc5")
|
|
(:public-url . "http://192.168.1.9:8776/v2/45ca25c")))
|
|
(:endpoints-links) (:type . "volumev2") (:name . "cinder"))
|
|
((:endpoints
|
|
((:admin-url . "http://192.168.1.9:8774/v3")
|
|
(:region . "RegionOne")
|
|
(:internal-url . "http://192.168.1.9:8774/v3")
|
|
(:id . "5ed56fb")
|
|
(:public-url . "http://192.168.1.9:8774/v3")))
|
|
(:endpoints-links) (:type . "computev3") (:name . "nova"))
|
|
((:endpoints
|
|
((:admin-url . "http://192.168.1.9:3333")
|
|
(:region . "RegionOne")
|
|
(:internal-url . "http://192.168.1.9:3333")
|
|
(:id . "a590747")
|
|
(:public-url . "http://192.168.1.9:3333")))
|
|
(:endpoints-links) (:type . "s3") (:name . "s3"))
|
|
((:endpoints
|
|
((:admin-url . "http://192.168.1.9:9292")
|
|
(:region . "RegionOne")
|
|
(:internal-url . "http://192.168.1.9:9292")
|
|
(:id . "010d69f")
|
|
(:public-url . "http://192.168.1.9:9292")))
|
|
(:endpoints-links) (:type . "image") (:name . "glance"))
|
|
((:endpoints
|
|
((:admin-url . "http://192.168.1.9:8776/v1/45ca25c")
|
|
(:region . "RegionOne")
|
|
(:internal-url . "http://192.168.1.9:8776/v1/45ca25c")
|
|
(:id . "3698a28")
|
|
(:public-url . "http://192.168.1.9:8776/v1/45ca25c")))
|
|
(:endpoints-links) (:type . "volume") (:name . "cinder"))
|
|
((:endpoints
|
|
((:admin-url . "http://192.168.1.9:8773/services/Admin")
|
|
(:region . "RegionOne")
|
|
(:internal-url . "http://192.168.1.9:8773/services/Cloud")
|
|
(:id . "aa700cc")
|
|
(:public-url . "http://192.168.1.9:8773/services/Cloud")))
|
|
(:endpoints-links) (:type . "ec2") (:name . "ec2"))
|
|
((:endpoints
|
|
((:admin-url . "http://192.168.1.9:35357/v2.0")
|
|
(:region . "RegionOne")
|
|
(:internal-url . "http://192.168.1.9:5000/v2.0")
|
|
(:id . "2c04749")
|
|
(:public-url . "http://192.168.1.9:5000/v2.0")))
|
|
(:endpoints-links) (:type . "identity") (:name . "keystone"))))
|
|
connection))
|
|
|
|
(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)))
|
|
|
|
(defun make-mock-http-stream (&optional (stream (make-instance 'mock-http-stream)))
|
|
(make-flexi-stream (make-chunked-stream stream) :external-format +latin-1+))
|
|
|
|
(defun mock-response (stream code &key headers content)
|
|
(setf (mock-response-stream stream)
|
|
(string-to-octets
|
|
(with-output-to-string (http-stream)
|
|
(labels ((write-http-line (fmt &rest args)
|
|
(format http-stream "~?~C~C" fmt args #\Return #\Linefeed))
|
|
(write-header (name value-fmt &rest value-args)
|
|
(write-http-line "~A: ~?" name value-fmt value-args)))
|
|
(write-http-line "HTTP/1.1 ~D" code)
|
|
(loop :for (header . value) :in headers
|
|
:do (write-header header "~A" value))
|
|
(write-header "Content-Type" "~A" "application/json")
|
|
(write-header "Content-Length" "~D" (length content))
|
|
(write-header "Connection" "~A" "close")
|
|
(format http-stream "~C~C" #\Return #\Linefeed)
|
|
(write-string content http-stream))))))
|
|
|
|
(defun read-status-line (stream)
|
|
(let* ((line (or (chunga:read-line* stream)
|
|
(error "No status line")))
|
|
(first-space-pos (or (position #\Space line :test #'char=)
|
|
(error "No space in status line ~S." line)))
|
|
(second-space-pos (position #\Space line
|
|
:test #'char=
|
|
:start (1+ first-space-pos))))
|
|
(list
|
|
(cond ((string-equal line "POST" :end1 first-space-pos) :post)
|
|
((string-equal line "GET" :end1 first-space-pos) :get)
|
|
((string-equal line "DELETE" :end1 first-space-pos) :delete)
|
|
((string-equal line "PUT" :end1 first-space-pos) :put)
|
|
((string-equal line "PATCH" :end1 first-space-pos) :patch)
|
|
(t (error "Unknown protocol in ~S." line)))
|
|
(cond ((string-equal line "HTTP/1.0" :start1 (1+ second-space-pos)) :http/1.0)
|
|
((string-equal line "HTTP/1.1" :start1 (1+ second-space-pos)) :http/1.1)
|
|
(t (error "Unknown protocol in ~S." line)))
|
|
(subseq line (1+ first-space-pos) second-space-pos))))
|
|
|
|
(defmethod read-mock-request ((stream mock-http-stream))
|
|
"Read a request out of a MOCK-HTTP-STREAM. The result is a list in
|
|
form (parsed-status-line headers contents)"
|
|
(let ((http-stream (make-in-memory-input-stream
|
|
(reverse
|
|
(slot-value stream 'mock-requests)))))
|
|
(destructuring-bind (method protocol uri)
|
|
(read-status-line http-stream)
|
|
(let ((headers (read-http-headers http-stream)))
|
|
(list (list :method method :protocol protocol :uri uri)
|
|
headers
|
|
(when (header-value :content-length headers)
|
|
(let ((result (make-array (parse-integer (header-value :content-length headers))
|
|
:element-type 'octet)))
|
|
(read-sequence result http-stream)
|
|
(octets-to-string result))))))))
|
|
|
|
|
|
(defmacro with-mock-http-stream ((stream) &body body)
|
|
`(let* ((,stream (make-instance 'mock-http-stream))
|
|
(*http-stream* (make-flexi-stream (make-chunked-stream ,stream)
|
|
:external-format +latin-1+)))
|
|
,@body))
|
|
|
|
|
|
(defun is-valid-request (stream method uri &optional content)
|
|
(destructuring-bind (status headers content1)
|
|
(read-mock-request stream)
|
|
(is (equal content1
|
|
content))
|
|
(when (header-value :content-length headers)
|
|
(is (string-equal "application/json"
|
|
(header-value :content-type headers))))
|
|
(is (string-equal "MIINUAYJKoZIhvcNAQ=="
|
|
(header-value :x-auth-token headers)))
|
|
(is (string-equal "192.168.1.9:5000"
|
|
(header-value :host headers)))
|
|
(is (eql (getf status :method) method))
|
|
(is (string-equal (getf status :uri) uri))))
|