From 68be4884ff21aa967b5bb08e10664d0e02845ba2 Mon Sep 17 00:00:00 2001 From: Hugo Duncan Date: Tue, 2 Mar 2010 23:12:15 -0500 Subject: [PATCH] import bindings from crane. Merge branch 'jclouds' of git://github.com/bradford/crane --- blobstore/project.clj | 14 + .../main/clojure/org/jclouds/blobstore.clj | 76 ++++ .../clojure/org/jclouds/blobstore_test.clj | 6 + compute/project.clj | 17 + .../src/main/clojure/org/jclouds/compute.clj | 331 ++++++++++++++++++ .../test/clojure/org/jclouds/compute_test.clj | 6 + 6 files changed, 450 insertions(+) create mode 100644 blobstore/project.clj create mode 100644 blobstore/src/main/clojure/org/jclouds/blobstore.clj create mode 100644 blobstore/src/test/clojure/org/jclouds/blobstore_test.clj create mode 100644 compute/project.clj create mode 100644 compute/src/main/clojure/org/jclouds/compute.clj create mode 100644 compute/src/test/clojure/org/jclouds/compute_test.clj diff --git a/blobstore/project.clj b/blobstore/project.clj new file mode 100644 index 0000000000..57010ea0d2 --- /dev/null +++ b/blobstore/project.clj @@ -0,0 +1,14 @@ +(defproject org.jclouds/clj-blobstore "0.1-SNAPSHOT" + :description "clojure binding for jclouds blobstore library" + :source-path "src/main/clojure" + :test-path "src/test/clojure" + :compile-path "target/classes" + :library-path "target" + :dependencies [[org.clojure/clojure "1.1.0"] + [org.clojure/clojure-contrib "1.1.0"] + [org.jclouds/jclouds-blobstore "1.0-beta-4"] + [org.jclouds/jclouds-log4j "1.0-beta-4"] + [log4j/log4j "1.2.14"]] + :dev-dependencies [[org.clojure/swank-clojure "1.0"]] + :repositories [["jclouds" "http://jclouds.googlecode.com/svn/repo"] + ["jclouds-snapshot" "http://jclouds.rimuhosting.com/maven2/snapshots"]]) diff --git a/blobstore/src/main/clojure/org/jclouds/blobstore.clj b/blobstore/src/main/clojure/org/jclouds/blobstore.clj new file mode 100644 index 0000000000..d766f45880 --- /dev/null +++ b/blobstore/src/main/clojure/org/jclouds/blobstore.clj @@ -0,0 +1,76 @@ +(ns +#^{:doc +" +a lib for interacting with jclouds BlobStore. + +Current supported services are: + [s3, azureblob, atmos, cloudfiles] + +Here's a quick example of how to view blob resources in rackspace + +(ns example.jclouds + (:use org.jclouds.blobstore) + (:use clojure.contrib.pprint) +) + + (def user \"rackspace_username\") + (def password \"rackspace_password\") + (def blobstore-name \"cloudfiles\") + + (def blobstore (blobstore-context blobstore-name user password )) + + (pprint (containers blobstore)) + (pprint (blobs blobstore "your_container_name" )) + +"} +org.jclouds.blobstore + (:use clojure.contrib.duck-streams) + (:import java.io.File) + (:import org.jclouds.blobstore.BlobStore) + (:import org.jclouds.blobstore.BlobStoreContext) + (:import org.jclouds.blobstore.BlobStoreContextFactory) + (:import org.jclouds.blobstore.domain.Blob) + (:import org.jclouds.blobstore.options.ListContainerOptions)) + +(defn blobstore-context + ([{service :service account :account key :key}] + (blobstore-context service account key)) + ([s a k] (.createContext (new BlobStoreContextFactory) s a k ))) + +(defn containers [blobstore] (.list (.getBlobStore blobstore) )) + +(defn blobs + +" +http://code.google.com/p/jclouds + +list the blobs in a container: +blobstore container -> blobs + +list the blobs in a container under a path: +blobstore container dir -> blobs + +example: (pprint +(blobs +(blobstore-context flightcaster-creds) +\"somecontainer\" \"some-dir\")) +" + ([blobstore container-name] + (.list (.getBlobStore blobstore) container-name )) + + ([blobstore container-name dir] + (.list (.getBlobStore blobstore) container-name (.inDirectory (new ListContainerOptions) dir) )) +) + +(defn put-blob + +" +http://code.google.com/p/jclouds + +Create an blob representing text data: +container, name, string -> etag +" + ([blobstore container-name name data] + (.putBlob (.getBlobStore blobstore) container-name (doto (.newBlob (.getBlobStore blobstore) name) (.setPayload data)))) +) + diff --git a/blobstore/src/test/clojure/org/jclouds/blobstore_test.clj b/blobstore/src/test/clojure/org/jclouds/blobstore_test.clj new file mode 100644 index 0000000000..3e73bb82de --- /dev/null +++ b/blobstore/src/test/clojure/org/jclouds/blobstore_test.clj @@ -0,0 +1,6 @@ +(ns org.jclouds.blobstore-test + (:use [org.jclouds.blobstore] :reload-all) + (:use clojure.test)) + +(deftest blobstore-test + (is true)) diff --git a/compute/project.clj b/compute/project.clj new file mode 100644 index 0000000000..74c36e0383 --- /dev/null +++ b/compute/project.clj @@ -0,0 +1,17 @@ +(defproject org.jclouds/clj-compute "0.1-SNAPSHOT" + :description "clojure binding for jclouds compute library" + :source-path "src/main/clojure" + :test-path "src/test/clojure" + :compile-path "target/classes" + :library-path "target" + :dependencies [[org.clojure/clojure "1.1.0"] + [org.clojure/clojure-contrib "1.1.0"] + [org.jclouds/jclouds-compute "1.0-beta-4"] + [org.jclouds/jclouds-jsch "1.0-beta-4"] + [org.jclouds/jclouds-log4j "1.0-beta-4"] + [org.jclouds/jclouds-enterprise "1.0-beta-4"] + [log4j/log4j "1.2.14"] + [com.jcraft/jsch "0.1.42"]] + :dev-dependencies [[org.clojure/swank-clojure "1.0"]] + :repositories [["jclouds" "http://jclouds.googlecode.com/svn/repo"] + ["jclouds-snapshot" "http://jclouds.rimuhosting.com/maven2/snapshots"]]) diff --git a/compute/src/main/clojure/org/jclouds/compute.clj b/compute/src/main/clojure/org/jclouds/compute.clj new file mode 100644 index 0000000000..b4da820878 --- /dev/null +++ b/compute/src/main/clojure/org/jclouds/compute.clj @@ -0,0 +1,331 @@ +(ns + #^{:doc " +a lib for interacting with jclouds ComputeService. + +Current supported services are: + [ec2, rimuhosting, terremark, vcloud, hostingdotcom] + +Here's an example of getting some compute configuration from rackspace: + + (ns example.jclouds + (:use org.jclouds.compute + clojure.contrib.pprint)) + + (def user \"username\") + (def password \"password\") + (def compute-name \"cloudservers\") + + (def compute (compute-context compute-name user password)) + + (pprint (locations compute)) + (pprint (images compute)) + (pprint (nodes compute)) + (pprint (sizes compute)) + +"} + org.jclouds.compute + (:use clojure.contrib.duck-streams + [clojure.contrib.str-utils2 :only [capitalize lower-case map-str]] + [clojure.contrib.java-utils :only [wall-hack-field]]) + (:import java.io.File + org.jclouds.domain.Location + org.jclouds.compute.options.TemplateOptions + (org.jclouds.compute ComputeService + ComputeServiceContext + ComputeServiceContextFactory) + (org.jclouds.compute.domain Template TemplateBuilder ComputeMetadata + NodeMetadata Size OsFamily Image + Architecture) + (com.google.common.collect ImmutableSet))) + +(def module-lookup + {:log4j org.jclouds.logging.log4j.config.Log4JLoggingModule + :ssh org.jclouds.ssh.jsch.config.JschSshClientModule + :enterprise org.jclouds.enterprise.config.EnterpriseConfigurationModule}) + +(defn modules + "Build a list of modules suitable for passing to compute-context" + [& modules] + (.build #^com.google.common.collect.ImmutableSet$Builder + (reduce #(.add #^com.google.common.collect.ImmutableSet$Builder %1 + (.newInstance #^Class (%2 module-lookup))) + (com.google.common.collect.ImmutableSet/builder) + modules))) + +(defn compute-context + "Create a logged in context." + ([s a k] + (compute-context s a k (modules :log4j :ssh :enterprise))) + ([#^String s #^String a #^String k #^ImmutableSet m] + (.createContext (new ComputeServiceContextFactory) s a k m))) + +(defn- seq-from-immutable-set [#^ImmutableSet set] + (map #(.getValue %) set)) + +(defn locations + "Retrieve the available compute locations for the compute context." + [#^ComputeServiceContext compute] + (seq-from-immutable-set (.getLocations (.getComputeService compute)))) + +(defn nodes + "Retrieve the existing nodes for the compute context." + ([#^ComputeServiceContext compute] + (seq-from-immutable-set (.getNodes (.getComputeService compute)))) + ([#^ComputeServiceContext compute #^String tag] + (seq-from-immutable-set (.getNodesWithTag (.getComputeService compute) tag)))) + +(defn images + "Retrieve the available images for the compute context." + [#^ComputeServiceContext compute] + (seq-from-immutable-set (.getImages (.getComputeService compute)))) + +(defn sizes + "Retrieve the available node sizes for the compute context." + [#^ComputeServiceContext compute] + (seq-from-immutable-set (.getSizes (.getComputeService compute)))) + +(defn default-template [#^ComputeServiceContext compute] + (.. compute (getComputeService) (templateBuilder) + (osFamily OsFamily/UBUNTU) + smallest + (options + (org.jclouds.compute.options.TemplateOptions$Builder/authorizePublicKey + (slurp (str (. System getProperty "user.home") "/.ssh/id_rsa.pub")))) + build)) + +(defn run-nodes + "Create the specified number of nodes using the default or specified + template." + ([compute tag count] + (run-nodes compute tag count (default-template compute))) + ([#^ComputeServiceContext compute tag count template] + (seq-from-immutable-set + (.runNodesWithTag + (.getComputeService compute) tag count template)))) + +(defn run-node + "Create a node using the default or specified template." + ([compute tag] + (run-nodes compute tag 1 (default-template compute))) + ([compute tag template] + (run-nodes compute tag 1 template))) + +(defn #^NodeMetadata node-details + "Retrieve the node metadata." + [#^ComputeServiceContext compute node] + (.getNodeMetadata (.getComputeService compute) node )) + +(defn reboot-nodes + "Reboot all the nodes with the given tag." + ([#^ComputeServiceContext compute #^String tag] + (.rebootNodesWithTag (.getComputeService compute) tag ))) + +(defn reboot-node + "Reboot a given node." + ([#^ComputeServiceContext compute + #^ComputeMetadata node] + (.rebootNode (.getComputeService compute) node ))) + +(defn destroy-nodes + "Destroy all the nodes with the given tag." + ([#^ComputeServiceContext compute #^String tag] + (.destroyNodesWithTag (.getComputeService compute) tag ))) + +(defn destroy-node + "Destroy a given node." + ([#^ComputeServiceContext compute + #^ComputeMetadata node] + (.destroyNode (.getComputeService compute) node ))) + +(defmacro state-predicate [node state] + `(= (.getState ~node) + (. org.jclouds.compute.domain.NodeState ~state))) + +(defn pending? + "Predicate for the node being in transition" + [#^NodeMetadata node] + (state-predicate node PENDING)) + +(defn running? + "Predicate for the node being available for requests." + [#^NodeMetadata node] + (state-predicate node RUNNING)) + +(defn terminated? + "Predicate for the node being halted." + [#^NodeMetadata node] + (state-predicate node TERMINATED)) + +(defn suspended? + "Predicate for the node being suspended." + [#^NodeMetadata node] + (state-predicate node SUSPENDED)) + +(defn error-state? + "Predicate for the node being in an error state." + [#^NodeMetadata node] + (state-predicate node ERROR)) + +(defn unknown-state? + "Predicate for the node being in an unknown state." + [#^NodeMetadata node] + (state-predicate node UNKNOWN)) + +(defn public-ips + "Returns the node's public ips" + [#^NodeMetadata node] + (map #(.getHostAddress %) (.getPublicAddresses node))) + +(defn private-ips + "Returns the node's private ips" + [#^NodeMetadata node] + (map #(.getHostAddress %) (.getPrivateAddresses node))) + +(defn tag + "Returns a the node's tag" + [#^NodeMetadata node] + (.getTag node)) + +(defn hostname + "Returns the compute node's name" + [#^ComputeMetadata node] + (.getName node)) + +(defn- dashed [a] + (apply str (interpose "-" (map lower-case (re-seq #"[A-Z][^A-Z]*" a))))) + +(defn- camelize [a] + (apply str (map-str capitalize (.split a "-")))) + +(defn camelize-mixed [a] + (let [c (.split a "-")] + (apply str (lower-case (first c)) (map capitalize (rest c))))) + +(defmacro #^{:private true} define-accessor + [class property obj-name] + (list 'defn (symbol (str obj-name "-" (name property))) + (vector (with-meta (symbol obj-name) {:tag (.getName class)})) + (list (symbol (str ".get" (camelize (name property)))) (symbol obj-name)))) + +(defmacro #^{:private true} define-accessors + "Defines read accessors, modelled on class-name-property-name. If the second + argument is a string, it is used instead of the class-name prefix." + [class & properties] + (let [obj-name (if (string? (first properties)) + (first properties) + (dashed (.getName class))) + properties (if (string? (first properties)) + (rest properties) + properties)] + `(do + ~@(for [property properties] + `(define-accessor ~class ~property ~obj-name))))) + +(define-accessors Template image size location options) +(define-accessors Image version os-family os-description architecture) +(define-accessors Size cores ram disk) +(define-accessors NodeMetadata "node" credentials extra state tag) + +(defmacro option-fn-0arg [key] + `(fn [builder#] + (~(symbol (str "." (camelize-mixed (name key)))) builder#))) + +(defmacro option-fn-1arg [key] + `(fn [builder# value#] + (~(symbol (str "." (camelize-mixed (name key)))) builder# value#))) + +(defn builder-options [builder] + (or (wall-hack-field org.jclouds.compute.internal.TemplateBuilderImpl :options builder) + (TemplateOptions.))) + +(defmacro option-option-fn-0arg [key] + `(fn [builder#] + (let [options# (builder-options builder#)] + (~(symbol (str "." (camelize-mixed (name key)))) options#) + (.options builder# options#)))) + +(defn- seq-to-array [args] + (if (or (seq? args) (vector? args)) + (int-array args) + args)) + +(defmacro option-option-fn-1arg [key] + `(fn [builder# value#] + (let [options# (builder-options builder#)] + (~(symbol (str "." (camelize-mixed (name key)))) options# (seq-to-array value#)) + (.options builder# options#)))) + +(defmacro make-option-map [f keywords] + `[ ~@(reduce (fn [v# k#] (conj (conj v# k#) `(~f ~k#))) [] keywords)]) + +(def option-1arg-map + (apply array-map + (concat + (make-option-map option-fn-1arg + [:os-family :location-id :architecture :image-id :size-id + :os-description-matches :image-version-matches + :image-description-matches :min-cores :min-ram]) + (make-option-map option-option-fn-1arg + [:run-script :install-private-key :authorize-public-key :inbound-ports])))) +(def option-0arg-map + (apply hash-map + (concat + (make-option-map option-fn-0arg + [:smallest :fastest :biggest]) + (make-option-map option-option-fn-0arg + [:destroy-on-error])))) + +(defn os-families [] + (. OsFamily values)) +(defn architectures [] + (. Architecture values)) + +(def enum-map {:os-family (os-families) + :architecture (architectures)}) + +(defn add-option-with-value-if [builder kword] + (loop [enums (sequence enum-map)] + (if (not (empty? enums)) + (let [enum (first enums) + value (filter #(= (name kword) (str %)) (second enum))] + (if (not (empty? value)) + (((first enum) option-1arg-map) builder (first value)) + (recur (rest enums))))))) + +(defn add-option-if [builder kword] + (let [f (option-0arg-map kword)] + (if f (f builder)))) + +(defn add-keyword-option [builder option] + (if (not (or (add-option-with-value-if builder option) + (add-option-if builder option))) + (println "Unknown option " option))) + +(defn add-value-option [builder option value] + (let [f (option-1arg-map option)] + (if f + (f builder value) + (println "Unknown option" option)))) + +(defn build-template [#^ComputeServiceContext compute option & options] + (let [builder (.. compute (getComputeService) (templateBuilder))] + (loop [option option + remaining options] + (if (empty? remaining) + (add-keyword-option builder option) + (let [next-is-keyword (keyword? (first remaining)) + arg (if (not next-is-keyword) + (first remaining)) + next (if next-is-keyword + (first remaining) + (fnext remaining)) + remaining (if (keyword? (first remaining)) + (rest remaining) + (drop 2 remaining))] + (if arg + (add-value-option builder option arg) + (add-keyword-option builder option)) + (if next + (recur next remaining))))) + (.build builder))) + diff --git a/compute/src/test/clojure/org/jclouds/compute_test.clj b/compute/src/test/clojure/org/jclouds/compute_test.clj new file mode 100644 index 0000000000..14a1e2c0ca --- /dev/null +++ b/compute/src/test/clojure/org/jclouds/compute_test.clj @@ -0,0 +1,6 @@ +(ns org.jclouds.compute-test + (:use [org.jclouds.compute] :reload-all) + (:use clojure.test)) + +(deftest os-families-test + (is (some #{"centos"} (map str (os-families)))))