Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- (ns pallet.compute.vmfest
- "A vmfest provider"
- (:require
- [pallet.compute :as compute]
- [pallet.compute.jvm :as jvm]
- [pallet.compute.implementation :as implementation]
- [clojure.contrib.condition :as condition]
- [clojure.string :as string]
- [vmfest.virtualbox.vbox :as vbox]
- [vmfest.machine :as machine])
- (:import
- com.sun.xml.ws.commons.virtualbox_3_2.IMedium
- com.sun.xml.ws.commons.virtualbox_3_2.IMachine))
- (defn supported-providers []
- ["virtualbox"])
- (defn machine-task [f]
- "Create a task that will be invoked with a machine"
- (fn [session]
- (let [mutable-machine (.getMachine session)]
- (f mutable-machine))))
- (defn execute-task-with-return-value
- "Execute a task, capturing the return value."
- [machine task]
- (let [return-value (atom nil)
- latch (java.util.concurrent.CountDownLatch. 1)]
- (machine/execute-task
- machine
- #(do
- (try
- (reset! return-value (task %))
- (finally
- (.countDown latch)))))
- (.await latch)
- @return-value))
- (def os-family-name
- {:ubuntu "Ubuntu"
- ;:rhel "RedHat"
- :rhel "RedHat_64"})
- (def os-family-from-name
- (zipmap (vals os-family-name) (keys os-family-name)))
- (extend-type vmfest.virtualbox.vbox.vbox-machine
- pallet.compute/Node
- (ssh-port [node] 22)
- (primary-ip [node] "")
- (private-ip [node] "")
- (is-64bit?
- [node]
- (re-find
- #"64 bit"
- (execute-task-with-return-value
- node (machine-task #(.getOSTypeId %)))))
- (tag [node] "")
- (hostname
- [node]
- (execute-task-with-return-value
- node (machine-task #(.getName %))))
- (os-family
- [node]
- (let [os-name (execute-task-with-return-value
- node (machine-task #(.getOSTypeId %)))]
- (os-family-from-name os-name os-name)))
- (running? [node] true)
- (terminated? [node] false)
- (id [node] ""))
- (defn connection
- [host port identity credential]
- (let [manager (#'vmfest.virtualbox.vbox/create-session-manager host port)
- virtual-box (#'vmfest.virtualbox.vbox/create-vbox
- manager identity credential)]
- [manager virtual-box]))
- (defn find-matching-os [node-type os-types]
- (let [os-family (or (-> node-type :image :os-family) :ubuntu)
- os-type-id (os-family-name os-family)
- os-type (first (filter #(= os-type-id (.getId %)) os-types))]
- (if os-type
- (.getId os-type)
- (throw (Exception. "Can not find a matching os type")))))
- (defn find-matching-machines [os-type-id machines]
- (filter #(= os-type-id (.getOSTypeId %)) machines))
- (defprotocol VirtualBoxService
- (os-families [compute] "Return supported os-families")
- (medium-formats [compute] "Return supported medium-formats"))
- (deftype VirtualBox [host port identity credential]
- VirtualBoxService
- (os-families
- [compute]
- (let [[manager virtual-box] (connection host port identity credential)]
- (try
- (.getGuestOSTypes virtual-box)
- (finally
- (.logoff manager virtual-box)))))
- (medium-formats
- [compute]
- (let [[manager virtual-box] (connection host port identity credential)]
- (.. virtual-box getSystemProperties getMediumFormats)))
- pallet.compute.ComputeService
- (nodes
- [compute-service]
- (let [[manager virtual-box] (connection host port identity credential)]
- (try
- (doall
- (map
- #(vbox/build-vbox-machine host port identity credential (.getId %))
- (.getMachines virtual-box)))
- (finally
- (.logoff manager virtual-box)))))
- (ensure-os-family
- [compute-service request]
- request)
- ;; Not implemented
- ;; (build-node-template)
- (run-nodes
- [compute node-type node-count request init-script]
- (let [[manager virtual-box] (connection host port identity credential)
- os-type-id (find-matching-os node-type (.getGuestOSTypes virtual-box))
- all-machines (.getMachines virtual-box)
- machines (find-matching-machines os-type-id all-machines)
- template-machine (first machines)
- storage-controller (first (.getStorageControllers template-machine))
- ^IMedium base-medium (.getMedium
- template-machine
- (.getName storage-controller) 0 0)
- base-folder nil
- tag-name (name (:tag node-type))
- machine-name (some
- (fn [i]
- (let [n (str tag-name i)]
- (when-not (some #(= n (.getName %)) all-machines)
- n)))
- (range))
- id nil
- override false
- ^IMachine machine (.createMachine
- virtual-box
- machine-name os-type-id base-folder id override)
- vdi (first
- (filter #(= "VDI" (.getName %))
- (.. virtual-box getSystemProperties getMediumFormats)))
- ^IMedium medium (.createHardDisk
- virtual-box
- (.getId vdi)
- (format
- "/Volumes/My Book/vms/diffdisks/%s.vdi"
- machine-name))
- ;; _ (.createDiffStorage
- ;; base-medium medium org.virtualbox_3_2.MediumVariant/DIFF)
- clone-progress (.cloneTo
- base-medium medium
- org.virtualbox_3_2.MediumVariant/DIFF
- base-medium)]
- (vbox/set-attributes {} machine)
- (.saveSettings machine)
- (.addStorageController machine "IDE" org.virtualbox_3_2.StorageBus/IDE)
- (.registerMachine virtual-box machine)
- (.waitForCompletion clone-progress 10000)
- (loop []
- (let [m1 (try
- (when-not (= (.getId medium) (java.util.UUID. 0 0))
- (.getHardDisk virtual-box (.getId medium)))
- (catch Throwable _
- nil))]
- (when-not m1
- (Thread/sleep 500)
- (recur))))
- (let [machine (vbox/build-vbox-machine host port identity credential
- (.getId machine))]
- (machine/execute-task
- machine
- (machine-task
- #(do
- (.attachDevice
- %
- "IDE"
- 0 0
- org.virtualbox_3_2.DeviceType/HARD_DISK
- (.getId medium))
- (.saveSettings %))))
- machine))
- ;; (dotimes [_ node-count]
- ;; (vmfest/start-vm connection virtual-box "image"))
- )
- ;; (reboot "Reboot the specified nodes")
- (boot-if-down
- [compute nodes]
- (doseq [node nodes]
- (let [^com.sun.xml.ws.commons.virtualbox_3_2.ISession
- session (#'vmfest.virtualbox.vbox/get-session node)
- virtual-box (#'vmfest.virtualbox.vbox/get-vbox node)
- uuid (:machine-id node)
- session-type "vrdp"
- env "DISPLAY:0.0"
- progress (.openRemoteSession
- virtual-box session uuid session-type env)]
- ;(with-open [session session])
- (println "Session for VM" uuid "is opening...")
- (.waitForCompletion progress 10000)
- (let [result-code (.getResultCode progress)]
- (if (zero? result-code)
- nil
- true)))))
- (shutdown-node
- [compute node _]
- (machine/execute-task
- node
- (fn [session]
- (let [machine (.getMachine session)
- console (.getConsole session)]
- (when (#{org.virtualbox_3_2.MachineState/RUNNING
- org.virtualbox_3_2.MachineState/PAUSED
- org.virtualbox_3_2.MachineState/STUCK} (.getState machine))
- (let [ progress (.powerDown console)]
- (.waitForCompletion progress 10000)))))))
- ;; (shutdown "Shutdown specified nodes")
- (destroy-nodes-with-tag [compute tag-name])
- (destroy-node
- [compute node]
- )
- (close [compute])
- )
- ;;;; Compute service
- (defmethod implementation/service :virtualbox
- [_ {:keys [host port identity credential]
- :or {host "localhost"
- port "18083"
- username "test"
- password "test"}
- :as options}]
- (VirtualBox. host port identity credential))
Add Comment
Please, Sign In to add comment