diff --git a/ocaml/tests/dune b/ocaml/tests/dune index ef06d7d0d9a..a75a74a986b 100644 --- a/ocaml/tests/dune +++ b/ocaml/tests/dune @@ -5,7 +5,7 @@ (:standard \ test_daemon_manager test_vdi_cbt test_event test_clustering test_cluster_host test_cluster test_pusb test_network_sriov test_vm_placement test_vm_helpers test_repository test_repository_helpers - test_livepatch test_rpm test_updateinfo test_storage_impl test_storage_quicktest)) + test_livepatch test_rpm test_updateinfo test_storage_smapiv1_wrapper test_storage_quicktest)) (libraries alcotest angstrom @@ -91,9 +91,9 @@ (preprocess (pps ppx_deriving_rpc ppx_sexp_conv)) ) (test -(name test_storage_impl) +(name test_storage_smapiv1_wrapper) (package xapi) -(modules test_storage_impl) +(modules test_storage_smapiv1_wrapper) (libraries alcotest xapi_internal fmt)) (test diff --git a/ocaml/tests/test_storage_quicktest.ml b/ocaml/tests/test_storage_quicktest.ml index d980324d8ed..c2d60a561a0 100644 --- a/ocaml/tests/test_storage_quicktest.ml +++ b/ocaml/tests/test_storage_quicktest.ml @@ -13,7 +13,7 @@ *) module Cb = Crowbar -open Storage_impl +open Storage_smapiv1_wrapper let dpvs_cb_t = let one_dpvs = diff --git a/ocaml/tests/test_storage_impl.ml b/ocaml/tests/test_storage_smapiv1_wrapper.ml similarity index 99% rename from ocaml/tests/test_storage_impl.ml rename to ocaml/tests/test_storage_smapiv1_wrapper.ml index 15d3f204868..293ab3203f6 100644 --- a/ocaml/tests/test_storage_impl.ml +++ b/ocaml/tests/test_storage_smapiv1_wrapper.ml @@ -12,7 +12,7 @@ * GNU Lesser General Public License for more details. *) -open Storage_impl +open Storage_smapiv1_wrapper open Vdi let state_pp fmt state = diff --git a/ocaml/xapi-idl/storage/storage_interface.ml b/ocaml/xapi-idl/storage/storage_interface.ml index 4f03c28f6ec..c69a265c273 100644 --- a/ocaml/xapi-idl/storage/storage_interface.ml +++ b/ocaml/xapi-idl/storage/storage_interface.ml @@ -528,13 +528,31 @@ module StorageAPI (R : RPC) = struct let allow_leak_p = Param.mk ~name:"allow_leak" Types.bool in declare "DP.destroy" [ - "[DP.destroy dbg id]: frees any resources associated with [id] and \ - destroys it." + "[DP.destroy dbg id allow_leak]: frees any resources associated with \ + [id] and destroys it." ; "This will typically do any needed VDI.detach, VDI.deactivate \ cleanup." ] (dbg_p @-> dp_p @-> allow_leak_p @-> returning unit_p err) + let destroy2 = + let allow_leak_p = Param.mk ~name:"allow_leak" Types.bool in + declare "DP.destroy2" + [ + "[DP.destroy2 dbg id sr vdi vm allow_leak]: frees any resources \ + associated with [id] and destroys it." + ; "This will typically do any needed VDI.detach, VDI.deactivate \ + cleanup." + ] + (dbg_p + @-> dp_p + @-> sr_p + @-> vdi_p + @-> vm_p + @-> allow_leak_p + @-> returning unit_p err + ) + let attach_info = let backend_p = Param.mk ~name:"backend" backend in declare "DP.attach_info" @@ -1118,6 +1136,16 @@ module type Server_impl = sig val destroy : context -> dbg:debug_info -> dp:dp -> allow_leak:bool -> unit + val destroy2 : + context + -> dbg:debug_info + -> dp:dp + -> sr:sr + -> vdi:vdi + -> vm:vm + -> allow_leak:bool + -> unit + val attach_info : context -> dbg:debug_info -> sr:sr -> vdi:vdi -> dp:dp -> backend @@ -1424,6 +1452,9 @@ module Server (Impl : Server_impl) () = struct S.DP.destroy (fun dbg dp allow_leak -> Impl.DP.destroy () ~dbg ~dp ~allow_leak ) ; + S.DP.destroy2 (fun dbg dp sr vdi vm allow_leak -> + Impl.DP.destroy2 () ~dbg ~dp ~sr ~vdi ~vm ~allow_leak + ) ; S.DP.attach_info (fun dbg sr vdi dp -> Impl.DP.attach_info () ~dbg ~sr ~vdi ~dp ) ; diff --git a/ocaml/xapi-idl/storage/storage_skeleton.ml b/ocaml/xapi-idl/storage/storage_skeleton.ml index 5e93071e130..0ded2c112b8 100644 --- a/ocaml/xapi-idl/storage/storage_skeleton.ml +++ b/ocaml/xapi-idl/storage/storage_skeleton.ml @@ -37,6 +37,8 @@ module DP = struct let destroy ctx ~dbg ~dp ~allow_leak = u "DP.destroy" + let destroy2 ctx ~dbg ~dp ~sr ~vdi ~vm ~allow_leak = u "DP.destroy2" + let attach_info ctx ~dbg ~sr ~vdi ~dp = u "DP.attach_info" let diagnostics ctx () = u "DP.diagnostics" diff --git a/ocaml/xapi-storage-script/main.ml b/ocaml/xapi-storage-script/main.ml index 5851006be5c..257b1327121 100644 --- a/ocaml/xapi-storage-script/main.ml +++ b/ocaml/xapi-storage-script/main.ml @@ -599,6 +599,14 @@ module Attached_SRs = struct Hashtbl.remove !sr_table key ; return (Ok ()) + let list () = + let srs = + Hashtbl.fold !sr_table + ~f:(fun ~key ~data:_ ac -> Storage_interface.Sr.of_string key :: ac) + ~init:[] + in + return (Ok srs) + let reload path = state_path := Some path ; Sys.is_file ~follow_symlinks:true path >>= function @@ -1461,46 +1469,74 @@ let bind ~volume_script_dir = Deferred.Result.return () |> wrap in S.VDI.set_persistent vdi_set_persistent_impl ; - let u _ = failwith "Unimplemented" in - S.get_by_name u ; - S.VDI.compose u ; - S.VDI.get_by_name u ; - S.DATA.MIRROR.receive_start u ; - S.SR.reset u ; - S.UPDATES.get u ; - S.SR.update_snapshot_info_dest u ; - S.VDI.data_destroy u ; - S.DATA.MIRROR.list u ; - S.TASK.stat u ; - S.VDI.remove_from_sm_config u ; - S.DP.diagnostics u ; - S.TASK.destroy u ; - S.VDI.list_changed_blocks u ; - S.DP.destroy u ; - S.VDI.add_to_sm_config u ; - S.VDI.similar_content u ; - S.DATA.copy u ; - S.DP.stat_vdi u ; - S.DATA.MIRROR.receive_finalize u ; - S.DP.create u ; - S.VDI.set_content_id u ; - S.VDI.disable_cbt u ; - S.DP.attach_info u ; - S.TASK.cancel u ; - S.SR.list u ; - S.VDI.attach u ; - S.VDI.attach2 u ; - S.VDI.activate u ; - S.DATA.MIRROR.stat u ; - S.TASK.list u ; - S.VDI.get_url u ; - S.VDI.enable_cbt u ; - S.DATA.MIRROR.start u ; - S.Policy.get_backend_vm u ; - S.DATA.copy_into u ; - S.DATA.MIRROR.receive_cancel u ; - S.SR.update_snapshot_info_src u ; - S.DATA.MIRROR.stop u ; + let dp_destroy2 dbg _dp sr vdi' vm' _allow_leak = + (let vdi = Storage_interface.Vdi.string_of vdi' in + let domain = Storage_interface.Vm.string_of vm' in + Attached_SRs.find sr >>>= fun sr -> + (* Discover the URIs using Volume.stat *) + stat ~dbg ~sr ~vdi >>>= fun response -> + ( match + List.Assoc.find response.Xapi_storage.Control.keys _clone_on_boot_key + ~equal:String.equal + with + | None -> + return (Ok response) + | Some temporary -> + stat ~dbg ~sr ~vdi:temporary + ) + >>>= fun response -> + choose_datapath domain response >>>= fun (rpc, _datapath, uri, domain) -> + return_data_rpc (fun () -> Datapath_client.deactivate rpc dbg uri domain) + >>>= fun () -> + return_data_rpc (fun () -> Datapath_client.detach rpc dbg uri domain) + ) + |> wrap + in + S.DP.destroy2 dp_destroy2 ; + let sr_list _dbg = + Attached_SRs.list () >>>= (fun srs -> Deferred.Result.return srs) |> wrap + in + S.SR.list sr_list ; + (* SR.reset is a no op in SMAPIv3 *) + S.SR.reset (fun _ _ -> Deferred.Result.return () |> wrap) ; + let u name _ = failwith ("Unimplemented: " ^ name) in + S.get_by_name (u "get_by_name") ; + S.VDI.compose (u "VDI.compose") ; + S.VDI.get_by_name (u "VDI.get_by_name") ; + S.DATA.MIRROR.receive_start (u "DATA.MIRROR.receive_start") ; + S.UPDATES.get (u "UPDATES.get") ; + S.SR.update_snapshot_info_dest (u "SR.update_snapshot_info_dest") ; + S.VDI.data_destroy (u "VDI.data_destroy") ; + S.DATA.MIRROR.list (u "DATA.MIRROR.list") ; + S.TASK.stat (u "TASK.stat") ; + S.VDI.remove_from_sm_config (u "VDI.remove_from_sm_config") ; + S.DP.diagnostics (u "DP.diagnostics") ; + S.TASK.destroy (u "TASK.destroy") ; + S.VDI.list_changed_blocks (u "VDI.list_changed_blocks") ; + S.DP.destroy (u "DP.destroy") ; + S.VDI.add_to_sm_config (u "VDI.add_to_sm_config") ; + S.VDI.similar_content (u "VDI.similar_content") ; + S.DATA.copy (u "DATA.copy") ; + S.DP.stat_vdi (u "DP.stat_vdi") ; + S.DATA.MIRROR.receive_finalize (u "DATA.MIRROR.receive_finalize") ; + S.DP.create (u "DP.create") ; + S.VDI.set_content_id (u "VDI.set_content_id") ; + S.VDI.disable_cbt (u "VDI.disable_cbt") ; + S.DP.attach_info (u "DP.attach_info") ; + S.TASK.cancel (u "TASK.cancel") ; + S.VDI.attach (u "VDI.attach") ; + S.VDI.attach2 (u "VDI.attach2") ; + S.VDI.activate (u "VDI.activate") ; + S.DATA.MIRROR.stat (u "DATA.MIRROR.stat") ; + S.TASK.list (u "TASK.list") ; + S.VDI.get_url (u "VDI.get_url") ; + S.VDI.enable_cbt (u "VDI.enable_cbt") ; + S.DATA.MIRROR.start (u "DATA.MIRROR.start") ; + S.Policy.get_backend_vm (u "Policy.get_backend_vm") ; + S.DATA.copy_into (u "DATA.copy_into") ; + S.DATA.MIRROR.receive_cancel (u "DATA.MIRROR.receive_cancel") ; + S.SR.update_snapshot_info_src (u "SR.update_snapshot_info_src") ; + S.DATA.MIRROR.stop (u "DATA.MIRROR.stop") ; Rpc_async.server S.implementation let process_smapiv2_requests server txt = diff --git a/ocaml/xapi/storage_access.ml b/ocaml/xapi/storage_access.ml index 51f8e05ba81..5ea3e9ae342 100644 --- a/ocaml/xapi/storage_access.ml +++ b/ocaml/xapi/storage_access.ml @@ -56,1146 +56,6 @@ let transform_storage_exn f = (Api_errors.internal_error, [Printexc.to_string e]) ) -exception No_VDI - -(* Find a VDI given a storage-layer SR and VDI *) -let find_vdi ~__context sr vdi = - let sr = s_of_sr sr in - let vdi = s_of_vdi vdi in - let open Db_filter_types in - let sr = Db.SR.get_by_uuid ~__context ~uuid:sr in - match - Db.VDI.get_records_where ~__context - ~expr: - (And - ( Eq (Field "location", Literal vdi) - , Eq (Field "SR", Literal (Ref.string_of sr)) - ) - ) - with - | x :: _ -> - x - | _ -> - raise No_VDI - -(* Find a VDI reference given a name *) -let find_content ~__context ?sr name = - (* PR-1255: the backend should do this for us *) - let open Db_filter_types in - let expr = - Option.fold ~none:True - ~some:(fun sr -> - Eq - ( Field "SR" - , Literal - (Ref.string_of (Db.SR.get_by_uuid ~__context ~uuid:(s_of_sr sr))) - ) - ) - sr - in - let all = Db.VDI.get_records_where ~__context ~expr in - List.find - (fun (_, vdi_rec) -> false || vdi_rec.API.vDI_location = name (* PR-1255 *)) - all - -let vdi_info_of_vdi_rec __context vdi_rec = - let content_id = - try List.assoc "content_id" vdi_rec.API.vDI_other_config - with Not_found -> vdi_rec.API.vDI_location - (* PR-1255 *) - in - { - vdi= Storage_interface.Vdi.of_string vdi_rec.API.vDI_location - ; uuid= Some vdi_rec.API.vDI_uuid - ; content_id - ; (* PR-1255 *) - name_label= vdi_rec.API.vDI_name_label - ; name_description= vdi_rec.API.vDI_name_description - ; ty= Storage_utils.string_of_vdi_type vdi_rec.API.vDI_type - ; metadata_of_pool= Ref.string_of vdi_rec.API.vDI_metadata_of_pool - ; is_a_snapshot= vdi_rec.API.vDI_is_a_snapshot - ; snapshot_time= Date.to_string vdi_rec.API.vDI_snapshot_time - ; snapshot_of= - ( if Db.is_valid_ref __context vdi_rec.API.vDI_snapshot_of then - Db.VDI.get_uuid ~__context ~self:vdi_rec.API.vDI_snapshot_of - else - "" - ) - |> Storage_interface.Vdi.of_string - ; read_only= vdi_rec.API.vDI_read_only - ; cbt_enabled= vdi_rec.API.vDI_cbt_enabled - ; virtual_size= vdi_rec.API.vDI_virtual_size - ; physical_utilisation= vdi_rec.API.vDI_physical_utilisation - ; persistent= vdi_rec.API.vDI_on_boot = `persist - ; sharable= vdi_rec.API.vDI_sharable - ; sm_config= vdi_rec.API.vDI_sm_config - } - -let redirect _sr = - raise (Storage_error (Redirect (Some (Pool_role.get_master_address ())))) - -module SMAPIv1 = struct - (** xapi's builtin ability to call local SM plugins using the existing - protocol. The code here should only call the SM functions and encapsulate - the return or error properly. It should not perform side-effects on - the xapi database: these should be handled in the layer above so they - can be shared with other SM implementation types. - - Where this layer has to perform interface adjustments (see VDI.activate - and the read/write debacle), this highlights desirable improvements to - the backend interface. - *) - - type context = unit - - let vdi_info_from_db ~__context self = - let vdi_rec = Db.VDI.get_record ~__context ~self in - vdi_info_of_vdi_rec __context vdi_rec - - (* For SMAPIv1, is_a_snapshot, snapshot_time and snapshot_of are stored in - * xapi's database. For SMAPIv2 they should be implemented by the storage - * backend. *) - let set_is_a_snapshot _context ~dbg ~sr ~vdi ~is_a_snapshot = - Server_helpers.exec_with_new_task "VDI.set_is_a_snapshot" - ~subtask_of:(Ref.of_string dbg) (fun __context -> - let vdi, _ = find_vdi ~__context sr vdi in - Db.VDI.set_is_a_snapshot ~__context ~self:vdi ~value:is_a_snapshot - ) - - let set_snapshot_time _context ~dbg ~sr ~vdi ~snapshot_time = - Server_helpers.exec_with_new_task "VDI.set_snapshot_time" - ~subtask_of:(Ref.of_string dbg) (fun __context -> - let vdi, _ = find_vdi ~__context sr vdi in - let snapshot_time = Date.of_string snapshot_time in - Db.VDI.set_snapshot_time ~__context ~self:vdi ~value:snapshot_time - ) - - let set_snapshot_of _context ~dbg ~sr ~vdi ~snapshot_of = - Server_helpers.exec_with_new_task "VDI.set_snapshot_of" - ~subtask_of:(Ref.of_string dbg) (fun __context -> - let vdi, _ = find_vdi ~__context sr vdi in - let snapshot_of, _ = find_vdi ~__context sr snapshot_of in - Db.VDI.set_snapshot_of ~__context ~self:vdi ~value:snapshot_of - ) - - module Query = struct - let query _context ~dbg:_ = - { - driver= "storage_access" - ; name= "SMAPIv1 adapter" - ; description= - "Allows legacy SMAPIv1 adapters to expose an SMAPIv2 interface" - ; vendor= "XCP" - ; copyright= "see the source code" - ; version= "2.0" - ; required_api_version= "2.0" - ; features= [] - ; configuration= [] - ; required_cluster_stack= [] - } - - let diagnostics _context ~dbg:_ = - "No diagnostics are available for SMAPIv1 plugins" - end - - module DP = struct - let create _context ~dbg:_ ~id:_ = assert false - - let destroy _context ~dbg:_ ~dp:_ = assert false - - let diagnostics _context () = assert false - - let attach_info _context ~dbg:_ ~sr:_ ~vdi:_ ~dp:_ = assert false - - let stat_vdi _context ~dbg:_ ~sr:_ ~vdi:_ = assert false - end - - module SR = struct - include Storage_skeleton.SR - - let probe _context ~dbg ~queue ~device_config ~sm_config = - let _type = - (* SMAPIv1 plugins have no namespaces, so strip off everything up to - the final dot *) - try - let i = String.rindex queue '.' in - String.sub queue (i + 1) (String.length queue - i - 1) - with Not_found -> queue - in - Server_helpers.exec_with_new_task "SR.probe" - ~subtask_of:(Ref.of_string dbg) (fun __context -> - let task = Context.get_task_id __context in - Storage_interface.Raw - (Sm.sr_probe - (Some task, Sm.sm_master true :: device_config) - _type sm_config - ) - ) - - let create _context ~dbg ~sr ~name_label ~name_description ~device_config - ~physical_size = - Server_helpers.exec_with_new_task "SR.create" - ~subtask_of:(Ref.of_string dbg) (fun __context -> - let subtask_of = Some (Context.get_task_id __context) in - let sr = - Db.SR.get_by_uuid ~__context - ~uuid:(Storage_interface.Sr.string_of sr) - in - Db.SR.set_name_label ~__context ~self:sr ~value:name_label ; - Db.SR.set_name_description ~__context ~self:sr ~value:name_description ; - let device_config = Sm.sm_master true :: device_config in - Sm.call_sm_functions ~__context ~sR:sr (fun _ _type -> - try - Sm.sr_create (subtask_of, device_config) _type sr physical_size - with - | Smint.Not_implemented_in_backend -> - error "SR.create failed SR:%s Not_implemented_in_backend" - (Ref.string_of sr) ; - raise - (Storage_interface.Storage_error - (Backend_error - ( Api_errors.sr_operation_not_supported - , [Ref.string_of sr] - ) - ) - ) - | Api_errors.Server_error (code, params) -> - raise (Storage_error (Backend_error (code, params))) - | e -> - let e' = ExnHelper.string_of_exn e in - error "SR.create failed SR:%s error:%s" (Ref.string_of sr) e' ; - raise e - ) ; - List.filter (fun (x, _) -> x <> "SRmaster") device_config - ) - - let set_name_label _context ~dbg ~sr ~new_name_label = - Server_helpers.exec_with_new_task "SR.set_name_label" - ~subtask_of:(Ref.of_string dbg) (fun __context -> - let sr = - Db.SR.get_by_uuid ~__context - ~uuid:(Storage_interface.Sr.string_of sr) - in - Db.SR.set_name_label ~__context ~self:sr ~value:new_name_label - ) - - let set_name_description _context ~dbg ~sr ~new_name_description = - Server_helpers.exec_with_new_task "SR.set_name_description" - ~subtask_of:(Ref.of_string dbg) (fun __context -> - let sr = - Db.SR.get_by_uuid ~__context - ~uuid:(Storage_interface.Sr.string_of sr) - in - Db.SR.set_name_description ~__context ~self:sr - ~value:new_name_description - ) - - let attach _context ~dbg ~sr ~device_config = - Server_helpers.exec_with_new_task "SR.attach" - ~subtask_of:(Ref.of_string dbg) (fun __context -> - let sr = - Db.SR.get_by_uuid ~__context - ~uuid:(Storage_interface.Sr.string_of sr) - in - (* Existing backends expect an SRMaster flag to be added - through the device-config. *) - let srmaster = Helpers.i_am_srmaster ~__context ~sr in - let device_config = Sm.sm_master srmaster :: device_config in - Sm.call_sm_functions ~__context ~sR:sr (fun _ _type -> - try - Sm.sr_attach - (Some (Context.get_task_id __context), device_config) - _type sr - with - | Api_errors.Server_error (code, params) -> - raise (Storage_error (Backend_error (code, params))) - | e -> - let e' = ExnHelper.string_of_exn e in - error "SR.attach failed SR:%s error:%s" (Ref.string_of sr) e' ; - raise e - ) - ) - - let detach _context ~dbg ~sr = - Server_helpers.exec_with_new_task "SR.detach" - ~subtask_of:(Ref.of_string dbg) (fun __context -> - let sr = - Db.SR.get_by_uuid ~__context - ~uuid:(Storage_interface.Sr.string_of sr) - in - Sm.call_sm_functions ~__context ~sR:sr (fun device_config _type -> - try Sm.sr_detach device_config _type sr with - | Api_errors.Server_error (code, params) -> - raise (Storage_error (Backend_error (code, params))) - | e -> - let e' = ExnHelper.string_of_exn e in - error "SR.detach failed SR:%s error:%s" (Ref.string_of sr) e' ; - raise e - ) - ) - - let reset _context ~dbg:_ ~sr:_ = assert false - - let destroy _context ~dbg ~sr = - Server_helpers.exec_with_new_task "SR.destroy" - ~subtask_of:(Ref.of_string dbg) (fun __context -> - let sr = - Db.SR.get_by_uuid ~__context - ~uuid:(Storage_interface.Sr.string_of sr) - in - Sm.call_sm_functions ~__context ~sR:sr (fun device_config _type -> - try Sm.sr_delete device_config _type sr with - | Smint.Not_implemented_in_backend -> - raise - (Storage_interface.Storage_error - (Backend_error - ( Api_errors.sr_operation_not_supported - , [Ref.string_of sr] - ) - ) - ) - | Api_errors.Server_error (code, params) -> - raise (Storage_error (Backend_error (code, params))) - | e -> - let e' = ExnHelper.string_of_exn e in - error "SR.detach failed SR:%s error:%s" (Ref.string_of sr) e' ; - raise e - ) - ) - - let stat _context ~dbg ~sr:sr' = - Server_helpers.exec_with_new_task "SR.stat" ~subtask_of:(Ref.of_string dbg) - (fun __context -> - let sr = - Db.SR.get_by_uuid ~__context - ~uuid:(Storage_interface.Sr.string_of sr') - in - Sm.call_sm_functions ~__context ~sR:sr (fun device_config _type -> - try - Sm.sr_update device_config _type sr ; - let r = Db.SR.get_record ~__context ~self:sr in - let sr_uuid = Some r.API.sR_uuid in - let name_label = r.API.sR_name_label in - let name_description = r.API.sR_name_description in - let total_space = r.API.sR_physical_size in - let free_space = - Int64.sub r.API.sR_physical_size r.API.sR_physical_utilisation - in - let clustered = false in - let health = Storage_interface.Healthy in - { - sr_uuid - ; name_label - ; name_description - ; total_space - ; free_space - ; clustered - ; health - } - with - | Smint.Not_implemented_in_backend -> - raise - (Storage_interface.Storage_error - (Backend_error - ( Api_errors.sr_operation_not_supported - , [Ref.string_of sr] - ) - ) - ) - | Api_errors.Server_error (code, params) -> - error "SR.scan failed SR:%s code=%s params=[%s]" - (Ref.string_of sr) code - (String.concat "; " params) ; - raise (Storage_error (Backend_error (code, params))) - | Sm.MasterOnly -> - redirect sr - | e -> - let e' = ExnHelper.string_of_exn e in - error "SR.scan failed SR:%s error:%s" (Ref.string_of sr) e' ; - raise e - ) - ) - - let scan _context ~dbg ~sr:sr' = - Server_helpers.exec_with_new_task "SR.scan" ~subtask_of:(Ref.of_string dbg) - (fun __context -> - let sr = Db.SR.get_by_uuid ~__context ~uuid:(s_of_sr sr') in - Sm.call_sm_functions ~__context ~sR:sr (fun device_config _type -> - try - Sm.sr_scan device_config _type sr ; - let open Db_filter_types in - let vdis = - Db.VDI.get_records_where ~__context - ~expr:(Eq (Field "SR", Literal (Ref.string_of sr))) - |> List.map snd - in - List.map (vdi_info_of_vdi_rec __context) vdis - with - | Smint.Not_implemented_in_backend -> - raise - (Storage_interface.Storage_error - (Backend_error - ( Api_errors.sr_operation_not_supported - , [Ref.string_of sr] - ) - ) - ) - | Api_errors.Server_error (code, params) -> - error "SR.scan failed SR:%s code=%s params=[%s]" - (Ref.string_of sr) code - (String.concat "; " params) ; - raise (Storage_error (Backend_error (code, params))) - | Sm.MasterOnly -> - redirect sr - | e -> - let e' = ExnHelper.string_of_exn e in - error "SR.scan failed SR:%s error:%s" (Ref.string_of sr) e' ; - raise e - ) - ) - - let list _context ~dbg:_ = assert false - - let update_snapshot_info_src _context ~dbg:_ ~sr:_ ~vdi:_ ~url:_ ~dest:_ - ~dest_vdi:_ ~snapshot_pairs:_ = - assert false - - let update_snapshot_info_dest _context ~dbg ~sr ~vdi ~src_vdi:_ - ~snapshot_pairs = - Server_helpers.exec_with_new_task "SR.update_snapshot_info_dest" - ~subtask_of:(Ref.of_string dbg) (fun __context -> - let local_vdis = scan __context ~dbg ~sr in - let find_sm_vdi ~vdi ~vdi_info_list = - try List.find (fun x -> x.vdi = vdi) vdi_info_list - with Not_found -> - raise (Storage_error (Vdi_does_not_exist (s_of_vdi vdi))) - in - let assert_content_ids_match ~vdi_info1 ~vdi_info2 = - if vdi_info1.content_id <> vdi_info2.content_id then - raise - (Storage_error - (Content_ids_do_not_match - (s_of_vdi vdi_info1.vdi, s_of_vdi vdi_info2.vdi) - ) - ) - in - (* For each (local snapshot vdi, source snapshot vdi) pair: - * - Check that the content_ids are the same - * - Copy snapshot_time from the source VDI to the local VDI - * - Set the local VDI's snapshot_of to vdi - * - Set is_a_snapshot = true for the local snapshot *) - List.iter - (fun (local_snapshot, src_snapshot_info) -> - let local_snapshot_info = - find_sm_vdi ~vdi:local_snapshot ~vdi_info_list:local_vdis - in - assert_content_ids_match ~vdi_info1:local_snapshot_info - ~vdi_info2:src_snapshot_info ; - set_snapshot_time __context ~dbg ~sr ~vdi:local_snapshot - ~snapshot_time:src_snapshot_info.snapshot_time ; - set_snapshot_of __context ~dbg ~sr ~vdi:local_snapshot - ~snapshot_of:vdi ; - set_is_a_snapshot __context ~dbg ~sr ~vdi:local_snapshot - ~is_a_snapshot:true - ) - snapshot_pairs - ) - end - - module VDI = struct - let for_vdi ~dbg ~sr ~vdi op_name f = - Server_helpers.exec_with_new_task op_name ~subtask_of:(Ref.of_string dbg) - (fun __context -> - let self = find_vdi ~__context sr vdi |> fst in - Sm.call_sm_vdi_functions ~__context ~vdi:self - (fun device_config _type sr -> f device_config _type sr self - ) - ) - - (* Allow us to remember whether a VDI is attached read/only or read/write. - If this is meaningful to the backend then this should be recorded there! *) - let vdi_read_write = Hashtbl.create 10 - - let vdi_read_write_m = Mutex.create () - - let vdi_read_caching_m = Mutex.create () - - let per_host_key ~__context ~prefix = - let host_uuid = - Db.Host.get_uuid ~__context ~self:(Helpers.get_localhost ~__context) - in - Printf.sprintf "%s-%s" prefix host_uuid - - let read_caching_key ~__context = - per_host_key ~__context ~prefix:"read-caching-enabled-on" - - let read_caching_reason_key ~__context = - per_host_key ~__context ~prefix:"read-caching-reason" - - let epoch_begin _context ~dbg ~sr ~vdi ~vm:_ ~persistent:_ = - try - for_vdi ~dbg ~sr ~vdi "VDI.epoch_begin" - (fun device_config _type sr self -> - Sm.vdi_epoch_begin device_config _type sr self - ) - with Api_errors.Server_error (code, params) -> - raise (Storage_error (Backend_error (code, params))) - - let attach2 _context ~dbg ~dp:_ ~sr ~vdi ~read_write = - try - let backend = - for_vdi ~dbg ~sr ~vdi "VDI.attach2" - (fun device_config _type sr self -> - let attach_info_v1 = - Sm.vdi_attach device_config _type sr self read_write - in - (* Record whether the VDI is benefiting from read caching *) - Server_helpers.exec_with_new_task "VDI.attach2" - ~subtask_of:(Ref.of_string dbg) (fun __context -> - let read_caching = not attach_info_v1.Smint.o_direct in - let on_key = read_caching_key ~__context in - let reason_key = read_caching_reason_key ~__context in - with_lock vdi_read_caching_m (fun () -> - Db.VDI.remove_from_sm_config ~__context ~self ~key:on_key ; - Db.VDI.remove_from_sm_config ~__context ~self - ~key:reason_key ; - Db.VDI.add_to_sm_config ~__context ~self ~key:on_key - ~value:(string_of_bool read_caching) ; - if not read_caching then - Db.VDI.add_to_sm_config ~__context ~self ~key:reason_key - ~value:attach_info_v1.Smint.o_direct_reason - ) - ) ; - { - implementations= - [ - XenDisk - { - params= attach_info_v1.Smint.params - ; extra= attach_info_v1.Smint.xenstore_data - ; backend_type= "vbd3" - } - ; (* Currently we always get a BlockDevice from SMAPIv1, never a File, not even for ISOs *) - BlockDevice {path= attach_info_v1.Smint.params} - ] - } - ) - in - with_lock vdi_read_write_m (fun () -> - Hashtbl.replace vdi_read_write (sr, vdi) read_write - ) ; - backend - with Api_errors.Server_error (code, params) -> - raise (Storage_error (Backend_error (code, params))) - - let attach3 context ~dbg ~dp ~sr ~vdi ~vm:_ ~read_write = - (*Throw away vm argument as does nothing in SMAPIv1*) - attach2 context ~dbg ~dp ~sr ~vdi ~read_write - - let attach _ = - failwith - "We'll never get here: attach is implemented in Storage_impl.Wrapper" - - let activate _context ~dbg ~dp ~sr ~vdi = - try - let read_write = - with_lock vdi_read_write_m (fun () -> - if not (Hashtbl.mem vdi_read_write (sr, vdi)) then - error "VDI.activate: doesn't know if sr:%s vdi:%s is RO or RW" - (s_of_sr sr) (s_of_vdi vdi) ; - Hashtbl.find vdi_read_write (sr, vdi) - ) - in - for_vdi ~dbg ~sr ~vdi "VDI.activate" (fun device_config _type sr self -> - Server_helpers.exec_with_new_task "VDI.activate" - ~subtask_of:(Ref.of_string dbg) (fun __context -> - if read_write then - Db.VDI.remove_from_other_config ~__context ~self - ~key:"content_id" - ) ; - (* If the backend doesn't advertise the capability then do nothing *) - if List.mem_assoc Smint.Vdi_activate (Sm.features_of_driver _type) - then - Sm.vdi_activate device_config _type sr self read_write - else - info "%s sr:%s does not support vdi_activate: doing nothing" dp - (Ref.string_of sr) - ) - with Api_errors.Server_error (code, params) -> - raise (Storage_error (Backend_error (code, params))) - - let activate3 context ~dbg ~dp ~sr ~vdi ~vm:_ = - activate context ~dbg ~dp ~sr ~vdi - - let deactivate _context ~dbg ~dp ~sr ~vdi ~vm:_ = - try - for_vdi ~dbg ~sr ~vdi "VDI.deactivate" - (fun device_config _type sr self -> - Server_helpers.exec_with_new_task "VDI.deactivate" - ~subtask_of:(Ref.of_string dbg) (fun __context -> - let other_config = Db.VDI.get_other_config ~__context ~self in - if not (List.mem_assoc "content_id" other_config) then - Db.VDI.add_to_other_config ~__context ~self ~key:"content_id" - ~value:Uuidx.(to_string (make ())) - ) ; - (* If the backend doesn't advertise the capability then do nothing *) - if List.mem_assoc Smint.Vdi_deactivate (Sm.features_of_driver _type) - then - Sm.vdi_deactivate device_config _type sr self - else - info "%s sr:%s does not support vdi_deactivate: doing nothing" dp - (Ref.string_of sr) - ) - with Api_errors.Server_error (code, params) -> - raise (Storage_error (Backend_error (code, params))) - - let detach _context ~dbg ~dp:_ ~sr ~vdi ~vm:_ = - try - for_vdi ~dbg ~sr ~vdi "VDI.detach" (fun device_config _type sr self -> - Sm.vdi_detach device_config _type sr self ; - Server_helpers.exec_with_new_task "VDI.detach" - ~subtask_of:(Ref.of_string dbg) (fun __context -> - let on_key = read_caching_key ~__context in - let reason_key = read_caching_reason_key ~__context in - with_lock vdi_read_caching_m (fun () -> - Db.VDI.remove_from_sm_config ~__context ~self ~key:on_key ; - Db.VDI.remove_from_sm_config ~__context ~self - ~key:reason_key - ) - ) - ) ; - with_lock vdi_read_write_m (fun () -> - Hashtbl.remove vdi_read_write (sr, vdi) - ) - with Api_errors.Server_error (code, params) -> - raise (Storage_error (Backend_error (code, params))) - - let epoch_end _context ~dbg ~sr ~vdi ~vm:_ = - try - for_vdi ~dbg ~sr ~vdi "VDI.epoch_end" - (fun device_config _type sr self -> - Sm.vdi_epoch_end device_config _type sr self - ) - with Api_errors.Server_error (code, params) -> - raise (Storage_error (Backend_error (code, params))) - - let require_uuid vdi_info = - match vdi_info.Smint.vdi_info_uuid with - | Some uuid -> - uuid - | None -> - failwith "SM backend failed to return field" - - let newvdi ~__context vi = - (* The current backends stash data directly in the db *) - let uuid = require_uuid vi in - vdi_info_from_db ~__context (Db.VDI.get_by_uuid ~__context ~uuid) - - let create _context ~dbg ~sr ~vdi_info = - try - Server_helpers.exec_with_new_task "VDI.create" - ~subtask_of:(Ref.of_string dbg) (fun __context -> - let sr = Db.SR.get_by_uuid ~__context ~uuid:(s_of_sr sr) in - let vi = - Sm.call_sm_functions ~__context ~sR:sr (fun device_config _type -> - Sm.vdi_create device_config _type sr vdi_info.sm_config - vdi_info.ty vdi_info.virtual_size vdi_info.name_label - vdi_info.name_description vdi_info.metadata_of_pool - vdi_info.is_a_snapshot vdi_info.snapshot_time - (s_of_vdi vdi_info.snapshot_of) - vdi_info.read_only - ) - in - newvdi ~__context vi - ) - with - | Api_errors.Server_error (code, params) -> - raise (Storage_error (Backend_error (code, params))) - | Sm.MasterOnly -> - redirect sr - - (* A list of keys in sm-config that will be preserved on clone/snapshot *) - let sm_config_keys_to_preserve_on_clone = ["base_mirror"] - - let snapshot_and_clone call_name call_f is_a_snapshot _context ~dbg ~sr - ~vdi_info = - try - Server_helpers.exec_with_new_task call_name - ~subtask_of:(Ref.of_string dbg) (fun __context -> - let vi = - for_vdi ~dbg ~sr ~vdi:vdi_info.vdi call_name - (fun device_config _type sr self -> - call_f device_config _type vdi_info.sm_config sr self - ) - in - (* PR-1255: modify clone, snapshot to take the same parameters as create? *) - let self, _ = - find_vdi ~__context sr - (Storage_interface.Vdi.of_string vi.Smint.vdi_info_location) - in - let clonee, _ = find_vdi ~__context sr vdi_info.vdi in - let content_id = - try - List.assoc "content_id" - (Db.VDI.get_other_config ~__context ~self:clonee) - with _ -> Uuidx.(to_string (make ())) - in - let snapshot_time = Date.of_float (Unix.gettimeofday ()) in - Db.VDI.set_name_label ~__context ~self ~value:vdi_info.name_label ; - Db.VDI.set_name_description ~__context ~self - ~value:vdi_info.name_description ; - Db.VDI.set_snapshot_time ~__context ~self ~value:snapshot_time ; - Db.VDI.set_is_a_snapshot ~__context ~self ~value:is_a_snapshot ; - Db.VDI.remove_from_other_config ~__context ~self ~key:"content_id" ; - Db.VDI.add_to_other_config ~__context ~self ~key:"content_id" - ~value:content_id ; - debug "copying sm-config" ; - List.iter - (fun (key, value) -> - let preserve = - List.mem key sm_config_keys_to_preserve_on_clone - in - if preserve then ( - Db.VDI.remove_from_sm_config ~__context ~self ~key ; - Db.VDI.add_to_sm_config ~__context ~self ~key ~value - ) - ) - vdi_info.sm_config ; - for_vdi ~dbg ~sr - ~vdi:(Storage_interface.Vdi.of_string vi.Smint.vdi_info_location) - "VDI.update" (fun device_config _type sr self -> - Sm.vdi_update device_config _type sr self - ) ; - let vdi = vdi_info_from_db ~__context self in - debug "vdi = %s" (string_of_vdi_info vdi) ; - vdi - ) - with - | Api_errors.Server_error (code, params) -> - raise (Storage_error (Backend_error (code, params))) - | Smint.Not_implemented_in_backend -> - raise (Storage_error (Unimplemented call_name)) - | Sm.MasterOnly -> - redirect sr - - let snapshot = snapshot_and_clone "VDI.snapshot" Sm.vdi_snapshot true - - let clone = snapshot_and_clone "VDI.clone" Sm.vdi_clone false - - let set_name_label _context ~dbg ~sr ~vdi ~new_name_label = - Server_helpers.exec_with_new_task "VDI.set_name_label" - ~subtask_of:(Ref.of_string dbg) (fun __context -> - let self, _ = find_vdi ~__context sr vdi in - Db.VDI.set_name_label ~__context ~self ~value:new_name_label - ) - - let set_name_description _context ~dbg ~sr ~vdi ~new_name_description = - Server_helpers.exec_with_new_task "VDI.set_name_description" - ~subtask_of:(Ref.of_string dbg) (fun __context -> - let self, _ = find_vdi ~__context sr vdi in - Db.VDI.set_name_description ~__context ~self - ~value:new_name_description - ) - - let resize _context ~dbg ~sr ~vdi ~new_size = - try - let vi = - for_vdi ~dbg ~sr ~vdi "VDI.resize" (fun device_config _type sr self -> - Sm.vdi_resize device_config _type sr self new_size - ) - in - Server_helpers.exec_with_new_task "VDI.resize" - ~subtask_of:(Ref.of_string dbg) (fun __context -> - let self, _ = - find_vdi ~__context sr - (Storage_interface.Vdi.of_string vi.Smint.vdi_info_location) - in - Db.VDI.get_virtual_size ~__context ~self - ) - with - | Api_errors.Server_error (code, params) -> - raise (Storage_error (Backend_error (code, params))) - | Smint.Not_implemented_in_backend -> - raise (Storage_error (Unimplemented "VDI.resize")) - | Sm.MasterOnly -> - redirect sr - - let destroy _context ~dbg ~sr ~vdi = - try - for_vdi ~dbg ~sr ~vdi "VDI.destroy" (fun device_config _type sr self -> - Sm.vdi_delete device_config _type sr self - ) ; - with_lock vdi_read_write_m (fun () -> - Hashtbl.remove vdi_read_write (sr, vdi) - ) - with - | Api_errors.Server_error (code, params) -> - raise (Storage_error (Backend_error (code, params))) - | No_VDI -> - raise (Storage_error (Vdi_does_not_exist (s_of_vdi vdi))) - | Sm.MasterOnly -> - redirect sr - - let stat _context ~dbg ~sr ~vdi = - try - Server_helpers.exec_with_new_task "VDI.stat" - ~subtask_of:(Ref.of_string dbg) (fun __context -> - for_vdi ~dbg ~sr ~vdi "VDI.stat" (fun device_config _type sr self -> - Sm.vdi_update device_config _type sr self ; - vdi_info_of_vdi_rec __context - (Db.VDI.get_record ~__context ~self) - ) - ) - with e -> - error "VDI.stat caught: %s" (Printexc.to_string e) ; - raise (Storage_error (Vdi_does_not_exist (s_of_vdi vdi))) - - let introduce _context ~dbg ~sr ~uuid ~sm_config ~location = - try - Server_helpers.exec_with_new_task "VDI.introduce" - ~subtask_of:(Ref.of_string dbg) (fun __context -> - let sr = Db.SR.get_by_uuid ~__context ~uuid:(s_of_sr sr) in - let vi = - Sm.call_sm_functions ~__context ~sR:sr - (fun device_config sr_type -> - Sm.vdi_introduce device_config sr_type sr uuid sm_config - location - ) - in - newvdi ~__context vi - ) - with e -> - error "VDI.introduce caught: %s" (Printexc.to_string e) ; - raise (Storage_error (Vdi_does_not_exist location)) - - let set_persistent _context ~dbg ~sr ~vdi ~persistent = - try - Server_helpers.exec_with_new_task "VDI.set_persistent" - ~subtask_of:(Ref.of_string dbg) (fun __context -> - if not persistent then ( - info - "VDI.set_persistent: calling VDI.clone and VDI.destroy to make \ - an empty vhd-leaf" ; - let new_vdi = - for_vdi ~dbg ~sr ~vdi "VDI.clone" - (fun device_config _type sr self -> - let vi = Sm.vdi_clone device_config _type [] sr self in - Storage_interface.Vdi.of_string vi.Smint.vdi_info_location - ) - in - for_vdi ~dbg ~sr ~vdi:new_vdi "VDI.destroy" - (fun device_config _type sr self -> - Sm.vdi_delete device_config _type sr self - ) - ) - ) - with - | Api_errors.Server_error (code, params) -> - raise (Storage_error (Backend_error (code, params))) - | Sm.MasterOnly -> - redirect sr - - let get_by_name _context ~dbg ~sr ~name = - info "VDI.get_by_name dbg:%s sr:%s name:%s" dbg (s_of_sr sr) name ; - (* PR-1255: the backend should do this for us *) - Server_helpers.exec_with_new_task "VDI.get_by_name" - ~subtask_of:(Ref.of_string dbg) (fun __context -> - (* PR-1255: the backend should do this for us *) - try - let _, vdi = find_content ~__context ~sr name in - let vi = vdi_info_of_vdi_rec __context vdi in - debug "VDI.get_by_name returning successfully" ; - vi - with e -> - error "VDI.get_by_name caught: %s" (Printexc.to_string e) ; - raise (Storage_error (Vdi_does_not_exist name)) - ) - - let set_content_id _context ~dbg ~sr ~vdi ~content_id = - info "VDI.get_by_content dbg:%s sr:%s vdi:%s content_id:%s" dbg - (s_of_sr sr) (s_of_vdi vdi) content_id ; - (* PR-1255: the backend should do this for us *) - Server_helpers.exec_with_new_task "VDI.set_content_id" - ~subtask_of:(Ref.of_string dbg) (fun __context -> - let vdi, _ = find_vdi ~__context sr vdi in - Db.VDI.remove_from_other_config ~__context ~self:vdi ~key:"content_id" ; - Db.VDI.add_to_other_config ~__context ~self:vdi ~key:"content_id" - ~value:content_id - ) - - let similar_content _context ~dbg ~sr ~vdi = - info "VDI.similar_content dbg:%s sr:%s vdi:%s" dbg (s_of_sr sr) - (s_of_vdi vdi) ; - Server_helpers.exec_with_new_task "VDI.similar_content" - ~subtask_of:(Ref.of_string dbg) (fun __context -> - (* PR-1255: the backend should do this for us. *) - let sr_ref = - Db.SR.get_by_uuid ~__context - ~uuid:(Storage_interface.Sr.string_of sr) - in - (* Return a nearest-first list of similar VDIs. "near" should mean - "has similar blocks" but we approximate this with distance in the tree *) - let module StringMap = Map.Make (struct - type t = string - - let compare = compare - end) in - let _vhdparent = "vhd-parent" in - let open Db_filter_types in - let all = - Db.VDI.get_records_where ~__context - ~expr:(Eq (Field "SR", Literal (Ref.string_of sr_ref))) - in - let locations = - List.fold_left - (fun acc (_, vdi_rec) -> - StringMap.add vdi_rec.API.vDI_location vdi_rec acc - ) - StringMap.empty all - in - (* Compute a map of parent location -> children locations *) - let children, parents = - List.fold_left - (fun (children, parents) (_, vdi_rec) -> - if List.mem_assoc _vhdparent vdi_rec.API.vDI_sm_config then - let me = vdi_rec.API.vDI_location in - let parent = - List.assoc _vhdparent vdi_rec.API.vDI_sm_config - in - let other_children = - if StringMap.mem parent children then - StringMap.find parent children - else - [] - in - ( StringMap.add parent (me :: other_children) children - , StringMap.add me parent parents - ) - else - (children, parents) - ) - (StringMap.empty, StringMap.empty) - all - in - let rec explore current_distance acc vdi = - (* add me *) - let acc = StringMap.add vdi current_distance acc in - (* add the parent *) - let parent = - if StringMap.mem vdi parents then - [StringMap.find vdi parents] - else - [] - in - let children = - if StringMap.mem vdi children then - StringMap.find vdi children - else - [] - in - List.fold_left - (fun acc vdi -> - if not (StringMap.mem vdi acc) then - explore (current_distance + 1) acc vdi - else - acc - ) - acc (parent @ children) - in - let module IntMap = Map.Make (struct - type t = int - - let compare = compare - end) in - let invert map = - StringMap.fold - (fun vdi n acc -> - let current = - if IntMap.mem n acc then IntMap.find n acc else [] - in - IntMap.add n (vdi :: current) acc - ) - map IntMap.empty - in - let _, vdi_rec = find_vdi ~__context sr vdi in - let vdis = - explore 0 StringMap.empty vdi_rec.API.vDI_location - |> invert - |> IntMap.bindings - |> List.map snd - |> List.concat - in - let vdi_recs = List.map (fun l -> StringMap.find l locations) vdis in - (* We drop cbt_metadata VDIs that do not have any actual data *) - let vdi_recs = - List.filter (fun r -> r.API.vDI_type <> `cbt_metadata) vdi_recs - in - List.map (fun x -> vdi_info_of_vdi_rec __context x) vdi_recs - ) - - let compose _context ~dbg ~sr ~vdi1 ~vdi2 = - info "VDI.compose dbg:%s sr:%s vdi1:%s vdi2:%s" dbg (s_of_sr sr) - (s_of_vdi vdi1) (s_of_vdi vdi2) ; - try - Server_helpers.exec_with_new_task "VDI.compose" - ~subtask_of:(Ref.of_string dbg) (fun __context -> - (* This call 'operates' on vdi2 *) - let vdi1 = find_vdi ~__context sr vdi1 |> fst in - for_vdi ~dbg ~sr ~vdi:vdi2 "VDI.compose" - (fun device_config _type sr self -> - Sm.vdi_compose device_config _type sr vdi1 self - ) - ) - with - | Smint.Not_implemented_in_backend -> - raise (Storage_error (Unimplemented "VDI.compose")) - | Api_errors.Server_error (code, params) -> - raise (Storage_error (Backend_error (code, params))) - | No_VDI -> - raise - (Storage_error - (Vdi_does_not_exist (Storage_interface.Vdi.string_of vdi1)) - ) - | Sm.MasterOnly -> - redirect sr - - let add_to_sm_config _context ~dbg ~sr ~vdi ~key ~value = - info "VDI.add_to_sm_config dbg:%s sr:%s vdi:%s key:%s value:%s" dbg - (s_of_sr sr) (s_of_vdi vdi) key value ; - Server_helpers.exec_with_new_task "VDI.add_to_sm_config" - ~subtask_of:(Ref.of_string dbg) (fun __context -> - let self = find_vdi ~__context sr vdi |> fst in - Db.VDI.add_to_sm_config ~__context ~self ~key ~value - ) - - let remove_from_sm_config _context ~dbg ~sr ~vdi ~key = - info "VDI.remove_from_sm_config dbg:%s sr:%s vdi:%s key:%s" dbg - (s_of_sr sr) (s_of_vdi vdi) key ; - Server_helpers.exec_with_new_task "VDI.remove_from_sm_config" - ~subtask_of:(Ref.of_string dbg) (fun __context -> - let self = find_vdi ~__context sr vdi |> fst in - Db.VDI.remove_from_sm_config ~__context ~self ~key - ) - - let get_url _context ~dbg ~sr ~vdi = - info "VDI.get_url dbg:%s sr:%s vdi:%s" dbg (s_of_sr sr) (s_of_vdi vdi) ; - (* XXX: PR-1255: tapdisk shouldn't hardcode xapi urls *) - (* peer_ip/session_ref/vdi_ref *) - Server_helpers.exec_with_new_task "VDI.get_url" - ~subtask_of:(Ref.of_string dbg) (fun __context -> - let ip = Helpers.get_management_ip_addr ~__context |> Option.get in - let rpc = Helpers.make_rpc ~__context in - let localhost = Helpers.get_localhost ~__context in - (* XXX: leaked *) - let session_ref = - XenAPI.Session.slave_login ~rpc ~host:localhost - ~psecret:(Xapi_globs.pool_secret ()) - in - let vdi, _ = find_vdi ~__context sr vdi in - Printf.sprintf "%s/%s/%s" ip - (Ref.string_of session_ref) - (Ref.string_of vdi) - ) - - let call_cbt_function _context ~f ~f_name ~dbg ~sr ~vdi = - try - for_vdi ~dbg ~sr ~vdi f_name (fun device_config _type sr self -> - f device_config _type sr self - ) - with - | Smint.Not_implemented_in_backend -> - raise (Storage_error (Unimplemented f_name)) - | Api_errors.Server_error (code, params) -> - raise (Storage_error (Backend_error (code, params))) - | No_VDI -> - raise - (Storage_error - (Vdi_does_not_exist (Storage_interface.Vdi.string_of vdi)) - ) - | Sm.MasterOnly -> - redirect sr - - let enable_cbt context = - call_cbt_function context ~f:Sm.vdi_enable_cbt ~f_name:"VDI.enable_cbt" - - let disable_cbt context = - call_cbt_function context ~f:Sm.vdi_disable_cbt ~f_name:"VDI.disable_cbt" - - let data_destroy context ~dbg ~sr ~vdi = - call_cbt_function context ~f:Sm.vdi_data_destroy - ~f_name:"VDI.data_destroy" ~dbg ~sr ~vdi ; - set_content_id context ~dbg ~sr ~vdi - ~content_id:"/No content: this is a cbt_metadata VDI/" - - let list_changed_blocks _context ~dbg ~sr ~vdi_from ~vdi_to = - try - Server_helpers.exec_with_new_task "VDI.list_changed_blocks" - ~subtask_of:(Ref.of_string dbg) (fun __context -> - let vdi_from = find_vdi ~__context sr vdi_from |> fst in - for_vdi ~dbg ~sr ~vdi:vdi_to "VDI.list_changed_blocks" - (fun device_config _type sr vdi_to -> - Sm.vdi_list_changed_blocks device_config _type sr ~vdi_from - ~vdi_to - ) - ) - with - | Smint.Not_implemented_in_backend -> - raise (Storage_error (Unimplemented "VDI.list_changed_blocks")) - | Api_errors.Server_error (code, params) -> - raise (Storage_error (Backend_error (code, params))) - | Sm.MasterOnly -> - redirect sr - end - - let get_by_name _context ~dbg:_ ~name:_ = assert false - - module DATA = struct - let copy_into _context ~dbg:_ ~sr:_ ~vdi:_ ~url:_ ~dest:_ ~dest_vdi:_ - ~verify_dest:_ = - assert false - - let copy _context ~dbg:_ ~sr:_ ~vdi:_ ~dp:_ ~url:_ ~dest:_ ~verify_dest:_ = - assert false - - module MIRROR = struct - let start _context ~dbg:_ ~sr:_ ~vdi:_ ~dp:_ ~url:_ ~dest:_ ~verify_dest:_ - = - assert false - - let stop _context ~dbg:_ ~id:_ = assert false - - let list _context ~dbg:_ = assert false - - let stat _context ~dbg:_ ~id:_ = assert false - - let receive_start _context ~dbg:_ ~sr:_ ~vdi_info:_ ~id:_ ~similar:_ = - assert false - - let receive_finalize _context ~dbg:_ ~id:_ = assert false - - let receive_cancel _context ~dbg:_ ~id:_ = assert false - end - end - - module Policy = struct - let get_backend_vm _context ~dbg:_ ~vm:_ ~sr:_ ~vdi:_ = assert false - end - - module TASK = struct - let stat _context ~dbg:_ ~task:_ = assert false - - let destroy _context ~dbg:_ ~task:_ = assert false - - let cancel _context ~dbg:_ ~task:_ = assert false - - let list _context ~dbg:_ = assert false - end - - module UPDATES = struct - let get _context ~dbg:_ ~from:_ ~timeout:_ = assert false - end -end - (* Start a set of servers for all SMAPIv1 plugins *) let start_smapiv1_servers () = let drivers = Sm.supported_drivers () in @@ -1203,7 +63,7 @@ let start_smapiv1_servers () = (fun ty -> let path = !Storage_interface.default_path ^ ".d/" ^ ty in let queue_name = !Storage_interface.queue_name ^ "." ^ ty in - let module S = Storage_interface.Server (SMAPIv1) () in + let module S = Storage_smapiv1_wrapper.Server in let s = Xcp_service.make ~path ~queue_name ~rpc_fn:S.process () in let (_ : Thread.t) = Thread.create (fun () -> Xcp_service.serve_forever s) () @@ -1699,24 +559,6 @@ let of_vbd ~__context ~vbd ~domid = , Storage_interface.Vdi.of_string location ) -(** [is_attached __context vbd] returns true if the [vbd] has an attached - or activated datapath. *) -let is_attached ~__context ~vbd ~domid = - transform_storage_exn (fun () -> - let rpc, dbg, _dp, sr, vdi = of_vbd ~__context ~vbd ~domid in - let open Vdi_automaton in - let module C = Storage_interface.StorageAPI (Idl.Exn.GenClient (struct - let rpc = rpc - end)) in - try - let x = C.DP.stat_vdi dbg sr vdi () in - x.superstate <> Detached - with e -> - error "Unable to query state of VDI: %s, %s" (s_of_vdi vdi) - (Printexc.to_string e) ; - false - ) - (** [on_vdi __context vbd domid f] calls [f rpc dp sr vdi] which is useful for executing Storage_interface.Client.VDI functions *) let on_vdi ~__context ~vbd ~domid f = @@ -1901,8 +743,8 @@ let refresh_local_vdi_activations ~__context = in let remember key ro_rw = (* The module above contains a hashtable of R/O vs R/W-ness *) - with_lock SMAPIv1.VDI.vdi_read_write_m (fun () -> - Hashtbl.replace SMAPIv1.VDI.vdi_read_write key (ro_rw = RW) + with_lock Storage_smapiv1.vdi_read_write_m (fun () -> + Hashtbl.replace Storage_smapiv1.vdi_read_write key (ro_rw = RW) ) in let dbg = Ref.string_of (Context.get_task_id __context) in diff --git a/ocaml/xapi/storage_access.mli b/ocaml/xapi/storage_access.mli index 7de7633a686..28cf3108dee 100644 --- a/ocaml/xapi/storage_access.mli +++ b/ocaml/xapi/storage_access.mli @@ -25,25 +25,6 @@ val start : unit -> unit (** once [start ()] returns the storage service is listening for requests on its unix domain socket. *) -val find_vdi : - __context:Context.t - -> Storage_interface.sr - -> Storage_interface.vdi - -> API.ref_VDI * API.vDI_t -(** [find_vdi __context sr vdi] returns the XenAPI VDI ref associated - with (sr, vdi) *) - -val find_content : - __context:Context.t - -> ?sr:Storage_interface.sr - -> Storage_interface.content_id - -> API.ref_VDI * API.vDI_t -(** [find_content __context ?sr content_id] returns the XenAPI VDI ref associated - with [content_id] *) - -val vdi_info_of_vdi_rec : Context.t -> API.vDI_t -> Storage_interface.vdi_info -(** [vdi_info_of_vdi_rec __context vdi_rec] constructs a vdi_info record from information in the given VDI database record. *) - val bind : __context:Context.t -> pbd:API.ref_PBD -> Storage_interface.query_result (** [bind __context pbd] causes the storage_access module to choose the most @@ -99,10 +80,6 @@ val deactivate_and_detach : (** [deactivate_and_detach __context vbd domid] idempotent function which ensures that any attached or activated VDI gets properly deactivated and detached. *) -val is_attached : __context:Context.t -> vbd:API.ref_VBD -> domid:int -> bool -(** [is_attached __context vbd] returns true if the [vbd] has an attached - or activated datapath. *) - val on_vdi : __context:Context.t -> vbd:API.ref_VBD diff --git a/ocaml/xapi/storage_mux.ml b/ocaml/xapi/storage_mux.ml index 06a525cfed6..fbb46bc3719 100644 --- a/ocaml/xapi/storage_mux.ml +++ b/ocaml/xapi/storage_mux.ml @@ -12,6 +12,8 @@ * GNU Lesser General Public License for more details. *) +module Unixext = Xapi_stdext_unix.Unixext + module D = Debug.Make (struct let name = "mux" end) open D @@ -26,6 +28,8 @@ let s_of_sr = Sr.string_of let s_of_vdi = Vdi.string_of +let s_of_vm = Vm.string_of + type plugin = { processor: processor ; backend_domain: string @@ -151,65 +155,170 @@ module Mux = struct ) end + module DP_info = struct + type t = {sr: Sr.t; vdi: Vdi.t; vm: Vm.t} [@@deriving rpcty] + + let storage_dp_path = "/var/run/nonpersistent/xapi/storage-dps" + + let m = Mutex.create () + + let filename_of dp = Xapi_stdext_std.Xstringext.String.replace "/" "-" dp + + let write dp info = + let filename = filename_of dp in + let data = Rpcmarshal.marshal t.Rpc.Types.ty info |> Jsonrpc.to_string in + with_lock m (fun () -> + Unixext.mkdir_rec storage_dp_path 0o600 ; + Unixext.write_string_to_file + (Filename.concat storage_dp_path filename) + data + ) + + let read dp : t option = + try + with_lock m (fun () -> + let x = + let path = Filename.concat storage_dp_path (filename_of dp) in + path |> Unixext.string_of_file |> Jsonrpc.of_string + in + match Rpcmarshal.unmarshal t.Rpc.Types.ty x with + | Ok x -> + Some x + | Error (`Msg m) -> + failwith (Printf.sprintf "Failed to unmarshal: %s" m) + ) + with _ -> None + + let delete dp = + try + with_lock m (fun () -> + let path = Filename.concat storage_dp_path (filename_of dp) in + Unix.unlink path + ) + with _ -> () + end + module DP = struct - (* We'll never get here, because DP is implemented in - Storage_impl.Wrapper(Impl), and it never calls Impl.DP *) - include Storage_skeleton.DP + let create _context ~dbg:_ ~id = id + + let destroy2 _context ~dbg ~dp ~sr ~vdi ~vm ~allow_leak = + info "DP.destroy2 dbg:%s dp:%s sr:%s vdi:%s vm:%s allow_leak:%b" dbg dp + (s_of_sr sr) (s_of_vdi vdi) (s_of_vm vm) allow_leak ; + let module C = StorageAPI (Idl.Exn.GenClient (struct + let rpc = of_sr sr + end)) in + C.DP.destroy2 dbg dp sr vdi vm allow_leak ; + DP_info.delete dp + + let destroy _context ~dbg ~dp ~allow_leak = + info "DP.destroy dbg:%s dp:%s allow_leak:%b" dbg dp allow_leak ; + let sr, vdi, vm = + let open DP_info in + match read dp with + | Some x -> + (x.sr, x.vdi, x.vm) + | None -> + failwith "DP not found" + in + destroy2 _context ~dbg ~dp ~sr ~vdi ~vm ~allow_leak + + let diagnostics () = Storage_smapiv1_wrapper.Impl.DP.diagnostics () + + let attach_info () = Storage_smapiv1_wrapper.Impl.DP.attach_info () + + let stat_vdi () = Storage_smapiv1_wrapper.Impl.DP.stat_vdi () end module SR = struct include Storage_skeleton.SR + let device_config_str device_config = + let censor_key = ["password"] in + String.concat "; " + (List.map + (fun (k, v) -> + let v' = + if + List.exists + (fun censored -> Astring.String.is_infix ~affix:censored k) + censor_key + then + "(omitted)" + else + v + in + k ^ ":" ^ v' + ) + device_config + ) + let create () ~dbg ~sr ~name_label ~name_description ~device_config ~physical_size = + info + "SR.create dbg:%s sr:%s name_label:%s name_description:%s \ + device_config:[%s] physical_size:%Ld" + dbg (s_of_sr sr) name_label name_description + (device_config_str device_config) + physical_size ; let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in C.SR.create dbg sr name_label name_description device_config physical_size let attach () ~dbg ~sr ~device_config = + info "SR.attach dbg:%s sr:%s device_config:[%s]" dbg (s_of_sr sr) + (device_config_str device_config) ; let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in C.SR.attach dbg sr device_config let set_name_label () ~dbg ~sr ~new_name_label = + info "SR.set_name_label dbg:%s sr:%s new_name_label:%s" dbg (s_of_sr sr) + new_name_label ; let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in C.SR.set_name_label dbg sr new_name_label let set_name_description () ~dbg ~sr ~new_name_description = + info "SR.set_name_description dbg:%s sr:%s new_name_description:%s" dbg + (s_of_sr sr) new_name_description ; let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in C.SR.set_name_description dbg sr new_name_description let detach () ~dbg ~sr = + info "SR.detach dbg:%s sr:%s" dbg (s_of_sr sr) ; let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in C.SR.detach dbg sr let destroy () ~dbg ~sr = + info "SR.destroy dbg:%s sr:%s" dbg (s_of_sr sr) ; let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in C.SR.destroy dbg sr let stat () ~dbg ~sr = + info "SR.stat dbg:%s sr:%s" dbg (s_of_sr sr) ; let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in C.SR.stat dbg sr let scan () ~dbg ~sr = + info "SR.scan dbg:%s sr:%s" dbg (s_of_sr sr) ; let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in C.SR.scan dbg sr let list () ~dbg = + info "SR.list dbg:%s" dbg ; List.fold_left (fun acc (_, list) -> match list with SMSuccess l -> l @ acc | _ -> acc @@ -223,37 +332,80 @@ module Mux = struct ) ) - let reset () ~dbg:_ ~sr:_ = assert false + let reset () ~dbg ~sr = + info "SR.reset dbg:%s sr:%s" dbg (s_of_sr sr) ; + let module C = StorageAPI (Idl.Exn.GenClient (struct + let rpc = of_sr sr + end)) in + C.SR.reset dbg sr - let update_snapshot_info_src () = Storage_migrate.update_snapshot_info_src + let update_snapshot_info_src () ~dbg ~sr ~vdi ~url ~dest ~dest_vdi + ~snapshot_pairs = + info + "SR.update_snapshot_info_src dbg:%s sr:%s vdi:%s url:%s dest:%s \ + dest_vdi:%s snapshot_pairs:%s" + dbg (s_of_sr sr) (s_of_vdi vdi) url (s_of_sr dest) (s_of_vdi dest_vdi) + (List.map + (fun (local_snapshot, dest_snapshot) -> + Printf.sprintf "local:%s, dest:%s" (s_of_vdi local_snapshot) + (s_of_vdi dest_snapshot) + ) + snapshot_pairs + |> String.concat "; " + |> Printf.sprintf "[%s]" + ) ; + Storage_migrate.update_snapshot_info_src ~dbg ~sr ~vdi ~url ~dest + ~dest_vdi ~snapshot_pairs let update_snapshot_info_dest () ~dbg ~sr ~vdi ~src_vdi ~snapshot_pairs = let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in + info + "SR.update_snapshot_info_dest dbg:%s sr:%s vdi:%s ~src_vdi:%s \ + snapshot_pairs:%s" + dbg (s_of_sr sr) (s_of_vdi vdi) (s_of_vdi src_vdi.vdi) + (List.map + (fun (local_snapshot, src_snapshot_info) -> + Printf.sprintf "local:%s, src:%s" (s_of_vdi local_snapshot) + (s_of_vdi src_snapshot_info.vdi) + ) + snapshot_pairs + |> String.concat "; " + |> Printf.sprintf "[%s]" + ) ; C.SR.update_snapshot_info_dest dbg sr vdi src_vdi snapshot_pairs end module VDI = struct let create () ~dbg ~sr ~vdi_info = + info "VDI.create dbg:%s sr:%s vdi_info:%s" dbg (s_of_sr sr) + (string_of_vdi_info vdi_info) ; let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in C.VDI.create dbg sr vdi_info let set_name_label () ~dbg ~sr ~vdi ~new_name_label = + info "VDI.set_name_label dbg:%s sr:%s vdi:%s new_name_label:%s" dbg + (s_of_sr sr) (s_of_vdi vdi) new_name_label ; let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in C.VDI.set_name_label dbg sr vdi new_name_label let set_name_description () ~dbg ~sr ~vdi ~new_name_description = + info + "VDI.set_name_description dbg:%s sr:%s vdi:%s new_name_description:%s" + dbg (s_of_sr sr) (s_of_vdi vdi) new_name_description ; let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in C.VDI.set_name_description dbg sr vdi new_name_description let snapshot () ~dbg ~sr ~vdi_info = + info "VDI.snapshot dbg:%s sr:%s vdi_info:%s" dbg (s_of_sr sr) + (string_of_vdi_info vdi_info) ; let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in @@ -271,155 +423,246 @@ module Mux = struct ) let clone () ~dbg ~sr ~vdi_info = + info "VDI.clone dbg:%s sr:%s vdi_info:%s" dbg (s_of_sr sr) + (string_of_vdi_info vdi_info) ; let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in C.VDI.clone dbg sr vdi_info let resize () ~dbg ~sr ~vdi ~new_size = + info "VDI.resize dbg:%s sr:%s vdi:%s new_size:%Ld" dbg (s_of_sr sr) + (s_of_vdi vdi) new_size ; let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in C.VDI.resize dbg sr vdi new_size let destroy () ~dbg ~sr ~vdi = + info "VDI.destroy dbg:%s sr:%s vdi:%s" dbg (s_of_sr sr) (s_of_vdi vdi) ; let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in C.VDI.destroy dbg sr vdi let stat () ~dbg ~sr ~vdi = + info "VDI.stat dbg:%s sr:%s vdi:%s" dbg (s_of_sr sr) (s_of_vdi vdi) ; let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in C.VDI.stat dbg sr vdi let introduce () ~dbg ~sr ~uuid ~sm_config ~location = + info "VDI.introduce dbg:%s sr:%s uuid:%s sm_config:%s location:%s" dbg + (s_of_sr sr) uuid + (String.concat ", " (List.map (fun (k, v) -> k ^ ":" ^ v) sm_config)) + location ; let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in C.VDI.introduce dbg sr uuid sm_config location let set_persistent () ~dbg ~sr ~vdi ~persistent = + info "VDI.set_persistent dbg:%s sr:%s vdi:%s persistent:%b" dbg + (s_of_sr sr) (s_of_vdi vdi) persistent ; let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in C.VDI.set_persistent dbg sr vdi persistent let epoch_begin () ~dbg ~sr ~vdi ~vm ~persistent = + info "VDI.epoch_begin dbg:%s sr:%s vdi:%s vm:%s persistent:%b" dbg + (s_of_sr sr) (s_of_vdi vdi) (s_of_vm vm) persistent ; let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in C.VDI.epoch_begin dbg sr vdi vm persistent - (* We need to include this to satisfy the SMAPIv2 signature *) - let attach () ~dbg:_ ~dp:_ ~sr:_ ~vdi:_ ~read_write:_ = - failwith - "We'll never get here: attach is implemented in Storage_impl.Wrapper" + let attach () ~dbg ~dp ~sr ~vdi ~read_write = + info "VDI.attach dbg:%s dp:%s sr:%s vdi:%s read_write:%b" dbg dp + (s_of_sr sr) (s_of_vdi vdi) read_write ; + let module C = StorageAPI (Idl.Exn.GenClient (struct + let rpc = of_sr sr + end)) in + let vm = Vm.of_string "0" in + DP_info.write dp DP_info.{sr; vdi; vm} ; + let backend = C.VDI.attach3 dbg dp sr vdi vm read_write in + (* VDI.attach2 should be used instead, VDI.attach is only kept for + backwards-compatibility, because older xapis call Remote.VDI.attach during SXM. + However, they ignore the return value, so in practice it does not matter what + we return from here. *) + let xendisks, blockdevs, files, _nbds = + Storage_interface.implementations_of_backend backend + in + let response params = + (* We've thrown o_direct info away from the SMAPIv1 info during the conversion to SMAPIv3 attach info *) + (* The removal of these fields does not break read caching info propagation for SMAPIv1 + * (REQ-49), because we put this information into the VDI's sm_config elsewhere, + * and XenCenter looks at the relevant sm_config keys. *) + {params; xenstore_data= []; o_direct= true; o_direct_reason= ""} + in + (* If Nbd is returned, then XenDisk must also be returned from attach2 *) + match (xendisks, files, blockdevs) with + | xendisk :: _, _, _ -> + response xendisk.Storage_interface.params + | _, file :: _, _ -> + response file.Storage_interface.path + | _, _, blockdev :: _ -> + response blockdev.Storage_interface.path + | [], [], [] -> + raise + (Storage_interface.Storage_error + (Backend_error + ( Api_errors.internal_error + , [ + "No File, BlockDev, or XenDisk implementation in \ + Datapath.attach response: " + ^ (Storage_interface.(rpc_of backend) backend + |> Jsonrpc.to_string + ) + ] + ) + ) + ) let attach2 () ~dbg ~dp ~sr ~vdi ~read_write = + info "VDI.attach2 dbg:%s dp:%s sr:%s vdi:%s read_write:%b" dbg dp + (s_of_sr sr) (s_of_vdi vdi) read_write ; let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in - C.VDI.attach2 dbg dp sr vdi read_write + let vm = Vm.of_string "0" in + DP_info.write dp DP_info.{sr; vdi; vm} ; + C.VDI.attach3 dbg dp sr vdi vm read_write let attach3 () ~dbg ~dp ~sr ~vdi ~vm ~read_write = + info "VDI.attach3 dbg:%s dp:%s sr:%s vdi:%s vm:%s read_write:%b" dbg dp + (s_of_sr sr) (s_of_vdi vdi) (s_of_vm vm) read_write ; let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in + DP_info.write dp DP_info.{sr; vdi; vm} ; C.VDI.attach3 dbg dp sr vdi vm read_write let activate () ~dbg ~dp ~sr ~vdi = + info "VDI.activate dbg:%s dp:%s sr:%s vdi:%s " dbg dp (s_of_sr sr) + (s_of_vdi vdi) ; let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in C.VDI.activate dbg dp sr vdi let activate3 () ~dbg ~dp ~sr ~vdi ~vm = + info "VDI.activate3 dbg:%s dp:%s sr:%s vdi:%s vm:%s" dbg dp (s_of_sr sr) + (s_of_vdi vdi) (s_of_vm vm) ; let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in C.VDI.activate3 dbg dp sr vdi vm let deactivate () ~dbg ~dp ~sr ~vdi ~vm = + info "VDI.deactivate dbg:%s dp:%s sr:%s vdi:%s vm:%s" dbg dp (s_of_sr sr) + (s_of_vdi vdi) (s_of_vm vm) ; let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in C.VDI.deactivate dbg dp sr vdi vm let detach () ~dbg ~dp ~sr ~vdi ~vm = + info "VDI.detach dbg:%s dp:%s sr:%s vdi:%s vm:%s" dbg dp (s_of_sr sr) + (s_of_vdi vdi) (s_of_vm vm) ; let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in - C.VDI.detach dbg dp sr vdi vm + C.VDI.detach dbg dp sr vdi vm ; + DP_info.delete dp let epoch_end () ~dbg ~sr ~vdi ~vm = + info "VDI.epoch_end dbg:%s sr:%s vdi:%s vm:%s" dbg (s_of_sr sr) + (s_of_vdi vdi) (s_of_vm vm) ; let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in C.VDI.epoch_end dbg sr vdi vm let get_by_name () ~dbg ~sr ~name = + info "VDI.get_by_name dbg:%s sr:%s name:%s" dbg (s_of_sr sr) name ; let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in C.VDI.get_by_name dbg sr name let set_content_id () ~dbg ~sr ~vdi ~content_id = + info "VDI.set_content_id dbg:%s sr:%s vdi:%s content_id:%s" dbg + (s_of_sr sr) (s_of_vdi vdi) content_id ; let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in C.VDI.set_content_id dbg sr vdi content_id let similar_content () ~dbg ~sr ~vdi = + info "VDI.similar_content dbg:%s sr:%s vdi:%s" dbg (s_of_sr sr) + (s_of_vdi vdi) ; let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in C.VDI.similar_content dbg sr vdi let compose () ~dbg ~sr ~vdi1 ~vdi2 = + info "VDI.compose dbg:%s sr:%s vdi1:%s vdi2:%s" dbg (s_of_sr sr) + (s_of_vdi vdi1) (s_of_vdi vdi2) ; let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in C.VDI.compose dbg sr vdi1 vdi2 let add_to_sm_config () ~dbg ~sr ~vdi ~key ~value = + info "VDI.add_to_sm_config dbg:%s sr:%s vdi:%s key:%s value:%s" dbg + (s_of_sr sr) (s_of_vdi vdi) key value ; let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in C.VDI.add_to_sm_config dbg sr vdi key value let remove_from_sm_config () ~dbg ~sr ~vdi ~key = + info "VDI.remove_from_sm_config dbg:%s sr:%s vdi:%s key:%s" dbg + (s_of_sr sr) (s_of_vdi vdi) key ; let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in C.VDI.remove_from_sm_config dbg sr vdi key let get_url () ~dbg ~sr ~vdi = + info "VDI.get_url dbg:%s sr:%s vdi:%s" dbg (s_of_sr sr) (s_of_vdi vdi) ; let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in C.VDI.get_url dbg sr vdi let enable_cbt () ~dbg ~sr ~vdi = + info "VDI.enable_cbt dbg:%s sr:%s vdi:%s" dbg (s_of_sr sr) (s_of_vdi vdi) ; let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in C.VDI.enable_cbt dbg sr vdi let disable_cbt () ~dbg ~sr ~vdi = + info "VDI.disable_cbt dbg:%s sr:%s vdi:%s" dbg (s_of_sr sr) (s_of_vdi vdi) ; let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in C.VDI.disable_cbt dbg sr vdi let data_destroy () ~dbg ~sr ~vdi = + info "VDI.data_destroy dbg:%s sr:%s vdi:%s" dbg (s_of_sr sr) (s_of_vdi vdi) ; let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in C.VDI.data_destroy dbg sr vdi let list_changed_blocks () ~dbg ~sr ~vdi_from ~vdi_to = + info "VDI.list_changed_blocks dbg:%s sr:%s vdi_from:%s vdi_to:%s" dbg + (s_of_sr sr) (s_of_vdi vdi_from) (s_of_vdi vdi_to) ; let module C = StorageAPI (Idl.Exn.GenClient (struct let rpc = of_sr sr end)) in @@ -488,19 +731,23 @@ module Mux = struct (Hashtbl.find plugins sr).backend_domain end - module TASK = struct - let stat () ~dbg:_ ~task:_ = assert false - - let cancel () ~dbg:_ ~task:_ = assert false - - let destroy () ~dbg:_ ~task:_ = assert false - - let list () ~dbg:_ = assert false - end - - module UPDATES = struct - let get () ~dbg:_ ~from:_ ~timeout:_ = assert false - end + module TASK = Storage_smapiv1_wrapper.Impl.TASK + module UPDATES = Storage_smapiv1_wrapper.Impl.UPDATES end -module Server = Storage_interface.Server (Storage_impl.Wrapper (Mux)) () +module Server = Storage_interface.Server (Mux) () + +module Local_domain_socket = struct + let path = Filename.concat "/var/lib/xcp" "storage" + + (* receives external requests on Constants.sm_uri *) + let xmlrpc_handler process req bio _ = + let body = Http_svr.read_body req bio in + let s = Buf_io.fd_of bio in + let rpc = Xmlrpc.call_of_string body in + (* Printf.fprintf stderr "Request: %s %s\n%!" rpc.Rpc.name (Rpc.to_string (List.hd rpc.Rpc.params)); *) + let result = process rpc in + (* Printf.fprintf stderr "Response: %s\n%!" (Rpc.to_string result.Rpc.contents); *) + let str = Xmlrpc.string_of_response result in + Http_svr.response_str req s str +end diff --git a/ocaml/xapi/storage_smapiv1.ml b/ocaml/xapi/storage_smapiv1.ml new file mode 100644 index 00000000000..c4832277391 --- /dev/null +++ b/ocaml/xapi/storage_smapiv1.ml @@ -0,0 +1,1157 @@ +(* + * Copyright (C) 2006-2011 Citrix Systems Inc. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published + * by the Free Software Foundation; version 2.1 only. with the special + * exception on linking described in file LICENSE. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + *) + +module D = Debug.Make (struct let name = __MODULE__ end) + +open D +module Date = Xapi_stdext_date.Date +module XenAPI = Client.Client +open Storage_interface + +exception No_VDI + +let s_of_vdi = Vdi.string_of + +let s_of_sr = Sr.string_of + +let with_lock = Xapi_stdext_threads.Threadext.Mutex.execute + +(* Find a VDI given a storage-layer SR and VDI *) +let find_vdi ~__context sr vdi = + let sr = s_of_sr sr in + let vdi = s_of_vdi vdi in + let open Db_filter_types in + let sr = Db.SR.get_by_uuid ~__context ~uuid:sr in + match + Db.VDI.get_records_where ~__context + ~expr: + (And + ( Eq (Field "location", Literal vdi) + , Eq (Field "SR", Literal (Ref.string_of sr)) + ) + ) + with + | x :: _ -> + x + | _ -> + raise No_VDI + +(* Find a VDI reference given a name *) +let find_content ~__context ?sr name = + (* PR-1255: the backend should do this for us *) + let open Db_filter_types in + let expr = + Option.fold ~none:True + ~some:(fun sr -> + Eq + ( Field "SR" + , Literal + (Ref.string_of (Db.SR.get_by_uuid ~__context ~uuid:(s_of_sr sr))) + ) + ) + sr + in + let all = Db.VDI.get_records_where ~__context ~expr in + List.find + (fun (_, vdi_rec) -> false || vdi_rec.API.vDI_location = name (* PR-1255 *)) + all + +let vdi_info_of_vdi_rec __context vdi_rec = + let content_id = + try List.assoc "content_id" vdi_rec.API.vDI_other_config + with Not_found -> vdi_rec.API.vDI_location + (* PR-1255 *) + in + { + vdi= Storage_interface.Vdi.of_string vdi_rec.API.vDI_location + ; uuid= Some vdi_rec.API.vDI_uuid + ; content_id + ; (* PR-1255 *) + name_label= vdi_rec.API.vDI_name_label + ; name_description= vdi_rec.API.vDI_name_description + ; ty= Storage_utils.string_of_vdi_type vdi_rec.API.vDI_type + ; metadata_of_pool= Ref.string_of vdi_rec.API.vDI_metadata_of_pool + ; is_a_snapshot= vdi_rec.API.vDI_is_a_snapshot + ; snapshot_time= Date.to_string vdi_rec.API.vDI_snapshot_time + ; snapshot_of= + ( if Db.is_valid_ref __context vdi_rec.API.vDI_snapshot_of then + Db.VDI.get_uuid ~__context ~self:vdi_rec.API.vDI_snapshot_of + else + "" + ) + |> Storage_interface.Vdi.of_string + ; read_only= vdi_rec.API.vDI_read_only + ; cbt_enabled= vdi_rec.API.vDI_cbt_enabled + ; virtual_size= vdi_rec.API.vDI_virtual_size + ; physical_utilisation= vdi_rec.API.vDI_physical_utilisation + ; persistent= vdi_rec.API.vDI_on_boot = `persist + ; sharable= vdi_rec.API.vDI_sharable + ; sm_config= vdi_rec.API.vDI_sm_config + } + +let redirect _sr = + raise (Storage_error (Redirect (Some (Pool_role.get_master_address ())))) + +(* Allow us to remember whether a VDI is attached read/only or read/write. + If this is meaningful to the backend then this should be recorded there! *) +let vdi_read_write = Hashtbl.create 10 + +let vdi_read_write_m = Mutex.create () + +let vdi_read_caching_m = Mutex.create () + +module SMAPIv1 : Server_impl = struct + (** xapi's builtin ability to call local SM plugins using the existing + protocol. The code here should only call the SM functions and encapsulate + the return or error properly. It should not perform side-effects on + the xapi database: these should be handled in the layer above so they + can be shared with other SM implementation types. + + Where this layer has to perform interface adjustments (see VDI.activate + and the read/write debacle), this highlights desirable improvements to + the backend interface. + *) + + type context = unit + + let vdi_info_from_db ~__context self = + let vdi_rec = Db.VDI.get_record ~__context ~self in + vdi_info_of_vdi_rec __context vdi_rec + + (* For SMAPIv1, is_a_snapshot, snapshot_time and snapshot_of are stored in + * xapi's database. For SMAPIv2 they should be implemented by the storage + * backend. *) + let set_is_a_snapshot _context ~dbg ~sr ~vdi ~is_a_snapshot = + Server_helpers.exec_with_new_task "VDI.set_is_a_snapshot" + ~subtask_of:(Ref.of_string dbg) (fun __context -> + let vdi, _ = find_vdi ~__context sr vdi in + Db.VDI.set_is_a_snapshot ~__context ~self:vdi ~value:is_a_snapshot + ) + + let set_snapshot_time _context ~dbg ~sr ~vdi ~snapshot_time = + Server_helpers.exec_with_new_task "VDI.set_snapshot_time" + ~subtask_of:(Ref.of_string dbg) (fun __context -> + let vdi, _ = find_vdi ~__context sr vdi in + let snapshot_time = Date.of_string snapshot_time in + Db.VDI.set_snapshot_time ~__context ~self:vdi ~value:snapshot_time + ) + + let set_snapshot_of _context ~dbg ~sr ~vdi ~snapshot_of = + Server_helpers.exec_with_new_task "VDI.set_snapshot_of" + ~subtask_of:(Ref.of_string dbg) (fun __context -> + let vdi, _ = find_vdi ~__context sr vdi in + let snapshot_of, _ = find_vdi ~__context sr snapshot_of in + Db.VDI.set_snapshot_of ~__context ~self:vdi ~value:snapshot_of + ) + + module Query = struct + let query _context ~dbg:_ = + { + driver= "storage_access" + ; name= "SMAPIv1 adapter" + ; description= + "Allows legacy SMAPIv1 adapters to expose an SMAPIv2 interface" + ; vendor= "XCP" + ; copyright= "see the source code" + ; version= "2.0" + ; required_api_version= "2.0" + ; features= [] + ; configuration= [] + ; required_cluster_stack= [] + } + + let diagnostics _context ~dbg:_ = + "No diagnostics are available for SMAPIv1 plugins" + end + + module DP = Storage_skeleton.DP + + module SR = struct + include Storage_skeleton.SR + + let probe _context ~dbg ~queue ~device_config ~sm_config = + let _type = + (* SMAPIv1 plugins have no namespaces, so strip off everything up to + the final dot *) + try + let i = String.rindex queue '.' in + String.sub queue (i + 1) (String.length queue - i - 1) + with Not_found -> queue + in + Server_helpers.exec_with_new_task "SR.probe" + ~subtask_of:(Ref.of_string dbg) (fun __context -> + let task = Context.get_task_id __context in + Storage_interface.Raw + (Sm.sr_probe + (Some task, Sm.sm_master true :: device_config) + _type sm_config + ) + ) + + let create _context ~dbg ~sr ~name_label ~name_description ~device_config + ~physical_size = + Server_helpers.exec_with_new_task "SR.create" + ~subtask_of:(Ref.of_string dbg) (fun __context -> + let subtask_of = Some (Context.get_task_id __context) in + let sr = + Db.SR.get_by_uuid ~__context + ~uuid:(Storage_interface.Sr.string_of sr) + in + Db.SR.set_name_label ~__context ~self:sr ~value:name_label ; + Db.SR.set_name_description ~__context ~self:sr ~value:name_description ; + let device_config = Sm.sm_master true :: device_config in + Sm.call_sm_functions ~__context ~sR:sr (fun _ _type -> + try + Sm.sr_create (subtask_of, device_config) _type sr physical_size + with + | Smint.Not_implemented_in_backend -> + error "SR.create failed SR:%s Not_implemented_in_backend" + (Ref.string_of sr) ; + raise + (Storage_interface.Storage_error + (Backend_error + ( Api_errors.sr_operation_not_supported + , [Ref.string_of sr] + ) + ) + ) + | Api_errors.Server_error (code, params) -> + raise (Storage_error (Backend_error (code, params))) + | e -> + let e' = ExnHelper.string_of_exn e in + error "SR.create failed SR:%s error:%s" (Ref.string_of sr) e' ; + raise e + ) ; + List.filter (fun (x, _) -> x <> "SRmaster") device_config + ) + + let set_name_label _context ~dbg ~sr ~new_name_label = + Server_helpers.exec_with_new_task "SR.set_name_label" + ~subtask_of:(Ref.of_string dbg) (fun __context -> + let sr = + Db.SR.get_by_uuid ~__context + ~uuid:(Storage_interface.Sr.string_of sr) + in + Db.SR.set_name_label ~__context ~self:sr ~value:new_name_label + ) + + let set_name_description _context ~dbg ~sr ~new_name_description = + Server_helpers.exec_with_new_task "SR.set_name_description" + ~subtask_of:(Ref.of_string dbg) (fun __context -> + let sr = + Db.SR.get_by_uuid ~__context + ~uuid:(Storage_interface.Sr.string_of sr) + in + Db.SR.set_name_description ~__context ~self:sr + ~value:new_name_description + ) + + let attach _context ~dbg ~sr ~device_config = + Server_helpers.exec_with_new_task "SR.attach" + ~subtask_of:(Ref.of_string dbg) (fun __context -> + let sr = + Db.SR.get_by_uuid ~__context + ~uuid:(Storage_interface.Sr.string_of sr) + in + (* Existing backends expect an SRMaster flag to be added + through the device-config. *) + let srmaster = Helpers.i_am_srmaster ~__context ~sr in + let device_config = Sm.sm_master srmaster :: device_config in + Sm.call_sm_functions ~__context ~sR:sr (fun _ _type -> + try + Sm.sr_attach + (Some (Context.get_task_id __context), device_config) + _type sr + with + | Api_errors.Server_error (code, params) -> + raise (Storage_error (Backend_error (code, params))) + | e -> + let e' = ExnHelper.string_of_exn e in + error "SR.attach failed SR:%s error:%s" (Ref.string_of sr) e' ; + raise e + ) + ) + + let detach _context ~dbg ~sr = + Server_helpers.exec_with_new_task "SR.detach" + ~subtask_of:(Ref.of_string dbg) (fun __context -> + let sr = + Db.SR.get_by_uuid ~__context + ~uuid:(Storage_interface.Sr.string_of sr) + in + Sm.call_sm_functions ~__context ~sR:sr (fun device_config _type -> + try Sm.sr_detach device_config _type sr with + | Api_errors.Server_error (code, params) -> + raise (Storage_error (Backend_error (code, params))) + | e -> + let e' = ExnHelper.string_of_exn e in + error "SR.detach failed SR:%s error:%s" (Ref.string_of sr) e' ; + raise e + ) + ) + + let reset _context ~dbg:_ ~sr:_ = assert false + + let destroy _context ~dbg ~sr = + Server_helpers.exec_with_new_task "SR.destroy" + ~subtask_of:(Ref.of_string dbg) (fun __context -> + let sr = + Db.SR.get_by_uuid ~__context + ~uuid:(Storage_interface.Sr.string_of sr) + in + Sm.call_sm_functions ~__context ~sR:sr (fun device_config _type -> + try Sm.sr_delete device_config _type sr with + | Smint.Not_implemented_in_backend -> + raise + (Storage_interface.Storage_error + (Backend_error + ( Api_errors.sr_operation_not_supported + , [Ref.string_of sr] + ) + ) + ) + | Api_errors.Server_error (code, params) -> + raise (Storage_error (Backend_error (code, params))) + | e -> + let e' = ExnHelper.string_of_exn e in + error "SR.detach failed SR:%s error:%s" (Ref.string_of sr) e' ; + raise e + ) + ) + + let stat _context ~dbg ~sr:sr' = + Server_helpers.exec_with_new_task "SR.stat" ~subtask_of:(Ref.of_string dbg) + (fun __context -> + let sr = + Db.SR.get_by_uuid ~__context + ~uuid:(Storage_interface.Sr.string_of sr') + in + Sm.call_sm_functions ~__context ~sR:sr (fun device_config _type -> + try + Sm.sr_update device_config _type sr ; + let r = Db.SR.get_record ~__context ~self:sr in + let sr_uuid = Some r.API.sR_uuid in + let name_label = r.API.sR_name_label in + let name_description = r.API.sR_name_description in + let total_space = r.API.sR_physical_size in + let free_space = + Int64.sub r.API.sR_physical_size r.API.sR_physical_utilisation + in + let clustered = false in + let health = Storage_interface.Healthy in + { + sr_uuid + ; name_label + ; name_description + ; total_space + ; free_space + ; clustered + ; health + } + with + | Smint.Not_implemented_in_backend -> + raise + (Storage_interface.Storage_error + (Backend_error + ( Api_errors.sr_operation_not_supported + , [Ref.string_of sr] + ) + ) + ) + | Api_errors.Server_error (code, params) -> + error "SR.scan failed SR:%s code=%s params=[%s]" + (Ref.string_of sr) code + (String.concat "; " params) ; + raise (Storage_error (Backend_error (code, params))) + | Sm.MasterOnly -> + redirect sr + | e -> + let e' = ExnHelper.string_of_exn e in + error "SR.scan failed SR:%s error:%s" (Ref.string_of sr) e' ; + raise e + ) + ) + + let scan _context ~dbg ~sr:sr' = + Server_helpers.exec_with_new_task "SR.scan" ~subtask_of:(Ref.of_string dbg) + (fun __context -> + let sr = Db.SR.get_by_uuid ~__context ~uuid:(s_of_sr sr') in + Sm.call_sm_functions ~__context ~sR:sr (fun device_config _type -> + try + Sm.sr_scan device_config _type sr ; + let open Db_filter_types in + let vdis = + Db.VDI.get_records_where ~__context + ~expr:(Eq (Field "SR", Literal (Ref.string_of sr))) + |> List.map snd + in + List.map (vdi_info_of_vdi_rec __context) vdis + with + | Smint.Not_implemented_in_backend -> + raise + (Storage_interface.Storage_error + (Backend_error + ( Api_errors.sr_operation_not_supported + , [Ref.string_of sr] + ) + ) + ) + | Api_errors.Server_error (code, params) -> + error "SR.scan failed SR:%s code=%s params=[%s]" + (Ref.string_of sr) code + (String.concat "; " params) ; + raise (Storage_error (Backend_error (code, params))) + | Sm.MasterOnly -> + redirect sr + | e -> + let e' = ExnHelper.string_of_exn e in + error "SR.scan failed SR:%s error:%s" (Ref.string_of sr) e' ; + raise e + ) + ) + + let list _context ~dbg:_ = assert false + + let update_snapshot_info_src _context ~dbg:_ ~sr:_ ~vdi:_ ~url:_ ~dest:_ + ~dest_vdi:_ ~snapshot_pairs:_ = + assert false + + let update_snapshot_info_dest _context ~dbg ~sr ~vdi ~src_vdi:_ + ~snapshot_pairs = + Server_helpers.exec_with_new_task "SR.update_snapshot_info_dest" + ~subtask_of:(Ref.of_string dbg) (fun __context -> + let local_vdis = scan __context ~dbg ~sr in + let find_sm_vdi ~vdi ~vdi_info_list = + try List.find (fun x -> x.vdi = vdi) vdi_info_list + with Not_found -> + raise (Storage_error (Vdi_does_not_exist (s_of_vdi vdi))) + in + let assert_content_ids_match ~vdi_info1 ~vdi_info2 = + if vdi_info1.content_id <> vdi_info2.content_id then + raise + (Storage_error + (Content_ids_do_not_match + (s_of_vdi vdi_info1.vdi, s_of_vdi vdi_info2.vdi) + ) + ) + in + (* For each (local snapshot vdi, source snapshot vdi) pair: + * - Check that the content_ids are the same + * - Copy snapshot_time from the source VDI to the local VDI + * - Set the local VDI's snapshot_of to vdi + * - Set is_a_snapshot = true for the local snapshot *) + List.iter + (fun (local_snapshot, src_snapshot_info) -> + let local_snapshot_info = + find_sm_vdi ~vdi:local_snapshot ~vdi_info_list:local_vdis + in + assert_content_ids_match ~vdi_info1:local_snapshot_info + ~vdi_info2:src_snapshot_info ; + set_snapshot_time __context ~dbg ~sr ~vdi:local_snapshot + ~snapshot_time:src_snapshot_info.snapshot_time ; + set_snapshot_of __context ~dbg ~sr ~vdi:local_snapshot + ~snapshot_of:vdi ; + set_is_a_snapshot __context ~dbg ~sr ~vdi:local_snapshot + ~is_a_snapshot:true + ) + snapshot_pairs + ) + end + + module VDI = struct + let for_vdi ~dbg ~sr ~vdi op_name f = + Server_helpers.exec_with_new_task op_name ~subtask_of:(Ref.of_string dbg) + (fun __context -> + let self = find_vdi ~__context sr vdi |> fst in + Sm.call_sm_vdi_functions ~__context ~vdi:self + (fun device_config _type sr -> f device_config _type sr self + ) + ) + + let per_host_key ~__context ~prefix = + let host_uuid = + Db.Host.get_uuid ~__context ~self:(Helpers.get_localhost ~__context) + in + Printf.sprintf "%s-%s" prefix host_uuid + + let read_caching_key ~__context = + per_host_key ~__context ~prefix:"read-caching-enabled-on" + + let read_caching_reason_key ~__context = + per_host_key ~__context ~prefix:"read-caching-reason" + + let epoch_begin _context ~dbg ~sr ~vdi ~vm:_ ~persistent:_ = + try + for_vdi ~dbg ~sr ~vdi "VDI.epoch_begin" + (fun device_config _type sr self -> + Sm.vdi_epoch_begin device_config _type sr self + ) + with Api_errors.Server_error (code, params) -> + raise (Storage_error (Backend_error (code, params))) + + let attach2 _context ~dbg ~dp:_ ~sr ~vdi ~read_write = + try + let backend = + for_vdi ~dbg ~sr ~vdi "VDI.attach2" + (fun device_config _type sr self -> + let attach_info_v1 = + Sm.vdi_attach device_config _type sr self read_write + in + (* Record whether the VDI is benefiting from read caching *) + Server_helpers.exec_with_new_task "VDI.attach2" + ~subtask_of:(Ref.of_string dbg) (fun __context -> + let read_caching = not attach_info_v1.Smint.o_direct in + let on_key = read_caching_key ~__context in + let reason_key = read_caching_reason_key ~__context in + with_lock vdi_read_caching_m (fun () -> + Db.VDI.remove_from_sm_config ~__context ~self ~key:on_key ; + Db.VDI.remove_from_sm_config ~__context ~self + ~key:reason_key ; + Db.VDI.add_to_sm_config ~__context ~self ~key:on_key + ~value:(string_of_bool read_caching) ; + if not read_caching then + Db.VDI.add_to_sm_config ~__context ~self ~key:reason_key + ~value:attach_info_v1.Smint.o_direct_reason + ) + ) ; + { + implementations= + [ + XenDisk + { + params= attach_info_v1.Smint.params + ; extra= attach_info_v1.Smint.xenstore_data + ; backend_type= "vbd3" + } + ; (* Currently we always get a BlockDevice from SMAPIv1, never a File, not even for ISOs *) + BlockDevice {path= attach_info_v1.Smint.params} + ] + } + ) + in + with_lock vdi_read_write_m (fun () -> + Hashtbl.replace vdi_read_write (sr, vdi) read_write + ) ; + backend + with Api_errors.Server_error (code, params) -> + raise (Storage_error (Backend_error (code, params))) + + let attach3 context ~dbg ~dp ~sr ~vdi ~vm:_ ~read_write = + (*Throw away vm argument as does nothing in SMAPIv1*) + attach2 context ~dbg ~dp ~sr ~vdi ~read_write + + let attach _ = + failwith + "We'll never get here: attach is implemented in \ + Storage_smapiv1_wrapper.Wrapper" + + let activate _context ~dbg ~dp ~sr ~vdi = + try + let read_write = + with_lock vdi_read_write_m (fun () -> + if not (Hashtbl.mem vdi_read_write (sr, vdi)) then + error "VDI.activate: doesn't know if sr:%s vdi:%s is RO or RW" + (s_of_sr sr) (s_of_vdi vdi) ; + Hashtbl.find vdi_read_write (sr, vdi) + ) + in + for_vdi ~dbg ~sr ~vdi "VDI.activate" (fun device_config _type sr self -> + Server_helpers.exec_with_new_task "VDI.activate" + ~subtask_of:(Ref.of_string dbg) (fun __context -> + if read_write then + Db.VDI.remove_from_other_config ~__context ~self + ~key:"content_id" + ) ; + (* If the backend doesn't advertise the capability then do nothing *) + if List.mem_assoc Smint.Vdi_activate (Sm.features_of_driver _type) + then + Sm.vdi_activate device_config _type sr self read_write + else + info "%s sr:%s does not support vdi_activate: doing nothing" dp + (Ref.string_of sr) + ) + with Api_errors.Server_error (code, params) -> + raise (Storage_error (Backend_error (code, params))) + + let activate3 context ~dbg ~dp ~sr ~vdi ~vm:_ = + activate context ~dbg ~dp ~sr ~vdi + + let deactivate _context ~dbg ~dp ~sr ~vdi ~vm:_ = + try + for_vdi ~dbg ~sr ~vdi "VDI.deactivate" + (fun device_config _type sr self -> + Server_helpers.exec_with_new_task "VDI.deactivate" + ~subtask_of:(Ref.of_string dbg) (fun __context -> + let other_config = Db.VDI.get_other_config ~__context ~self in + if not (List.mem_assoc "content_id" other_config) then + Db.VDI.add_to_other_config ~__context ~self ~key:"content_id" + ~value:Uuidx.(to_string (make ())) + ) ; + (* If the backend doesn't advertise the capability then do nothing *) + if List.mem_assoc Smint.Vdi_deactivate (Sm.features_of_driver _type) + then + Sm.vdi_deactivate device_config _type sr self + else + info "%s sr:%s does not support vdi_deactivate: doing nothing" dp + (Ref.string_of sr) + ) + with Api_errors.Server_error (code, params) -> + raise (Storage_error (Backend_error (code, params))) + + let detach _context ~dbg ~dp:_ ~sr ~vdi ~vm:_ = + try + for_vdi ~dbg ~sr ~vdi "VDI.detach" (fun device_config _type sr self -> + Sm.vdi_detach device_config _type sr self ; + Server_helpers.exec_with_new_task "VDI.detach" + ~subtask_of:(Ref.of_string dbg) (fun __context -> + let on_key = read_caching_key ~__context in + let reason_key = read_caching_reason_key ~__context in + with_lock vdi_read_caching_m (fun () -> + Db.VDI.remove_from_sm_config ~__context ~self ~key:on_key ; + Db.VDI.remove_from_sm_config ~__context ~self + ~key:reason_key + ) + ) + ) ; + with_lock vdi_read_write_m (fun () -> + Hashtbl.remove vdi_read_write (sr, vdi) + ) + with Api_errors.Server_error (code, params) -> + raise (Storage_error (Backend_error (code, params))) + + let epoch_end _context ~dbg ~sr ~vdi ~vm:_ = + try + for_vdi ~dbg ~sr ~vdi "VDI.epoch_end" + (fun device_config _type sr self -> + Sm.vdi_epoch_end device_config _type sr self + ) + with Api_errors.Server_error (code, params) -> + raise (Storage_error (Backend_error (code, params))) + + let require_uuid vdi_info = + match vdi_info.Smint.vdi_info_uuid with + | Some uuid -> + uuid + | None -> + failwith "SM backend failed to return field" + + let newvdi ~__context vi = + (* The current backends stash data directly in the db *) + let uuid = require_uuid vi in + vdi_info_from_db ~__context (Db.VDI.get_by_uuid ~__context ~uuid) + + let create _context ~dbg ~sr ~vdi_info = + try + Server_helpers.exec_with_new_task "VDI.create" + ~subtask_of:(Ref.of_string dbg) (fun __context -> + let sr = Db.SR.get_by_uuid ~__context ~uuid:(s_of_sr sr) in + let vi = + Sm.call_sm_functions ~__context ~sR:sr (fun device_config _type -> + Sm.vdi_create device_config _type sr vdi_info.sm_config + vdi_info.ty vdi_info.virtual_size vdi_info.name_label + vdi_info.name_description vdi_info.metadata_of_pool + vdi_info.is_a_snapshot vdi_info.snapshot_time + (s_of_vdi vdi_info.snapshot_of) + vdi_info.read_only + ) + in + newvdi ~__context vi + ) + with + | Api_errors.Server_error (code, params) -> + raise (Storage_error (Backend_error (code, params))) + | Sm.MasterOnly -> + redirect sr + + (* A list of keys in sm-config that will be preserved on clone/snapshot *) + let sm_config_keys_to_preserve_on_clone = ["base_mirror"] + + let snapshot_and_clone call_name call_f is_a_snapshot _context ~dbg ~sr + ~vdi_info = + try + Server_helpers.exec_with_new_task call_name + ~subtask_of:(Ref.of_string dbg) (fun __context -> + let vi = + for_vdi ~dbg ~sr ~vdi:vdi_info.vdi call_name + (fun device_config _type sr self -> + call_f device_config _type vdi_info.sm_config sr self + ) + in + (* PR-1255: modify clone, snapshot to take the same parameters as create? *) + let self, _ = + find_vdi ~__context sr + (Storage_interface.Vdi.of_string vi.Smint.vdi_info_location) + in + let clonee, _ = find_vdi ~__context sr vdi_info.vdi in + let content_id = + try + List.assoc "content_id" + (Db.VDI.get_other_config ~__context ~self:clonee) + with _ -> Uuidx.(to_string (make ())) + in + let snapshot_time = Date.of_float (Unix.gettimeofday ()) in + Db.VDI.set_name_label ~__context ~self ~value:vdi_info.name_label ; + Db.VDI.set_name_description ~__context ~self + ~value:vdi_info.name_description ; + Db.VDI.set_snapshot_time ~__context ~self ~value:snapshot_time ; + Db.VDI.set_is_a_snapshot ~__context ~self ~value:is_a_snapshot ; + Db.VDI.remove_from_other_config ~__context ~self ~key:"content_id" ; + Db.VDI.add_to_other_config ~__context ~self ~key:"content_id" + ~value:content_id ; + debug "copying sm-config" ; + List.iter + (fun (key, value) -> + let preserve = + List.mem key sm_config_keys_to_preserve_on_clone + in + if preserve then ( + Db.VDI.remove_from_sm_config ~__context ~self ~key ; + Db.VDI.add_to_sm_config ~__context ~self ~key ~value + ) + ) + vdi_info.sm_config ; + for_vdi ~dbg ~sr + ~vdi:(Storage_interface.Vdi.of_string vi.Smint.vdi_info_location) + "VDI.update" (fun device_config _type sr self -> + Sm.vdi_update device_config _type sr self + ) ; + let vdi = vdi_info_from_db ~__context self in + debug "vdi = %s" (string_of_vdi_info vdi) ; + vdi + ) + with + | Api_errors.Server_error (code, params) -> + raise (Storage_error (Backend_error (code, params))) + | Smint.Not_implemented_in_backend -> + raise (Storage_error (Unimplemented call_name)) + | Sm.MasterOnly -> + redirect sr + + let snapshot = snapshot_and_clone "VDI.snapshot" Sm.vdi_snapshot true + + let clone = snapshot_and_clone "VDI.clone" Sm.vdi_clone false + + let set_name_label _context ~dbg ~sr ~vdi ~new_name_label = + Server_helpers.exec_with_new_task "VDI.set_name_label" + ~subtask_of:(Ref.of_string dbg) (fun __context -> + let self, _ = find_vdi ~__context sr vdi in + Db.VDI.set_name_label ~__context ~self ~value:new_name_label + ) + + let set_name_description _context ~dbg ~sr ~vdi ~new_name_description = + Server_helpers.exec_with_new_task "VDI.set_name_description" + ~subtask_of:(Ref.of_string dbg) (fun __context -> + let self, _ = find_vdi ~__context sr vdi in + Db.VDI.set_name_description ~__context ~self + ~value:new_name_description + ) + + let resize _context ~dbg ~sr ~vdi ~new_size = + try + let vi = + for_vdi ~dbg ~sr ~vdi "VDI.resize" (fun device_config _type sr self -> + Sm.vdi_resize device_config _type sr self new_size + ) + in + Server_helpers.exec_with_new_task "VDI.resize" + ~subtask_of:(Ref.of_string dbg) (fun __context -> + let self, _ = + find_vdi ~__context sr + (Storage_interface.Vdi.of_string vi.Smint.vdi_info_location) + in + Db.VDI.get_virtual_size ~__context ~self + ) + with + | Api_errors.Server_error (code, params) -> + raise (Storage_error (Backend_error (code, params))) + | Smint.Not_implemented_in_backend -> + raise (Storage_error (Unimplemented "VDI.resize")) + | Sm.MasterOnly -> + redirect sr + + let destroy _context ~dbg ~sr ~vdi = + try + for_vdi ~dbg ~sr ~vdi "VDI.destroy" (fun device_config _type sr self -> + Sm.vdi_delete device_config _type sr self + ) ; + with_lock vdi_read_write_m (fun () -> + Hashtbl.remove vdi_read_write (sr, vdi) + ) + with + | Api_errors.Server_error (code, params) -> + raise (Storage_error (Backend_error (code, params))) + | No_VDI -> + raise (Storage_error (Vdi_does_not_exist (s_of_vdi vdi))) + | Sm.MasterOnly -> + redirect sr + + let stat _context ~dbg ~sr ~vdi = + try + Server_helpers.exec_with_new_task "VDI.stat" + ~subtask_of:(Ref.of_string dbg) (fun __context -> + for_vdi ~dbg ~sr ~vdi "VDI.stat" (fun device_config _type sr self -> + Sm.vdi_update device_config _type sr self ; + vdi_info_of_vdi_rec __context + (Db.VDI.get_record ~__context ~self) + ) + ) + with e -> + error "VDI.stat caught: %s" (Printexc.to_string e) ; + raise (Storage_error (Vdi_does_not_exist (s_of_vdi vdi))) + + let introduce _context ~dbg ~sr ~uuid ~sm_config ~location = + try + Server_helpers.exec_with_new_task "VDI.introduce" + ~subtask_of:(Ref.of_string dbg) (fun __context -> + let sr = Db.SR.get_by_uuid ~__context ~uuid:(s_of_sr sr) in + let vi = + Sm.call_sm_functions ~__context ~sR:sr + (fun device_config sr_type -> + Sm.vdi_introduce device_config sr_type sr uuid sm_config + location + ) + in + newvdi ~__context vi + ) + with e -> + error "VDI.introduce caught: %s" (Printexc.to_string e) ; + raise (Storage_error (Vdi_does_not_exist location)) + + let set_persistent _context ~dbg ~sr ~vdi ~persistent = + try + Server_helpers.exec_with_new_task "VDI.set_persistent" + ~subtask_of:(Ref.of_string dbg) (fun __context -> + if not persistent then ( + info + "VDI.set_persistent: calling VDI.clone and VDI.destroy to make \ + an empty vhd-leaf" ; + let new_vdi = + for_vdi ~dbg ~sr ~vdi "VDI.clone" + (fun device_config _type sr self -> + let vi = Sm.vdi_clone device_config _type [] sr self in + Storage_interface.Vdi.of_string vi.Smint.vdi_info_location + ) + in + for_vdi ~dbg ~sr ~vdi:new_vdi "VDI.destroy" + (fun device_config _type sr self -> + Sm.vdi_delete device_config _type sr self + ) + ) + ) + with + | Api_errors.Server_error (code, params) -> + raise (Storage_error (Backend_error (code, params))) + | Sm.MasterOnly -> + redirect sr + + let get_by_name _context ~dbg ~sr ~name = + info "VDI.get_by_name dbg:%s sr:%s name:%s" dbg (s_of_sr sr) name ; + (* PR-1255: the backend should do this for us *) + Server_helpers.exec_with_new_task "VDI.get_by_name" + ~subtask_of:(Ref.of_string dbg) (fun __context -> + (* PR-1255: the backend should do this for us *) + try + let _, vdi = find_content ~__context ~sr name in + let vi = vdi_info_of_vdi_rec __context vdi in + debug "VDI.get_by_name returning successfully" ; + vi + with e -> + error "VDI.get_by_name caught: %s" (Printexc.to_string e) ; + raise (Storage_error (Vdi_does_not_exist name)) + ) + + let set_content_id _context ~dbg ~sr ~vdi ~content_id = + info "VDI.get_by_content dbg:%s sr:%s vdi:%s content_id:%s" dbg + (s_of_sr sr) (s_of_vdi vdi) content_id ; + (* PR-1255: the backend should do this for us *) + Server_helpers.exec_with_new_task "VDI.set_content_id" + ~subtask_of:(Ref.of_string dbg) (fun __context -> + let vdi, _ = find_vdi ~__context sr vdi in + Db.VDI.remove_from_other_config ~__context ~self:vdi ~key:"content_id" ; + Db.VDI.add_to_other_config ~__context ~self:vdi ~key:"content_id" + ~value:content_id + ) + + let similar_content _context ~dbg ~sr ~vdi = + info "VDI.similar_content dbg:%s sr:%s vdi:%s" dbg (s_of_sr sr) + (s_of_vdi vdi) ; + Server_helpers.exec_with_new_task "VDI.similar_content" + ~subtask_of:(Ref.of_string dbg) (fun __context -> + (* PR-1255: the backend should do this for us. *) + let sr_ref = + Db.SR.get_by_uuid ~__context + ~uuid:(Storage_interface.Sr.string_of sr) + in + (* Return a nearest-first list of similar VDIs. "near" should mean + "has similar blocks" but we approximate this with distance in the tree *) + let module StringMap = Map.Make (struct + type t = string + + let compare = compare + end) in + let _vhdparent = "vhd-parent" in + let open Db_filter_types in + let all = + Db.VDI.get_records_where ~__context + ~expr:(Eq (Field "SR", Literal (Ref.string_of sr_ref))) + in + let locations = + List.fold_left + (fun acc (_, vdi_rec) -> + StringMap.add vdi_rec.API.vDI_location vdi_rec acc + ) + StringMap.empty all + in + (* Compute a map of parent location -> children locations *) + let children, parents = + List.fold_left + (fun (children, parents) (_, vdi_rec) -> + if List.mem_assoc _vhdparent vdi_rec.API.vDI_sm_config then + let me = vdi_rec.API.vDI_location in + let parent = + List.assoc _vhdparent vdi_rec.API.vDI_sm_config + in + let other_children = + if StringMap.mem parent children then + StringMap.find parent children + else + [] + in + ( StringMap.add parent (me :: other_children) children + , StringMap.add me parent parents + ) + else + (children, parents) + ) + (StringMap.empty, StringMap.empty) + all + in + let rec explore current_distance acc vdi = + (* add me *) + let acc = StringMap.add vdi current_distance acc in + (* add the parent *) + let parent = + if StringMap.mem vdi parents then + [StringMap.find vdi parents] + else + [] + in + let children = + if StringMap.mem vdi children then + StringMap.find vdi children + else + [] + in + List.fold_left + (fun acc vdi -> + if not (StringMap.mem vdi acc) then + explore (current_distance + 1) acc vdi + else + acc + ) + acc (parent @ children) + in + let module IntMap = Map.Make (struct + type t = int + + let compare = compare + end) in + let invert map = + StringMap.fold + (fun vdi n acc -> + let current = + if IntMap.mem n acc then IntMap.find n acc else [] + in + IntMap.add n (vdi :: current) acc + ) + map IntMap.empty + in + let _, vdi_rec = find_vdi ~__context sr vdi in + let vdis = + explore 0 StringMap.empty vdi_rec.API.vDI_location + |> invert + |> IntMap.bindings + |> List.map snd + |> List.concat + in + let vdi_recs = List.map (fun l -> StringMap.find l locations) vdis in + (* We drop cbt_metadata VDIs that do not have any actual data *) + let vdi_recs = + List.filter (fun r -> r.API.vDI_type <> `cbt_metadata) vdi_recs + in + List.map (fun x -> vdi_info_of_vdi_rec __context x) vdi_recs + ) + + let compose _context ~dbg ~sr ~vdi1 ~vdi2 = + info "VDI.compose dbg:%s sr:%s vdi1:%s vdi2:%s" dbg (s_of_sr sr) + (s_of_vdi vdi1) (s_of_vdi vdi2) ; + try + Server_helpers.exec_with_new_task "VDI.compose" + ~subtask_of:(Ref.of_string dbg) (fun __context -> + (* This call 'operates' on vdi2 *) + let vdi1 = find_vdi ~__context sr vdi1 |> fst in + for_vdi ~dbg ~sr ~vdi:vdi2 "VDI.compose" + (fun device_config _type sr self -> + Sm.vdi_compose device_config _type sr vdi1 self + ) + ) + with + | Smint.Not_implemented_in_backend -> + raise (Storage_error (Unimplemented "VDI.compose")) + | Api_errors.Server_error (code, params) -> + raise (Storage_error (Backend_error (code, params))) + | No_VDI -> + raise + (Storage_error + (Vdi_does_not_exist (Storage_interface.Vdi.string_of vdi1)) + ) + | Sm.MasterOnly -> + redirect sr + + let add_to_sm_config _context ~dbg ~sr ~vdi ~key ~value = + info "VDI.add_to_sm_config dbg:%s sr:%s vdi:%s key:%s value:%s" dbg + (s_of_sr sr) (s_of_vdi vdi) key value ; + Server_helpers.exec_with_new_task "VDI.add_to_sm_config" + ~subtask_of:(Ref.of_string dbg) (fun __context -> + let self = find_vdi ~__context sr vdi |> fst in + Db.VDI.add_to_sm_config ~__context ~self ~key ~value + ) + + let remove_from_sm_config _context ~dbg ~sr ~vdi ~key = + info "VDI.remove_from_sm_config dbg:%s sr:%s vdi:%s key:%s" dbg + (s_of_sr sr) (s_of_vdi vdi) key ; + Server_helpers.exec_with_new_task "VDI.remove_from_sm_config" + ~subtask_of:(Ref.of_string dbg) (fun __context -> + let self = find_vdi ~__context sr vdi |> fst in + Db.VDI.remove_from_sm_config ~__context ~self ~key + ) + + let get_url _context ~dbg ~sr ~vdi = + info "VDI.get_url dbg:%s sr:%s vdi:%s" dbg (s_of_sr sr) (s_of_vdi vdi) ; + (* XXX: PR-1255: tapdisk shouldn't hardcode xapi urls *) + (* peer_ip/session_ref/vdi_ref *) + Server_helpers.exec_with_new_task "VDI.get_url" + ~subtask_of:(Ref.of_string dbg) (fun __context -> + let ip = Helpers.get_management_ip_addr ~__context |> Option.get in + let rpc = Helpers.make_rpc ~__context in + let localhost = Helpers.get_localhost ~__context in + (* XXX: leaked *) + let session_ref = + XenAPI.Session.slave_login ~rpc ~host:localhost + ~psecret:(Xapi_globs.pool_secret ()) + in + let vdi, _ = find_vdi ~__context sr vdi in + Printf.sprintf "%s/%s/%s" ip + (Ref.string_of session_ref) + (Ref.string_of vdi) + ) + + let call_cbt_function _context ~f ~f_name ~dbg ~sr ~vdi = + try + for_vdi ~dbg ~sr ~vdi f_name (fun device_config _type sr self -> + f device_config _type sr self + ) + with + | Smint.Not_implemented_in_backend -> + raise (Storage_error (Unimplemented f_name)) + | Api_errors.Server_error (code, params) -> + raise (Storage_error (Backend_error (code, params))) + | No_VDI -> + raise + (Storage_error + (Vdi_does_not_exist (Storage_interface.Vdi.string_of vdi)) + ) + | Sm.MasterOnly -> + redirect sr + + let enable_cbt context = + call_cbt_function context ~f:Sm.vdi_enable_cbt ~f_name:"VDI.enable_cbt" + + let disable_cbt context = + call_cbt_function context ~f:Sm.vdi_disable_cbt ~f_name:"VDI.disable_cbt" + + let data_destroy context ~dbg ~sr ~vdi = + call_cbt_function context ~f:Sm.vdi_data_destroy + ~f_name:"VDI.data_destroy" ~dbg ~sr ~vdi ; + set_content_id context ~dbg ~sr ~vdi + ~content_id:"/No content: this is a cbt_metadata VDI/" + + let list_changed_blocks _context ~dbg ~sr ~vdi_from ~vdi_to = + try + Server_helpers.exec_with_new_task "VDI.list_changed_blocks" + ~subtask_of:(Ref.of_string dbg) (fun __context -> + let vdi_from = find_vdi ~__context sr vdi_from |> fst in + for_vdi ~dbg ~sr ~vdi:vdi_to "VDI.list_changed_blocks" + (fun device_config _type sr vdi_to -> + Sm.vdi_list_changed_blocks device_config _type sr ~vdi_from + ~vdi_to + ) + ) + with + | Smint.Not_implemented_in_backend -> + raise (Storage_error (Unimplemented "VDI.list_changed_blocks")) + | Api_errors.Server_error (code, params) -> + raise (Storage_error (Backend_error (code, params))) + | Sm.MasterOnly -> + redirect sr + end + + let get_by_name _context ~dbg:_ ~name:_ = assert false + + module DATA = struct + let copy_into _context ~dbg:_ ~sr:_ ~vdi:_ ~url:_ ~dest:_ ~dest_vdi:_ + ~verify_dest:_ = + assert false + + let copy _context ~dbg:_ ~sr:_ ~vdi:_ ~dp:_ ~url:_ ~dest:_ ~verify_dest:_ = + assert false + + module MIRROR = struct + let start _context ~dbg:_ ~sr:_ ~vdi:_ ~dp:_ ~url:_ ~dest:_ ~verify_dest:_ + = + assert false + + let stop _context ~dbg:_ ~id:_ = assert false + + let list _context ~dbg:_ = assert false + + let stat _context ~dbg:_ ~id:_ = assert false + + let receive_start _context ~dbg:_ ~sr:_ ~vdi_info:_ ~id:_ ~similar:_ = + assert false + + let receive_finalize _context ~dbg:_ ~id:_ = assert false + + let receive_cancel _context ~dbg:_ ~id:_ = assert false + end + end + + module Policy = struct + let get_backend_vm _context ~dbg:_ ~vm:_ ~sr:_ ~vdi:_ = assert false + end + + module TASK = struct + let stat _context ~dbg:_ ~task:_ = assert false + + let destroy _context ~dbg:_ ~task:_ = assert false + + let cancel _context ~dbg:_ ~task:_ = assert false + + let list _context ~dbg:_ = assert false + end + + module UPDATES = struct + let get _context ~dbg:_ ~from:_ ~timeout:_ = assert false + end +end diff --git a/ocaml/xapi/storage_smapiv1.mli b/ocaml/xapi/storage_smapiv1.mli new file mode 100644 index 00000000000..69a0a22aa9f --- /dev/null +++ b/ocaml/xapi/storage_smapiv1.mli @@ -0,0 +1,26 @@ +(* + * Copyright (C) 2006-2011 Citrix Systems Inc. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published + * by the Free Software Foundation; version 2.1 only. with the special + * exception on linking described in file LICENSE. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + *) + +open Storage_interface + +val vdi_read_write_m : Mutex.t + +val vdi_read_write : (Sr.t * Vdi.t, bool) Hashtbl.t + +val vdi_info_of_vdi_rec : Context.t -> API.vDI_t -> Storage_interface.vdi_info + +val find_vdi : __context:Context.t -> Sr.t -> Vdi.t -> [`VDI] Ref.t * API.vDI_t +(** Find a VDI given a storage-layer SR and VDI *) + +module SMAPIv1 : Server_impl diff --git a/ocaml/xapi/storage_impl.ml b/ocaml/xapi/storage_smapiv1_wrapper.ml similarity index 98% rename from ocaml/xapi/storage_impl.ml rename to ocaml/xapi/storage_smapiv1_wrapper.ml index 0a3a405fa9b..90c1aa4e466 100644 --- a/ocaml/xapi/storage_impl.ml +++ b/ocaml/xapi/storage_smapiv1_wrapper.ml @@ -1,5 +1,5 @@ (* - * Copyright (C) 2011 Citrix Systems Inc. + * Copyright (C) Citrix Systems Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published @@ -436,14 +436,15 @@ functor (Internal_error "Storage_access.No_VDI") as e when op = Vdi_automaton.Deactivate || op = Vdi_automaton.Detach -> error - "Storage_impl: caught exception %s while doing %s . Continuing \ - as if succesful, being optimistic" + "Storage_smapiv1_wrapper: caught exception %s while doing %s . \ + Continuing as if succesful, being optimistic" (Printexc.to_string e) (Vdi_automaton.string_of_op op) ; vdi_t | e -> error - "Storage_impl: dp:%s sr:%s vdi:%s op:%s error:%s backtrace:%s" + "Storage_smapiv1_wrapper: dp:%s sr:%s vdi:%s op:%s error:%s \ + backtrace:%s" dp (s_of_sr sr) (s_of_vdi vdi) (Vdi_automaton.string_of_op op) (Printexc.to_string e) @@ -1015,8 +1016,7 @@ functor ) ; failure - let destroy context ~dbg ~dp ~allow_leak = - info "DP.destroy dbg:%s dp:%s allow_leak:%b" dbg dp allow_leak ; + let destroy' context ~dbg ~dp ~allow_leak = let failures = Host.list !Host.host |> List.filter_map (fun (sr, sr_t) -> @@ -1033,6 +1033,15 @@ functor info "Forgetting leaked datapath: dp: %s" dp ; () + let destroy _context ~dbg:_ ~dp:_ ~allow_leak:_ = + (* This is no longer called. The mux redirects it to DP.destroy2. *) + assert false + + let destroy2 context ~dbg ~dp ~sr ~vdi ~vm ~allow_leak = + info "DP.destroy2 dbg:%s dp:%s sr:%s vdi:%s vm:%s allow_leak:%b" dbg dp + (s_of_sr sr) (s_of_vdi vdi) (s_of_vm vm) allow_leak ; + destroy' context ~dbg ~dp ~allow_leak + let diagnostics _context () = let srs = Host.list !Host.host in let of_sr (sr, sr_t) = @@ -1321,17 +1330,6 @@ let initialise () = info "No storage state is persisted in %s; creating blank database" !host_state_path -module Local_domain_socket = struct - let path = Filename.concat "/var/lib/xcp" "storage" - - (* receives external requests on Constants.sm_uri *) - let xmlrpc_handler process req bio _ = - let body = Http_svr.read_body req bio in - let s = Buf_io.fd_of bio in - let rpc = Xmlrpc.call_of_string body in - (* Printf.fprintf stderr "Request: %s %s\n%!" rpc.Rpc.name (Rpc.to_string (List.hd rpc.Rpc.params)); *) - let result = process rpc in - (* Printf.fprintf stderr "Response: %s\n%!" (Rpc.to_string result.Rpc.contents); *) - let str = Xmlrpc.string_of_response result in - Http_svr.response_str req s str -end +module Impl = Wrapper (Storage_smapiv1.SMAPIv1) + +module Server = Storage_interface.Server (Impl) () diff --git a/ocaml/xapi/xapi.ml b/ocaml/xapi/xapi.ml index 6ccdff4ddb4..e039c80992e 100644 --- a/ocaml/xapi/xapi.ml +++ b/ocaml/xapi/xapi.ml @@ -1030,11 +1030,14 @@ let server_init () = ; ("Initialise TLS verification", [], init_tls_verification) ; ("Running startup check", [], startup_check) ; ("Registering SMAPIv1 plugins", [Startup.OnlyMaster], Sm.register) + ; ( "Initialising SMAPIv1 state" + , [] + , Storage_smapiv1_wrapper.initialise + ) ; ( "Starting SMAPIv1 proxies" , [Startup.OnlyMaster] , Storage_access.start_smapiv1_servers ) - ; ("Initialising SM state", [], Storage_impl.initialise) ; ("Starting SM service", [], Storage_access.start) ; ("Starting SM xapi event service", [], Storage_access.events_from_sm) ; ("Killing stray sparse_dd processes", [], Sparse_dd_wrapper.killall) diff --git a/ocaml/xapi/xapi_services.ml b/ocaml/xapi/xapi_services.ml index 955f65f42a0..b88638739bc 100644 --- a/ocaml/xapi/xapi_services.ml +++ b/ocaml/xapi/xapi_services.ml @@ -177,7 +177,7 @@ let post_handler (req : Http.Request.t) s _ = | "" :: services :: "plugin" :: name :: _ when services = _services -> http_proxy_to_plugin req s name | [""; services; "SM"] when services = _services -> - Storage_impl.Local_domain_socket.xmlrpc_handler + Storage_mux.Local_domain_socket.xmlrpc_handler Storage_mux.Server.process req (Buf_io.of_fd s) () | _ -> Http_svr.headers s (Http.http_404_missing ~version:"1.0" ()) ; @@ -196,7 +196,7 @@ let put_handler (req : Http.Request.t) s _ = http_proxy_to_plugin req s name | [""; services; "SM"; "data"; sr; vdi] when services = _services -> let vdi, _ = - Storage_access.find_vdi ~__context + Storage_smapiv1.find_vdi ~__context (Storage_interface.Sr.of_string sr) (Storage_interface.Vdi.of_string vdi) in diff --git a/ocaml/xapi/xapi_vdi.ml b/ocaml/xapi/xapi_vdi.ml index a2c307d39b2..668e83b3da3 100644 --- a/ocaml/xapi/xapi_vdi.ml +++ b/ocaml/xapi/xapi_vdi.ml @@ -804,7 +804,7 @@ let snapshot_and_clone call_f ~__context ~vdi ~driver_params = let open Storage_interface in let vdi_info = { - (Storage_access.vdi_info_of_vdi_rec __context vdi_rec) with + (Storage_smapiv1.vdi_info_of_vdi_rec __context vdi_rec) with sm_config= driver_params } in