Import basic Keystone client

Signed-off-by: Julien Danjou <julien@danjou.info>

.gitignore

@@ -0,0 +1,2 @@
+.test-env
+.cache

cl-openstack-client-test.asd

@@ -0,0 +1,11 @@
+(defsystem cl-openstack-client-test
+  :author "Julien Danjou <julien@danjou.info>"
+  :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")))

cl-openstack-client.asd

@@ -1,3 +1,6 @@
 (defsystem cl-openstack-client
   :author "Julien Danjou <julien@danjou.info>"
-  :description "OpenStack client libraries")
+  :depends-on (#:drakma #:cl-json)
+  :description "OpenStack client libraries"
+  :components
+  ((:file "keystone")))

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))))

requirements.txt

@@ -0,0 +1,2 @@
+cl-json
+drakma

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)))

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

test-requirements.txt

@@ -0,0 +1 @@
+fiveam

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)))

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)))

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")