From e1e220acb9c143e155858fd0d6a755a48838cea5 Mon Sep 17 00:00:00 2001 From: Gabriel Buica Date: Tue, 5 Dec 2023 15:45:54 +0000 Subject: [PATCH 1/4] CP-46379: Pass unchaged dbg to underlying function. Pass the complete 'dbg', 'log' and 'tracing', to the underlying functions. The following fuctions inside WRAPPER: 'VDI.epoch_begin' 'VDI.attach3' 'VDI.attach2' 'VDI.attach' 'VDI.activate3' 'VDI.activate' 'VDI.deactivate' 'VDI.detach' 'VDI.epoch_end' 'VDI.create' 'VDI.snapshot_and_clone' 'VDI.set_name_label' 'VDI.set_name_description' 'VDI.resize' 'VDI.destroy_and_data_destroy' 'VDI.stat' 'VDI.introduce' 'VDI.set_persistent' 'VDI.get_by_name' 'VDI.set_content_id' 'VDI.similar_content' 'VDI.compose' 'VDI.add_to_sm_config' 'VDI.remove_from_sm_config' 'VDI.get_url' 'VDI.enable_cbt' 'VDI.disable_cbt' 'VDI.list_changed_blocks' 'get_by_name' 'DP.destroy2' 'SR.probe' 'SR.list' 'SR.stat' 'SR.scan' 'SR.create' 'SR.set_name_label' 'SR.set_name_description' 'SR.attach' 'SR.detach' 'SR.reset' 'SR.destroy' 'SR.update_snapshot_info_src' 'SR.update_snapshot_info_dest' passed only the 'log' to the underlying 'Impl' fuction calls without passing the 'tracing'. This change passes on both 'log' and 'tracing' inside 'dbg' while passing only the 'log' to debug/info statements. Signed-off-by: Gabriel Buica --- ocaml/xapi/storage_smapiv1_wrapper.ml | 174 +++++++++++++------------- 1 file changed, 86 insertions(+), 88 deletions(-) diff --git a/ocaml/xapi/storage_smapiv1_wrapper.ml b/ocaml/xapi/storage_smapiv1_wrapper.ml index 3f2cdc7f619..87ecc24212c 100644 --- a/ocaml/xapi/storage_smapiv1_wrapper.ml +++ b/ocaml/xapi/storage_smapiv1_wrapper.ml @@ -603,8 +603,8 @@ functor match failures with [] -> next () | f :: _ -> raise f let epoch_begin context ~dbg ~sr ~vdi ~vm ~persistent = - with_dbg ~name:"VDI.epoch_begin" ~dbg @@ fun {log= dbg; _} -> - info "VDI.epoch_begin dbg:%s sr:%s vdi:%s vm:%s persistent:%b" dbg + with_dbg ~name:"VDI.epoch_begin" ~dbg @@ fun {log; _} -> + info "VDI.epoch_begin dbg:%s sr:%s vdi:%s vm:%s persistent:%b" log (s_of_sr sr) (s_of_vdi vdi) (s_of_vm vm) persistent ; with_vdi sr vdi (fun () -> remove_datapaths_andthen_nolock context ~dbg ~sr ~vdi ~vm Vdi.leaked @@ -614,8 +614,8 @@ functor ) let attach3 context ~dbg ~dp ~sr ~vdi ~vm ~read_write = - with_dbg ~name:"VDI.attach3" ~dbg @@ fun {log= dbg; _} -> - info "VDI.attach3 dbg:%s dp:%s sr:%s vdi:%s vm:%s read_write:%b" dbg dp + with_dbg ~name:"VDI.attach3" ~dbg @@ fun {log; _} -> + info "VDI.attach3 dbg:%s dp:%s sr:%s vdi:%s vm:%s read_write:%b" log dp (s_of_sr sr) (s_of_vdi vdi) (s_of_vm vm) read_write ; with_vdi sr vdi (fun () -> remove_datapaths_andthen_nolock context ~dbg ~sr ~vdi ~vm Vdi.leaked @@ -635,16 +635,16 @@ functor ) let attach2 context ~dbg ~dp ~sr ~vdi ~read_write = - with_dbg ~name:"VDI.attach2" ~dbg @@ fun {log= dbg; _} -> - info "VDI.attach2 dbg:%s dp:%s sr:%s vdi:%s read_write:%b" dbg dp + with_dbg ~name:"VDI.attach2" ~dbg @@ fun {log; _} -> + info "VDI.attach2 dbg:%s dp:%s sr:%s vdi:%s read_write:%b" log dp (s_of_sr sr) (s_of_vdi vdi) read_write ; (*Support calls from older XAPI during migrate operation (dom 0 attach )*) let vm = vm_of_s "0" in attach3 context ~dbg ~dp ~sr ~vdi ~vm ~read_write let attach context ~dbg ~dp ~sr ~vdi ~read_write = - with_dbg ~name:"VDI.attach" ~dbg @@ fun {log= dbg; _} -> - info "VDI.attach dbg:%s dp:%s sr:%s vdi:%s read_write:%b" dbg dp + with_dbg ~name:"VDI.attach" ~dbg @@ fun {log; _} -> + info "VDI.attach dbg:%s dp:%s sr:%s vdi:%s read_write:%b" log dp (s_of_sr sr) (s_of_vdi vdi) read_write ; let vm = vm_of_s "0" in let backend = attach3 context ~dbg ~dp ~sr ~vdi ~vm ~read_write in @@ -687,8 +687,8 @@ functor ) let activate3 context ~dbg ~dp ~sr ~vdi ~vm = - with_dbg ~name:"VDI.activate3" ~dbg @@ fun {log= dbg; _} -> - info "VDI.activate3 dbg:%s dp:%s sr:%s vdi:%s vm:%s" dbg dp (s_of_sr sr) + with_dbg ~name:"VDI.activate3" ~dbg @@ fun {log; _} -> + info "VDI.activate3 dbg:%s dp:%s sr:%s vdi:%s vm:%s" log dp (s_of_sr sr) (s_of_vdi vdi) (s_of_vm vm) ; with_vdi sr vdi (fun () -> remove_datapaths_andthen_nolock context ~dbg ~sr ~vdi ~vm Vdi.leaked @@ -703,16 +703,16 @@ functor let activate_readonly = activate3 let activate context ~dbg ~dp ~sr ~vdi = - with_dbg ~name:"VDI.activate" ~dbg @@ fun {log= dbg; _} -> - info "VDI.activate dbg:%s dp:%s sr:%s vdi:%s " dbg dp (s_of_sr sr) + with_dbg ~name:"VDI.activate" ~dbg @@ fun {log; _} -> + info "VDI.activate dbg:%s dp:%s sr:%s vdi:%s " log dp (s_of_sr sr) (s_of_vdi vdi) ; (*Support calls from older XAPI during migrate operation (dom 0 attach )*) let vm = vm_of_s "0" in activate3 context ~dbg ~dp ~sr ~vdi ~vm let deactivate context ~dbg ~dp ~sr ~vdi ~vm = - with_dbg ~name:"VDI.deactivate" ~dbg @@ fun {log= dbg; _} -> - info "VDI.deactivate dbg:%s dp:%s sr:%s vdi:%s vm:%s" dbg dp + with_dbg ~name:"VDI.deactivate" ~dbg @@ fun {log; _} -> + info "VDI.deactivate dbg:%s dp:%s sr:%s vdi:%s vm:%s" log dp (s_of_sr sr) (s_of_vdi vdi) (s_of_vm vm) ; with_vdi sr vdi (fun () -> remove_datapaths_andthen_nolock context ~dbg ~sr ~vdi ~vm Vdi.leaked @@ -725,8 +725,8 @@ functor ) let detach context ~dbg ~dp ~sr ~vdi ~vm = - with_dbg ~name:"VDI.detach" ~dbg @@ fun {log= dbg; _} -> - info "VDI.detach dbg:%s dp:%s sr:%s vdi:%s vm:%s" dbg dp (s_of_sr sr) + with_dbg ~name:"VDI.detach" ~dbg @@ fun {log; _} -> + info "VDI.detach dbg:%s dp:%s sr:%s vdi:%s vm:%s" log dp (s_of_sr sr) (s_of_vdi vdi) (s_of_vm vm) ; with_vdi sr vdi (fun () -> remove_datapaths_andthen_nolock context ~dbg ~sr ~vdi ~vm Vdi.leaked @@ -739,8 +739,8 @@ functor ) let epoch_end context ~dbg ~sr ~vdi ~vm = - with_dbg ~name:"VDI.epoch_end" ~dbg @@ fun {log= dbg; _} -> - info "VDI.epoch_end dbg:%s sr:%s vdi:%s vm:%s" dbg (s_of_sr sr) + with_dbg ~name:"VDI.epoch_end" ~dbg @@ fun {log; _} -> + info "VDI.epoch_end dbg:%s sr:%s vdi:%s vm:%s" log (s_of_sr sr) (s_of_vdi vdi) (s_of_vm vm) ; with_vdi sr vdi (fun () -> remove_datapaths_andthen_nolock context ~dbg ~sr ~vdi ~vm Vdi.leaked @@ -749,8 +749,8 @@ functor ) let create context ~dbg ~sr ~vdi_info = - with_dbg ~name:"VDI.create" ~dbg @@ fun {log= dbg; _} -> - info "VDI.create dbg:%s sr:%s vdi_info:%s" dbg (s_of_sr sr) + with_dbg ~name:"VDI.create" ~dbg @@ fun {log; _} -> + info "VDI.create dbg:%s sr:%s vdi_info:%s" log (s_of_sr sr) (string_of_vdi_info vdi_info) ; let result = Impl.VDI.create context ~dbg ~sr ~vdi_info in match result with @@ -774,8 +774,8 @@ functor result let snapshot_and_clone call_name call_f context ~dbg ~sr ~vdi_info = - with_dbg ~name:call_name ~dbg @@ fun {log= dbg; _} -> - info "%s dbg:%s sr:%s vdi_info:%s" call_name dbg (s_of_sr sr) + with_dbg ~name:call_name ~dbg @@ fun {log; _} -> + info "%s dbg:%s sr:%s vdi_info:%s" call_name log (s_of_sr sr) (string_of_vdi_info vdi_info) ; with_vdi sr vdi_info.vdi (fun () -> call_f context ~dbg ~sr ~vdi_info) @@ -784,34 +784,34 @@ functor let clone = snapshot_and_clone "VDI.clone" Impl.VDI.clone let set_name_label context ~dbg ~sr ~vdi ~new_name_label = - with_dbg ~name:"VDI.set_name_label" ~dbg @@ fun {log= dbg; _} -> - info "VDI.set_name_label dbg:%s sr:%s vdi:%s new_name_label:%s" dbg + with_dbg ~name:"VDI.set_name_label" ~dbg @@ fun {log; _} -> + info "VDI.set_name_label dbg:%s sr:%s vdi:%s new_name_label:%s" log (s_of_sr sr) (s_of_vdi vdi) new_name_label ; with_vdi sr vdi (fun () -> Impl.VDI.set_name_label context ~dbg ~sr ~vdi ~new_name_label ) let set_name_description context ~dbg ~sr ~vdi ~new_name_description = - with_dbg ~name:"VDI.set_name_description" ~dbg @@ fun {log= dbg; _} -> + with_dbg ~name:"VDI.set_name_description" ~dbg @@ fun {log; _} -> 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 ; + log (s_of_sr sr) (s_of_vdi vdi) new_name_description ; with_vdi sr vdi (fun () -> Impl.VDI.set_name_description context ~dbg ~sr ~vdi ~new_name_description ) let resize context ~dbg ~sr ~vdi ~new_size = - with_dbg ~name:"VDI.resize" ~dbg @@ fun {log= dbg; _} -> - info "VDI.resize dbg:%s sr:%s vdi:%s new_size:%Ld" dbg (s_of_sr sr) + with_dbg ~name:"VDI.resize" ~dbg @@ fun {log; _} -> + info "VDI.resize dbg:%s sr:%s vdi:%s new_size:%Ld" log (s_of_sr sr) (s_of_vdi vdi) new_size ; with_vdi sr vdi (fun () -> Impl.VDI.resize context ~dbg ~sr ~vdi ~new_size ) let destroy_and_data_destroy call_name call_f context ~dbg ~sr ~vdi = - with_dbg ~name:call_name ~dbg @@ fun {log= dbg; _} -> - info "%s dbg:%s sr:%s vdi:%s" call_name dbg (s_of_sr sr) (s_of_vdi vdi) ; + with_dbg ~name:call_name ~dbg @@ fun {log; _} -> + info "%s dbg:%s sr:%s vdi:%s" call_name log (s_of_sr sr) (s_of_vdi vdi) ; with_vdi sr vdi (fun () -> remove_datapaths_andthen_nolock context ~dbg ~sr ~vdi Vdi.all @@ -825,81 +825,81 @@ functor destroy_and_data_destroy "VDI.data_destroy" Impl.VDI.data_destroy let stat context ~dbg ~sr ~vdi = - with_dbg ~name:"VDI.stat" ~dbg @@ fun {log= dbg; _} -> - info "VDI.stat dbg:%s sr:%s vdi:%s" dbg (s_of_sr sr) (s_of_vdi vdi) ; + with_dbg ~name:"VDI.stat" ~dbg @@ fun {log; _} -> + info "VDI.stat dbg:%s sr:%s vdi:%s" log (s_of_sr sr) (s_of_vdi vdi) ; Impl.VDI.stat context ~dbg ~sr ~vdi let introduce context ~dbg ~sr ~uuid ~sm_config ~location = - with_dbg ~name:"VDI.introduce" ~dbg @@ fun {log= dbg; _} -> - info "VDI.introduce dbg:%s sr:%s uuid:%s sm_config:%s location:%s" dbg + with_dbg ~name:"VDI.introduce" ~dbg @@ fun {log; _} -> + info "VDI.introduce dbg:%s sr:%s uuid:%s sm_config:%s location:%s" log (s_of_sr sr) uuid (String.concat ", " (List.map (fun (k, v) -> k ^ ":" ^ v) sm_config)) location ; Impl.VDI.introduce context ~dbg ~sr ~uuid ~sm_config ~location let set_persistent context ~dbg ~sr ~vdi ~persistent = - with_dbg ~name:"VDI.set_persistent" ~dbg @@ fun {log= dbg; _} -> - info "VDI.set_persistent dbg:%s sr:%s vdi:%s persistent:%b" dbg + with_dbg ~name:"VDI.set_persistent" ~dbg @@ fun {log; _} -> + info "VDI.set_persistent dbg:%s sr:%s vdi:%s persistent:%b" log (s_of_sr sr) (s_of_vdi vdi) persistent ; with_vdi sr vdi (fun () -> Impl.VDI.set_persistent context ~dbg ~sr ~vdi ~persistent ) let get_by_name context ~dbg ~sr ~name = - with_dbg ~name:"VDI.get_by_name" ~dbg @@ fun {log= dbg; _} -> - info "VDI.get_by_name dbg:%s sr:%s name:%s" dbg (s_of_sr sr) name ; + with_dbg ~name:"VDI.get_by_name" ~dbg @@ fun {log; _} -> + info "VDI.get_by_name dbg:%s sr:%s name:%s" log (s_of_sr sr) name ; Impl.VDI.get_by_name context ~dbg ~sr ~name let set_content_id context ~dbg ~sr ~vdi ~content_id = - with_dbg ~name:"VDI.set_content_id" ~dbg @@ fun {log= dbg; _} -> - info "VDI.set_content_id dbg:%s sr:%s vdi:%s content_id:%s" dbg + with_dbg ~name:"VDI.set_content_id" ~dbg @@ fun {log; _} -> + info "VDI.set_content_id dbg:%s sr:%s vdi:%s content_id:%s" log (s_of_sr sr) (s_of_vdi vdi) content_id ; Impl.VDI.set_content_id context ~dbg ~sr ~vdi ~content_id let similar_content context ~dbg ~sr ~vdi = - with_dbg ~name:"VDI.similar_content" ~dbg @@ fun {log= dbg; _} -> - info "VDI.similar_content dbg:%s sr:%s vdi:%s" dbg (s_of_sr sr) + with_dbg ~name:"VDI.similar_content" ~dbg @@ fun {log; _} -> + info "VDI.similar_content dbg:%s sr:%s vdi:%s" log (s_of_sr sr) (s_of_vdi vdi) ; Impl.VDI.similar_content context ~dbg ~sr ~vdi let compose context ~dbg ~sr ~vdi1 ~vdi2 = - with_dbg ~name:"VDI.compose" ~dbg @@ fun {log= dbg; _} -> - info "VDI.compose dbg:%s sr:%s vdi1:%s vdi2:%s" dbg (s_of_sr sr) + with_dbg ~name:"VDI.compose" ~dbg @@ fun {log; _} -> + info "VDI.compose dbg:%s sr:%s vdi1:%s vdi2:%s" log (s_of_sr sr) (s_of_vdi vdi1) (s_of_vdi vdi2) ; Impl.VDI.compose context ~dbg ~sr ~vdi1 ~vdi2 let add_to_sm_config context ~dbg ~sr ~vdi ~key ~value = - with_dbg ~name:"VDI.add_to_sm_config" ~dbg @@ fun {log= dbg; _} -> - info "VDI.add_to_sm_config dbg:%s sr:%s vdi:%s key:%s value:%s" dbg + with_dbg ~name:"VDI.add_to_sm_config" ~dbg @@ fun {log; _} -> + info "VDI.add_to_sm_config dbg:%s sr:%s vdi:%s key:%s value:%s" log (s_of_sr sr) (s_of_vdi vdi) key value ; Impl.VDI.add_to_sm_config context ~dbg ~sr ~vdi ~key ~value let remove_from_sm_config context ~dbg ~sr ~vdi ~key = - with_dbg ~name:"VDI.remove_from_sm_config" ~dbg @@ fun {log= dbg; _} -> - info "VDI.remove_from_sm_config dbg:%s sr:%s vdi:%s key:%s" dbg + with_dbg ~name:"VDI.remove_from_sm_config" ~dbg @@ fun {log; _} -> + info "VDI.remove_from_sm_config dbg:%s sr:%s vdi:%s key:%s" log (s_of_sr sr) (s_of_vdi vdi) key ; Impl.VDI.remove_from_sm_config context ~dbg ~sr ~vdi ~key let get_url context ~dbg ~sr ~vdi = - with_dbg ~name:"VDI.get_url" ~dbg @@ fun {log= dbg; _} -> - info "VDI.get_url dbg:%s sr:%s vdi:%s" dbg (s_of_sr sr) (s_of_vdi vdi) ; + with_dbg ~name:"VDI.get_url" ~dbg @@ fun {log; _} -> + info "VDI.get_url dbg:%s sr:%s vdi:%s" log (s_of_sr sr) (s_of_vdi vdi) ; Impl.VDI.get_url context ~dbg ~sr ~vdi let enable_cbt context ~dbg ~sr ~vdi = - with_dbg ~name:"VDI.enabled_cbt" ~dbg @@ fun {log= dbg; _} -> - info "VDI.enable_cbt dbg:%s sr:%s vdi:%s" dbg (s_of_sr sr) (s_of_vdi vdi) ; + with_dbg ~name:"VDI.enabled_cbt" ~dbg @@ fun {log; _} -> + info "VDI.enable_cbt dbg:%s sr:%s vdi:%s" log (s_of_sr sr) (s_of_vdi vdi) ; with_vdi sr vdi (fun () -> Impl.VDI.enable_cbt context ~dbg ~sr ~vdi) let disable_cbt context ~dbg ~sr ~vdi = - with_dbg ~name:"VDI.disable_cbt" ~dbg @@ fun {log= dbg; _} -> - info "VDI.disable_cbt dbg:%s sr:%s vdi:%s" dbg (s_of_sr sr) + with_dbg ~name:"VDI.disable_cbt" ~dbg @@ fun {log; _} -> + info "VDI.disable_cbt dbg:%s sr:%s vdi:%s" log (s_of_sr sr) (s_of_vdi vdi) ; with_vdi sr vdi (fun () -> Impl.VDI.disable_cbt context ~dbg ~sr ~vdi) (** The [sr] parameter is the SR of VDI [vdi_to]. *) let list_changed_blocks context ~dbg ~sr ~vdi_from ~vdi_to = - with_dbg ~name:"VDI.list_changed_blocks" ~dbg @@ fun {log= dbg; _} -> - info "VDI.list_changed_blocks dbg:%s sr:%s vdi_from:%s vdi_to:%s" dbg + with_dbg ~name:"VDI.list_changed_blocks" ~dbg @@ fun {log; _} -> + info "VDI.list_changed_blocks dbg:%s sr:%s vdi_from:%s vdi_to:%s" log (s_of_sr sr) (s_of_vdi vdi_from) (s_of_vdi vdi_to) ; with_vdi sr vdi_to (fun () -> Impl.VDI.list_changed_blocks context ~dbg ~sr ~vdi_from ~vdi_to @@ -907,8 +907,8 @@ functor end let get_by_name context ~dbg ~name = - with_dbg ~name:"get_by_name" ~dbg @@ fun {log= dbg; _} -> - debug "get_by_name dbg:%s name:%s" dbg name ; + with_dbg ~name:"get_by_name" ~dbg @@ fun {log; _} -> + debug "get_by_name dbg:%s name:%s" log name ; Impl.get_by_name context ~dbg ~name module DATA = struct @@ -1091,8 +1091,8 @@ functor assert false let destroy2 context ~dbg ~dp ~sr ~vdi ~vm ~allow_leak = - with_dbg ~name:"DP.destroy2" ~dbg @@ fun {log= dbg; _} -> - info "DP.destroy2 dbg:%s dp:%s sr:%s vdi:%s vm:%s allow_leak:%b" dbg dp + with_dbg ~name:"DP.destroy2" ~dbg @@ fun {log; _} -> + info "DP.destroy2 dbg:%s dp:%s sr:%s vdi:%s vm:%s allow_leak:%b" log dp (s_of_sr sr) (s_of_vdi vdi) (s_of_vm vm) allow_leak ; destroy' context ~dbg ~dp ~allow_leak @@ -1167,18 +1167,18 @@ functor let with_sr sr f = Storage_locks.with_instance_lock locks (s_of_sr sr) f let probe context ~dbg ~queue ~device_config ~sm_config = - with_dbg ~name:"SR.probe" ~dbg @@ fun {log= dbg; _} -> - info "SR.probe dbg:%s" dbg ; + with_dbg ~name:"SR.probe" ~dbg @@ fun {log; _} -> + info "SR.probe dbg:%s" log ; Impl.SR.probe context ~dbg ~queue ~device_config ~sm_config let list _context ~dbg = - with_dbg ~name:"SR.list" ~dbg @@ fun {log= dbg; _} -> - info "SR.list dbg:%s" dbg ; + with_dbg ~name:"SR.list" ~dbg @@ fun {log; _} -> + info "SR.list dbg:%s" log ; List.map fst (Host.list !Host.host) let stat context ~dbg ~sr = - with_dbg ~name:"SR.stat" ~dbg @@ fun {log= dbg; _} -> - info "SR.stat dbg:%s sr:%s" dbg (s_of_sr sr) ; + with_dbg ~name:"SR.stat" ~dbg @@ fun {log; _} -> + info "SR.stat dbg:%s sr:%s" log (s_of_sr sr) ; with_sr sr (fun () -> match Host.find sr !Host.host with | None -> @@ -1188,8 +1188,8 @@ functor ) let scan context ~dbg ~sr = - with_dbg ~name:"SR.scan" ~dbg @@ fun {log= dbg; _} -> - info "SR.scan dbg:%s sr:%s" dbg (s_of_sr sr) ; + with_dbg ~name:"SR.scan" ~dbg @@ fun {log; _} -> + info "SR.scan dbg:%s sr:%s" log (s_of_sr sr) ; with_sr sr (fun () -> match Host.find sr !Host.host with | None -> @@ -1200,8 +1200,8 @@ functor let create context ~dbg ~sr ~name_label ~name_description ~device_config ~physical_size = - with_dbg ~name:"SR.create" ~dbg @@ fun {log= dbg; _} -> - info "SR.create dbg:%s sr:%s name_label:%s" dbg (s_of_sr sr) name_label ; + with_dbg ~name:"SR.create" ~dbg @@ fun {log; _} -> + info "SR.create dbg:%s sr:%s name_label:%s" log (s_of_sr sr) name_label ; with_sr sr (fun () -> match Host.find sr !Host.host with | None -> @@ -1213,19 +1213,19 @@ functor ) let set_name_label context ~dbg ~sr ~new_name_label = - with_dbg ~name:"SR.set_name_label" ~dbg @@ fun {log= dbg; _} -> - info "SR.set_name_label dbg:%s sr:%s new_name_label:%s" dbg (s_of_sr sr) + with_dbg ~name:"SR.set_name_label" ~dbg @@ fun {log; _} -> + info "SR.set_name_label dbg:%s sr:%s new_name_label:%s" log (s_of_sr sr) new_name_label ; Impl.SR.set_name_label context ~dbg ~sr ~new_name_label let set_name_description context ~dbg ~sr ~new_name_description = - with_dbg ~name:"SR.set_name_description" ~dbg @@ fun {log= dbg; _} -> - info "SR.set_name_description dbg:%s sr:%s new_name_description:%s" dbg + with_dbg ~name:"SR.set_name_description" ~dbg @@ fun {log; _} -> + info "SR.set_name_description dbg:%s sr:%s new_name_description:%s" log (s_of_sr sr) new_name_description ; Impl.SR.set_name_description context ~dbg ~sr ~new_name_description let attach context ~dbg ~sr ~device_config = - with_dbg ~name:"SR.attach" ~dbg @@ fun {log= dbg; _} -> + with_dbg ~name:"SR.attach" ~dbg @@ fun {log; _} -> let censor_key = ["password"] in let device_config_str = String.concat "; " @@ -1248,7 +1248,7 @@ functor device_config ) in - info "SR.attach dbg:%s sr:%s device_config:[%s]" dbg (s_of_sr sr) + info "SR.attach dbg:%s sr:%s device_config:[%s]" log (s_of_sr sr) device_config_str ; with_sr sr (fun () -> match Host.find sr !Host.host with @@ -1297,13 +1297,13 @@ functor ) let detach context ~dbg ~sr = - with_dbg ~name:"SR.detach" ~dbg @@ fun {log= dbg; _} -> - info "SR.detach dbg:%s sr:%s" dbg (s_of_sr sr) ; + with_dbg ~name:"SR.detach" ~dbg @@ fun {log; _} -> + info "SR.detach dbg:%s sr:%s" log (s_of_sr sr) ; detach_destroy_common context ~dbg ~sr Impl.SR.detach let reset _context ~dbg ~sr = - with_dbg ~name:"SR.reset" ~dbg @@ fun {log= dbg; _} -> - info "SR.reset dbg:%s sr:%s" dbg (s_of_sr sr) ; + with_dbg ~name:"SR.reset" ~dbg @@ fun {log; _} -> + info "SR.reset dbg:%s sr:%s" log (s_of_sr sr) ; with_sr sr (fun () -> Host.remove sr !Host.host ; Everything.to_file !host_state_path (Everything.make ()) ; @@ -1311,18 +1311,17 @@ functor ) let destroy context ~dbg ~sr = - with_dbg ~name:"SR.destroy" ~dbg @@ fun {log= dbg; _} -> - info "SR.destroy dbg:%s sr:%s" dbg (s_of_sr sr) ; + with_dbg ~name:"SR.destroy" ~dbg @@ fun {log; _} -> + info "SR.destroy dbg:%s sr:%s" log (s_of_sr sr) ; detach_destroy_common context ~dbg ~sr Impl.SR.destroy let update_snapshot_info_src context ~dbg ~sr ~vdi ~url ~dest ~dest_vdi ~snapshot_pairs = - with_dbg ~name:"SR.update_snapshot_info_src" ~dbg - @@ fun {log= dbg; _} -> + with_dbg ~name:"SR.update_snapshot_info_src" ~dbg @@ fun {log; _} -> 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) + log (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) @@ -1337,12 +1336,11 @@ functor let update_snapshot_info_dest context ~dbg ~sr ~vdi ~src_vdi ~snapshot_pairs = - with_dbg ~name:"SR.update_snapshot_info_dest" ~dbg - @@ fun {log= dbg; _} -> + with_dbg ~name:"SR.update_snapshot_info_dest" ~dbg @@ fun {log; _} -> 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) + log (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) From fd672a9dd4048d3cb9fe63a4e6c0fd7300560ebb Mon Sep 17 00:00:00 2001 From: Gabriel Buica Date: Thu, 7 Dec 2023 13:55:01 +0000 Subject: [PATCH 2/4] CP-46379: Refactor 'with_dbg' to handle exceptions. Refactors 'with_dbg' function from 'storage_smapiv1_wrapper.ml' and moves it into 'Debuginfo.with_di'. Old 'with_dbg' would not close the span if the function returns an exceptions. This solves the issue by rewritting 'with_dbg' with the use 'Tracing.with_tracing'. Signed-off-by: Gabriel Buica --- ocaml/xapi-idl/lib/debuginfo.ml | 18 ++++++++++++++++++ ocaml/xapi-idl/lib/debuginfo.mli | 8 ++++++++ ocaml/xapi/storage_smapiv1_wrapper.ml | 21 ++------------------- 3 files changed, 28 insertions(+), 19 deletions(-) diff --git a/ocaml/xapi-idl/lib/debuginfo.ml b/ocaml/xapi-idl/lib/debuginfo.ml index 1b6d92e6c3b..3b5306a50cd 100644 --- a/ocaml/xapi-idl/lib/debuginfo.ml +++ b/ocaml/xapi-idl/lib/debuginfo.ml @@ -47,3 +47,21 @@ let to_string t = (* Used for xapi-idl servers that do not yet accept tracing data in the debuginfo *) let to_log_string t = t.log + +(* Sets the logging context based on `dbg`. + Also adds a new tracing span, linked to the parent span from `dbg`, if available. *) +let with_dbg ?(with_thread = false) ~module_name ~name ~dbg f = + let di = of_string dbg in + let f_with_trace () = + let name = + match module_name with "" -> name | _ -> module_name ^ "." ^ name + in + Tracing.with_tracing ~parent:di.tracing ~name (fun span -> + match span with Some _ -> f {di with tracing= span} | None -> f di + ) + in + match with_thread with + | true -> + Debug.with_thread_associated di.log f_with_trace () + | false -> + f_with_trace () diff --git a/ocaml/xapi-idl/lib/debuginfo.mli b/ocaml/xapi-idl/lib/debuginfo.mli index b0589a58c1c..f50db605eb0 100644 --- a/ocaml/xapi-idl/lib/debuginfo.mli +++ b/ocaml/xapi-idl/lib/debuginfo.mli @@ -21,3 +21,11 @@ val of_string : string -> t val to_string : t -> string val to_log_string : t -> string + +val with_dbg : + ?with_thread:bool + -> module_name:string + -> name:string + -> dbg:string + -> (t -> 'a) + -> 'a diff --git a/ocaml/xapi/storage_smapiv1_wrapper.ml b/ocaml/xapi/storage_smapiv1_wrapper.ml index 87ecc24212c..c854c761250 100644 --- a/ocaml/xapi/storage_smapiv1_wrapper.ml +++ b/ocaml/xapi/storage_smapiv1_wrapper.ml @@ -92,26 +92,9 @@ let indent x = " " ^ x let string_of_date x = Date.to_string (Date.of_float x) -(* Sets the logging context based on `dbg`. - Also adds a new tracing span, linked to the parent span from `dbg`, if available. *) let with_dbg ~name ~dbg f = - let open Debuginfo in - let di = of_string dbg in - Debug.with_thread_associated di.log - (fun () -> - let name = "SMAPIv1." ^ name in - let tracer = Tracing.get_tracer ~name in - let span = Tracing.Tracer.start ~tracer ~name ~parent:di.tracing () in - match span with - | Ok span_context -> - let result = f {di with tracing= span_context} in - let _ = Tracing.Tracer.finish span_context in - result - | Error e -> - D.warn "Failed to start tracing: %s" (Printexc.to_string e) ; - f di - ) - () + Debuginfo.with_dbg ~with_thread:true ~module_name:"SMAPIv1-Wrapper" ~name ~dbg + f let rpc_fns keyty valty = let rpc_of hashtbl = From 9ec01f0dac0041693f4619163ff082c125a9a14e Mon Sep 17 00:00:00 2001 From: Gabriel Buica Date: Fri, 8 Dec 2023 16:29:21 +0000 Subject: [PATCH 3/4] CP-46379: Instrument 'storage_smapiv1.ml' to create spans. Uses 'with_dbg' to create spans inside 'Impl' functions. Spans were created only around 'storage_smapiv1_wrapper.ml' functions. This commit adds spans around the underlying 'Impl' functions as well. Signed-off-by: Gabriel Buica --- ocaml/xapi/storage_smapiv1.ml | 43 +++++++++++++++++++++++++++++------ 1 file changed, 36 insertions(+), 7 deletions(-) diff --git a/ocaml/xapi/storage_smapiv1.ml b/ocaml/xapi/storage_smapiv1.ml index 8705896d719..205b8d298ad 100644 --- a/ocaml/xapi/storage_smapiv1.ml +++ b/ocaml/xapi/storage_smapiv1.ml @@ -27,6 +27,9 @@ let s_of_sr = Sr.string_of let with_lock = Xapi_stdext_threads.Threadext.Mutex.execute +let with_dbg ~name ~dbg f = + Debuginfo.with_dbg ~module_name:"SMAPIv1" ~name ~dbg f + (* Find a VDI given a storage-layer SR and VDI *) let find_vdi ~__context sr vdi = let sr = s_of_sr sr in @@ -492,6 +495,7 @@ module SMAPIv1 : Server_impl = struct per_host_key ~__context ~prefix:"read-caching-reason" let epoch_begin _context ~dbg ~sr ~vdi ~vm:_ ~persistent:_ = + with_dbg ~name:"VDI.epoch_begin" ~dbg @@ fun _ -> try for_vdi ~dbg ~sr ~vdi "VDI.epoch_begin" (fun device_config _type sr self -> @@ -501,6 +505,7 @@ module SMAPIv1 : Server_impl = struct raise (Storage_error (Backend_error (code, params))) let attach2 _context ~dbg ~dp:_ ~sr ~vdi ~read_write = + with_dbg ~name:"VDI.attach2" ~dbg @@ fun _ -> try let backend = for_vdi ~dbg ~sr ~vdi "VDI.attach2" @@ -565,6 +570,7 @@ module SMAPIv1 : Server_impl = struct raise (Storage_error (Backend_error (code, params))) let attach3 context ~dbg ~dp ~sr ~vdi ~vm:_ ~read_write = + with_dbg ~name:"VDI.attach3" ~dbg @@ fun _ -> (*Throw away vm argument as does nothing in SMAPIv1*) attach2 context ~dbg ~dp ~sr ~vdi ~read_write @@ -574,6 +580,7 @@ module SMAPIv1 : Server_impl = struct Storage_smapiv1_wrapper.Wrapper" let activate _context ~dbg ~dp ~sr ~vdi = + with_dbg ~name:"VDI.activate" ~dbg @@ fun _ -> try let read_write = with_lock vdi_read_write_m (fun () -> @@ -602,11 +609,13 @@ module SMAPIv1 : Server_impl = struct raise (Storage_error (Backend_error (code, params))) let activate3 context ~dbg ~dp ~sr ~vdi ~vm:_ = + with_dbg ~name:"VDI.activate3" ~dbg @@ fun _ -> activate context ~dbg ~dp ~sr ~vdi let activate_readonly = activate3 let deactivate _context ~dbg ~dp ~sr ~vdi ~vm:_ = + with_dbg ~name:"VDI.deactivate" ~dbg @@ fun _ -> try for_vdi ~dbg ~sr ~vdi "VDI.deactivate" (fun device_config _type sr self -> @@ -629,6 +638,7 @@ module SMAPIv1 : Server_impl = struct raise (Storage_error (Backend_error (code, params))) let detach _context ~dbg ~dp:_ ~sr ~vdi ~vm:_ = + with_dbg ~name:"VDI.detach" ~dbg @@ fun _ -> try for_vdi ~dbg ~sr ~vdi "VDI.detach" (fun device_config _type sr self -> Sm.vdi_detach device_config _type sr self ; @@ -650,6 +660,7 @@ module SMAPIv1 : Server_impl = struct raise (Storage_error (Backend_error (code, params))) let epoch_end _context ~dbg ~sr ~vdi ~vm:_ = + with_dbg ~name:"VDI.epoch_end" ~dbg @@ fun _ -> try for_vdi ~dbg ~sr ~vdi "VDI.epoch_end" (fun device_config _type sr self -> @@ -671,6 +682,7 @@ module SMAPIv1 : Server_impl = struct vdi_info_from_db ~__context (Db.VDI.get_by_uuid ~__context ~uuid) let create _context ~dbg ~sr ~vdi_info = + with_dbg ~name:"VDI.create" ~dbg @@ fun _ -> try Server_helpers.exec_with_new_task "VDI.create" ~subtask_of:(Ref.of_string dbg) (fun __context -> @@ -698,6 +710,7 @@ module SMAPIv1 : Server_impl = struct let snapshot_and_clone call_name call_f is_a_snapshot _context ~dbg ~sr ~vdi_info = + with_dbg ~name:"VDI.snapshot_and_clone" ~dbg @@ fun _ -> try Server_helpers.exec_with_new_task call_name ~subtask_of:(Ref.of_string dbg) (fun __context -> @@ -762,6 +775,7 @@ module SMAPIv1 : Server_impl = struct let clone = snapshot_and_clone "VDI.clone" Sm.vdi_clone false let set_name_label _context ~dbg ~sr ~vdi ~new_name_label = + with_dbg ~name:"VDI.set_name_label" ~dbg @@ fun _ -> 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 @@ -769,6 +783,7 @@ module SMAPIv1 : Server_impl = struct ) let set_name_description _context ~dbg ~sr ~vdi ~new_name_description = + with_dbg ~name:"VDI.set_name_description" ~dbg @@ fun _ -> 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 @@ -777,6 +792,7 @@ module SMAPIv1 : Server_impl = struct ) let resize _context ~dbg ~sr ~vdi ~new_size = + with_dbg ~name:"VDI.resize" ~dbg @@ fun _ -> try let vi = for_vdi ~dbg ~sr ~vdi "VDI.resize" (fun device_config _type sr self -> @@ -800,6 +816,7 @@ module SMAPIv1 : Server_impl = struct redirect sr let destroy _context ~dbg ~sr ~vdi = + with_dbg ~name:"VDI.destroy" ~dbg @@ fun _ -> try for_vdi ~dbg ~sr ~vdi "VDI.destroy" (fun device_config _type sr self -> Sm.vdi_delete device_config _type sr self @@ -816,6 +833,7 @@ module SMAPIv1 : Server_impl = struct redirect sr let stat _context ~dbg ~sr ~vdi = + with_dbg ~name:"VDI.stat" ~dbg @@ fun _ -> try Server_helpers.exec_with_new_task "VDI.stat" ~subtask_of:(Ref.of_string dbg) (fun __context -> @@ -830,6 +848,7 @@ module SMAPIv1 : Server_impl = struct raise (Storage_error (Vdi_does_not_exist (s_of_vdi vdi))) let introduce _context ~dbg ~sr ~uuid ~sm_config ~location = + with_dbg ~name:"VDI.introduce" ~dbg @@ fun _ -> try Server_helpers.exec_with_new_task "VDI.introduce" ~subtask_of:(Ref.of_string dbg) (fun __context -> @@ -848,6 +867,7 @@ module SMAPIv1 : Server_impl = struct raise (Storage_error (Vdi_does_not_exist location)) let set_persistent _context ~dbg ~sr ~vdi ~persistent = + with_dbg ~name:"VDI.set_persistent" ~dbg @@ fun _ -> try Server_helpers.exec_with_new_task "VDI.set_persistent" ~subtask_of:(Ref.of_string dbg) (fun __context -> @@ -875,7 +895,8 @@ module SMAPIv1 : Server_impl = struct 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 ; + with_dbg ~name:"VDI.get_by_name" ~dbg @@ fun {log; _} -> + info "VDI.get_by_name dbg:%s sr:%s name:%s" log (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 -> @@ -891,7 +912,8 @@ module SMAPIv1 : Server_impl = struct ) 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 + with_dbg ~name:"VDI.set_content_id" ~dbg @@ fun {log; _} -> + info "VDI.get_by_content dbg:%s sr:%s vdi:%s content_id:%s" log (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" @@ -903,7 +925,8 @@ module SMAPIv1 : Server_impl = struct ) let similar_content _context ~dbg ~sr ~vdi = - info "VDI.similar_content dbg:%s sr:%s vdi:%s" dbg (s_of_sr sr) + with_dbg ~name:"VDI.similar_content" ~dbg @@ fun {log; _} -> + info "VDI.similar_content dbg:%s sr:%s vdi:%s" log (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 -> @@ -1013,7 +1036,8 @@ module SMAPIv1 : Server_impl = struct ) let compose _context ~dbg ~sr ~vdi1 ~vdi2 = - info "VDI.compose dbg:%s sr:%s vdi1:%s vdi2:%s" dbg (s_of_sr sr) + with_dbg ~name:"VDI.compose" ~dbg @@ fun {log; _} -> + info "VDI.compose dbg:%s sr:%s vdi1:%s vdi2:%s" log (s_of_sr sr) (s_of_vdi vdi1) (s_of_vdi vdi2) ; try Server_helpers.exec_with_new_task "VDI.compose" @@ -1039,7 +1063,8 @@ module SMAPIv1 : Server_impl = struct 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 + with_dbg ~name:"VDI.add_to_sm_config" ~dbg @@ fun {log; _} -> + info "VDI.add_to_sm_config dbg:%s sr:%s vdi:%s key:%s value:%s" log (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 -> @@ -1048,7 +1073,8 @@ module SMAPIv1 : Server_impl = struct ) 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 + with_dbg ~name:"VDI.remove_from_sm_config" ~dbg @@ fun {log; _} -> + info "VDI.remove_from_sm_config dbg:%s sr:%s vdi:%s key:%s" log (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 -> @@ -1057,7 +1083,8 @@ module SMAPIv1 : Server_impl = struct ) 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) ; + with_dbg ~name:"VDI.get_url" ~dbg @@ fun {log; _} -> + info "VDI.get_url dbg:%s sr:%s vdi:%s" log (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" @@ -1077,6 +1104,7 @@ module SMAPIv1 : Server_impl = struct ) let call_cbt_function _context ~f ~f_name ~dbg ~sr ~vdi = + with_dbg ~name:"VDI.call_cbt_function" ~dbg @@ fun _ -> try for_vdi ~dbg ~sr ~vdi f_name (fun device_config _type sr self -> f device_config _type sr self @@ -1107,6 +1135,7 @@ module SMAPIv1 : Server_impl = struct ~content_id:"/No content: this is a cbt_metadata VDI/" let list_changed_blocks _context ~dbg ~sr ~vdi_from ~vdi_to = + with_dbg ~name:"VDI.list_changed_blocks" ~dbg @@ fun _ -> try Server_helpers.exec_with_new_task "VDI.list_changed_blocks" ~subtask_of:(Ref.of_string dbg) (fun __context -> From f189579a9d90b694b5d65a222489f022b8d54669 Mon Sep 17 00:00:00 2001 From: Gabriel Buica Date: Mon, 11 Dec 2023 15:58:11 +0000 Subject: [PATCH 4/4] CP-46379: Propagate 'traceparent' to 'Sm.*' functions Adds an optional parameter to 'Sm.*' function to inherit the traceparent. The 'traceparent' was not propagated to the functions inside 'sm.ml'. This commit propagetes the 'traceparent' and instruments 'sm.ml' to create spans for function calls. Signed-off-by: Gabriel Buica --- ocaml/xapi/sm.ml | 56 ++++++++++++++++++++++++----------- ocaml/xapi/static_vdis.ml | 3 +- ocaml/xapi/storage_smapiv1.ml | 36 +++++++++++----------- 3 files changed, 58 insertions(+), 37 deletions(-) diff --git a/ocaml/xapi/sm.ml b/ocaml/xapi/sm.ml index 2a18041f507..c55c2c423c3 100644 --- a/ocaml/xapi/sm.ml +++ b/ocaml/xapi/sm.ml @@ -59,6 +59,8 @@ let driver_filename driver = (*****************************************************************************) +let with_dbg ~name ~dbg f = Debuginfo.with_dbg ~module_name:"SM" ~name ~dbg f + let debug operation driver msg = debug "SM %s %s %s" driver operation msg let srmaster_only (_, dconf) = @@ -132,9 +134,10 @@ let sr_update dconf driver sr = let call = Sm_exec.make_call ~sr_ref:sr dconf "sr_update" [] in Sm_exec.parse_unit (Sm_exec.exec_xmlrpc (driver_filename driver) call) -let vdi_create dconf driver sr sm_config vdi_type size name_label +let vdi_create ~dbg dconf driver sr sm_config vdi_type size name_label name_description metadata_of_pool is_a_snapshot snapshot_time snapshot_of read_only = + with_dbg ~dbg ~name:"vdi_create" @@ fun _ -> debug "vdi_create" driver (sprintf "sr=%s sm_config=[%s] type=[%s] size=%Ld" (Ref.string_of sr) (String.concat "; " (List.map (fun (k, v) -> k ^ "=" ^ v) sm_config)) @@ -157,13 +160,15 @@ let vdi_create dconf driver sr sm_config vdi_type size name_label in Sm_exec.parse_vdi_info (Sm_exec.exec_xmlrpc (driver_filename driver) call) -let vdi_update dconf driver sr vdi = +let vdi_update ~dbg dconf driver sr vdi = + with_dbg ~dbg ~name:"vdi_update" @@ fun _ -> debug "vdi_update" driver (sprintf "sr=%s vdi=%s" (Ref.string_of sr) (Ref.string_of vdi)) ; let call = Sm_exec.make_call ~sr_ref:sr ~vdi_ref:vdi dconf "vdi_update" [] in Sm_exec.parse_unit (Sm_exec.exec_xmlrpc (driver_filename driver) call) -let vdi_introduce dconf driver sr new_uuid sm_config location = +let vdi_introduce ~dbg dconf driver sr new_uuid sm_config location = + with_dbg ~dbg ~name:"vdi_introduce" @@ fun _ -> debug "vdi_introduce" driver (sprintf "sr=%s new_uuid=%s sm_config=[%s] location=%s" (Ref.string_of sr) new_uuid @@ -176,14 +181,16 @@ let vdi_introduce dconf driver sr new_uuid sm_config location = in Sm_exec.parse_vdi_info (Sm_exec.exec_xmlrpc (driver_filename driver) call) -let vdi_delete dconf driver sr vdi = +let vdi_delete ~dbg dconf driver sr vdi = + with_dbg ~dbg ~name:"vdi_delete" @@ fun _ -> debug "vdi_delete" driver (sprintf "sr=%s vdi=%s" (Ref.string_of sr) (Ref.string_of vdi)) ; srmaster_only dconf ; let call = Sm_exec.make_call ~sr_ref:sr ~vdi_ref:vdi dconf "vdi_delete" [] in Sm_exec.parse_unit (Sm_exec.exec_xmlrpc (driver_filename driver) call) -let vdi_attach dconf driver sr vdi writable = +let vdi_attach ~dbg dconf driver sr vdi writable = + with_dbg ~dbg ~name:"vdi_attach" @@ fun _ -> debug "vdi_attach" driver (sprintf "sr=%s vdi=%s writable=%b" (Ref.string_of sr) (Ref.string_of vdi) writable @@ -195,13 +202,15 @@ let vdi_attach dconf driver sr vdi writable = let result = Sm_exec.exec_xmlrpc (driver_filename driver) call in Sm_exec.parse_attach_result result -let vdi_detach dconf driver sr vdi = +let vdi_detach ~dbg dconf driver sr vdi = + with_dbg ~dbg ~name:"vdi_detach" @@ fun _ -> debug "vdi_detach" driver (sprintf "sr=%s vdi=%s" (Ref.string_of sr) (Ref.string_of vdi)) ; let call = Sm_exec.make_call ~sr_ref:sr ~vdi_ref:vdi dconf "vdi_detach" [] in Sm_exec.parse_unit (Sm_exec.exec_xmlrpc (driver_filename driver) call) -let vdi_activate dconf driver sr vdi writable = +let vdi_activate ~dbg dconf driver sr vdi writable = + with_dbg ~dbg ~name:"vdi_activate" @@ fun _ -> debug "vdi_activate" driver (sprintf "sr=%s vdi=%s" (Ref.string_of sr) (Ref.string_of vdi)) ; let call = @@ -210,7 +219,8 @@ let vdi_activate dconf driver sr vdi writable = in Sm_exec.parse_unit (Sm_exec.exec_xmlrpc (driver_filename driver) call) -let vdi_deactivate dconf driver sr vdi = +let vdi_deactivate ~dbg dconf driver sr vdi = + with_dbg ~dbg ~name:"vdi_deactivate" @@ fun _ -> debug "vdi_deactivate" driver (sprintf "sr=%s vdi=%s" (Ref.string_of sr) (Ref.string_of vdi)) ; let call = @@ -218,7 +228,8 @@ let vdi_deactivate dconf driver sr vdi = in Sm_exec.parse_unit (Sm_exec.exec_xmlrpc (driver_filename driver) call) -let vdi_snapshot dconf driver driver_params sr vdi = +let vdi_snapshot ~dbg dconf driver driver_params sr vdi = + with_dbg ~dbg ~name:"vdi_snapshot" @@ fun _ -> debug "vdi_snapshot" driver (sprintf "sr=%s vdi=%s driver_params=[%s]" (Ref.string_of sr) (Ref.string_of vdi) @@ -231,7 +242,8 @@ let vdi_snapshot dconf driver driver_params sr vdi = in Sm_exec.parse_vdi_info (Sm_exec.exec_xmlrpc (driver_filename driver) call) -let vdi_clone dconf driver driver_params sr vdi = +let vdi_clone ~dbg dconf driver driver_params sr vdi = + with_dbg ~dbg ~name:"vdi_clone" @@ fun _ -> debug "vdi_clone" driver (sprintf "sr=%s vdi=%s driver_params=[%s]" (Ref.string_of sr) (Ref.string_of vdi) @@ -244,7 +256,8 @@ let vdi_clone dconf driver driver_params sr vdi = in Sm_exec.parse_vdi_info (Sm_exec.exec_xmlrpc (driver_filename driver) call) -let vdi_resize dconf driver sr vdi newsize = +let vdi_resize ~dbg dconf driver sr vdi newsize = + with_dbg ~dbg ~name:"vdi_resize" @@ fun _ -> debug "vdi_resize" driver (sprintf "sr=%s vdi=%s newsize=%Ld" (Ref.string_of sr) (Ref.string_of vdi) newsize @@ -264,7 +277,8 @@ let vdi_generate_config dconf driver sr vdi = in Sm_exec.parse_string (Sm_exec.exec_xmlrpc (driver_filename driver) call) -let vdi_compose dconf driver sr vdi1 vdi2 = +let vdi_compose ~dbg dconf driver sr vdi1 vdi2 = + with_dbg ~dbg ~name:"vdi_compose" @@ fun _ -> debug "vdi_compose" driver (sprintf "sr=%s vdi1=%s vdi2=%s" (Ref.string_of sr) (Ref.string_of vdi1) (Ref.string_of vdi2) @@ -276,7 +290,8 @@ let vdi_compose dconf driver sr vdi1 vdi2 = in Sm_exec.parse_unit (Sm_exec.exec_xmlrpc (driver_filename driver) call) -let vdi_epoch_begin dconf driver sr vdi = +let vdi_epoch_begin ~dbg dconf driver sr vdi = + with_dbg ~dbg ~name:"vdi_epoch_begin" @@ fun _ -> debug "vdi_epoch_begin" driver (sprintf "sr=%s vdi=%s" (Ref.string_of sr) (Ref.string_of vdi)) ; let call = @@ -284,7 +299,8 @@ let vdi_epoch_begin dconf driver sr vdi = in Sm_exec.parse_unit (Sm_exec.exec_xmlrpc (driver_filename driver) call) -let vdi_epoch_end dconf driver sr vdi = +let vdi_epoch_end ~dbg dconf driver sr vdi = + with_dbg ~dbg ~name:"vdi_epoch_end" @@ fun _ -> debug "vdi_epoch_end" driver (sprintf "sr=%s vdi=%s" (Ref.string_of sr) (Ref.string_of vdi)) ; let call = @@ -292,7 +308,8 @@ let vdi_epoch_end dconf driver sr vdi = in Sm_exec.parse_unit (Sm_exec.exec_xmlrpc (driver_filename driver) call) -let vdi_enable_cbt dconf driver sr vdi = +let vdi_enable_cbt ~dbg dconf driver sr vdi = + with_dbg ~dbg ~name:"vdi_enable_cbt" @@ fun _ -> debug "vdi_enable_cbt" driver (sprintf "sr=%s vdi=%s" (Ref.string_of sr) (Ref.string_of vdi)) ; srmaster_only dconf ; @@ -301,7 +318,8 @@ let vdi_enable_cbt dconf driver sr vdi = in Sm_exec.parse_unit (Sm_exec.exec_xmlrpc (driver_filename driver) call) -let vdi_disable_cbt dconf driver sr vdi = +let vdi_disable_cbt ~dbg dconf driver sr vdi = + with_dbg ~dbg ~name:"vdi_disable_cbt" @@ fun _ -> debug "vdi_disable_cbt" driver (sprintf "sr=%s vdi=%s" (Ref.string_of sr) (Ref.string_of vdi)) ; srmaster_only dconf ; @@ -310,7 +328,8 @@ let vdi_disable_cbt dconf driver sr vdi = in Sm_exec.parse_unit (Sm_exec.exec_xmlrpc (driver_filename driver) call) -let vdi_data_destroy dconf driver sr vdi = +let vdi_data_destroy ~dbg dconf driver sr vdi = + with_dbg ~dbg ~name:"vdi_data_destroy" @@ fun _ -> debug "vdi_data_destroy" driver (sprintf "sr=%s vdi=%s" (Ref.string_of sr) (Ref.string_of vdi)) ; srmaster_only dconf ; @@ -319,7 +338,8 @@ let vdi_data_destroy dconf driver sr vdi = in Sm_exec.parse_unit (Sm_exec.exec_xmlrpc (driver_filename driver) call) -let vdi_list_changed_blocks dconf driver sr ~vdi_from ~vdi_to = +let vdi_list_changed_blocks ~dbg dconf driver sr ~vdi_from ~vdi_to = + with_dbg ~dbg ~name:"vdi_list_changed_blocks" @@ fun _ -> debug "vdi_list_changed_blocks" driver (sprintf "sr=%s vdi_from=%s vdi_to=%s" (Ref.string_of sr) (Ref.string_of vdi_from) (Ref.string_of vdi_to) diff --git a/ocaml/xapi/static_vdis.ml b/ocaml/xapi/static_vdis.ml index 672c67a8855..5ed45c95e16 100644 --- a/ocaml/xapi/static_vdis.ml +++ b/ocaml/xapi/static_vdis.ml @@ -77,7 +77,8 @@ let permanent_vdi_deactivate_by_uuid ~__context ~uuid = try let vdi = Db.VDI.get_by_uuid ~__context ~uuid in Sm.call_sm_vdi_functions ~__context ~vdi (fun srconf srtype sr -> - Sm.vdi_deactivate srconf srtype sr vdi + let dbg = Context.string_of_task_and_tracing __context in + Sm.vdi_deactivate ~dbg srconf srtype sr vdi ) with e -> warn diff --git a/ocaml/xapi/storage_smapiv1.ml b/ocaml/xapi/storage_smapiv1.ml index 205b8d298ad..4c7c382f250 100644 --- a/ocaml/xapi/storage_smapiv1.ml +++ b/ocaml/xapi/storage_smapiv1.ml @@ -499,7 +499,7 @@ module SMAPIv1 : Server_impl = struct try for_vdi ~dbg ~sr ~vdi "VDI.epoch_begin" (fun device_config _type sr self -> - Sm.vdi_epoch_begin device_config _type sr self + Sm.vdi_epoch_begin ~dbg device_config _type sr self ) with Api_errors.Server_error (code, params) -> raise (Storage_error (Backend_error (code, params))) @@ -511,7 +511,7 @@ module SMAPIv1 : Server_impl = struct 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 + Sm.vdi_attach ~dbg 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" @@ -600,7 +600,7 @@ module SMAPIv1 : Server_impl = struct (* 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 + Sm.vdi_activate ~dbg device_config _type sr self read_write else info "%s sr:%s does not support vdi_activate: doing nothing" dp (Ref.string_of sr) @@ -629,7 +629,7 @@ module SMAPIv1 : Server_impl = struct (* 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 + Sm.vdi_deactivate ~dbg device_config _type sr self else info "%s sr:%s does not support vdi_deactivate: doing nothing" dp (Ref.string_of sr) @@ -641,7 +641,7 @@ module SMAPIv1 : Server_impl = struct with_dbg ~name:"VDI.detach" ~dbg @@ fun _ -> try for_vdi ~dbg ~sr ~vdi "VDI.detach" (fun device_config _type sr self -> - Sm.vdi_detach device_config _type sr self ; + Sm.vdi_detach ~dbg 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 @@ -664,7 +664,7 @@ module SMAPIv1 : Server_impl = struct try for_vdi ~dbg ~sr ~vdi "VDI.epoch_end" (fun device_config _type sr self -> - Sm.vdi_epoch_end device_config _type sr self + Sm.vdi_epoch_end ~dbg device_config _type sr self ) with Api_errors.Server_error (code, params) -> raise (Storage_error (Backend_error (code, params))) @@ -689,7 +689,7 @@ module SMAPIv1 : Server_impl = struct 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 + Sm.vdi_create ~dbg 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 @@ -717,7 +717,7 @@ module SMAPIv1 : Server_impl = struct 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 + call_f ~dbg device_config _type vdi_info.sm_config sr self ) in (* PR-1255: modify clone, snapshot to take the same parameters as create? *) @@ -756,7 +756,7 @@ module SMAPIv1 : Server_impl = struct 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 + Sm.vdi_update ~dbg device_config _type sr self ) ; let vdi = vdi_info_from_db ~__context self in debug "vdi = %s" (string_of_vdi_info vdi) ; @@ -796,7 +796,7 @@ module SMAPIv1 : Server_impl = struct 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 + Sm.vdi_resize ~dbg device_config _type sr self new_size ) in Server_helpers.exec_with_new_task "VDI.resize" @@ -819,7 +819,7 @@ module SMAPIv1 : Server_impl = struct with_dbg ~name:"VDI.destroy" ~dbg @@ fun _ -> try for_vdi ~dbg ~sr ~vdi "VDI.destroy" (fun device_config _type sr self -> - Sm.vdi_delete device_config _type sr self + Sm.vdi_delete ~dbg device_config _type sr self ) ; with_lock vdi_read_write_m (fun () -> Hashtbl.remove vdi_read_write (sr, vdi) @@ -838,7 +838,7 @@ module SMAPIv1 : Server_impl = struct 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 ; + Sm.vdi_update ~dbg device_config _type sr self ; vdi_info_of_vdi_rec __context (Db.VDI.get_record ~__context ~self) ) @@ -856,7 +856,7 @@ module SMAPIv1 : Server_impl = struct 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 + Sm.vdi_introduce ~dbg device_config sr_type sr uuid sm_config location ) in @@ -878,13 +878,13 @@ module SMAPIv1 : Server_impl = struct 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 + let vi = Sm.vdi_clone ~dbg 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 + Sm.vdi_delete ~dbg device_config _type sr self ) ) ) @@ -1046,7 +1046,7 @@ module SMAPIv1 : Server_impl = struct 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 + Sm.vdi_compose ~dbg device_config _type sr vdi1 self ) ) with @@ -1107,7 +1107,7 @@ module SMAPIv1 : Server_impl = struct with_dbg ~name:"VDI.call_cbt_function" ~dbg @@ fun _ -> try for_vdi ~dbg ~sr ~vdi f_name (fun device_config _type sr self -> - f device_config _type sr self + f ~dbg device_config _type sr self ) with | Smint.Not_implemented_in_backend -> @@ -1142,7 +1142,7 @@ module SMAPIv1 : Server_impl = struct 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 + Sm.vdi_list_changed_blocks ~dbg device_config _type sr ~vdi_from ~vdi_to ) )