diff --git a/apis/ec2/src/main/clojure/org/jclouds/ec2/ebs.clj b/apis/ec2/src/main/clojure/org/jclouds/ec2/ebs.clj deleted file mode 100644 index bb06f27334..0000000000 --- a/apis/ec2/src/main/clojure/org/jclouds/ec2/ebs.clj +++ /dev/null @@ -1,319 +0,0 @@ -; -; Licensed to jclouds, Inc. (jclouds) under one or more -; contributor license agreements. See the NOTICE file -; distributed with this work for additional information -; regarding copyright ownership. jclouds licenses this file -; to you under the Apache License, Version 2.0 (the -; "License"); you may not use this file except in compliance -; with the License. You may obtain a copy of the License at -; -; http://www.apache.org/licenses/LICENSE-2.0 -; -; Unless required by applicable law or agreed to in writing, -; software distributed under the License is distributed on an -; "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY -; KIND, either express or implied. See the License for the -; specific language governing permissions and limitations -; under the License. -; - -(ns - #^{:author "Chas Emerick, cemerick@snowtide.com" - :doc "A clojure binding to the jclouds EBS service interface."} - org.jclouds.ec2.ebs - (:use [clojure.core.incubator :only (-?>)]) - (:require (org.jclouds [compute :as compute])) - (:import org.jclouds.aws.domain.Region - org.jclouds.compute.domain.NodeMetadata - (org.jclouds.ec2.domain Volume Volume$Status Snapshot Snapshot$Status AvailabilityZoneInfo) - (org.jclouds.ec2.options DescribeSnapshotsOptions DetachVolumeOptions CreateSnapshotOptions))) - -(defn snapshot? - "Returns true iff the argument is a org.jclouds.ec2.domain.Snapshot." - [s] - (instance? Snapshot s)) - -(defn volume? - "Returns true iff the argument is a org.jclouds.ec2.domain.Volume." - [v] - (instance? Volume v)) - -(defn #^org.jclouds.ec2.services.ElasticBlockStoreClient - ebs-service - "Returns the synchronous ElasticBlockStoreClient associated with - the specified compute service, or compute/*compute* as bound by with-compute-service." - [& [compute]] - (-> (or compute compute/*compute*) - .getContext .getProviderSpecificContext .getApi .getElasticBlockStoreServices)) - -(defn get-region - "Coerces the first parameter into a Region string; strings, keywords, and - NodeMetadata instances are acceptable arguments. An optional second argument - is returned if the first cannot be coerced into a region string. - Returns nil otherwise." - ([v] (get-region v nil)) - ([v default-region] - (cond - (string? v) v - (keyword? v) (name v) - (instance? NodeMetadata v) (let [zone (compute/location v)] - ; no easier way to go from zone -> region? - (if (> (.indexOf zone "-") -1) - (subs zone 0 (-> zone count dec)) - zone)) - :else default-region))) - -(defn get-volume-id - "Returns a string volume ID taken from the given string, keyword, or Volume argument." - [v] - (cond - (instance? Volume v) (.getId #^Volume v) - (keyword? v) (name v) - (string? v) v - :else (throw (IllegalArgumentException. - (str "Can't obtain volume id from argument of type " (class v)))))) - -(defn volumes - "Returns a set of org.jclouds.ec2.domain.Volume instances corresponding to the - volumes in the specified region (defaulting to your account's default region). - - e.g. (with-compute-service [compute] (volumes)) - (with-compute-service [compute] (volumes :us-east-1 \"vol-6b218805\" ...))" - [& [region & volume-ids]] - (set - (.describeVolumesInRegion (ebs-service) - (get-region region) - (into-array String (map get-volume-id - (if (get-region region) - volume-ids - (when region (cons region volume-ids)))))))) -(defn- as-string - [v] - (cond - (string? v) v - (keyword? v) (name v) - :else v)) -(defn- get-string - [map key] - (as-string (get map key))) -(defn- as-int - [v] - (cond - (number? v) (int v) - (string? v) (Integer/parseInt v) - :else (throw (IllegalArgumentException. - (str "Don't know how to convert object of type " (class v) " to a string"))))) - -(defn- snapshot-options - [optmap] - (let [string-array #(let [v (% optmap)] - (into-array String (cond - (keyword? v) [(name v)] - (string? v) [v] - :else (map as-string v))))] - (-> (DescribeSnapshotsOptions.) - (.ownedBy (string-array :owner)) - (.snapshotIds (string-array :ids)) - (.restorableBy (string-array :restorable-by))))) - -(defn snapshots - "Returns a set of org.jclouds.aws.ec2.domain.Snapshot instances that match - the criteria provided. Options include: - - :region - region string, keyword, or NodeMetadata - :owner - AWS account id (or \"amazon\" or \"self\") - :restorable-by - AWS account id - - Multiple values for each type of criteria can be provided by passing a seq - of the appropriate types as values. - - (with-compute-service [compute] - (snapshots :owner \"self\") - (snapshots :region :us-west-1 :ids [\"snap-44b3ab2d\" \"snap-9e8821f7\"]))" - [& options] - (let [options (apply hash-map options) - region (:region options) - options (snapshot-options (dissoc options :region))] - (set - (.describeSnapshotsInRegion (ebs-service) - (get-region region) - (into-array DescribeSnapshotsOptions [options]))))) - -(defn create-snapshot - "Creates a snapshot of a volume in the specified region with an optional description. - If provided, the description must be < 255 characters in length. Returns the - org.jclouds.aws.ec2.domain.Snapshot object representing the created snapshot. - - e.g. (with-compute-service [compute] - (create-snapshot some-volume-instance) - (create-snapshot :us-east-1 \"vol-1dbe6785\" nil) - (create-snapshot :us-east-1 \"vol-1dbe6785\" \"super-important data\"))" - ([#^Volume volume] (create-snapshot volume nil)) - ([#^Volume volume description] (create-snapshot (.getRegion volume) (.getId volume) description)) - ([region volume-id description] - (.createSnapshotInRegion (ebs-service) - (get-region region) - (as-string volume-id) - (into-array CreateSnapshotOptions (when description - [(.withDescription (CreateSnapshotOptions.) description)]))))) - -(defn delete-snapshot - "Deletes a snapshot in the specified region. - - e.g. (with-compute-service [compute] - (delete-snapshot :us-east-1 :snap-252310af) - (delete-snapshot :us-east-1 \"snap-242adf03\"))" - ([#^Snapshot snapshot] (delete-snapshot (.getRegion snapshot) (.getId snapshot))) - ([region snapshot-id] - (.deleteSnapshotInRegion (ebs-service) - (get-region region) - (as-string snapshot-id)))) - -(defn get-zone - [v] - (cond - (instance? AvailabilityZoneInfo v) (.getZone v) - (instance? NodeMetadata v) (compute/location #^NodeMetadata v) - (string? v) v - (keyword? v) (name v) - :else (throw (IllegalArgumentException. - (str "Can't obtain zone from argument of type " (class v)))))) - -(defn attach-volume - "Attaches a volume to an instance, returning the resulting org.jclouds.aws.ec2.domain.Attachment. - - e.g. (with-compute-service [compute] - (attach-volume :us-east-1 \"i-a92358c1\" :vol-45228a6d \"/dev/sdh\") - (attach-volume some-node-instance :vol-45228a6d \"/dev/sdh\") - (attach-volume some-node-instance some-volume-instance \"/dev/sdh\"))" - ([#^NodeMetadata node volume device] - (attach-volume node (.getProviderId node) (get-volume-id volume) device)) - ([region instance-id volume-id device] - (apply #(.attachVolumeInRegion (ebs-service) - (get-region region) % %2 %3) - (map as-string [volume-id instance-id device])))) - -(defn detach-volume - "Detatches a volume from the instance to which it is currently attached. - The volume may be specified with a Volume instance, a string, or a keyword. - Providing a logical true value for the :force option will cause the volume - to be forcibly detached, regardless of whether it is in-use (mounted) or not. - - If the volume is specified as a string or keyword, one of the following options - is additionally required: - - :region - the region where the volume is allocated - :node - a node in the region where the volume is allocated - - FYI: It appears that issuing a detatch-volume command while the volume in question is mounted - will cause the volume to be detatched immediately upon the volume beign unmounted." - [volume & options] - (let [options (apply hash-map options) - volume-id (get-volume-id volume) - region (get-region (if (instance? Volume volume) - (.getRegion volume) - (or (:region options) (:node options))))] - (when (not region) - (throw (IllegalArgumentException. - "Must specify volume's region via :region or :node options, or by providing a Volume instance."))) - (.detachVolumeInRegion (ebs-service) - region - volume-id - (boolean (:force options)) - (into-array DetachVolumeOptions [])))) - -(defn create-volume - "Creates a new volume given a set of options: - - - one of :zone (keyword, string, or AvailabilityZoneInfo) or :node (NodeMetadata) - - one or both of :snapshot (keyword, string, or Snapshot instance) or :size - (string, keyword, or number) - - :device (string or keyword) provided *only* when you want to attach the new volume to - the :node you specified! - - Returns a vector of [created org.jclouds.ec2.domain.Volume, - optional org.jclouds.ec2.domain.Attachment] - - Note that specifying :node instead of :zone will only attach the created volume - :device is also provided. Otherwise, the node is only used to obtain the desired - availability zone. - - Note also that if :device and :node are specified, and the attach operation fails, - you will have \"leaked\" the newly-created volume - (volume creation and attachment cannot be done atomically). - - e.g. (with-compute-service [compute] - (create-volume :zone :us-east-1a :size 250) - (create-volume :node node-instance :size 250) - (create-volume :node node-instance :size 250 :device \"/dev/sdj\") - (create-volume :zone :eu-west-1b :snapshot \"snap-252310af\") - (create-volume :zone :eu-west-1b :snapshot snapshot-instance) - (create-volume :zone :eu-west-1b :snapshot \"snap-252310af\" :size :1024))" - [& options] - (when (-> options count odd?) - (throw (IllegalArgumentException. "Must provide key-value pairs, e.g. :zone :us-east-1d :size 200"))) - (let [options (apply hash-map options) - snapshot (get-string options :snapshot) - snapshot (if (snapshot? snapshot) (.getId snapshot) snapshot) - size (-?> (get-string options :size) as-int) - #^NodeMetadata node (:node options) - zone (or node (get-string options :zone)) - zone (if zone - (get-zone zone) - (throw (IllegalArgumentException. "Must supply a :zone or :node option."))) - ebs (ebs-service)] - (when (and (:device options) (not node)) - (throw (IllegalArgumentException. "Cannot create and attach new volume; no :node specified"))) - (let [new-volume (cond - (and snapshot size) (.createVolumeFromSnapshotInAvailabilityZone ebs zone size snapshot) - snapshot (.createVolumeFromSnapshotInAvailabilityZone ebs zone snapshot) - size (.createVolumeInAvailabilityZone ebs zone size) - :else (throw (IllegalArgumentException. "Must supply :size and/or :snapshot options.")))] - [new-volume (when (:device options) - (attach-volume node new-volume (as-string (:device options))))]))) - -(defn delete-volume - "Deletes a volume in the specified region. - - e.g. (with-compute-service [compute] - (delete-volume :us-east-1 :vol-45228a6d) - (delete-volume :us-east-1 \"vol-052b846c\"))" - ([#^Volume volume] - (delete-volume (.getRegion volume) (.getId volume))) - ([region volume-id] - (.deleteVolumeInRegion (ebs-service) - (get-region region) - (as-string volume-id)))) - -(defn status - "Returns the status of the given entity; works for Volumes and Snapshots." - [k] - (.getStatus k)) - -(defn status-available? - [#^Volume v] - (= Volume$Status/AVAILABLE (status v))) - -(defn status-creating? - [#^Volume v] - (= Volume$Status/CREATING (status v))) - -(defn status-deleting? - [#^Volume v] - (= Volume$Status/DELETING (status v))) - -(defn status-in-use? - [#^Volume v] - (= Volume$Status/IN_USE (status v))) - -(defn status-completed? - [#^Snapshot s] - (= Snapshot$Status/COMPLETED (status s))) - -(defn status-error? - [#^Snapshot s] - (= Snapshot$Status/ERROR (status s))) - -(defn status-pending? - [#^Snapshot s] - (= Snapshot$Status/PENDING (status s))) \ No newline at end of file diff --git a/apis/ec2/src/main/clojure/org/jclouds/ec2/elastic_ip.clj b/apis/ec2/src/main/clojure/org/jclouds/ec2/elastic_ip.clj deleted file mode 100644 index 6c52c4cc7f..0000000000 --- a/apis/ec2/src/main/clojure/org/jclouds/ec2/elastic_ip.clj +++ /dev/null @@ -1,83 +0,0 @@ -; -; Licensed to jclouds, Inc. (jclouds) under one or more -; contributor license agreements. See the NOTICE file -; distributed with this work for additional information -; regarding copyright ownership. jclouds licenses this file -; to you under the Apache License, Version 2.0 (the -; "License"); you may not use this file except in compliance -; with the License. You may obtain a copy of the License at -; -; http://www.apache.org/licenses/LICENSE-2.0 -; -; Unless required by applicable law or agreed to in writing, -; software distributed under the License is distributed on an -; "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY -; KIND, either express or implied. See the License for the -; specific language governing permissions and limitations -; under the License. -; - -(ns - #^{:author "Chas Emerick, cemerick@snowtide.com" - :doc "A clojure binding for the jclouds AWS elastic IP address interface."} - org.jclouds.ec2.elastic-ip - (:require (org.jclouds [compute :as compute]) - [org.jclouds.ec2.ebs :as ebs]) - (:import org.jclouds.compute.domain.NodeMetadata - (org.jclouds.ec2.domain PublicIpInstanceIdPair))) - -(defn #^org.jclouds.ec2.services.ElasticIPAddressClient - eip-service - "Returns the synchronous ElasticIPAddressClient associated with - the specified compute service, or compute/*compute* as bound by with-compute-service." - [& [compute]] - (-> (or compute compute/*compute*) - .getContext .getProviderSpecificContext .getApi .getElasticIPAddressServices)) - -(defn allocate - "Claims a new elastic IP address within the (optionally) specified region for your account. - Region may be a string, keyword, or a node from which the region - is inferred. Returns the IP address as a string." - ([] (allocate nil)) - ([region] - (.allocateAddressInRegion (eip-service) (ebs/get-region region)))) - -(defn associate - "Associates an elastic IP address with a node." - ([#^NodeMetadata node public-ip] - (associate node public-ip (.getProviderId node))) - ([region public-ip instance-id] - (.associateAddressInRegion (eip-service) - (ebs/get-region region) - public-ip - instance-id))) - -(defn addresses - "Returns a map of elastic IP addresses to maps with slots: - - :region - the region (string/keyword/NodeMetadata) the IP address is allocated within - :node-id - the ID of the instance with which the IP address is associated (optional) - - You may optionally specify which IP addresses you would like to query." - ([] (addresses nil)) - ([region & public-ips] - (into {} (for [#^PublicIpInstanceIdPair pair (.describeAddressesInRegion (eip-service) - (ebs/get-region region) - (into-array String public-ips))] - [(.getPublicIp pair) (merge {:region (.getRegion pair)} - (when (.getInstanceId pair) {:node-id (.getInstanceId pair)}))])))) - -(defn dissociate - "Dissociates an elastic IP address from the node with which it is currently associated." - [region public-ip] - (.disassociateAddressInRegion (eip-service) - (ebs/get-region region) - public-ip)) - -(defn release - "Disclaims an elastic IP address from your account." - ([public-ip] (release nil public-ip)) - ([region public-ip] - (.releaseAddressInRegion (eip-service) - (ebs/get-region region) - public-ip))) diff --git a/blobstore/src/main/clojure/org/jclouds/blobstore.clj b/blobstore/src/main/clojure/org/jclouds/blobstore.clj deleted file mode 100644 index c27e95bcb0..0000000000 --- a/blobstore/src/main/clojure/org/jclouds/blobstore.clj +++ /dev/null @@ -1,460 +0,0 @@ -; -; Licensed to jclouds, Inc. (jclouds) under one or more -; contributor license agreements. See the NOTICE file -; distributed with this work for additional information -; regarding copyright ownership. jclouds licenses this file -; to you under the Apache License, Version 2.0 (the -; "License"); you may not use this file except in compliance -; with the License. You may obtain a copy of the License at -; -; http://www.apache.org/licenses/LICENSE-2.0 -; -; Unless required by applicable law or agreed to in writing, -; software distributed under the License is distributed on an -; "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY -; KIND, either express or implied. See the License for the -; specific language governing permissions and limitations -; under the License. -; - -(ns org.jclouds.blobstore - "A clojure binding for the jclouds BlobStore. - -Current supported services are: - [transient, filesystem, azureblob, atmos, walrus, scaleup-storage, ninefold-storage - googlestorage, synaptic, peer1-storage, aws-s3, eucalyptus-partnercloud-s3, - cloudfiles-us, cloudfiles-uk, swift, scality-rs2, hosteurope-storage - tiscali-storage] - -Here's a quick example of how to viewresources in rackspace - - (use 'org.jclouds.blobstore) - - (def user \"rackspace_username\") - (def password \"rackspace_password\") - (def blobstore-name \"cloudfiles\") - - (with-blobstore [blobstore-name user password] - (pprint (locations)) - (pprint (containers)) - (pprint (blobs blobstore your_container_name))) - -See http://code.google.com/p/jclouds for details." - (:use [org.jclouds.core]) - (:import [java.io File FileOutputStream OutputStream] - java.util.Properties - [org.jclouds.blobstore - AsyncBlobStore domain.BlobBuilder BlobStore BlobStoreContext - BlobStoreContextFactory domain.BlobMetadata domain.StorageMetadata - domain.Blob options.ListContainerOptions] - org.jclouds.io.Payloads - org.jclouds.io.payloads.PhantomPayload - java.util.Arrays - [java.security DigestOutputStream MessageDigest] - com.google.common.collect.ImmutableSet)) - -(defn blobstore - "Create a logged in context. -Options for communication style - :sync and :async. -Options can also be specified for extension modules - :log4j :enterprise :ning :apachehc :bouncycastle :joda :gae" - ([#^String provider #^String provider-identity #^String provider-credential - & options] - (let [module-keys (set (keys module-lookup)) - ext-modules (filter #(module-keys %) options) - opts (apply hash-map (filter #(not (module-keys %)) options))] - (let [context (.. (BlobStoreContextFactory.) - (createContext - provider provider-identity provider-credential - (apply modules (concat ext-modules (opts :extensions))) - (reduce #(do (.put %1 (name (first %2)) (second %2)) %1) - (Properties.) (dissoc opts :extensions))))] - (if (some #(= :async %) options) - (.getAsyncBlobStore context) - (.getBlobStore context)))))) - -(defn blobstore-context - "Returns a blobstore context from a blobstore." - [blobstore] - (.getContext blobstore)) - -(defn blob? - [object] - (instance? Blob)) - -(defn blobstore? - [object] - (or (instance? BlobStore object) - (instance? AsyncBlobStore object))) - -(defn blobstore-context? - [object] - (instance? BlobStoreContext object)) - -(defn as-blobstore - "Tries hard to produce a blobstore from its input arguments" - [& args] - (cond - (blobstore? (first args)) (first args) - (blobstore-context? (first args)) (.getBlobStore (first args)) - :else (apply blobstore args))) - -(def ^{:dynamic :true} *blobstore*) - -(def ^{:dynamic :true} *max-retries* 3) - -(defmacro with-blobstore [[& blobstore-or-args] & body] - `(binding [*blobstore* (as-blobstore ~@blobstore-or-args)] - ~@body)) - -(defn containers - "List all containers in a blobstore." - ([] (containers *blobstore*)) - ([blobstore] (.list blobstore))) - -(def #^{:private true} list-option-map - {:after-marker #(.afterMarker %1 %2) - :in-directory #(.inDirectory %1 %2) - :max-results #(.maxResults %1 %2) - :with-details #(when %2 (.withDetails %1)) - :recursive #(when %2 (.recursive %1))}) - -(defn list-container - "Low-level container listing. Use list-blobs where possible since - it's higher-level and returns a lazy seq. Options are: - :after-marker string - :in-direcory path - :max-results n - :with-details true - :recursive true" - [blobstore & args] - (if (blobstore? blobstore) - (let [[container-name & args] args - options (apply hash-map args) - list-options (reduce - (fn [lco [k v]] - ((list-option-map k) lco v) - lco) - (ListContainerOptions.) - options)] - (.list blobstore container-name list-options)) - (apply list-container *blobstore* blobstore args))) - -(defn- list-blobs-chunk [container prefix #^BlobStore blobstore & [marker]] - (apply list-container blobstore container - (concat (when prefix - [:in-directory prefix]) - (when (string? marker) - [:after-marker marker])))) - -(defn- list-blobs-chunks [container prefix #^BlobStore blobstore marker] - (when marker - (let [chunk (list-blobs-chunk container prefix blobstore marker)] - (lazy-seq (cons chunk - (list-blobs-chunks container prefix blobstore - (.getNextMarker chunk))))))) - -(defn- concat-elements - "Make a lazy concatenation of the lazy sequences contained in coll. Lazily evaluates coll. -Note: (apply concat coll) or (lazy-cat coll) are not lazy wrt coll itself." - [coll] - (if-let [s (seq coll)] - (lazy-seq (concat (first s) (concat-elements (next s)))))) - -(defn list-blobs - "Returns a lazy seq of all blobs in the given container." - ([container] - (list-blobs container *blobstore*)) - ([container blobstore] - (list-blobs container nil blobstore)) - ([container prefix blobstore] - (concat-elements (list-blobs-chunks container prefix blobstore :start)))) - -(defn locations - "Retrieve the available container locations for the blobstore context." - ([] (locations *blobstore*)) - ([#^BlobStore blobstore] - (seq (.listAssignableLocations blobstore)))) - -(defn create-container - "Create a container." - ([container-name] - (create-container container-name nil *blobstore*)) - ([container-name location] - (create-container container-name location *blobstore*)) - ([container-name location #^BlobStore blobstore] - (.createContainerInLocation blobstore location container-name))) - -(defn clear-container - "Clear a container." - ([container-name] - (clear-container container-name *blobstore*)) - ([container-name #^BlobStore blobstore] - (.clearContainer blobstore container-name))) - -(defn delete-container - "Delete a container." - ([container-name] - (delete-container container-name *blobstore*)) - ([container-name #^BlobStore blobstore] - (.deleteContainer blobstore container-name))) - -(defn container-exists? - "Predicate to check presence of a container" - ([container-name] - (container-exists? container-name *blobstore*)) - ([container-name #^BlobStore blobstore] - (.containerExists blobstore container-name))) - -(defn directory-exists? - "Predicate to check presence of a directory" - ([container-name path] - (directory-exists? container-name path *blobstore*)) - ([container-name path #^BlobStore blobstore] - (.directoryExists blobstore container-name path))) - -(defn create-directory - "Create a directory path." - ([container-name path] - (create-directory container-name path *blobstore*)) - ([container-name path #^BlobStore blobstore] - (.createDirectory blobstore container-name path))) - -(defn delete-directory - "Delete a directory path." - ([container-name path] - (delete-directory container-name path *blobstore*)) - ([container-name path #^BlobStore blobstore] - (.deleteDirectory blobstore container-name path))) - -(defn blob-exists? - "Predicate to check presence of a blob" - ([container-name path] - (blob-exists? container-name path *blobstore*)) - ([container-name path #^BlobStore blobstore] - (.blobExists blobstore container-name path))) - -(defn put-blob - "Put a blob. Metadata in the blob determines location." - ([container-name blob] - (put-blob container-name blob *blobstore*)) - ([container-name blob #^BlobStore blobstore] - (.putBlob blobstore container-name blob))) - -(defn blob-metadata - "Get metadata from given path" - ([container-name path] - (blob-metadata container-name path *blobstore*)) - ([container-name path #^BlobStore blobstore] - (.blobMetadata blobstore container-name path))) - -(defn ^{:dynamic :true} get-blob - "Get blob from given path" - ([container-name path] - (get-blob container-name path *blobstore*)) - ([container-name path #^BlobStore blobstore] - (.getBlob blobstore container-name path))) - -(defn sign-blob-request - "Get a signed http request for manipulating a blob in another application. - ex. curl. The default is for a :get request. - The request argument is used to specify charecteristics of the request - to be signed. The :method key must be set to one of :get, :delete, and - :put. For :put requests, :content-length must be specified. Optionally, - :content-type, :content-disposition, :content-language, :content-encoding - and :content-md5 may be given." - {:deprecated "1.0-beta-10"} - ([container-name path] - (sign-blob-request container-name path {:method :get} *blobstore*)) - ([container-name path - {:keys [method content-type content-length content-md5 - content-disposition content-encoding content-language] :as request}] - (sign-blob-request container-name path request *blobstore*)) - ([container-name path - {:keys [method content-type content-length content-md5 - content-disposition content-encoding content-language]} blobstore] - {:pre [(#{:delete :get :put} method) - (or content-length (#{:delete :get} method))]} - (case method - :delete (.signRemoveBlob - (.. blobstore getContext getSigner) container-name path) - :get (.signGetBlob - (.. blobstore getContext getSigner) container-name path) - :put (.signPutBlob - (.. blobstore getContext getSigner) container-name - (doto (.build (.blobBuilder blobstore path)) - (.setPayload - (let [payload (PhantomPayload.) - metadata (.getContentMetadata payload)] - ;; TODO look into use of ContentMetadata constructor - (doto metadata - (.setContentLength (long content-length)) - (.setContentType content-type) - (.setContentMD5 content-md5) - (.setContentDisposition content-disposition) - (.setContentEncoding content-encoding) - (.setContentLanguage content-language)) - payload))))))) - -(defn sign-get - "Get a signed http GET request for manipulating a blob in another - application, Ex. curl." - ([container-name name] - (sign-get container-name name *blobstore*)) - ([container-name name ^BlobStore blobstore] - (.signGetBlob (.. blobstore getContext getSigner) container-name name))) - -(defn sign-put - "Get a signed http PUT request for manipulating a blob in another - application, Ex. curl. A Blob with at least the name and content-length - must be given." - ([container-name blob] - (sign-put container-name blob *blobstore*)) - ([container-name ^Blob blob ^BlobStore blobstore] - (.signPutBlob (.. blobstore getContext getSigner) - container-name - blob))) - -(defn sign-delete - "Get a signed http DELETE request for manipulating a blob in another - applicaiton, Ex. curl." - ([container-name name] - (sign-delete container-name name *blobstore*)) - ([container-name name ^BlobStore blobstore] - (.signRemoveBlob (.. blobstore getContext getSigner) container-name name))) - -(defn get-blob-stream - "Get an inputstream from the blob at a given path" - ([container-name path] - (get-blob-stream container-name path *blobstore*)) - ([container-name path #^BlobStore blobstore] - (.getInput(.getPayload(.getBlob blobstore container-name path))))) - -(defn remove-blob - "Remove blob from given path" - ([container-name path] - (remove-blob container-name path *blobstore*)) - ([container-name path #^BlobStore blobstore] - (.removeBlob blobstore container-name path))) - -(defn count-blobs - "Count blobs" - ([container-name] - (count-blobs container-name *blobstore*)) - ([container-name blobstore] - (.countBlobs blobstore container-name))) - -(defn blobs - "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 (as-blobstore blobstore) container-name)) - - ([blobstore container-name dir] - (.list (as-blobstore blobstore) container-name - (.inDirectory (new ListContainerOptions) dir)))) -(defn blob - "create a new blob with the specified payload" - {:deprecated "1.0-beta-10"} - ([#^String name payload] - (blob name payload *blobstore*)) - ([#^String name payload #^BlobStore blobstore] - (.build - (.payload - (.blobBuilder blobstore name) payload)))) - -(defn blob2 - "Create a new blob with the specified payload and options." - ([^String name option-map] - (blob2 name option-map *blobstore*)) - ([^String name - {:keys [payload content-type content-length content-md5 calculate-md5 - content-disposition content-encoding content-language metadata]} - ^BlobStore blobstore] - {:pre [(not (and content-md5 calculate-md5)) - (not (and (nil? payload) calculate-md5))]} - (let [blob-builder (if payload - (.payload (.blobBuilder blobstore name) payload) - (.forSigning (.blobBuilder blobstore name))) - blob-builder (if content-length ;; Special case, arg is prim. - (.contentLength blob-builder content-length) - blob-builder) - blob-builder (if calculate-md5 ;; Only do calculateMD5 OR contentMD5. - (.calculateMD5 blob-builder) - (if content-md5 - (.contentMD5 blob-builder content-md5) - blob-builder))] - (doto blob-builder - (.contentType content-type) - (.contentDisposition content-disposition) - (.contentEncoding content-encoding) - (.contentLanguage content-language) - (.userMetadata metadata)) - (.build blob-builder)))) - -(defn md5-blob - "add a content md5 to a blob, or make a new blob that has an md5. -note that this implies rebuffering, if the blob's payload isn't repeatable" - ([#^Blob blob] - (Payloads/calculateMD5 blob)) - ([#^String name payload] - (md5-blob name payload *blobstore*)) - ([#^String name payload #^BlobStore blobstore] - (md5-blob (blob2 name {:payload payload} blobstore)))) - -(defn upload-blob - "Create anrepresenting text data: -container, name, string -> etag" - ([container-name name data] - (upload-blob container-name name data *blobstore*)) - ([container-name name data #^BlobStore blobstore] - (put-blob container-name - (md5-blob name data blobstore) blobstore))) - -(defmulti #^{:arglists '[[container-name name target] - [container-name name target blobstore]]} - download-blob (fn [& args] - (if (= (count args) 3) - ::short-form - (class (last (butlast args)))))) - -(defmethod download-blob ::short-form - [container-name name target] - (download-blob container-name name target *blobstore*)) - -(defmethod download-blob OutputStream [container-name name target blobstore - & [retries]] - (let [blob (get-blob container-name name blobstore) - digest-stream (DigestOutputStream. - target (.md5(.crypto (.utils (blobstore-context blobstore)))))] - (.writeTo (.getPayload blob) digest-stream) - (let [digest (.digest (.getMessageDigest digest-stream)) - metadata-digest (.getContentMD5 (.getContentMetadata (.getPayload blob)))] - (when-not (Arrays/equals digest metadata-digest) - (if (<= (or retries 0) *max-retries*) - (recur container-name name target blobstore [(inc (or retries 1))]) - (throw (Exception. (format "Download failed for %s/%s" - container-name name)))))))) - -(defmethod download-blob File [container-name name target blobstore] - (download-blob container-name name (FileOutputStream. target) blobstore)) - -(define-accessors StorageMetadata "blob" type id name - location-id uri last-modified) -(define-accessors BlobMetadata "blob" content-type) - -(defn blob-etag [blob] - (.getETag blob)) - -(defn blob-md5 [blob] - (.getContentMD5 blob)) diff --git a/blobstore/src/test/clojure/org/jclouds/blobstore_test.clj b/blobstore/src/test/clojure/org/jclouds/blobstore_test.clj deleted file mode 100644 index 54318f5591..0000000000 --- a/blobstore/src/test/clojure/org/jclouds/blobstore_test.clj +++ /dev/null @@ -1,247 +0,0 @@ -; -; Licensed to jclouds, Inc. (jclouds) under one or more -; contributor license agreements. See the NOTICE file -; distributed with this work for additional information -; regarding copyright ownership. jclouds licenses this file -; to you under the Apache License, Version 2.0 (the -; "License"); you may not use this file except in compliance -; with the License. You may obtain a copy of the License at -; -; http://www.apache.org/licenses/LICENSE-2.0 -; -; Unless required by applicable law or agreed to in writing, -; software distributed under the License is distributed on an -; "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY -; KIND, either express or implied. See the License for the -; specific language governing permissions and limitations -; under the License. -; - -(ns org.jclouds.blobstore-test - (:use [org.jclouds.blobstore] :reload-all) - (:use [clojure.test]) - (:import [org.jclouds.blobstore BlobStoreContextFactory] - [org.jclouds.crypto CryptoStreams] - [java.io ByteArrayOutputStream] - [org.jclouds.util Strings2])) - -(defn clean-stub-fixture - "This should allow basic tests to easily be run with another service." - [service account key & options] - (fn [f] - (with-blobstore [(apply blobstore service account key options)] - (doseq [container (containers)] - (delete-container (.getName container))) - (f)))) - -(use-fixtures :each (clean-stub-fixture "transient" "" "")) - -(deftest blobstore?-test - (is (blobstore? *blobstore*))) - -(deftest as-blobstore-test - (is (blobstore? (blobstore "transient" "user" "password"))) - (is (blobstore? (as-blobstore *blobstore*))) - (is (blobstore? (as-blobstore (blobstore-context *blobstore*))))) - -(deftest create-existing-container-test - (is (not (container-exists? ""))) - (is (create-container "fred")) - (is (container-exists? "fred"))) - -(deftest create-container-test - (is (create-container "fred")) - (is (container-exists? "fred"))) - -(deftest locations-test - (is (not (empty? (locations)))) - (is (create-container "fred" (first (locations))))) - -(deftest containers-test - (is (empty? (containers))) - (is (create-container "fred")) - (is (= 1 (count (containers))))) - -(deftest list-container-test - (is (create-container "container")) - (is (empty? (list-container "container"))) - (is (upload-blob "container" "blob1" "blob1")) - (is (upload-blob "container" "blob2" "blob2")) - (is (= 2 (count (list-container "container")))) - (is (= 1 (count (list-container "container" :max-results 1)))) - (create-directory "container" "dir") - (is (upload-blob "container" "dir/blob2" "blob2")) - (is (= 3 (count-blobs "container"))) - (is (= 3 (count (list-container "container")))) - (is (= 4 (count (list-container "container" :recursive true)))) - (is (= 3 (count (list-container "container" :with-details true)))) - (is (= 1 (count (list-container "container" :in-directory "dir"))))) - -(deftest list-blobs-test - (is (create-container "container")) - (is (empty? (list-blobs "container"))) - (is (empty? (list-blobs "container" "/a" *blobstore*)))) - -(deftest large-container-list-test - (let [container-name "test" - total-blobs 5000] - ;; create a container full of blobs - (create-container container-name) - (dotimes [i total-blobs] (upload-blob container-name (str i) (str i))) - ;; verify - (is (= total-blobs (count-blobs container-name))))) - -(deftest get-blob-test - (is (create-container "blob")) - (is (upload-blob "blob" "blob1" "blob1")) - (is (upload-blob "blob" "blob2" "blob2")) - (is (= "blob2" (Strings2/toStringAndClose (get-blob-stream "blob" "blob2"))))) - -(deftest download-blob-test - (let [name "test" - container-name "test-container" - data "test content" - data-file (java.io.File/createTempFile "jclouds" "data")] - (try (create-container container-name) - (upload-blob container-name name data) - (download-blob container-name name data-file) - (is (= data (slurp (.getAbsolutePath data-file)))) - (finally (.delete data-file))))) - -(deftest download-checksum-test - (binding [get-blob (fn [blobstore c-name name] - (let [blob (.newBlob blobstore name) - md (.getMetadata blob)] - (.setPayload blob "bogus payload") - (.setContentMD5 md (.getBytes "bogus MD5")) - blob))] - (let [name "test" - container-name "test-container" - data "test content" - data-file (java.io.File/createTempFile "jclouds" "data")] - (try (create-container container-name) - (upload-blob container-name name data) - (is (thrown? Exception - (download-blob container-name name data-file))) - (finally (.delete data-file)))))) - -(deftest sign-blob-request-test - (testing "delete" - (let [request (sign-blob-request "container" "path" {:method :delete})] - (is (= "http://localhost/container/path" (str (.getEndpoint request)))) - (is (= "DELETE" (.getMethod request))))) - (testing "default request" - (let [request (sign-blob-request "container" "path")] - (is (= "http://localhost/container/path" (str (.getEndpoint request)))) - (is (= "GET" (.getMethod request))))) - (testing "get" - (let [request (sign-blob-request "container" "path" {:method :get})] - (is (= "http://localhost/container/path" (str (.getEndpoint request)))) - (is (= "GET" (.getMethod request))))) - (testing "put" - (let [request (sign-blob-request - "container" "path" {:method :put :content-length 10})] - (is (= "http://localhost/container/path" (str (.getEndpoint request)))) - (is (= "PUT" (.getMethod request))) - (is (= "10" (first (.get (.getHeaders request) "Content-Length")))) - (is (nil? - (first (.get (.getHeaders request) "Content-Type")))))) - (testing "put with headers" - (let [request (sign-blob-request - "container" "path" - {:method :put :content-length 10 - :content-type "x" - :content-language "en" - :content-disposition "f" - :content-encoding "g"})] - (is (= "PUT" (.getMethod request))) - (is (= "10" (first (.get (.getHeaders request) "Content-Length")))) - (is (= "x" (first (.get (.getHeaders request) "Content-Type")))) - (is (= "en" (first (.get (.getHeaders request) "Content-Language")))) - (is (= "f" (first (.get (.getHeaders request) "Content-Disposition")))) - (is (= "g" (first (.get (.getHeaders request) "Content-Encoding"))))))) - -(deftest sign-get-test - (let [request (sign-get "container" "path")] - (is (= "http://localhost/container/path" (str (.getEndpoint request)))) - (is (= "GET" (.getMethod request))))) - -(deftest sign-put-test - (let [request (sign-put "container" - (blob2 "path" {:content-length 10}))] - (is (= "http://localhost/container/path" (str (.getEndpoint request)))) - (is (= "PUT" (.getMethod request))) - (is (= "10" (first (.get (.getHeaders request) "Content-Length")))) - (is (nil? - (first (.get (.getHeaders request) "Content-Type")))))) - -(deftest sign-put-with-headers-test - (let [request (sign-put - "container" - (blob2 "path" {:content-length 10 - :content-type "x" - :content-language "en" - :content-disposition "f" - :content-encoding "g"}))] - (is (= "PUT" (.getMethod request))) - (is (= "10" (first (.get (.getHeaders request) "Content-Length")))) - (is (= "x" (first (.get (.getHeaders request) "Content-Type")))) - (is (= "en" (first (.get (.getHeaders request) "Content-Language")))) - (is (= "f" (first (.get (.getHeaders request) "Content-Disposition")))) - (is (= "g" (first (.get (.getHeaders request) "Content-Encoding")))))) - -(deftest sign-delete-test - (let [request (sign-delete "container" "path")] - (is (= "http://localhost/container/path" (str (.getEndpoint request)))) - (is (= "DELETE" (.getMethod request))))) - -(deftest blob2-test - (let [a-blob (blob2 "test-name" {:payload (.getBytes "test-payload") - :calculate-md5 true})] - (is (= (seq (.. a-blob (getPayload) (getContentMetadata) (getContentMD5))) - (seq (CryptoStreams/md5 (.getBytes "test-payload"))))))) - -;; TODO: more tests involving blob-specific functions - -(deftest corruption-hunt - (let [container-name "test" - name "work-file" - total-downloads 100 - threads 10] - - ;; upload - (create-container container-name) - (when-not (blob-exists? container-name name) - (let [data-stream (java.io.ByteArrayOutputStream.)] - (dotimes [i 5000000] (.write data-stream i)) - (upload-blob container-name name (.toByteArray data-stream)))) - - ;; download - (let [total (atom total-downloads)] - (defn new-agent [] - (agent name)) - - (defn dl-and-restart [blob-s file] - (when-not (<= @total 0) - (with-open [baos (java.io.ByteArrayOutputStream.)] - (try - (download-blob container-name file baos blob-s) - (catch Exception e - (with-open [of (java.io.FileOutputStream. - (java.io.File/createTempFile "jclouds" ".dl"))] - (.write of (.toByteArray baos))) - (throw e)))) - (swap! total dec) - (send *agent* (partial dl-and-restart blob-s)) - file)) - - (defn start-agents [] - (let [agents (map (fn [_] (new-agent)) - (range threads))] - (doseq [a agents] - (send-off a (partial dl-and-restart *blobstore*))) - agents)) - - (let [agents (start-agents)] - (apply await agents) - (is (every? nil? (map agent-errors agents))))))) diff --git a/compute/src/main/clojure/org/jclouds/compute.clj b/compute/src/main/clojure/org/jclouds/compute.clj deleted file mode 100644 index 9589d07da4..0000000000 --- a/compute/src/main/clojure/org/jclouds/compute.clj +++ /dev/null @@ -1,459 +0,0 @@ -; -; Licensed to jclouds, Inc. (jclouds) under one or more -; contributor license agreements. See the NOTICE file -; distributed with this work for additional information -; regarding copyright ownership. jclouds licenses this file -; to you under the Apache License, Version 2.0 (the -; "License"); you may not use this file except in compliance -; with the License. You may obtain a copy of the License at -; -; http://www.apache.org/licenses/LICENSE-2.0 -; -; Unless required by applicable law or agreed to in writing, -; software distributed under the License is distributed on an -; "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY -; KIND, either express or implied. See the License for the -; specific language governing permissions and limitations -; under the License. -; - -(ns org.jclouds.compute - "A clojure binding to the jclouds ComputeService. - -Current supported providers are: - [aws-ec2, eucualyptus-partnercloud-ec2, elastichosts-lon-b, nova, - cloudservers-uk, cloudservers-us, byon, cloudsigma-zrh, stub, - trmk-ecloud, trmk-vcloudexpress, vcloud, bluelock, eucalyptus, - slicehost, elastichosts-lon-p, elastichosts-sat-p, elastichosts, - openhosting-east1, serverlove-z1-man, skalicloud-sdg-my, deltacloud] - -Here's an example of getting some compute configuration from rackspace: - - (use 'org.jclouds.compute) - - (def provider \"cloudservers\") - (def provider-identity \"username\") - (def provider-credential \"password\") - - ;; create a compute service - (def compute - (compute-service provider provider-identity provider-credential)) - - (with-compute-service [compute] - (pprint (locations)) - (pprint (images)) - (pprint (nodes)) - (pprint (hardware-profiles))) - -Here's an example of creating and running a small linux node in the group -webserver: - - ;; create a compute service using ssh and log4j extensions - (def compute - (compute-service - provider provider-identity provider-credential :sshj :log4j)) - - (create-node \"webserver\" compute) - -See http://code.google.com/p/jclouds for details." - (:use org.jclouds.core - (org.jclouds predicate) [clojure.core.incubator :only (-?>)]) - (:import java.io.File - java.util.Properties - [org.jclouds.domain Location] - [org.jclouds.compute - ComputeService ComputeServiceContext ComputeServiceContextFactory] - [org.jclouds.compute.domain - Template TemplateBuilder ComputeMetadata NodeMetadata Hardware - OsFamily Image] - [org.jclouds.compute.options TemplateOptions] - [org.jclouds.compute.predicates - NodePredicates] - [com.google.common.collect ImmutableSet])) - -(defmacro deprecate-fwd [old-name new-name] `(defn ~old-name {:deprecated "beta-9"} [& args#] (apply ~new-name args#))) - -(defn compute-service - "Create a logged in context." - ([#^String provider #^String provider-identity #^String provider-credential - & options] - (let [module-keys (set (keys module-lookup)) - ext-modules (filter #(module-keys %) options) - opts (apply hash-map (filter #(not (module-keys %)) options))] - (.. (ComputeServiceContextFactory.) - (createContext - provider provider-identity provider-credential - (apply modules (concat ext-modules (opts :extensions))) - (reduce #(do (.put %1 (name (first %2)) (second %2)) %1) - (Properties.) (dissoc opts :extensions))) - (getComputeService))))) - -(defn compute-context - "Returns a compute context from a compute service." - [compute] - (.getContext compute)) - -(defn compute-service? - [object] - (instance? ComputeService object)) - -(defn compute-context? - [object] - (instance? ComputeServiceContext object)) - -(defn as-compute-service - "Tries hard to produce a compute service from its input arguments" - [& args] - (cond - (compute-service? (first args)) (first args) - (compute-context? (first args)) (.getComputeService (first args)) - :else (apply compute-service args))) - -(def ^{:dynamic :true} *compute*) - -(defmacro with-compute-service - "Specify the default compute service" - [[& compute-or-args] & body] - `(binding [*compute* (as-compute-service ~@compute-or-args)] - ~@body)) - -(defn locations - "Retrieve the available compute locations for the compute context." - ([] (locations *compute*)) - ([#^ComputeService compute] - (seq (.listAssignableLocations compute)))) - -(defn nodes - "Retrieve the existing nodes for the compute context." - ([] (nodes *compute*)) - ([#^ComputeService compute] - (seq (.listNodes compute)))) - -(defn nodes-with-details - "Retrieve the existing nodes for the compute context." - ([] (nodes-with-details *compute*)) - ([#^ComputeService compute] - (seq (.listNodesDetailsMatching compute (NodePredicates/all))))) - -(defn nodes-in-group - "list details of all the nodes in the given group." - ([group] (nodes-in-group group *compute*)) - ([#^String group #^ComputeService compute] - (filter #(= (.getGroup %) group) (nodes-with-details compute)))) - -(defn images - "Retrieve the available images for the compute context." - ([] (images *compute*)) - ([#^ComputeService compute] - (seq (.listImages compute)))) - -(defn hardware-profiles - "Retrieve the available node hardware profiles for the compute context." - ([] (hardware-profiles *compute*)) - ([#^ComputeService compute] - (seq (.listHardwareProfiles compute)))) - -(defn default-template - ([] (default-template *compute*)) - ([#^ComputeService compute] - (.. compute (templateBuilder) - (options - (org.jclouds.compute.options.TemplateOptions$Builder/authorizePublicKey - (slurp (str (. System getProperty "user.home") "/.ssh/id_rsa.pub")))) - build))) - -(defn create-nodes - "Create the specified number of nodes using the default or specified - template. - - ;; Simplest way to add 2 small linux nodes to the group webserver is to run - (create-nodes \"webserver\" 2 compute) - - ;; which is the same as wrapping the create-nodes command with an implicit - ;; compute service. - ;; Note that this will actually add another 2 nodes to the set called - ;; \"webserver\" - - (with-compute-service [compute] - (create-nodes \"webserver\" 2 )) - - ;; which is the same as specifying the default template - (with-compute-service [compute] - (create-nodes \"webserver\" 2 (default-template))) - - ;; which, on gogrid, is the same as constructing the smallest centos template - ;; that has no layered software - (with-compute-service [compute] - (create-nodes \"webserver\" 2 - (build-template - service - {:os-family :centos :smallest true - :image-name-matches \".*w/ None.*\"})))" - ([group count] - (create-nodes group count (default-template *compute*) *compute*)) - ([group count compute-or-template] - (if (compute-service? compute-or-template) - (create-nodes - group count (default-template compute-or-template) compute-or-template) - (create-nodes group count compute-or-template *compute*))) - ([group count template #^ComputeService compute] - (seq - (.createNodesInGroup compute group count template)))) - -(deprecate-fwd run-nodes create-nodes) - -(defn create-node - "Create a node using the default or specified template. - - ;; simplest way to add a small linux node to the group webserver is to run - (create-node \"webserver\" compute) - - ;; which is the same as wrapping the create-node command with an implicit compute - ;; service. - ;; Note that this will actually add another node to the set called - ;; \"webserver\" - (with-compute-service [compute] - (create-node \"webserver\" ))" - ([group] - (first (create-nodes group 1 (default-template *compute*) *compute*))) - ([group compute-or-template] - (if (compute-service? compute-or-template) - (first - (create-nodes - group 1 (default-template compute-or-template) compute-or-template)) - (first (create-nodes group 1 compute-or-template *compute*)))) - ([group template compute] - (first (create-nodes group 1 template compute)))) - -(deprecate-fwd run-node create-node) - -(defn #^NodeMetadata node-details - "Retrieve the node metadata, given its id." - ([id] (node-details id *compute*)) - ([id #^ComputeService compute] - (.getNodeMetadata compute id))) - -(defn suspend-nodes-in-group - "Reboot all the nodes in the given group." - ([group] (suspend-nodes-in-group group *compute*)) - ([#^String group #^ComputeService compute] - (.suspendNodesMatching compute (NodePredicates/inGroup group)))) - -(defn suspend-node - "Suspend a node, given its id." - ([id] (suspend-node id *compute*)) - ([id #^ComputeService compute] - (.suspendNode compute id))) - -(defn resume-nodes-in-group - "Suspend all the nodes in the given group." - ([group] (resume-nodes-in-group group *compute*)) - ([#^String group #^ComputeService compute] - (.resumeNodesMatching compute (NodePredicates/inGroup group)))) - -(defn resume-node - "Resume a node, given its id." - ([id] (resume-node id *compute*)) - ([id #^ComputeService compute] - (.resumeNode compute id))) - -(defn reboot-nodes-in-group - "Reboot all the nodes in the given group." - ([group] (reboot-nodes-in-group group *compute*)) - ([#^String group #^ComputeService compute] - (.rebootNodesMatching compute (NodePredicates/inGroup group)))) - -(defn reboot-node - "Reboot a node, given its id." - ([id] (reboot-node id *compute*)) - ([id #^ComputeService compute] - (.rebootNode compute id))) - -(defn destroy-nodes-in-group - "Destroy all the nodes in the given group." - ([group] (destroy-nodes-in-group group *compute*)) - ([#^String group #^ComputeService compute] - (.destroyNodesMatching compute (NodePredicates/inGroup group)))) - -(defn destroy-node - "Destroy a node, given its id." - ([id] (destroy-node id *compute*)) - ([id #^ComputeService compute] - (.destroyNode compute id))) - -(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] - (or - (= node nil) - (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 unrecognized-state? - "Predicate for the node being in an unrecognized state." - [#^NodeMetadata node] - (state-predicate node UNRECOGNIZED)) - -(defn public-ips - "Returns the node's public ips" - [#^NodeMetadata node] - (.getPublicAddresses node)) - -(defn private-ips - "Returns the node's private ips" - [#^NodeMetadata node] - (.getPrivateAddresses node)) - -(defn group - "Returns a the node's group" - [#^NodeMetadata node] - (.getGroup node)) - -(defn hostname - "Returns the compute node's name" - [#^ComputeMetadata node] - (.getName node)) - -(defn location - "Returns the compute node's location id" - [#^ComputeMetadata node] - (-?> node .getLocation .getId)) - -(defn id - "Returns the compute node's id" - [#^ComputeMetadata node] - (.getId node)) - -(define-accessors Template image hardware location options) -(define-accessors Image version os-family os-description architecture) -(define-accessors Hardware processors ram volumes) -(define-accessors NodeMetadata "node" credentials hardware state group) - -(def - ^{:doc "TemplateBuilder functions" :private true} - template-map - (merge - (make-option-map - kw-memfn-0arg [:smallest :fastest :biggest :any]) - (make-option-map - kw-memfn-1arg - [:os-family :location-id :architecture :image-id :hardware-id - :os-name-matches :os-version-matches :os-description-matches - :os-64-bit :image-version-matches :image-name-matches - :image-description-matches :min-cores :min-ram]))) - -(def - ^{:doc "TemplateOptions functions" :private true} - options-map - (merge - (make-option-map - kw-memfn-0arg - [:destroy-on-error :enable-monitoring :no-placement-group :no-key-pair - :with-details]) - (make-option-map - kw-memfn-1arg - [:run-script :install-private-key :authorize-public-key - :override-credentials-with :override-login-user-with - :override-login-credential-with - ;; aws ec2 options - :spot-price :spot-options :placement-group :subnet-id - :block-device-mappings :unmapDeviceNamed :security-groups - :key-pair :user-data]) - (make-option-map kw-memfn-varargs [:inbound-ports]) - (make-option-map - kw-memfn-2arg - [:block-on-port - ;; aws ec2 options - :map-ephemeral-device-to-device-name]) - {:map-ebs-snapshot-to-device-name - (memfn-apply mapEBSSnapshotToDeviceName - device-name snapshot-id size-in-gib delete-on-termination) - :map-new-volume-to-device-name - (kw-memfn-apply :map-new-volume-to-device-name - device-name size-in-gib delete-on-termination)})) - -(def - ^{:doc "All receognised options"} - known-template-options - (set (mapcat keys [options-map template-map]))) - -(defn os-families [] - (. OsFamily values)) - -(def enum-map {:os-family (os-families)}) - -(defn translate-enum-value [kword value] - (or (-> (filter #(= (name value) (str %)) (kword enum-map)) first) - value)) - -(defn apply-option [builder option-map option value] - (when-let [f (option-map option)] - (f builder (translate-enum-value option value)))) - -;; TODO look at clojure-datalog -(defn build-template - "Creates a template that can be used to run nodes. - -The :os-family key expects a keyword version of OsFamily, - eg. :os-family :ubuntu. - -The :smallest, :fastest, :biggest, :any, and :destroy-on-error keys expect a -boolean value. - -Options correspond to TemplateBuilder methods." - [#^ComputeService compute - {:keys [os-family location-id architecture image-id hardware-id - os-name-matches os-version-matches os-description-matches - os-64-bit image-version-matches image-name-matches - image-description-matches min-cores min-ram - run-script install-private-key authorize-public-key - inbound-ports smallest fastest biggest any destroy-on-error] - :as options}] - (let [builder (.. compute (templateBuilder))] - (doseq [[option value] options] - (when-not (known-template-options option) - (throw (Exception. (format "Invalid template builder option : %s" option)))) - ;; apply template builder options - (try - (apply-option builder template-map option value) - (catch Exception e - (throw (Exception. (format - "Problem applying template builder %s with value %s: %s" - option (pr-str value) (.getMessage e)) - e))))) - (let [template (.build builder) - template-options (.getOptions template)] - (doseq [[option value] options] - ;; apply template option options - (try - (apply-option template-options options-map option value) - (catch Exception e - (throw (Exception. - (format - "Problem applying template option %s with value %s: %s" - option (pr-str value) (.getMessage e)) - e))))) - template))) diff --git a/compute/src/test/clojure/org/jclouds/compute_test.clj b/compute/src/test/clojure/org/jclouds/compute_test.clj deleted file mode 100644 index 9e7e839a41..0000000000 --- a/compute/src/test/clojure/org/jclouds/compute_test.clj +++ /dev/null @@ -1,111 +0,0 @@ -; -; Licensed to jclouds, Inc. (jclouds) under one or more -; contributor license agreements. See the NOTICE file -; distributed with this work for additional information -; regarding copyright ownership. jclouds licenses this file -; to you under the Apache License, Version 2.0 (the -; "License"); you may not use this file except in compliance -; with the License. You may obtain a copy of the License at -; -; http://www.apache.org/licenses/LICENSE-2.0 -; -; Unless required by applicable law or agreed to in writing, -; software distributed under the License is distributed on an -; "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY -; KIND, either express or implied. See the License for the -; specific language governing permissions and limitations -; under the License. -; - -(ns org.jclouds.compute-test - (:use [org.jclouds.compute] :reload-all) - (:use clojure.test) - (:import - org.jclouds.compute.domain.OsFamily)) - -(defmacro with-private-vars [[ns fns] & tests] - "Refers private fns from ns and runs tests in context. From users mailing -list, Alan Dipert and MeikelBrandmeyer." - `(let ~(reduce #(conj %1 %2 `@(ns-resolve '~ns '~%2)) [] fns) - ~@tests)) - -(deftest os-families-test - (is (some #{"centos"} (map str (os-families))))) - - -(defn clean-stub-fixture - "This should allow basic tests to easily be run with another service." - [service account key & options] - (fn [f] - (with-compute-service [(apply compute-service service account key options)] - (doseq [node (nodes)] - (destroy-node (.getId node))) - (f)))) - -(use-fixtures :each (clean-stub-fixture "stub" "compute.clj" "")) - -(deftest compute-service?-test - (is (compute-service? *compute*))) - -(deftest as-compute-service-test - (is (compute-service? (compute-service "stub" "compute.clj" ""))) - (is (compute-service? (as-compute-service *compute*))) - (is (compute-service? (as-compute-service (compute-context *compute*))))) - -(deftest nodes-test - (is (create-node "fred" (build-template - *compute* {} ))) - (is (= 1 (count (nodes)))) - (is (= 1 (count (nodes-in-group "fred")))) - (suspend-nodes-in-group "fred") - (is (suspended? (first (nodes-in-group "fred")))) - (resume-nodes-in-group "fred") - (is (running? (first (nodes-in-group "fred")))) - (reboot-nodes-in-group "fred") - (is (running? (first (nodes-in-group "fred")))) - (is (create-nodes "fred" 2 (build-template - *compute* {} ))) - (is (= 3 (count (nodes-in-group "fred")))) - (is (= "fred" (group (first (nodes))))) - (destroy-nodes-in-group "fred") - (is (terminated? (first (nodes-in-group "fred"))))) - -(deftest build-template-test - (let [service (compute-service "stub" "compute.clj" "")] - (testing "nullary" - (is (>= (-> (build-template service {:fastest true}) - bean :hardware bean :processors first bean :cores) - 8.0))) - (testing "one arg" - (is (> (-> (build-template service {:min-ram 512}) - bean :hardware bean :ram) - 512)) - (let [credentials (org.jclouds.domain.Credentials. "user" "pwd") - f (juxt #(.identity %) #(.credential %)) - template (build-template - service {:override-credentials-with credentials}) - node (create-node "something" template service)] - (is (= (-> node bean :credentials f) - (f credentials)))) - (let [user "fred" - f #(.identity %) - template (build-template service {:override-login-user-with user}) - node (create-node "something" template service)] - (is (= (-> node bean :credentials f) user))) - (let [credential "fred" - f #(.credential %) - template (build-template - service {:override-login-credential-with credential}) - node (create-node "something" template service)] - (is (= (-> node bean :credentials f) credential)))) - (testing "enumerated" - (is (= OsFamily/CENTOS - (-> (build-template service {:os-family :centos}) - bean :image bean :operatingSystem bean :family)))) - (testing "varags" - (is (java.util.Arrays/equals - (int-array [22 8080]) - (-> (build-template service {:inbound-ports [22 8080]}) - bean :options bean :inboundPorts)))) - (testing "invalid" - (is (thrown? Exception (build-template service {:xx :yy}))))))