mirror of https://github.com/apache/jclouds.git
Issue 840:remove compute.clj and blobstore.clj
This commit is contained in:
Adrian Cole
parent
44db3e0d57
commit
ed7b8895e6
|
|
@ -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)))
|
||||
|
|
@ -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)))
|
||||
|
|
@ -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))
|
||||
|
|
@ -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)))))))
|
||||
|
|
@ -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)))
|
||||
|
|
@ -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}))))))
|
||||
Loading…
Reference in New Issue