diff --git a/ocaml/xapi/storage_access.ml b/ocaml/xapi/storage_access.ml index c92651bc57..4568863f8c 100644 --- a/ocaml/xapi/storage_access.ml +++ b/ocaml/xapi/storage_access.ml @@ -21,6 +21,7 @@ let finally = Xapi_stdext_pervasives.Pervasiveext.finally module XenAPI = Client.Client open Storage_interface +open Storage_utils module D = Debug.Make (struct let name = "storage_access" end) @@ -30,50 +31,6 @@ let s_of_vdi = Vdi.string_of let s_of_sr = Sr.string_of -let transform_storage_exn f = - let get_sr_ref sr_uuid = - Server_helpers.exec_with_new_task "transform_storage_exn" (fun __context -> - Db.SR.get_by_uuid ~__context ~uuid:sr_uuid - ) - in - try f () with - | Storage_error (Backend_error (code, params)) as e -> - Backtrace.reraise e (Api_errors.Server_error (code, params)) - | Storage_error (Backend_error_with_backtrace (code, backtrace :: params)) as - e -> - let backtrace = Backtrace.Interop.of_json "SM" backtrace in - Backtrace.add e backtrace ; - Backtrace.reraise e (Api_errors.Server_error (code, params)) - | Storage_error (Sr_unhealthy (sr, health)) as e -> - let advice = - match health with - | Unavailable -> - "try reboot" - | Unreachable -> - "try again later" - | _health -> - "" - in - let sr = get_sr_ref sr in - Backtrace.reraise e - (Api_errors.Server_error - ( Api_errors.sr_unhealthy - , [Ref.string_of sr; Storage_interface.show_sr_health health; advice] - ) - ) - | Api_errors.Server_error _ as e -> - raise e - | Storage_error (No_storage_plugin_for_sr sr) as e -> - let sr = get_sr_ref sr in - Backtrace.reraise e - (Api_errors.Server_error (Api_errors.sr_not_attached, [Ref.string_of sr]) - ) - | e -> - Backtrace.reraise e - (Api_errors.Server_error - (Api_errors.internal_error, [Printexc.to_string e]) - ) - (* Start a set of servers for all SMAPIv1 plugins *) let start_smapiv1_servers () = let drivers = Sm.supported_drivers () in diff --git a/ocaml/xapi/storage_access.mli b/ocaml/xapi/storage_access.mli index 28cf3108de..b781e9e9f2 100644 --- a/ocaml/xapi/storage_access.mli +++ b/ocaml/xapi/storage_access.mli @@ -61,9 +61,6 @@ val reset : __context:Context.t -> vm:API.ref_VM -> unit (** [reset __context vm] declares that [vm] has reset and if it's a driver domain, we expect it to lose all state. *) -val transform_storage_exn : (unit -> 'a) -> 'a -(** [transform_storage_exn f] runs [f], rethrowing any storage error as a nice XenAPI error *) - val attach_and_activate : __context:Context.t -> vbd:API.ref_VBD diff --git a/ocaml/xapi/storage_utils.ml b/ocaml/xapi/storage_utils.ml index 16397af643..dd7d6b6e63 100644 --- a/ocaml/xapi/storage_utils.ml +++ b/ocaml/xapi/storage_utils.ml @@ -12,6 +12,8 @@ * GNU Lesser General Public License for more details. *) +open Storage_interface + let string_of_vdi_type vdi_type = Rpc.string_of_rpc (API.rpc_of_vdi_type vdi_type) @@ -127,3 +129,47 @@ let rpc ~srcstr ~dststr {url; pool_secret; verify_cert} = intra_pool_rpc_of_ip ~srcstr ~dststr ~ip in redirectable_rpc ~original ~redirect_to_ip + +let transform_storage_exn f = + let get_sr_ref sr_uuid = + Server_helpers.exec_with_new_task "transform_storage_exn" (fun __context -> + Db.SR.get_by_uuid ~__context ~uuid:sr_uuid + ) + in + try f () with + | Storage_error (Backend_error (code, params)) as e -> + Backtrace.reraise e (Api_errors.Server_error (code, params)) + | Storage_error (Backend_error_with_backtrace (code, backtrace :: params)) as + e -> + let backtrace = Backtrace.Interop.of_json "SM" backtrace in + Backtrace.add e backtrace ; + Backtrace.reraise e (Api_errors.Server_error (code, params)) + | Storage_error (Sr_unhealthy (sr, health)) as e -> + let advice = + match health with + | Unavailable -> + "try reboot" + | Unreachable -> + "try again later" + | _health -> + "" + in + let sr = get_sr_ref sr in + Backtrace.reraise e + (Api_errors.Server_error + ( Api_errors.sr_unhealthy + , [Ref.string_of sr; Storage_interface.show_sr_health health; advice] + ) + ) + | Api_errors.Server_error _ as e -> + raise e + | Storage_error (No_storage_plugin_for_sr sr) as e -> + let sr = get_sr_ref sr in + Backtrace.reraise e + (Api_errors.Server_error (Api_errors.sr_not_attached, [Ref.string_of sr]) + ) + | e -> + Backtrace.reraise e + (Api_errors.Server_error + (Api_errors.internal_error, [Printexc.to_string e]) + ) diff --git a/ocaml/xapi/storage_utils.mli b/ocaml/xapi/storage_utils.mli new file mode 100644 index 0000000000..401c21e659 --- /dev/null +++ b/ocaml/xapi/storage_utils.mli @@ -0,0 +1,54 @@ +val string_of_vdi_type : + [< `cbt_metadata + | `crashdump + | `ephemeral + | `ha_statefile + | `metadata + | `pvs_cache + | `redo_log + | `rrd + | `suspend + | `system + | `user ] + -> string + +val vdi_type_of_string : + string + -> [> `cbt_metadata + | `crashdump + | `ephemeral + | `ha_statefile + | `metadata + | `pvs_cache + | `redo_log + | `rrd + | `suspend + | `system + | `user ] + +val redirectable_rpc : + redirect_to_ip:(ip:string -> Rpc.call -> Rpc.response) + -> original:(Rpc.call -> Rpc.response) + -> Rpc.call + -> Rpc.response + +type connection_args = { + url: Http.Url.t + ; pool_secret: SecretString.t option + ; verify_cert: Stunnel.verification_config option +} + +val localhost_connection_args : unit -> connection_args + +val intra_pool_connection_args_of_ip : string -> connection_args + +val connection_args_of_uri : verify_dest:bool -> string -> connection_args + +val intra_pool_rpc_of_ip : + srcstr:string -> dststr:string -> ip:string -> Rpc.call -> Rpc.response + +val rpc : + srcstr:string -> dststr:string -> connection_args -> Rpc.call -> Rpc.response + +val transform_storage_exn : (unit -> 'a) -> 'a +(** [transform_storage_exn f] runs [f], rethrowing any storage error as a nice XenAPI error *) diff --git a/ocaml/xapi/xapi_pbd.ml b/ocaml/xapi/xapi_pbd.ml index 7ba1fd8642..a9625dc3c6 100644 --- a/ocaml/xapi/xapi_pbd.ml +++ b/ocaml/xapi/xapi_pbd.ml @@ -188,7 +188,7 @@ let plug ~__context ~self = check_sharing_constraint ~__context ~sr ; let dbg = Ref.string_of (Context.get_task_id __context) in let device_config = Db.PBD.get_device_config ~__context ~self in - Storage_access.transform_storage_exn (fun () -> + Storage_utils.transform_storage_exn (fun () -> C.SR.attach dbg (Storage_interface.Sr.of_string (Db.SR.get_uuid ~__context ~self:sr) @@ -264,7 +264,7 @@ let unplug ~__context ~self = ) ; let dbg = Ref.string_of (Context.get_task_id __context) in let uuid = Db.SR.get_uuid ~__context ~self:sr in - Storage_access.transform_storage_exn (fun () -> + Storage_utils.transform_storage_exn (fun () -> C.SR.detach dbg (Storage_interface.Sr.of_string uuid) ) ; Storage_access.unbind ~__context ~pbd:self ; diff --git a/ocaml/xapi/xapi_sr.ml b/ocaml/xapi/xapi_sr.ml index 7a83493b2d..c4fd4268cd 100644 --- a/ocaml/xapi/xapi_sr.ml +++ b/ocaml/xapi/xapi_sr.ml @@ -234,7 +234,7 @@ let call_probe ~__context ~host:_ ~device_config ~_type ~sm_config ~f = let rpc = rpc end)) in let dbg = Context.string_of_task __context in - Storage_access.transform_storage_exn (fun () -> + Storage_utils.transform_storage_exn (fun () -> Client.SR.probe dbg queue device_config sm_config |> f ) @@ -587,7 +587,7 @@ let update ~__context ~sr = let module C = Storage_interface.StorageAPI (Idl.Exn.GenClient (struct let rpc = rpc end)) in - transform_storage_exn (fun () -> + Storage_utils.transform_storage_exn (fun () -> let sr' = Db.SR.get_uuid ~__context ~self:sr |> Storage_interface.Sr.of_string in @@ -784,7 +784,7 @@ let scan ~__context ~sr = end)) in let sr' = Ref.string_of sr in SRScanThrottle.execute (fun () -> - transform_storage_exn (fun () -> + Storage_utils.transform_storage_exn (fun () -> let sr_uuid = Db.SR.get_uuid ~__context ~self:sr in let vs, sr_info = C.SR.scan2 (Ref.string_of task) @@ -827,13 +827,12 @@ let set_shared ~__context ~sr ~value = Db.SR.set_shared ~__context ~self:sr ~value let set_name_label ~__context ~sr ~value = - let open Storage_access in let task = Context.get_task_id __context in let sr' = Db.SR.get_uuid ~__context ~self:sr in let module C = Storage_interface.StorageAPI (Idl.Exn.GenClient (struct let rpc = Storage_access.rpc end)) in - transform_storage_exn (fun () -> + Storage_utils.transform_storage_exn (fun () -> C.SR.set_name_label (Ref.string_of task) (Storage_interface.Sr.of_string sr') value @@ -841,13 +840,12 @@ let set_name_label ~__context ~sr ~value = update ~__context ~sr let set_name_description ~__context ~sr ~value = - let open Storage_access in let task = Context.get_task_id __context in let sr' = Db.SR.get_uuid ~__context ~self:sr in let module C = Storage_interface.StorageAPI (Idl.Exn.GenClient (struct let rpc = Storage_access.rpc end)) in - transform_storage_exn (fun () -> + Storage_utils.transform_storage_exn (fun () -> C.SR.set_name_description (Ref.string_of task) (Storage_interface.Sr.of_string sr') value diff --git a/ocaml/xapi/xapi_vdi.ml b/ocaml/xapi/xapi_vdi.ml index ab8c543a36..f250db7045 100644 --- a/ocaml/xapi/xapi_vdi.ml +++ b/ocaml/xapi/xapi_vdi.ml @@ -659,7 +659,7 @@ let create ~__context ~name_label ~name_description ~sR ~virtual_size ~_type let rpc = rpc end)) in let sm_vdi = - transform_storage_exn (fun () -> + Storage_utils.transform_storage_exn (fun () -> C.VDI.create (Ref.string_of task) (Db.SR.get_uuid ~__context ~self:sR |> Storage_interface.Sr.of_string) vdi_info @@ -739,7 +739,6 @@ let introduce ~__context ~uuid ~name_label ~name_description ~sR ~_type ~sharable ~read_only:_ ~other_config ~location ~xenstore_data ~sm_config ~managed:_ ~virtual_size:_ ~physical_utilisation:_ ~metadata_of_pool:_ ~is_a_snapshot:_ ~snapshot_time:_ ~snapshot_of:_ = - let open Storage_access in debug "introduce uuid=%s name_label=%s sm_config=[ %s ]" uuid name_label (String.concat "; " (List.map (fun (k, v) -> k ^ " = " ^ v) sm_config)) ; Sm.assert_pbd_is_plugged ~__context ~sr:sR ; @@ -765,7 +764,7 @@ let introduce ~__context ~uuid ~name_label ~name_description ~sR ~_type end)) in Sm.assert_pbd_is_plugged ~__context ~sr:sR ; let vdi_info = - transform_storage_exn (fun () -> + Storage_utils.transform_storage_exn (fun () -> C.VDI.introduce (Ref.string_of task) sr' uuid sm_config location ) in @@ -853,7 +852,7 @@ let snapshot ~__context ~vdi ~driver_params = let rpc = Storage_access.rpc end)) in let newvdi = - Storage_access.transform_storage_exn (fun () -> + Storage_utils.transform_storage_exn (fun () -> try snapshot_and_clone C.VDI.snapshot ~__context ~vdi ~driver_params with Storage_interface.Storage_error (Unimplemented _) -> debug @@ -1013,7 +1012,7 @@ let destroy_and_data_destroy_common ~__context ~self | `data_destroy _ -> C.VDI.data_destroy in - transform_storage_exn (fun () -> + Storage_utils.transform_storage_exn (fun () -> call_f (Ref.string_of task) (Db.SR.get_uuid ~__context ~self:sr |> Storage_interface.Sr.of_string) (Storage_interface.Vdi.of_string location) @@ -1060,7 +1059,7 @@ let data_destroy = _data_destroy ~timeout:4 let resize ~__context ~vdi ~size = Sm.assert_pbd_is_plugged ~__context ~sr:(Db.VDI.get_SR ~__context ~self:vdi) ; Xapi_vdi_helpers.assert_managed ~__context ~vdi ; - Storage_access.transform_storage_exn (fun () -> + Storage_utils.transform_storage_exn (fun () -> let module C = Storage_interface.StorageAPI (Idl.Exn.GenClient (struct let rpc = Storage_access.rpc end)) in @@ -1086,7 +1085,7 @@ let generate_config ~__context ~host:_ ~vdi = ) let clone ~__context ~vdi ~driver_params = - Storage_access.transform_storage_exn (fun () -> + Storage_utils.transform_storage_exn (fun () -> try let module C = Storage_interface.StorageAPI (Idl.Exn.GenClient (struct let rpc = Storage_access.rpc @@ -1264,7 +1263,6 @@ let set_metadata_of_pool ~__context ~self ~value = let set_on_boot ~__context ~self ~value = let sr = Db.VDI.get_SR ~__context ~self in Sm.assert_pbd_is_plugged ~__context ~sr ; - let open Storage_access in let task = Context.get_task_id __context in let sr' = Db.SR.get_uuid ~__context ~self:sr |> Storage_interface.Sr.of_string @@ -1275,7 +1273,7 @@ let set_on_boot ~__context ~self ~value = let module C = Storage_interface.StorageAPI (Idl.Exn.GenClient (struct let rpc = Storage_access.rpc end)) in - transform_storage_exn (fun () -> + Storage_utils.transform_storage_exn (fun () -> C.VDI.set_persistent (Ref.string_of task) sr' vdi' (value = `persist) ) ; Db.VDI.set_on_boot ~__context ~self ~value @@ -1284,7 +1282,6 @@ let set_allow_caching ~__context ~self ~value = Db.VDI.set_allow_caching ~__context ~self ~value let set_name_label ~__context ~self ~value = - let open Storage_access in let task = Context.get_task_id __context in let sr = Db.VDI.get_SR ~__context ~self in let sr' = @@ -1296,13 +1293,12 @@ let set_name_label ~__context ~self ~value = let module C = Storage_interface.StorageAPI (Idl.Exn.GenClient (struct let rpc = Storage_access.rpc end)) in - transform_storage_exn (fun () -> + Storage_utils.transform_storage_exn (fun () -> C.VDI.set_name_label (Ref.string_of task) sr' vdi' value ) ; update ~__context ~vdi:self let set_name_description ~__context ~self ~value = - let open Storage_access in let task = Context.get_task_id __context in let sr = Db.VDI.get_SR ~__context ~self in let sr' = @@ -1314,7 +1310,7 @@ let set_name_description ~__context ~self ~value = let module C = Storage_interface.StorageAPI (Idl.Exn.GenClient (struct let rpc = Storage_access.rpc end)) in - transform_storage_exn (fun () -> + Storage_utils.transform_storage_exn (fun () -> C.VDI.set_name_description (Ref.string_of task) sr' vdi' value ) ; update ~__context ~vdi:self @@ -1380,7 +1376,7 @@ let change_cbt_status ~__context ~self ~new_cbt_enabled ~caller_name = let call_f = if new_cbt_enabled then C.VDI.enable_cbt else C.VDI.disable_cbt in - Storage_access.transform_storage_exn (fun () -> + Storage_utils.transform_storage_exn (fun () -> call_f (Ref.string_of task) sr' vdi' ) ; Db.VDI.set_cbt_enabled ~__context ~self ~value:new_cbt_enabled @@ -1422,7 +1418,7 @@ let list_changed_blocks ~__context ~vdi_from ~vdi_to = let module C = Storage_interface.StorageAPI (Idl.Exn.GenClient (struct let rpc = Storage_access.rpc end)) in - Storage_access.transform_storage_exn (fun () -> + Storage_utils.transform_storage_exn (fun () -> C.VDI.list_changed_blocks (Ref.string_of task) sr' vdi_from vdi_to ) diff --git a/quality-gate.sh b/quality-gate.sh index 16a90270b1..db8444b53e 100755 --- a/quality-gate.sh +++ b/quality-gate.sh @@ -25,7 +25,7 @@ verify-cert () { } mli-files () { - N=499 + N=498 # do not count ml files from the tests in ocaml/{tests/perftest/quicktest} MLIS=$(git ls-files -- '**/*.mli' | grep -vE "ocaml/tests|ocaml/perftest|ocaml/quicktest|ocaml/message-switch/core_test" | xargs -I {} sh -c "echo {} | cut -f 1 -d '.'" \;) MLS=$(git ls-files -- '**/*.ml' | grep -vE "ocaml/tests|ocaml/perftest|ocaml/quicktest|ocaml/message-switch/core_test" | xargs -I {} sh -c "echo {} | cut -f 1 -d '.'" \;)