Guest User

Untitled

a guest
Jun 19th, 2018
86
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 7.96 KB | None | 0 0
  1. (ns pallet.compute.vmfest
  2. "A vmfest provider"
  3. (:require
  4. [pallet.compute :as compute]
  5. [pallet.compute.jvm :as jvm]
  6. [pallet.compute.implementation :as implementation]
  7. [clojure.contrib.condition :as condition]
  8. [clojure.string :as string]
  9. [vmfest.virtualbox.vbox :as vbox]
  10. [vmfest.machine :as machine])
  11. (:import
  12. com.sun.xml.ws.commons.virtualbox_3_2.IMedium
  13. com.sun.xml.ws.commons.virtualbox_3_2.IMachine))
  14.  
  15. (defn supported-providers []
  16. ["virtualbox"])
  17.  
  18. (defn machine-task [f]
  19. "Create a task that will be invoked with a machine"
  20. (fn [session]
  21. (let [mutable-machine (.getMachine session)]
  22. (f mutable-machine))))
  23.  
  24. (defn execute-task-with-return-value
  25. "Execute a task, capturing the return value."
  26. [machine task]
  27. (let [return-value (atom nil)
  28. latch (java.util.concurrent.CountDownLatch. 1)]
  29. (machine/execute-task
  30. machine
  31. #(do
  32. (try
  33. (reset! return-value (task %))
  34. (finally
  35. (.countDown latch)))))
  36. (.await latch)
  37. @return-value))
  38.  
  39. (def os-family-name
  40. {:ubuntu "Ubuntu"
  41. ;:rhel "RedHat"
  42. :rhel "RedHat_64"})
  43.  
  44. (def os-family-from-name
  45. (zipmap (vals os-family-name) (keys os-family-name)))
  46.  
  47. (extend-type vmfest.virtualbox.vbox.vbox-machine
  48. pallet.compute/Node
  49. (ssh-port [node] 22)
  50. (primary-ip [node] "")
  51. (private-ip [node] "")
  52. (is-64bit?
  53. [node]
  54. (re-find
  55. #"64 bit"
  56. (execute-task-with-return-value
  57. node (machine-task #(.getOSTypeId %)))))
  58. (tag [node] "")
  59. (hostname
  60. [node]
  61. (execute-task-with-return-value
  62. node (machine-task #(.getName %))))
  63. (os-family
  64. [node]
  65. (let [os-name (execute-task-with-return-value
  66. node (machine-task #(.getOSTypeId %)))]
  67. (os-family-from-name os-name os-name)))
  68. (running? [node] true)
  69. (terminated? [node] false)
  70. (id [node] ""))
  71.  
  72.  
  73. (defn connection
  74. [host port identity credential]
  75. (let [manager (#'vmfest.virtualbox.vbox/create-session-manager host port)
  76. virtual-box (#'vmfest.virtualbox.vbox/create-vbox
  77. manager identity credential)]
  78. [manager virtual-box]))
  79.  
  80. (defn find-matching-os [node-type os-types]
  81. (let [os-family (or (-> node-type :image :os-family) :ubuntu)
  82. os-type-id (os-family-name os-family)
  83. os-type (first (filter #(= os-type-id (.getId %)) os-types))]
  84. (if os-type
  85. (.getId os-type)
  86. (throw (Exception. "Can not find a matching os type")))))
  87.  
  88. (defn find-matching-machines [os-type-id machines]
  89. (filter #(= os-type-id (.getOSTypeId %)) machines))
  90.  
  91. (defprotocol VirtualBoxService
  92. (os-families [compute] "Return supported os-families")
  93. (medium-formats [compute] "Return supported medium-formats"))
  94.  
  95. (deftype VirtualBox [host port identity credential]
  96. VirtualBoxService
  97. (os-families
  98. [compute]
  99. (let [[manager virtual-box] (connection host port identity credential)]
  100. (try
  101. (.getGuestOSTypes virtual-box)
  102. (finally
  103. (.logoff manager virtual-box)))))
  104. (medium-formats
  105. [compute]
  106. (let [[manager virtual-box] (connection host port identity credential)]
  107. (.. virtual-box getSystemProperties getMediumFormats)))
  108.  
  109. pallet.compute.ComputeService
  110. (nodes
  111. [compute-service]
  112. (let [[manager virtual-box] (connection host port identity credential)]
  113. (try
  114. (doall
  115. (map
  116. #(vbox/build-vbox-machine host port identity credential (.getId %))
  117. (.getMachines virtual-box)))
  118. (finally
  119. (.logoff manager virtual-box)))))
  120. (ensure-os-family
  121. [compute-service request]
  122. request)
  123. ;; Not implemented
  124. ;; (build-node-template)
  125. (run-nodes
  126. [compute node-type node-count request init-script]
  127. (let [[manager virtual-box] (connection host port identity credential)
  128. os-type-id (find-matching-os node-type (.getGuestOSTypes virtual-box))
  129. all-machines (.getMachines virtual-box)
  130. machines (find-matching-machines os-type-id all-machines)
  131. template-machine (first machines)
  132. storage-controller (first (.getStorageControllers template-machine))
  133. ^IMedium base-medium (.getMedium
  134. template-machine
  135. (.getName storage-controller) 0 0)
  136. base-folder nil
  137. tag-name (name (:tag node-type))
  138. machine-name (some
  139. (fn [i]
  140. (let [n (str tag-name i)]
  141. (when-not (some #(= n (.getName %)) all-machines)
  142. n)))
  143. (range))
  144. id nil
  145. override false
  146. ^IMachine machine (.createMachine
  147. virtual-box
  148. machine-name os-type-id base-folder id override)
  149. vdi (first
  150. (filter #(= "VDI" (.getName %))
  151. (.. virtual-box getSystemProperties getMediumFormats)))
  152. ^IMedium medium (.createHardDisk
  153. virtual-box
  154. (.getId vdi)
  155. (format
  156. "/Volumes/My Book/vms/diffdisks/%s.vdi"
  157. machine-name))
  158. ;; _ (.createDiffStorage
  159. ;; base-medium medium org.virtualbox_3_2.MediumVariant/DIFF)
  160. clone-progress (.cloneTo
  161. base-medium medium
  162. org.virtualbox_3_2.MediumVariant/DIFF
  163. base-medium)]
  164. (vbox/set-attributes {} machine)
  165. (.saveSettings machine)
  166. (.addStorageController machine "IDE" org.virtualbox_3_2.StorageBus/IDE)
  167. (.registerMachine virtual-box machine)
  168. (.waitForCompletion clone-progress 10000)
  169. (loop []
  170. (let [m1 (try
  171. (when-not (= (.getId medium) (java.util.UUID. 0 0))
  172. (.getHardDisk virtual-box (.getId medium)))
  173. (catch Throwable _
  174. nil))]
  175. (when-not m1
  176. (Thread/sleep 500)
  177. (recur))))
  178. (let [machine (vbox/build-vbox-machine host port identity credential
  179. (.getId machine))]
  180. (machine/execute-task
  181. machine
  182. (machine-task
  183. #(do
  184. (.attachDevice
  185. %
  186. "IDE"
  187. 0 0
  188. org.virtualbox_3_2.DeviceType/HARD_DISK
  189. (.getId medium))
  190. (.saveSettings %))))
  191. machine))
  192.  
  193. ;; (dotimes [_ node-count]
  194. ;; (vmfest/start-vm connection virtual-box "image"))
  195. )
  196. ;; (reboot "Reboot the specified nodes")
  197. (boot-if-down
  198. [compute nodes]
  199. (doseq [node nodes]
  200. (let [^com.sun.xml.ws.commons.virtualbox_3_2.ISession
  201. session (#'vmfest.virtualbox.vbox/get-session node)
  202. virtual-box (#'vmfest.virtualbox.vbox/get-vbox node)
  203. uuid (:machine-id node)
  204. session-type "vrdp"
  205. env "DISPLAY:0.0"
  206. progress (.openRemoteSession
  207. virtual-box session uuid session-type env)]
  208. ;(with-open [session session])
  209. (println "Session for VM" uuid "is opening...")
  210. (.waitForCompletion progress 10000)
  211. (let [result-code (.getResultCode progress)]
  212. (if (zero? result-code)
  213. nil
  214. true)))))
  215.  
  216. (shutdown-node
  217. [compute node _]
  218. (machine/execute-task
  219. node
  220. (fn [session]
  221. (let [machine (.getMachine session)
  222. console (.getConsole session)]
  223. (when (#{org.virtualbox_3_2.MachineState/RUNNING
  224. org.virtualbox_3_2.MachineState/PAUSED
  225. org.virtualbox_3_2.MachineState/STUCK} (.getState machine))
  226. (let [ progress (.powerDown console)]
  227. (.waitForCompletion progress 10000)))))))
  228.  
  229. ;; (shutdown "Shutdown specified nodes")
  230. (destroy-nodes-with-tag [compute tag-name])
  231. (destroy-node
  232. [compute node]
  233. )
  234. (close [compute])
  235. )
  236.  
  237. ;;;; Compute service
  238. (defmethod implementation/service :virtualbox
  239. [_ {:keys [host port identity credential]
  240. :or {host "localhost"
  241. port "18083"
  242. username "test"
  243. password "test"}
  244. :as options}]
  245. (VirtualBox. host port identity credential))
Add Comment
Please, Sign In to add comment