From 9c10c0070d4a695d3298f3f410ffefcae80ac90f Mon Sep 17 00:00:00 2001 From: David Scott Date: Tue, 14 Jul 2015 15:32:47 +0100 Subject: [PATCH 01/10] Convert epoch_begin to Datapath.open, epoch_end to Datapath.close This allows datapath plugins to be clever, creating temporary linked clones on local storage or enabling caching. Signed-off-by: David Scott --- main.ml | 29 +++++++++++++++++++++++++---- 1 file changed, 25 insertions(+), 4 deletions(-) diff --git a/main.ml b/main.ml index e5b9ca1..73e0f7f 100644 --- a/main.ml +++ b/main.ml @@ -569,16 +569,37 @@ let process root_dir name x = let args = Args.VDI.Epoch_begin.request_of_rpc args in Attached_SRs.find args.Args.VDI.Epoch_begin.sr >>= fun sr -> - (* FIXME: will some backends do this in special ways? - See [djs55/xapi-storage#19] *) + (* Discover the URIs using Volume.stat *) + stat root_dir name + args.Args.VDI.Epoch_begin.dbg + sr + args.Args.VDI.Epoch_begin.vdi + >>= fun (datapath, uri, domain) -> + let persistent = args.Args.VDI.Epoch_begin.persistent in + let args = Storage.Datapath.Types.Datapath.Open.In.make + args.Args.VDI.Epoch_begin.dbg + uri persistent in + let args = Storage.Datapath.Types.Datapath.Open.In.rpc_of_t args in + fork_exec_rpc root_dir (script root_dir name (`Datapath datapath) "Datapath.open") args Storage.Datapath.Types.Datapath.Open.Out.t_of_rpc + >>= fun () -> Deferred.Result.return (R.success (Args.VDI.Epoch_begin.rpc_of_response ())) | { R.name = "VDI.epoch_end"; R.params = [ args ] } -> let open Deferred.Result.Monad_infix in let args = Args.VDI.Epoch_end.request_of_rpc args in Attached_SRs.find args.Args.VDI.Epoch_end.sr >>= fun sr -> - (* FIXME: will some backends do this in special ways? - See [djs55/xapi-storage#19] *) + (* Discover the URIs using Volume.stat *) + stat root_dir name + args.Args.VDI.Epoch_end.dbg + sr + args.Args.VDI.Epoch_end.vdi + >>= fun (datapath, uri, domain) -> + let args = Storage.Datapath.Types.Datapath.Close.In.make + args.Args.VDI.Epoch_end.dbg + uri in + let args = Storage.Datapath.Types.Datapath.Close.In.rpc_of_t args in + fork_exec_rpc root_dir (script root_dir name (`Datapath datapath) "Datapath.close") args Storage.Datapath.Types.Datapath.Close.Out.t_of_rpc + >>= fun () -> Deferred.Result.return (R.success (Args.VDI.Epoch_end.rpc_of_response ())) | { R.name = name } -> From 0327da784fbefa822a7a3b2ff2fe156e7a5c8d9a Mon Sep 17 00:00:00 2001 From: David Scott Date: Tue, 14 Jul 2015 19:38:33 +0100 Subject: [PATCH 02/10] Refactor the volume plugin watching code This creates the foundation for watching the datapath plugins. Signed-off-by: David Scott --- main.ml | 71 ++++++++++++++++++++++++++++----------------------------- 1 file changed, 35 insertions(+), 36 deletions(-) diff --git a/main.ml b/main.ml index 73e0f7f..5183d6f 100644 --- a/main.ml +++ b/main.ml @@ -625,49 +625,43 @@ let get_ok = function Format.pp_print_flush fmt (); failwith (Buffer.contents b) -let create switch_path root_dir name = - if Hashtbl.mem servers name - then return () - else begin - info "Adding %s" name - >>= fun () -> - Protocol_async.Server.listen ~process:(process root_dir name) ~switch:switch_path ~queue:(Filename.basename name) () - >>= fun result -> - let server = get_ok result in - Hashtbl.add_exn servers name server; - return () - end - -let destroy switch_path name = - info "Removing %s" name - >>= fun () -> - if Hashtbl.mem servers name then begin - let t = Hashtbl.find_exn servers name in - Protocol_async.Server.shutdown ~t () >>= fun () -> - Hashtbl.remove servers name; - return () - end else return () let rec diff a b = match a with | [] -> [] | a :: aa -> if List.mem b a then diff aa b else a :: (diff aa b) -(* Ensure the right servers are started *) -let sync ~root_dir ~switch_path = - Sys.readdir root_dir - >>= fun names -> - let needed : string list = Array.to_list names in - let got_already : string list = Hashtbl.keys servers in - Deferred.all_ignore (List.map ~f:(create switch_path root_dir) (diff needed got_already)) - >>= fun () -> - Deferred.all_ignore (List.map ~f:(destroy switch_path) (diff got_already needed)) - -let main ~root_dir ~state_path ~switch_path = - Attached_SRs.reload state_path - >>= fun () -> - (* We watch and create queues for the Volume plugins only *) +let watch_volume_plugins ~root_dir ~switch_path = let root_dir = Filename.concat root_dir "volume" in + let create switch_path root_dir name = + if Hashtbl.mem servers name + then return () + else begin + info "Adding %s" name + >>= fun () -> + Protocol_async.Server.listen ~process:(process root_dir name) ~switch:switch_path ~queue:(Filename.basename name) () + >>= fun result -> + let server = get_ok result in + Hashtbl.add_exn servers name server; + return () + end in + let destroy switch_path name = + info "Removing %s" name + >>= fun () -> + if Hashtbl.mem servers name then begin + let t = Hashtbl.find_exn servers name in + Protocol_async.Server.shutdown ~t () >>= fun () -> + Hashtbl.remove servers name; + return () + end else return () in + let sync ~root_dir ~switch_path = + Sys.readdir root_dir + >>= fun names -> + let needed : string list = Array.to_list names in + let got_already : string list = Hashtbl.keys servers in + Deferred.all_ignore (List.map ~f:(create switch_path root_dir) (diff needed got_already)) + >>= fun () -> + Deferred.all_ignore (List.map ~f:(destroy switch_path) (diff got_already needed)) in Async_inotify.create ~recursive:false ~watch_new_dirs:false root_dir >>= fun (watch, _) -> sync ~root_dir ~switch_path @@ -698,6 +692,11 @@ let main ~root_dir ~state_path ~switch_path = loop () in loop () +let main ~root_dir ~state_path ~switch_path = + Attached_SRs.reload state_path + >>= fun () -> + watch_volume_plugins ~root_dir ~switch_path + let main ~root_dir ~state_path ~switch_path = let (_: unit Deferred.t) = main ~root_dir ~state_path ~switch_path in never_returns (Scheduler.go ()) From bc1b570bf292620f85f921daa26f165800cb53b8 Mon Sep 17 00:00:00 2001 From: David Scott Date: Tue, 14 Jul 2015 20:45:05 +0100 Subject: [PATCH 03/10] Watch for new datapath plugins, query their capabilities We keep a table of the known datapath plugins so we can choose the most appropriate one to use. Signed-off-by: David Scott --- main.ml | 76 +++++++++++++++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 71 insertions(+), 5 deletions(-) diff --git a/main.ml b/main.ml index 5183d6f..5047981 100644 --- a/main.ml +++ b/main.ml @@ -106,6 +106,10 @@ let fork_exec_rpc root_dir script_name args response_of_rpc = end end +let script root_dir name kind script = match kind with +| `Volume -> Filename.(concat (concat root_dir name) script) +| `Datapath datapath -> Filename.(concat (concat (concat (dirname root_dir) "datapath") datapath) script) + module Attached_SRs = struct let sr_table : string String.Table.t ref = ref (String.Table.create ()) let state_path = ref None @@ -146,6 +150,29 @@ module Attached_SRs = struct return () end +module Datapath_plugins = struct + let table: Storage.Plugin.Types.query_result String.Table.t ref = ref (String.Table.create ()) + + let register root_dir name = + let args = Storage.Plugin.Types.Plugin.Query.In.make "register" in + let args = Storage.Plugin.Types.Plugin.Query.In.rpc_of_t args in + fork_exec_rpc root_dir (script root_dir name (`Datapath name) "Plugin.Query") args Storage.Plugin.Types.Plugin.Query.Out.t_of_rpc + >>= function + | Ok response -> + info "Registered datapath plugin %s" name + >>= fun () -> + Hashtbl.replace !table name response; + return () + | _ -> + info "Failed to register datapath plugin %s" name + >>= fun () -> + return () + + let unregister root_dir name = + Hashtbl.remove !table name; + return () +end + let vdi_of_volume x = let open Storage_interface in { vdi = x.Storage.Volume.Types.key; @@ -174,10 +201,6 @@ let choose_datapath = function | Some scheme -> return (Ok (scheme, uri, domain)) end -let script root_dir name kind script = match kind with -| `Volume -> Filename.(concat (concat root_dir name) script) -| `Datapath datapath -> Filename.(concat (concat (concat (dirname root_dir) "datapath") datapath) script) - let stat root_dir name dbg sr vdi = let args = Storage.Volume.Types.Volume.Stat.In.make dbg sr vdi in let args = Storage.Volume.Types.Volume.Stat.In.rpc_of_t args in @@ -692,10 +715,53 @@ let watch_volume_plugins ~root_dir ~switch_path = loop () in loop () +let watch_datapath_plugins ~root_dir = + let root_dir = Filename.concat root_dir "datapath" in + let sync ~root_dir = + Sys.readdir root_dir + >>= fun names -> + let needed : string list = Array.to_list names in + let got_already : string list = Hashtbl.keys servers in + Deferred.all_ignore (List.map ~f:(Datapath_plugins.register root_dir) (diff needed got_already)) + >>= fun () -> + Deferred.all_ignore (List.map ~f:(Datapath_plugins.unregister root_dir) (diff got_already needed)) in + Async_inotify.create ~recursive:false ~watch_new_dirs:false root_dir + >>= fun (watch, _) -> + sync ~root_dir + >>= fun () -> + let pipe = Async_inotify.pipe watch in + let open Async_inotify.Event in + let rec loop () = + ( Pipe.read pipe >>= function + | `Eof -> + info "Received EOF from inotify event pipe" + >>= fun () -> + Shutdown.exit 1 + | `Ok (Created path) + | `Ok (Moved (Into path)) -> + Datapath_plugins.register root_dir (Filename.basename path) + | `Ok (Unlinked path) + | `Ok (Moved (Away path)) -> + Datapath_plugins.unregister root_dir (Filename.basename path) + | `Ok (Modified _) -> + return () + | `Ok (Moved (Move (path_a, path_b))) -> + Datapath_plugins.unregister root_dir (Filename.basename path_a) + >>= fun () -> + Datapath_plugins.register root_dir (Filename.basename path_b) + | `Ok Queue_overflow -> + sync ~root_dir + ) >>= fun () -> + loop () in + loop () + let main ~root_dir ~state_path ~switch_path = Attached_SRs.reload state_path >>= fun () -> - watch_volume_plugins ~root_dir ~switch_path + Deferred.all_unit [ + watch_volume_plugins ~root_dir ~switch_path; + watch_datapath_plugins ~root_dir + ] let main ~root_dir ~state_path ~switch_path = let (_: unit Deferred.t) = main ~root_dir ~state_path ~switch_path in From c4cdd127b1c93ac9274415fc2929b21dda81ea42 Mon Sep 17 00:00:00 2001 From: David Scott Date: Tue, 14 Jul 2015 21:22:14 +0100 Subject: [PATCH 04/10] Preliminary support for clone-on-boot / reset-on-boot Upon VDI.epoch_begin with persistent = false, we call `Volume.stat` to discover the possible URIs. We look first for a datapath plugin which can perform clone-on-boot natively (e.g. by truncating vhd leaves) and delegate to that. If a datapath plugin doesn't exist then we will fall back to the Volume.clone / Volume.destroy API. This will be done in a later patch. We expose the VDI_RESET_ON_BOOT/2 capability if the volume plugin supports VDI_CLONE. This isn't ideal as it won't cover the case where a LUN-per-VDI SR which doesn't support VDI.CLONE nevertheless can support clone-on-boot if the tapdisk datapath is used. Signed-off-by: David Scott --- main.ml | 75 +++++++++++++++++++++++++++++++++++++++++---------------- 1 file changed, 54 insertions(+), 21 deletions(-) diff --git a/main.ml b/main.ml index 5047981..6f57f2b 100644 --- a/main.ml +++ b/main.ml @@ -36,6 +36,8 @@ let info fmt = end ) fmt +let _nonpersistent = "NONPERSISTENT" + let backend_error name args = let open Storage_interface in let exnty = Exception.Backend_error (name, args) in @@ -171,6 +173,11 @@ module Datapath_plugins = struct let unregister root_dir name = Hashtbl.remove !table name; return () + + let supports_feature scheme feature = + match Hashtbl.find !table scheme with + | None -> false + | Some query_result -> List.mem query_result.Storage.Plugin.Types.features feature end let vdi_of_volume x = @@ -191,23 +198,36 @@ let vdi_of_volume x = persistent = true; } -let choose_datapath = function - | [] -> return (Error (missing_uri ())) - | uri :: _ -> - let uri' = Uri.of_string uri in - let domain = "0" in - begin match Uri.scheme uri' with - | None -> return (Error (missing_uri ())) - | Some scheme -> return (Ok (scheme, uri, domain)) - end - -let stat root_dir name dbg sr vdi = +let stat ?(persistent = true) root_dir name dbg sr vdi = let args = Storage.Volume.Types.Volume.Stat.In.make dbg sr vdi in let args = Storage.Volume.Types.Volume.Stat.In.rpc_of_t args in let open Deferred.Result.Monad_infix in fork_exec_rpc root_dir (script root_dir name `Volume "Volume.stat") args Storage.Volume.Types.Volume.Stat.Out.t_of_rpc >>= fun response -> - choose_datapath response.Storage.Volume.Types.uri + (* We can only use a URI with a valid scheme, since we use the scheme + to name the datapath plugin. *) + let possible = + List.filter_map ~f:(fun x -> + let uri = Uri.of_string x in + match Uri.scheme uri with + | None -> None + | Some scheme -> Some (scheme, uri) + ) response.Storage.Volume.Types.uri in + (* We can only use URIs whose schemes correspond to registered plugins *) + let possible = List.filter ~f:(fun (scheme, _) -> Hashtbl.mem !Datapath_plugins.table scheme) possible in + (* If we want to be non-persistent, we prefer if the datapath plugin supports it natively *) + let preference_order = + if persistent + then possible + else + let supports_nonpersistent, others = List.partition_map ~f:(fun (scheme, uri) -> + if Datapath_plugins.supports_feature scheme _nonpersistent + then `Fst (scheme, uri) else `Snd (scheme, uri) + ) possible in + supports_nonpersistent @ others in + match preference_order with + | [] -> return (Error (missing_uri ())) + | (scheme, u) :: us -> return (Ok (scheme, Uri.to_string u, "0")) (* Process a message *) let process root_dir name x = @@ -268,6 +288,12 @@ let process root_dir name x = "VDI_ATTACH"; "VDI_DETACH"; "VDI_ACTIVATE"; "VDI_DEACTIVATE"; "VDI_INTRODUCE" ] in + (* If we have the ability to clone a disk then we can provide + clone on boot. *) + let features = + if List.mem features "VDI_CLONE" + then "VDI_RESET_ON_BOOT/2" :: features + else features in let response = { driver = response.Storage.Plugin.Types.plugin; name = response.Storage.Plugin.Types.name; @@ -593,19 +619,26 @@ let process root_dir name x = Attached_SRs.find args.Args.VDI.Epoch_begin.sr >>= fun sr -> (* Discover the URIs using Volume.stat *) - stat root_dir name + let persistent = args.Args.VDI.Epoch_begin.persistent in + stat ~persistent root_dir name args.Args.VDI.Epoch_begin.dbg sr args.Args.VDI.Epoch_begin.vdi >>= fun (datapath, uri, domain) -> - let persistent = args.Args.VDI.Epoch_begin.persistent in - let args = Storage.Datapath.Types.Datapath.Open.In.make - args.Args.VDI.Epoch_begin.dbg - uri persistent in - let args = Storage.Datapath.Types.Datapath.Open.In.rpc_of_t args in - fork_exec_rpc root_dir (script root_dir name (`Datapath datapath) "Datapath.open") args Storage.Datapath.Types.Datapath.Open.Out.t_of_rpc - >>= fun () -> - Deferred.Result.return (R.success (Args.VDI.Epoch_begin.rpc_of_response ())) + (* If non-persistent and the datapath plugin supports NONPERSISTENT + then we delegate this to the datapath plugin. Otherwise we will + make a temporary clone now and attach/detach etc this file. *) + if Datapath_plugins.supports_feature datapath _nonpersistent then begin + let args = Storage.Datapath.Types.Datapath.Open.In.make + args.Args.VDI.Epoch_begin.dbg + uri persistent in + let args = Storage.Datapath.Types.Datapath.Open.In.rpc_of_t args in + fork_exec_rpc root_dir (script root_dir name (`Datapath datapath) "Datapath.open") args Storage.Datapath.Types.Datapath.Open.Out.t_of_rpc + >>= fun () -> + Deferred.Result.return (R.success (Args.VDI.Epoch_begin.rpc_of_response ())) + end else begin + Deferred.return (Error (backend_error "UNIMPLEMENTED" [ name ])) + end | { R.name = "VDI.epoch_end"; R.params = [ args ] } -> let open Deferred.Result.Monad_infix in let args = Args.VDI.Epoch_end.request_of_rpc args in From de23bc31af31d0496e6a1c2e11c29f9e60763c28 Mon Sep 17 00:00:00 2001 From: David Scott Date: Wed, 15 Jul 2015 10:52:42 +0100 Subject: [PATCH 05/10] If the datapath doesn't support clone-on-boot, do it via Volume.clone When the toolstack calls VDI.epoch_begin we query the volume and choose the datapath. If the datapath doesn't expose the NONPERSISTENT capability then we use Volume.clone to make a temporary volume. The key of the volume is added to the metadata of the original volume. In subsequent functions we call `Volume.stat` on the original volume, discover the _clone_on_boot_key and follow the link to the temporary volume. The temporary volume is destroyed on VDI.epoch_end and on Volume.destroy of the original volume. Signed-off-by: David Scott --- main.ml | 169 +++++++++++++++++++++++++++++++++++--------------------- 1 file changed, 105 insertions(+), 64 deletions(-) diff --git a/main.ml b/main.ml index 6f57f2b..ee8d1f3 100644 --- a/main.ml +++ b/main.ml @@ -37,6 +37,7 @@ let info fmt = ) fmt let _nonpersistent = "NONPERSISTENT" +let _clone_on_boot_key = "clone-on-boot" let backend_error name args = let open Storage_interface in @@ -198,12 +199,27 @@ let vdi_of_volume x = persistent = true; } -let stat ?(persistent = true) root_dir name dbg sr vdi = +let stat root_dir name dbg sr vdi = let args = Storage.Volume.Types.Volume.Stat.In.make dbg sr vdi in let args = Storage.Volume.Types.Volume.Stat.In.rpc_of_t args in - let open Deferred.Result.Monad_infix in fork_exec_rpc root_dir (script root_dir name `Volume "Volume.stat") args Storage.Volume.Types.Volume.Stat.Out.t_of_rpc - >>= fun response -> + +let clone root_dir name dbg sr vdi = + let args = Storage.Volume.Types.Volume.Clone.In.make dbg sr vdi in + let args = Storage.Volume.Types.Volume.Clone.In.rpc_of_t args in + fork_exec_rpc root_dir (script root_dir name `Volume "Volume.clone") args Storage.Volume.Types.Volume.Clone.Out.t_of_rpc + +let destroy root_dir name dbg sr vdi = + let args = Storage.Volume.Types.Volume.Destroy.In.make dbg sr vdi in + let args = Storage.Volume.Types.Volume.Destroy.In.rpc_of_t args in + fork_exec_rpc root_dir (script root_dir name `Volume "Volume.destroy") args Storage.Volume.Types.Volume.Destroy.Out.t_of_rpc + +let set root_dir name dbg sr vdi k v = + let args = Storage.Volume.Types.Volume.Set.In.make dbg sr vdi k v in + let args = Storage.Volume.Types.Volume.Set.In.rpc_of_t args in + fork_exec_rpc root_dir (script root_dir name `Volume "Volume.set") args Storage.Volume.Types.Volume.Set.Out.t_of_rpc + +let choose_datapath ?(persistent = true) response = (* We can only use a URI with a valid scheme, since we use the scheme to name the datapath plugin. *) let possible = @@ -403,14 +419,19 @@ let process root_dir name x = let args = Args.VDI.Destroy.request_of_rpc args in Attached_SRs.find args.Args.VDI.Destroy.sr >>= fun sr -> - let args = Storage.Volume.Types.Volume.Destroy.In.make - args.Args.VDI.Destroy.dbg - sr - args.Args.VDI.Destroy.vdi in - let args = Storage.Volume.Types.Volume.Destroy.In.rpc_of_t args in - fork_exec_rpc root_dir (script root_dir name `Volume "Volume.destroy") args Storage.Volume.Types.Volume.Destroy.Out.t_of_rpc + stat root_dir name args.Args.VDI.Destroy.dbg sr args.Args.VDI.Destroy.vdi >>= fun response -> - Deferred.Result.return (R.success (Args.VDI.Destroy.rpc_of_response response)) + (* Destroy any clone-on-boot volume that might exist *) + ( match List.Assoc.find response.Storage.Volume.Types.keys _clone_on_boot_key with + | None -> + return (Ok ()) + | Some temporary -> + (* Destroy the temporary disk we made earlier *) + destroy root_dir name args.Args.VDI.Destroy.dbg sr temporary + ) >>= fun () -> + destroy root_dir name args.Args.VDI.Destroy.dbg sr args.Args.VDI.Destroy.vdi + >>= fun () -> + Deferred.Result.return (R.success (Args.VDI.Destroy.rpc_of_response ())) | { R.name = "VDI.snapshot"; R.params = [ args ] } -> let open Deferred.Result.Monad_infix in let args = Args.VDI.Snapshot.request_of_rpc args in @@ -432,12 +453,7 @@ let process root_dir name x = Attached_SRs.find args.Args.VDI.Clone.sr >>= fun sr -> let vdi_info = args.Args.VDI.Clone.vdi_info in - let args = Storage.Volume.Types.Volume.Clone.In.make - args.Args.VDI.Clone.dbg - sr - vdi_info.vdi in - let args = Storage.Volume.Types.Volume.Clone.In.rpc_of_t args in - fork_exec_rpc root_dir (script root_dir name `Volume "Volume.clone") args Storage.Volume.Types.Volume.Clone.Out.t_of_rpc + clone root_dir name args.Args.VDI.Clone.dbg sr vdi_info.vdi >>= fun response -> let response = vdi_of_volume response in Deferred.Result.return (R.success (Args.VDI.Clone.rpc_of_response response)) @@ -480,9 +496,7 @@ let process root_dir name x = fork_exec_rpc root_dir (script root_dir name `Volume "Volume.resize") args Storage.Volume.Types.Volume.Resize.Out.t_of_rpc >>= fun () -> (* Now call Volume.stat to discover the size *) - let args = Storage.Volume.Types.Volume.Stat.In.make dbg sr vdi in - let args = Storage.Volume.Types.Volume.Stat.In.rpc_of_t args in - fork_exec_rpc root_dir (script root_dir name `Volume "Volume.stat") args Storage.Volume.Types.Volume.Stat.Out.t_of_rpc + stat root_dir name dbg sr vdi >>= fun response -> Deferred.Result.return (R.success (Args.VDI.Resize.rpc_of_response response.Storage.Volume.Types.virtual_size)) | { R.name = "VDI.stat"; R.params = [ args ] } -> @@ -491,12 +505,7 @@ let process root_dir name x = Attached_SRs.find args.Args.VDI.Stat.sr >>= fun sr -> let vdi = args.Args.VDI.Stat.vdi in - let args = Storage.Volume.Types.Volume.Stat.In.make - args.Args.VDI.Stat.dbg - sr - vdi in - let args = Storage.Volume.Types.Volume.Stat.In.rpc_of_t args in - fork_exec_rpc root_dir (script root_dir name `Volume "Volume.stat") args Storage.Volume.Types.Volume.Stat.Out.t_of_rpc + stat root_dir name args.Args.VDI.Stat.dbg sr vdi >>= fun response -> let response = vdi_of_volume response in Deferred.Result.return (R.success (Args.VDI.Stat.rpc_of_response response)) @@ -506,12 +515,7 @@ let process root_dir name x = Attached_SRs.find args.Args.VDI.Introduce.sr >>= fun sr -> let vdi = args.Args.VDI.Introduce.location in - let args = Storage.Volume.Types.Volume.Stat.In.make - args.Args.VDI.Introduce.dbg - sr - vdi in - let args = Storage.Volume.Types.Volume.Stat.In.rpc_of_t args in - fork_exec_rpc root_dir (script root_dir name `Volume "Volume.stat") args Storage.Volume.Types.Volume.Stat.Out.t_of_rpc + stat root_dir name args.Args.VDI.Introduce.dbg sr vdi >>= fun response -> let response = vdi_of_volume response in Deferred.Result.return (R.success (Args.VDI.Introduce.rpc_of_response response)) @@ -521,10 +525,16 @@ let process root_dir name x = Attached_SRs.find args.Args.VDI.Attach.sr >>= fun sr -> (* Discover the URIs using Volume.stat *) - stat root_dir name - args.Args.VDI.Attach.dbg - sr - args.Args.VDI.Attach.vdi + stat root_dir name args.Args.VDI.Attach.dbg sr args.Args.VDI.Attach.vdi + >>= fun response -> + (* If we have a clone-on-boot volume then use that instead *) + ( match List.Assoc.find response.Storage.Volume.Types.keys _clone_on_boot_key with + | None -> + return (Ok response) + | Some temporary -> + stat root_dir name args.Args.VDI.Attach.dbg sr temporary + ) >>= fun response -> + choose_datapath response >>= fun (datapath, uri, domain) -> let args' = Storage.Datapath.Types.Datapath.Attach.In.make args.Args.VDI.Attach.dbg @@ -549,10 +559,16 @@ let process root_dir name x = Attached_SRs.find args.Args.VDI.Activate.sr >>= fun sr -> (* Discover the URIs using Volume.stat *) - stat root_dir name - args.Args.VDI.Activate.dbg - sr - args.Args.VDI.Activate.vdi + stat root_dir name args.Args.VDI.Activate.dbg sr args.Args.VDI.Activate.vdi + >>= fun response -> + (* If we have a clone-on-boot volume then use that instead *) + ( match List.Assoc.find response.Storage.Volume.Types.keys _clone_on_boot_key with + | None -> + return (Ok response) + | Some temporary -> + stat root_dir name args.Args.VDI.Activate.dbg sr temporary + ) >>= fun response -> + choose_datapath response >>= fun (datapath, uri, domain) -> let args' = Storage.Datapath.Types.Datapath.Activate.In.make args.Args.VDI.Activate.dbg @@ -567,10 +583,15 @@ let process root_dir name x = Attached_SRs.find args.Args.VDI.Deactivate.sr >>= fun sr -> (* Discover the URIs using Volume.stat *) - stat root_dir name - args.Args.VDI.Deactivate.dbg - sr - args.Args.VDI.Deactivate.vdi + stat root_dir name args.Args.VDI.Deactivate.dbg sr args.Args.VDI.Deactivate.vdi + >>= fun response -> + ( match List.Assoc.find response.Storage.Volume.Types.keys _clone_on_boot_key with + | None -> + return (Ok response) + | Some temporary -> + stat root_dir name args.Args.VDI.Deactivate.dbg sr temporary + ) >>= fun response -> + choose_datapath response >>= fun (datapath, uri, domain) -> let args' = Storage.Datapath.Types.Datapath.Deactivate.In.make args.Args.VDI.Deactivate.dbg @@ -585,10 +606,15 @@ let process root_dir name x = Attached_SRs.find args.Args.VDI.Detach.sr >>= fun sr -> (* Discover the URIs using Volume.stat *) - stat root_dir name - args.Args.VDI.Detach.dbg - sr - args.Args.VDI.Detach.vdi + stat root_dir name args.Args.VDI.Detach.dbg sr args.Args.VDI.Detach.vdi + >>= fun response -> + ( match List.Assoc.find response.Storage.Volume.Types.keys _clone_on_boot_key with + | None -> + return (Ok response) + | Some temporary -> + stat root_dir name args.Args.VDI.Detach.dbg sr temporary + ) >>= fun response -> + choose_datapath response >>= fun (datapath, uri, domain) -> let args' = Storage.Datapath.Types.Datapath.Detach.In.make args.Args.VDI.Detach.dbg @@ -620,15 +646,15 @@ let process root_dir name x = >>= fun sr -> (* Discover the URIs using Volume.stat *) let persistent = args.Args.VDI.Epoch_begin.persistent in - stat ~persistent root_dir name - args.Args.VDI.Epoch_begin.dbg - sr - args.Args.VDI.Epoch_begin.vdi + stat root_dir name args.Args.VDI.Epoch_begin.dbg sr args.Args.VDI.Epoch_begin.vdi + >>= fun response -> + choose_datapath ~persistent response >>= fun (datapath, uri, domain) -> (* If non-persistent and the datapath plugin supports NONPERSISTENT then we delegate this to the datapath plugin. Otherwise we will make a temporary clone now and attach/detach etc this file. *) if Datapath_plugins.supports_feature datapath _nonpersistent then begin + (* We delegate handling non-persistent disks to the datapath plugin. *) let args = Storage.Datapath.Types.Datapath.Open.In.make args.Args.VDI.Epoch_begin.dbg uri persistent in @@ -637,7 +663,13 @@ let process root_dir name x = >>= fun () -> Deferred.Result.return (R.success (Args.VDI.Epoch_begin.rpc_of_response ())) end else begin - Deferred.return (Error (backend_error "UNIMPLEMENTED" [ name ])) + (* We create a non-persistent disk here with Volume.clone, and store + the name of the cloned disk in the metadata of the original. *) + clone root_dir name args.Args.VDI.Epoch_begin.dbg sr args.Args.VDI.Epoch_begin.vdi + >>= fun vdi -> + set root_dir name args.Args.VDI.Epoch_begin.dbg sr args.Args.VDI.Epoch_begin.vdi _clone_on_boot_key vdi.Storage.Volume.Types.key + >>= fun () -> + Deferred.Result.return (R.success (Args.VDI.Epoch_begin.rpc_of_response ())) end | { R.name = "VDI.epoch_end"; R.params = [ args ] } -> let open Deferred.Result.Monad_infix in @@ -645,19 +677,28 @@ let process root_dir name x = Attached_SRs.find args.Args.VDI.Epoch_end.sr >>= fun sr -> (* Discover the URIs using Volume.stat *) - stat root_dir name - args.Args.VDI.Epoch_end.dbg - sr - args.Args.VDI.Epoch_end.vdi + stat root_dir name args.Args.VDI.Epoch_end.dbg sr args.Args.VDI.Epoch_end.vdi + >>= fun response -> + choose_datapath response >>= fun (datapath, uri, domain) -> - let args = Storage.Datapath.Types.Datapath.Close.In.make - args.Args.VDI.Epoch_end.dbg - uri in - let args = Storage.Datapath.Types.Datapath.Close.In.rpc_of_t args in - fork_exec_rpc root_dir (script root_dir name (`Datapath datapath) "Datapath.close") args Storage.Datapath.Types.Datapath.Close.Out.t_of_rpc - >>= fun () -> - Deferred.Result.return (R.success (Args.VDI.Epoch_end.rpc_of_response ())) - + if Datapath_plugins.supports_feature datapath _nonpersistent then begin + let args = Storage.Datapath.Types.Datapath.Close.In.make + args.Args.VDI.Epoch_end.dbg + uri in + let args = Storage.Datapath.Types.Datapath.Close.In.rpc_of_t args in + fork_exec_rpc root_dir (script root_dir name (`Datapath datapath) "Datapath.close") args Storage.Datapath.Types.Datapath.Close.Out.t_of_rpc + >>= fun () -> + Deferred.Result.return (R.success (Args.VDI.Epoch_end.rpc_of_response ())) + end else begin + match List.Assoc.find response.Storage.Volume.Types.keys _clone_on_boot_key with + | None -> + Deferred.Result.return (R.success (Args.VDI.Epoch_end.rpc_of_response ())) + | Some temporary -> + (* Destroy the temporary disk we made earlier *) + destroy root_dir name args.Args.VDI.Epoch_end.dbg sr temporary + >>= fun () -> + Deferred.Result.return (R.success (Args.VDI.Epoch_end.rpc_of_response ())) + end | { R.name = name } -> Deferred.return (Error (backend_error "UNIMPLEMENTED" [ name ]))) >>= function From 179be08be435fd65f8f3da8677526949f6876d56 Mon Sep 17 00:00:00 2001 From: David Scott Date: Wed, 15 Jul 2015 11:23:59 +0100 Subject: [PATCH 06/10] VDI.epoch_begin: delete any leftover clone-on-boot VDI we may have Signed-off-by: David Scott --- main.ml | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/main.ml b/main.ml index ee8d1f3..a481eb5 100644 --- a/main.ml +++ b/main.ml @@ -665,6 +665,13 @@ let process root_dir name x = end else begin (* We create a non-persistent disk here with Volume.clone, and store the name of the cloned disk in the metadata of the original. *) + ( match List.Assoc.find response.Storage.Volume.Types.keys _clone_on_boot_key with + | None -> + return (Ok ()) + | Some temporary -> + (* Destroy the temporary disk we made earlier *) + destroy root_dir name args.Args.VDI.Epoch_begin.dbg sr temporary + ) >>= fun () -> clone root_dir name args.Args.VDI.Epoch_begin.dbg sr args.Args.VDI.Epoch_begin.vdi >>= fun vdi -> set root_dir name args.Args.VDI.Epoch_begin.dbg sr args.Args.VDI.Epoch_begin.vdi _clone_on_boot_key vdi.Storage.Volume.Types.key From 5686c704a991cf5212154a390f35bb0780b31b22 Mon Sep 17 00:00:00 2001 From: David Scott Date: Wed, 15 Jul 2015 11:24:34 +0100 Subject: [PATCH 07/10] VDI.set_persistent: this is a no-op We do all clone-on-boot actions during the VDI.epoch_begin and VDI.epoch_end, so we can ignore this one. Signed-off-by: David Scott --- main.ml | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/main.ml b/main.ml index a481eb5..bff6a80 100644 --- a/main.ml +++ b/main.ml @@ -706,6 +706,10 @@ let process root_dir name x = >>= fun () -> Deferred.Result.return (R.success (Args.VDI.Epoch_end.rpc_of_response ())) end + | { R.name = "VDI.set_persistent"; R.params = [ args ] } -> + let open Deferred.Result.Monad_infix in + (* We don't do anything until the VDI.epoch_begin *) + Deferred.Result.return (R.success (Args.VDI.Set_persistent.rpc_of_response ())) | { R.name = name } -> Deferred.return (Error (backend_error "UNIMPLEMENTED" [ name ]))) >>= function From 63f9d84cdfdab87a6d0cb649fe679f265e6b0dd7 Mon Sep 17 00:00:00 2001 From: David Scott Date: Wed, 15 Jul 2015 11:39:57 +0100 Subject: [PATCH 08/10] Avoid parsing and printing URIs from the backends This avoids tripping up if Uri.(to_string (of_string x)) <> x from the point-of-view of the backend. Signed-off-by: David Scott --- main.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/main.ml b/main.ml index bff6a80..376c66d 100644 --- a/main.ml +++ b/main.ml @@ -227,7 +227,7 @@ let choose_datapath ?(persistent = true) response = let uri = Uri.of_string x in match Uri.scheme uri with | None -> None - | Some scheme -> Some (scheme, uri) + | Some scheme -> Some (scheme, x) ) response.Storage.Volume.Types.uri in (* We can only use URIs whose schemes correspond to registered plugins *) let possible = List.filter ~f:(fun (scheme, _) -> Hashtbl.mem !Datapath_plugins.table scheme) possible in @@ -243,7 +243,7 @@ let choose_datapath ?(persistent = true) response = supports_nonpersistent @ others in match preference_order with | [] -> return (Error (missing_uri ())) - | (scheme, u) :: us -> return (Ok (scheme, Uri.to_string u, "0")) + | (scheme, u) :: us -> return (Ok (scheme, u, "0")) (* Process a message *) let process root_dir name x = From 92c0a705bcf2b4fa3350d730e8f383224fcb577e Mon Sep 17 00:00:00 2001 From: David Scott Date: Wed, 15 Jul 2015 11:46:37 +0100 Subject: [PATCH 09/10] After destroying the clone-on-boot disk, remove the link Signed-off-by: David Scott --- main.ml | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/main.ml b/main.ml index 376c66d..d2a999b 100644 --- a/main.ml +++ b/main.ml @@ -219,6 +219,11 @@ let set root_dir name dbg sr vdi k v = let args = Storage.Volume.Types.Volume.Set.In.rpc_of_t args in fork_exec_rpc root_dir (script root_dir name `Volume "Volume.set") args Storage.Volume.Types.Volume.Set.Out.t_of_rpc +let unset root_dir name dbg sr vdi k = + let args = Storage.Volume.Types.Volume.Unset.In.make dbg sr vdi k in + let args = Storage.Volume.Types.Volume.Unset.In.rpc_of_t args in + fork_exec_rpc root_dir (script root_dir name `Volume "Volume.unset") args Storage.Volume.Types.Volume.Unset.Out.t_of_rpc + let choose_datapath ?(persistent = true) response = (* We can only use a URI with a valid scheme, since we use the scheme to name the datapath plugin. *) @@ -704,6 +709,8 @@ let process root_dir name x = (* Destroy the temporary disk we made earlier *) destroy root_dir name args.Args.VDI.Epoch_end.dbg sr temporary >>= fun () -> + unset root_dir name args.Args.VDI.Epoch_end.dbg sr args.Args.VDI.Epoch_end.vdi _clone_on_boot_key + >>= fun () -> Deferred.Result.return (R.success (Args.VDI.Epoch_end.rpc_of_response ())) end | { R.name = "VDI.set_persistent"; R.params = [ args ] } -> From 5a50d0c746bedf4ed668818fcc4b57a85c902e23 Mon Sep 17 00:00:00 2001 From: David Scott Date: Wed, 15 Jul 2015 15:22:39 +0100 Subject: [PATCH 10/10] SR.ls: filter out Volumes which are the clone-on-boot temporary clones Signed-off-by: David Scott --- main.ml | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/main.ml b/main.ml index d2a999b..49d02cb 100644 --- a/main.ml +++ b/main.ml @@ -400,6 +400,13 @@ let process root_dir name x = let args = Storage.Volume.Types.SR.Ls.In.rpc_of_t args in fork_exec_rpc root_dir (script root_dir name `Volume "SR.ls") args Storage.Volume.Types.SR.Ls.Out.t_of_rpc >>= fun response -> + (* Filter out volumes which are clone-on-boot transients *) + let transients = List.fold ~f:(fun set x -> + match List.Assoc.find x.Storage.Volume.Types.keys _clone_on_boot_key with + | None -> set + | Some transient -> Set.add set transient + ) ~init:(Set.empty ~comparator:String.comparator) response in + let response = List.filter ~f:(fun x -> not(Set.mem transients x.Storage.Volume.Types.key)) response in let response = List.map ~f:vdi_of_volume response in Deferred.Result.return (R.success (Args.SR.Scan.rpc_of_response response)) | { R.name = "VDI.create"; R.params = [ args ] } ->