From e4e7a658d89fe414421ec7ec381dd2e5a7778987 Mon Sep 17 00:00:00 2001 From: Julien Danjou Date: Sat, 15 Jun 2013 22:17:29 +0200 Subject: [PATCH] Import basic Keystone client Signed-off-by: Julien Danjou --- .gitignore | 2 ++ cl-openstack-client-test.asd | 11 ++++++ cl-openstack-client.asd | 5 ++- keystone.lisp | 65 ++++++++++++++++++++++++++++++++++++ requirements.txt | 2 ++ run-tests.lisp | 4 +++ run-tests.sh | 6 ++++ test-requirements.txt | 1 + tests/keystone.lisp | 15 +++++++++ tests/openstack.lisp | 20 +++++++++++ update-deps.lisp | 13 ++++++++ 11 files changed, 143 insertions(+), 1 deletion(-) create mode 100644 .gitignore create mode 100644 cl-openstack-client-test.asd create mode 100644 keystone.lisp create mode 100644 requirements.txt create mode 100644 run-tests.lisp create mode 100755 run-tests.sh create mode 100644 test-requirements.txt create mode 100644 tests/keystone.lisp create mode 100644 tests/openstack.lisp create mode 100644 update-deps.lisp diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..9cc7428 --- /dev/null +++ b/.gitignore @@ -0,0 +1,2 @@ +.test-env +.cache diff --git a/cl-openstack-client-test.asd b/cl-openstack-client-test.asd new file mode 100644 index 0000000..0fea5a3 --- /dev/null +++ b/cl-openstack-client-test.asd @@ -0,0 +1,11 @@ +(defsystem cl-openstack-client-test + :author "Julien Danjou " + :depends-on (#:cl-openstack-client + #:fiveam) + :description "OpenStack client libraries tests" + :components + ((:file "keystone" + :pathname "tests/keystone" + :depends-on ("openstack")) + (:file "openstack" + :pathname "tests/openstack"))) diff --git a/cl-openstack-client.asd b/cl-openstack-client.asd index 0213302..8f0ecfd 100644 --- a/cl-openstack-client.asd +++ b/cl-openstack-client.asd @@ -1,3 +1,6 @@ (defsystem cl-openstack-client :author "Julien Danjou " - :description "OpenStack client libraries") + :depends-on (#:drakma #:cl-json) + :description "OpenStack client libraries" + :components + ((:file "keystone"))) diff --git a/keystone.lisp b/keystone.lisp new file mode 100644 index 0000000..1b9d221 --- /dev/null +++ b/keystone.lisp @@ -0,0 +1,65 @@ +(defpackage cl-keystone-client + (:use cl cl-json drakma) + (:export connection-v2 + authenticate + connection-username + connection-tenant-id + connectino-tenant-name + connection-password + connection-url + connection-token-id + connection-token-expires)) + +(in-package :cl-keystone-client) + + +(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) + (token :initarg :password) + (url :initarg :url :reader connection-url))) + +(defclass connection-v2 (connection) + ((version :initform 2 :reader connection-version))) + + +(defgeneric authenticate (connection) + (: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 + :content-type "application/json" + :content + (with-explicit-encoder + (encode-json-to-string + `(:object "auth" (:object "passwordCredentials" + (:object "username" ,username + "password" ,password) + ,@tenant-prop))))) + (setf token + (cdr (assoc :token (cdr (assoc :access (decode-json stream)))))))))) + + +(defgeneric connection-token-id (connection) + (:documentation "Retrieve token id for CONNECTION.")) + +(defmethod connection-token-id ((connection connection-v2)) + (cdr (assoc :id (slot-value connection 'token)))) + + +(defgeneric connection-token-expires (connection) + (:documentation "Retrieve token expiration for CONNECTION.")) + +(defmethod connection-token-expires ((connection connection-v2)) + (cdr (assoc :expires (slot-value connection 'token)))) diff --git a/requirements.txt b/requirements.txt new file mode 100644 index 0000000..36dcfbe --- /dev/null +++ b/requirements.txt @@ -0,0 +1,2 @@ +cl-json +drakma diff --git a/run-tests.lisp b/run-tests.lisp new file mode 100644 index 0000000..609af4b --- /dev/null +++ b/run-tests.lisp @@ -0,0 +1,4 @@ +(require 'cl-openstack-client-test) +(let ((results (5am:run 5am::*suite*))) + (5am:explain! results) + (exit :code (if (eq (5am:results-status results ) t) 0 1))) diff --git a/run-tests.sh b/run-tests.sh new file mode 100755 index 0000000..6d45bec --- /dev/null +++ b/run-tests.sh @@ -0,0 +1,6 @@ +#!/bin/sh +export HOME=$PWD/.test-env +mkdir $HOME +cd $HOME +wget -q http://beta.quicklisp.org/quicklisp.lisp -O quicklisp.lisp +sbcl --load ../update-deps.lisp diff --git a/test-requirements.txt b/test-requirements.txt new file mode 100644 index 0000000..ad1ba28 --- /dev/null +++ b/test-requirements.txt @@ -0,0 +1 @@ +fiveam diff --git a/tests/keystone.lisp b/tests/keystone.lisp new file mode 100644 index 0000000..f8c45e6 --- /dev/null +++ b/tests/keystone.lisp @@ -0,0 +1,15 @@ +(defpackage cl-keystone-client-test + (:use fiveam + cl + cl-openstack-client-test + cl-keystone-client)) + +(in-package :cl-keystone-client-test) + +(def-suite keystone :description "My Example Suite") + +(in-suite keystone) + +(test make-connection + "Make a connection object" + (is-true (make-instance 'connection-v2))) diff --git a/tests/openstack.lisp b/tests/openstack.lisp new file mode 100644 index 0000000..43e80f6 --- /dev/null +++ b/tests/openstack.lisp @@ -0,0 +1,20 @@ +(defpackage cl-openstack-client-test + (:use cl) + (:export with-function-patch)) + +(in-package :cl-openstack-client-test) + +(defmacro with-function-patch (patch &rest body) + "Takes a PATCH form like a FLET clause, i.e. (fn-name (lambda-list) body), +evaluates BODY in an environment with fn-name rebound to the PATCH form and +uses UNWIND-PROTECT to safely restore the original definition afterwards." + (let ((oldfn (gensym)) + (result (gensym)) + (name (car patch)) + (args (cadr patch)) + (pbody (cddr patch))) + `(let ((,oldfn (symbol-function ',name))) + (setf (symbol-function ',name) (lambda ,args ,@pbody)) + (unwind-protect (progn ,@body) + (setf (symbol-function ',name) ,oldfn)) + ,result))) diff --git a/update-deps.lisp b/update-deps.lisp new file mode 100644 index 0000000..6a56def --- /dev/null +++ b/update-deps.lisp @@ -0,0 +1,13 @@ +(load "quicklisp.lisp") +(handler-case (quicklisp-quickstart:install :path (user-homedir-pathname)) + (error nil (load "setup"))) +(dolist (file '("../requirements.txt" "../test-requirements.txt")) + (with-open-file (s file) + (loop for line = (read-line s nil) + while line + do (ql:quickload line)))) +(push + ;; Send me a patch to make this simpler please. + (apply 'make-pathname (list :directory (butlast (pathname-directory (user-homedir-pathname))))) + asdf:*central-registry*) +(load "../run-tests")