mirror of https://github.com/apache/jclouds.git
import bindings from crane. Merge branch 'jclouds' of git://github.com/bradford/crane
This commit is contained in:
parent
2dda30b922
commit
33a31c03ed
|
@ -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"]])
|
|
@ -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))))
|
||||
)
|
||||
|
|
@ -0,0 +1,6 @@
|
|||
(ns org.jclouds.blobstore-test
|
||||
(:use [org.jclouds.blobstore] :reload-all)
|
||||
(:use clojure.test))
|
||||
|
||||
(deftest blobstore-test
|
||||
(is true))
|
|
@ -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"]])
|
|
@ -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)))
|
||||
|
|
@ -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)))))
|
Loading…
Reference in New Issue