Permalink
Browse files

Starting a VM should involve attaching storage

Signed-off-by: David Scott <dave.scott@eu.citrix.com>
  • Loading branch information...
1 parent 9b0973b commit 84264fa1c9c2fba50c2a38341ed4005f800e821e David Scott committed Feb 3, 2014
Showing with 29 additions and 3 deletions.
  1. +5 −2 dbus/vm/ocaml/build.sh
  2. +23 −0 dbus/vm/ocaml/simulator.ml
  3. +1 −1 dbus/vm/resource.xml
View
7 dbus/vm/ocaml/build.sh
@@ -5,14 +5,17 @@ set -x
#obus-gen-server ../vm.xml
obus-gen-interface -o vm ../vm.xml
-
+obus-gen-interface -o resource ../resource.xml
PACKS=obus,lwt.syntax
ocamlfind ocamlc -syntax camlp4o -package $PACKS -c vm.mli
ocamlfind ocamlc -syntax camlp4o -package $PACKS -c vm.ml
+ocamlfind ocamlc -syntax camlp4o -package $PACKS -c resource.mli
+ocamlfind ocamlc -syntax camlp4o -package $PACKS -c resource.ml
+
ocamlfind ocamlc -syntax camlp4o -package $PACKS -c simulator.ml
-ocamlfind ocamlc -syntax camlp4o -package $PACKS -o simulator -linkpkg vm.cmo simulator.cmo
+ocamlfind ocamlc -syntax camlp4o -package $PACKS -o simulator -linkpkg vm.cmo resource.cmo simulator.cmo
View
23 dbus/vm/ocaml/simulator.ml
@@ -3,6 +3,11 @@ open Lwt_io
let vm_start config =
lwt () = printlf "vm_start %s" config in
+ (* Create a proxy for the remote object *)
+ lwt bus = OBus_bus.session () in
+ let proxy = OBus_proxy.make (OBus_peer.make bus "org.xenserver.vm") ["volume"] in
+ lwt (local_uri, id) = OBus_method.call Resource.Org_xenserver_api_resource.m_attach proxy "iscsi://target/lun" in
+ lwt () = printlf " got local_uri %s id %s" local_uri id in
return ()
let vm_stop id =
@@ -16,6 +21,19 @@ let vm_interface =
m_stop = (fun obj id -> vm_stop id);
})
+let volume_attach global_uri =
+ lwt () = printlf "volume_attach %s" global_uri in
+ return ("file://block/device", "some id")
+
+let volume_detach id = printlf "volume_detach %s" id
+
+let volume_interface =
+ Resource.Org_xenserver_api_resource.(make {
+ m_attach = (fun obj global_uri -> volume_attach global_uri);
+ m_detach = (fun obj id -> volume_detach id);
+ })
+
+
lwt () =
lwt bus = OBus_bus.session () in
@@ -29,5 +47,10 @@ lwt () =
(* Export the object on the connection *)
OBus_object.export bus obj;
+ lwt _ = OBus_bus.request_name bus "org.xenserver.volume" in
+ let obj = OBus_object.make ~interfaces:[volume_interface] ["volume"] in
+ OBus_object.attach obj ();
+ OBus_object.export bus obj;
+
(* Wait forever *)
fst (wait ())
View
2 dbus/vm/resource.xml
@@ -5,7 +5,7 @@
<arg name="local_uri" type="s" direction="out"/>
<arg name="id" type="s" direction="out"/>
</method>
- <method name="attach">
+ <method name="detach">
<arg name="id" type="s" direction="in"/>
</method>
</interface>

0 comments on commit 84264fa

Please sign in to comment.