世の中の Common Lisp OpenStack Clients を眺めてみる

タイトルの通りです。気になったので調べて見ます。

github で 「openstack common lisp」で検索してみたところ・・・

2013/12/15

4つのリポジトリが見つかりました。


■russell/cl-openstack

　とてもシンプルな実装でnovaに対して最低限の操作が実装されています。マクロを活用して実装されておりLISPっぽいつくりです。行数も少ないので、入門として読むのに適していると思います。


novaを操作するための関数をマクロによって定義しています。

(defmacro nova-call (name args documentation lambda-list &body body)
  (let ((documentation (if (stringp documentation) documentation "")))
    (destructuring-bind (&key url content (method :get)) lambda-list
      `(defun ,name ,args
         ,documentation
         (assert *token*)
         (assert *service-catalog*)
         (let* ((service-url (car (service-catalog-query "compute")))
                (url (merge-uris ,url service-url)))
           (let ((data (restart-case
                           (rpc-call url ,method ,content)
                         (retry ()
                           :report "Retry Openstack Call."
                           (rpc-call url ,method ,content)))))
                 ,@body))))))

■stackforge/cl-openstack-client

　こちらも機能としてはシンプルですが、CLOSを活用した実装がなされています。

(defclass resource ()
  ((id :initarg :id
       :reader resource-id)
   (connection :initarg :connection
               :reader resource-connection)
   (attributes :initform (make-hash-table))))

(defmethod resource-error-class ((resource resource))
  'openstack-error)

(defmethod print-object ((resource resource) stream)
  (if (slot-boundp resource 'id)
      (print-unreadable-object (resource stream :type t :identity t)
        (format stream "~A" (resource-id resource)))
      (print-unreadable-object (resource stream :type t :identity t))))

(defmethod decode-resource (resource parent type)
  ;; TODO (RS) currently extra keys are just ignored in all resources,
  ;; it would be best if they were saved somewhere.
  (apply #'make-instance
         type
         :connection (resource-connection parent)
         :parent parent
         (concatenate 'list
                      (alist-plist resource)
                      '(:allow-other-keys t))))

(defmethod decode-resource-list (resources parent type)
  (loop :for resource :in resources
        :collect (decode-resource resource parent type)))

(defgeneric resource-authentication-headers (resource)
  (:documentation "Return a list of the authentication headers that
  should be added to the request."))

■AeroNotix/cl-stack

　こちらは先の二つと違い、Novaではなくオブジェクトストアに対する基本的なファイルアップロードを実装しているようです。

(defmethod upload-file ((client openstack-client) (filename string)
                        &key (container "/testainer") (content-type "application/text") headers)
  "Upload file will upload `filename' into the ObjectStore."
  (let* ((url (format nil "~a~a~a/~a"
                      *computeurl*
                      (slot-value client 'tenantid)
                      container
                      (pathname-name filename)))
         (md5-hash (md5-digest-file filename)))
    (base-request url :PUT
                  :content-type content-type
                  :content (pathname filename)
                  :headers (base-headers client headers)
                  :after-request #'(lambda (request)
                                     (let* ((recvdheaders (nth 2 request))
                                            (etag (cdr (assoc :ETAG recvdheaders))))
                                       (string= etag md5-hash))))))

■irixjp/cl-openstackclients

　どっかでみたリポジトリですね。全然できていませんXD




この4つを眺めてみましたが、実装としてはどれも実験的、といった印象です。

Lispっぽい使い方をOpenStack上で実装しているものや、アイデアのある方はぜひ教えてください。