From d6ab15362548b8fe270bd14d5153b8d94e1b15c0 Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Wed, 22 Nov 2023 16:27:20 +0000 Subject: [PATCH 1/2] maintenance: reformat using ocamlformat 0.26.1 Signed-off-by: Pau Ruiz Safont --- ocaml/database/db_cache_impl.ml | 27 +++-- ocaml/database/master_connection.ml | 4 +- ocaml/database/parse_db_conf.ml | 4 +- ocaml/idl/datamodel_schema.ml | 4 +- ocaml/idl/json_backend/gen_json.ml | 12 +- ocaml/idl/markdown_backend.ml | 16 +-- ocaml/idl/ocaml_backend/gen_client.ml | 10 +- ocaml/idl/ocaml_backend/gen_db_actions.ml | 4 +- ocaml/idl/ocaml_backend/gen_server.ml | 30 ++--- ocaml/idl/ocaml_backend/ocaml_syntax.ml | 10 +- .../ezxenstore/watch/ez_xenstore_watch.ml | 4 +- ocaml/libs/http-lib/http_svr.ml | 8 +- ocaml/libs/stunnel/stunnel.ml | 8 +- ocaml/libs/uuid/uuidx.mli | 8 +- ocaml/libs/vhd/vhd_format/f.ml | 67 +++++------ ocaml/libs/vhd/vhd_format_lwt/iO.ml | 4 +- .../vhd/vhd_format_lwt_test/patterns_lwt.ml | 12 +- ocaml/message-switch/cli/main.ml | 66 ++++++----- ocaml/message-switch/switch/logging.ml | 4 +- ocaml/message-switch/switch/switch_main.ml | 6 +- ocaml/networkd/bin/network_server.ml | 1 - ocaml/networkd/bin/networkd.ml | 3 +- ocaml/networkd/lib/network_utils.ml | 22 ++-- .../test/network_test_lacp_properties.ml | 2 +- ocaml/perftest/createVM.ml | 4 +- ocaml/perftest/histogram.ml | 4 +- ocaml/perftest/tests.ml | 18 +-- ocaml/quicktest/quicktest_vdi.ml | 6 +- .../quicktest_vdi_ops_data_integrity.ml | 4 +- ocaml/sdk-gen/c/gen_c_binding.ml | 4 +- ocaml/sdk-gen/csharp/gen_csharp_binding.ml | 16 +-- ocaml/sdk-gen/java/main.ml | 18 +-- .../powershell/gen_powershell_binding.ml | 112 +++++++++--------- ocaml/squeezed/lib/squeeze.ml | 16 +-- ocaml/tests/common/test_vgpu_common.ml | 8 +- ocaml/tests/test_clustering.ml | 8 +- ocaml/tests/test_dbsync_master.ml | 4 +- ocaml/tests/test_observer.ml | 4 +- ocaml/tests/test_platformdata.ml | 4 +- ocaml/tests/test_repository_helpers.ml | 4 +- ocaml/tests/test_rpm.ml | 3 +- ocaml/tests/test_vdi_cbt.ml | 2 +- ocaml/vhd-tool/src/impl.ml | 16 +-- ocaml/vhd-tool/src/nbd_input.ml | 8 +- ocaml/xapi-cli-server/cli_operations.ml | 64 +++++----- ocaml/xapi-cli-server/cli_util.ml | 4 +- ocaml/xapi-cli-server/records.ml | 8 +- ocaml/xapi-idl/cluster/cluster_cli.ml | 1 - .../guard/privileged/xapiguard_cli.ml | 1 - .../xapi-idl/guard/varstored/varstored_cli.ml | 1 - ocaml/xapi-idl/memory/memory.ml | 8 +- ocaml/xapi-idl/memory/memory_cli.ml | 1 - ocaml/xapi-idl/network/network_cli.ml | 1 - ocaml/xapi-storage-script/main.ml | 4 - ocaml/xapi-storage/generator/lib/control.ml | 1 - ocaml/xapi-storage/generator/lib/data.ml | 1 - ocaml/xapi/certificates.ml | 4 +- ocaml/xapi/console.ml | 9 +- ocaml/xapi/export.ml | 20 ++-- ocaml/xapi/extauth_plugin_ADpbis.ml | 44 +++---- ocaml/xapi/import.ml | 15 +-- ocaml/xapi/importexport.ml | 4 +- ocaml/xapi/memory_check.ml | 4 +- ocaml/xapi/message_forwarding.ml | 2 +- ocaml/xapi/repository_helpers.ml | 3 +- ocaml/xapi/storage_access.ml | 4 +- ocaml/xapi/storage_smapiv1.ml | 4 +- ocaml/xapi/storage_smapiv1_wrapper.ml | 9 +- ocaml/xapi/vm_platform.ml | 2 +- ocaml/xapi/workload_balancing.ml | 4 +- ocaml/xapi/xapi_clustering.ml | 3 +- ocaml/xapi/xapi_diagnostics.ml | 12 +- ocaml/xapi/xapi_event.ml | 16 +-- ocaml/xapi/xapi_ha.ml | 4 +- ocaml/xapi/xapi_ha_vm_failover.ml | 12 +- ocaml/xapi/xapi_host.ml | 14 +-- ocaml/xapi/xapi_observer.ml | 23 ++-- ocaml/xapi/xapi_periodic_scheduler.ml | 4 +- ocaml/xapi/xapi_pif_helpers.ml | 3 +- ocaml/xapi/xapi_pool.ml | 3 +- ocaml/xapi/xapi_pool_update.ml | 4 +- ocaml/xapi/xapi_session.ml | 8 +- ocaml/xapi/xapi_sr_operations.ml | 4 +- ocaml/xapi/xapi_vif_helpers.ml | 4 +- ocaml/xapi/xapi_vm.ml | 9 +- ocaml/xapi/xapi_vm_clone.ml | 8 +- ocaml/xapi/xapi_vm_helpers.ml | 76 ++++++------ ocaml/xapi/xapi_vm_lifecycle.ml | 10 +- ocaml/xapi/xapi_xenops.ml | 66 +++++------ ocaml/xcp-rrdd/bin/rrdd/rrdd_http_handler.ml | 4 +- ocaml/xcp-rrdd/bin/rrdp-iostat/rrdp_iostat.ml | 8 +- ocaml/xen-api-client/lib_test/xen_api_test.ml | 8 +- ocaml/xen-api-client/lwt/disk.ml | 4 +- ocaml/xenopsd/cli/xn.ml | 66 +++++------ ocaml/xenopsd/lib/xenops_server.ml | 12 +- ocaml/xenopsd/lib/xenops_server_simulator.ml | 8 +- ocaml/xenopsd/lib/xenopsd.ml | 4 +- ocaml/xenopsd/xc/device.ml | 16 +-- ocaml/xenopsd/xc/domain.ml | 8 +- ocaml/xenopsd/xc/memory_breakdown.ml | 16 +-- ocaml/xenopsd/xc/xenops_server_xen.ml | 19 +-- 101 files changed, 613 insertions(+), 665 deletions(-) diff --git a/ocaml/database/db_cache_impl.ml b/ocaml/database/db_cache_impl.ml index 791492f7091..b4f23b0af00 100644 --- a/ocaml/database/db_cache_impl.ml +++ b/ocaml/database/db_cache_impl.ml @@ -399,8 +399,8 @@ let spawn_db_flush_threads () = ( if dbconn.Parse_db_conf.mode <> Parse_db_conf.No_limit then "Write limited with coallesce_time=" ^ string_of_float coallesce_time - else - "" + else + "" ) ; (* check if we are currently in a coallescing_period *) let in_coallescing_period () = @@ -417,17 +417,18 @@ let spawn_db_flush_threads () = exceeded. *) ( if - !Db_connections.exit_on_next_flush - (* always flush straight away; this request is urgent *) - || (* otherwise, we only write if (i) "coalesscing period has come to an end"; and (ii) "write limiting requirements are met": *) - (not (in_coallescing_period ())) - (* see (i) above *) - && (!my_writes_this_period - < dbconn.Parse_db_conf.write_limit_write_cycles - || dbconn.Parse_db_conf.mode = Parse_db_conf.No_limit - (* (ii) above *) - ) - then (* debug "[%s] considering flush" db_path; *) + !Db_connections.exit_on_next_flush + (* always flush straight away; this request is urgent *) + || (* otherwise, we only write if (i) "coalesscing period has come to an end"; and (ii) "write limiting requirements are met": *) + (not (in_coallescing_period ())) + (* see (i) above *) + && (!my_writes_this_period + < dbconn.Parse_db_conf.write_limit_write_cycles + || dbconn.Parse_db_conf.mode + = Parse_db_conf.No_limit + (* (ii) above *) + ) + then (* debug "[%s] considering flush" db_path; *) let was_anything_flushed = Xapi_stdext_threads.Threadext.Mutex.execute Db_lock.global_flush_mutex (fun () -> diff --git a/ocaml/database/master_connection.ml b/ocaml/database/master_connection.ml index 6643f431e90..01a413a512d 100644 --- a/ocaml/database/master_connection.ml +++ b/ocaml/database/master_connection.ml @@ -301,8 +301,8 @@ let do_db_xml_rpc_persistent_with_reopen ~host:_ ~path (req : string) : time_sofar ( if !connection_timeout < 0. then "never timeout" - else - Printf.sprintf "timeout after '%f'" !connection_timeout + else + Printf.sprintf "timeout after '%f'" !connection_timeout ) ; if time_sofar > !connection_timeout && !connection_timeout >= 0. then if !restart_on_connection_timeout then ( diff --git a/ocaml/database/parse_db_conf.ml b/ocaml/database/parse_db_conf.ml index 0782b3208ac..852ace7d9f4 100644 --- a/ocaml/database/parse_db_conf.ml +++ b/ocaml/database/parse_db_conf.ml @@ -77,8 +77,8 @@ let from_block r = ; ( if r.mode = Write_limit then Printf.sprintf "write_limit_period:%d\nwrite_limit_write_cycles:%d\n" r.write_limit_period r.write_limit_write_cycles - else - "" + else + "" ) ; String.concat "" (List.map diff --git a/ocaml/idl/datamodel_schema.ml b/ocaml/idl/datamodel_schema.ml index 132d109cb1e..32bc3a94fc4 100644 --- a/ocaml/idl/datamodel_schema.ml +++ b/ocaml/idl/datamodel_schema.ml @@ -64,8 +64,8 @@ let of_datamodel () = default= ( if issetref then Some (Value.Set []) - else - Option.map Datamodel_values.to_db f.Datamodel_types.default_value + else + Option.map Datamodel_values.to_db f.Datamodel_types.default_value ) ; ty ; issetref diff --git a/ocaml/idl/json_backend/gen_json.ml b/ocaml/idl/json_backend/gen_json.ml index f96253531f2..d47db08514d 100644 --- a/ocaml/idl/json_backend/gen_json.ml +++ b/ocaml/idl/json_backend/gen_json.ml @@ -422,8 +422,8 @@ end = struct , obj.name , ( if doc = "" && transition = Lifecycle.Published then obj.description - else - doc + else + doc ) , "class" ) @@ -445,8 +445,8 @@ end = struct , obj.name ^ "." ^ m.msg_name , ( if doc = "" && transition = Lifecycle.Published then m.msg_doc - else - doc + else + doc ) , "message" ) @@ -474,8 +474,8 @@ end = struct , obj.name ^ "." ^ field_name , ( if doc = "" && transition = Lifecycle.Published then f.field_description - else - doc + else + doc ) , "field" ) diff --git a/ocaml/idl/markdown_backend.ml b/ocaml/idl/markdown_backend.ml index 5dc93a0963b..edd95d95d50 100644 --- a/ocaml/idl/markdown_backend.ml +++ b/ocaml/idl/markdown_backend.ml @@ -268,10 +268,10 @@ let print_field_table_of_obj printer ~is_class_deprecated ~is_class_removed x = let descr = ( if y.lifecycle.state = Removed_s || is_class_removed then "**Removed**. " - else if y.lifecycle.state = Deprecated_s || is_class_deprecated then - "**Deprecated**. " - else - "" + else if y.lifecycle.state = Deprecated_s || is_class_deprecated then + "**Deprecated**. " + else + "" ) ^ escape description in @@ -401,10 +401,10 @@ let print_classes api io = let get_descr obj = ( if obj.obj_lifecycle.state = Removed_s then "**Removed**. " - else if obj.obj_lifecycle.state = Deprecated_s then - "**Deprecated**. " - else - "" + else if obj.obj_lifecycle.state = Deprecated_s then + "**Deprecated**. " + else + "" ) ^ escape obj.description in diff --git a/ocaml/idl/ocaml_backend/gen_client.ml b/ocaml/idl/ocaml_backend/gen_client.ml index 93d2452c584..d456dd9d5d8 100644 --- a/ocaml/idl/ocaml_backend/gen_client.ml +++ b/ocaml/idl/ocaml_backend/gen_client.ml @@ -137,8 +137,8 @@ let gen_module api : O.Module.t = OU.alias_of_ty x | _ -> "unit" - else - OU.alias_of_ty (DT.Ref Datamodel_common._task) + else + OU.alias_of_ty (DT.Ref Datamodel_common._task) ) ~body:(x.msg_name :: "~rpc" :: all) () @@ -206,9 +206,9 @@ let gen_module api : O.Module.t = "rpc_wrapper rpc %s [ %s ] >>= fun x -> return (%s x)" ( if sync then Printf.sprintf "\"%s\"" wire_name - else - Printf.sprintf {|(Printf.sprintf "%%s%s" AQ.async_qualifier)|} - wire_name + else + Printf.sprintf {|(Printf.sprintf "%%s%s" AQ.async_qualifier)|} + wire_name ) (String.concat "; " rpc_args) (from_xmlrpc x.msg_result) diff --git a/ocaml/idl/ocaml_backend/gen_db_actions.ml b/ocaml/idl/ocaml_backend/gen_db_actions.ml index b149a86a4df..db222970b92 100644 --- a/ocaml/idl/ocaml_backend/gen_db_actions.ml +++ b/ocaml/idl/ocaml_backend/gen_db_actions.ml @@ -567,8 +567,8 @@ let db_action api : O.Module.t = ~elements: ( if obj.DT.in_database then [O.Module.Let (register_get_record obj)] - else - [] + else + [] ) () in diff --git a/ocaml/idl/ocaml_backend/gen_server.ml b/ocaml/idl/ocaml_backend/gen_server.ml index 88d8996c99b..e091e07b4d2 100644 --- a/ocaml/idl/ocaml_backend/gen_server.ml +++ b/ocaml/idl/ocaml_backend/gen_server.ml @@ -176,13 +176,13 @@ let operation (obj : obj) (x : message) = [ ( if Gen_empty_custom.operation_requires_side_effect x then ["(* has side-effect (with locks and no automatic DB action) *)"] - else - ["(* has no side-effect; should be handled by DB action *) "] + else + ["(* has no side-effect; should be handled by DB action *) "] ) ; ( if has_async then ["(* has asynchronous mode *)"] - else - ["(* has no asynchronous mode *)"] + else + ["(* has no asynchronous mode *)"] ) ] in @@ -270,16 +270,16 @@ let operation (obj : obj) (x : message) = because we know we don't need the arguments *) let ignore = x.DT.msg_forward_to <> None in ( if - (* If we're a constructor then unmarshall all the fields from the constructor record, passed as a struct *) - is_ctor - then + (* If we're a constructor then unmarshall all the fields from the constructor record, passed as a struct *) + is_ctor + then [from_rpc Client.session; from_ctor_record] (* Otherwise, go read non-default fields from pattern match; if we have default fields then we need to get those from the 'default_fields' arg *) - else - List.map - (fun a -> from_rpc ~ignore:(ignore && not (is_session_arg a)) a) - args_without_default_values + else + List.map + (fun a -> from_rpc ~ignore:(ignore && not (is_session_arg a)) a) + args_without_default_values ) (* and for every default value we try to get this from default_args or default it *) @ unmarshall_default_params @@ -380,8 +380,8 @@ let operation (obj : obj) (x : message) = Printf.sprintf "%s \"%s\";" ( if may_be_side_effecting x then "ApiLogSideEffect.debug" - else - "ApiLogRead.debug" + else + "ApiLogRead.debug" ) wire_name ] @@ -395,8 +395,8 @@ let operation (obj : obj) (x : message) = (if x.msg_session then "~session_id" else "") ( if Gen_empty_custom.operation_requires_side_effect x then "~forward_op" - else - "" + else + "" ) ; (* "P.debug \"Server RPC response: %s\" (Rpc.to_string (resp.Rpc.contents));"; *) "resp" diff --git a/ocaml/idl/ocaml_backend/ocaml_syntax.ml b/ocaml/idl/ocaml_backend/ocaml_syntax.ml index 01da3d662eb..634b7477830 100644 --- a/ocaml/idl/ocaml_backend/ocaml_syntax.ml +++ b/ocaml/idl/ocaml_backend/ocaml_syntax.ml @@ -142,9 +142,9 @@ module Module = struct ^ " = " ^ ( if x.args = [] then "" - else - String.concat " " - (List.map (fun x -> "functor(" ^ x ^ ") ->") x.args) + else + String.concat " " + (List.map (fun x -> "functor(" ^ x ^ ") ->") x.args) ) ^ "struct" in @@ -179,8 +179,8 @@ module Signature = struct [ ( if toplevel then Line ("module type " ^ x.name ^ " = sig") - else - Line ("module " ^ x.name ^ " : sig") + else + Line ("module " ^ x.name ^ " : sig") ) ; Indent (List.concat (List.map e x.elements)) ; Line "end" diff --git a/ocaml/libs/ezxenstore/watch/ez_xenstore_watch.ml b/ocaml/libs/ezxenstore/watch/ez_xenstore_watch.ml index cac3725b633..d65bc43d466 100644 --- a/ocaml/libs/ezxenstore/watch/ez_xenstore_watch.ml +++ b/ocaml/libs/ezxenstore/watch/ez_xenstore_watch.ml @@ -158,8 +158,8 @@ module Make (Debug : DEBUG) = struct IntMap.find domid ( if IntMap.mem domid domains' then domains' - else - !domains + else + !domains ) in let id = Uuidm.to_string (uuid_of_di di) in diff --git a/ocaml/libs/http-lib/http_svr.ml b/ocaml/libs/http-lib/http_svr.ml index 65c54292c70..c824277e5be 100644 --- a/ocaml/libs/http-lib/http_svr.ml +++ b/ocaml/libs/http-lib/http_svr.ml @@ -326,8 +326,8 @@ let escape uri = let aux h t = ( if List.mem_assoc h rules then List.assoc h rules - else - Astring.String.of_char h + else + Astring.String.of_char h ) :: t in @@ -761,8 +761,8 @@ let clean_addr_of_string ip = let ipv4_affix = "::ffff:" in ( if Astring.String.is_prefix ~affix:ipv4_affix ip then Astring.String.drop ~max:(String.length ipv4_affix) ip - else - ip + else + ip ) |> Ipaddr.of_string |> Stdlib.Result.to_option diff --git a/ocaml/libs/stunnel/stunnel.ml b/ocaml/libs/stunnel/stunnel.ml index ae4e341d16c..aaaf3dd7d2a 100644 --- a/ocaml/libs/stunnel/stunnel.ml +++ b/ocaml/libs/stunnel/stunnel.ml @@ -256,8 +256,8 @@ let disconnect_with_pid ?(wait = true) ?(force = false) pid = (fun () -> ( if wait then Forkhelpers.waitpid - else - Forkhelpers.waitpid_nohang + else + Forkhelpers.waitpid_nohang ) fpid ) @@ -267,8 +267,8 @@ let disconnect_with_pid ?(wait = true) ?(force = false) pid = (fun () -> ( if wait then Unix.waitpid [] - else - Unix.waitpid [Unix.WNOHANG] + else + Unix.waitpid [Unix.WNOHANG] ) pid ) diff --git a/ocaml/libs/uuid/uuidx.mli b/ocaml/libs/uuid/uuidx.mli index 17e3e5874f6..57b4058b8ca 100644 --- a/ocaml/libs/uuid/uuidx.mli +++ b/ocaml/libs/uuid/uuidx.mli @@ -48,11 +48,11 @@ val to_string : 'a t -> string (** Marshal a UUID to a string. *) val uuid_of_string : string -> 'a t option - [@@deprecated "Use of_string"] +[@@deprecated "Use of_string"] (** Deprecated alias for {! Uuidx.of_string} *) val string_of_uuid : 'a t -> string - [@@deprecated "Use to_string"] +[@@deprecated "Use to_string"] (** Deprecated alias for {! Uuidx.to_string} *) val of_int_array : int array -> 'a t option @@ -62,11 +62,11 @@ val to_int_array : 'a t -> int array (** Convert a UUID to an array. *) val uuid_of_int_array : int array -> 'a t option - [@@deprecated "Use Uuidx.of_int_array"] +[@@deprecated "Use Uuidx.of_int_array"] (** Deprecated alias for {! Uuidx.of_int_array} *) val int_array_of_uuid : 'a t -> int array - [@@deprecated "Use Uuidx.to_int_array"] +[@@deprecated "Use Uuidx.to_int_array"] (** Deprecated alias for {! Uuidx.to_int_array} *) val of_bytes : string -> 'a t option diff --git a/ocaml/libs/vhd/vhd_format/f.ml b/ocaml/libs/vhd/vhd_format/f.ml index 00d31ae66eb..ac9d945eba4 100644 --- a/ocaml/libs/vhd/vhd_format/f.ml +++ b/ocaml/libs/vhd/vhd_format/f.ml @@ -366,7 +366,8 @@ module UTF16 = struct ) else (c, ofs + 2, n + 1) in - string.(n) <- code ; inner ofs' n' + string.(n) <- code ; + inner ofs' n' in try Rresult.R.ok (inner pos 0) with e -> Rresult.R.error e end @@ -518,8 +519,8 @@ module Footer = struct magic magic' ) ) - else - R.ok () + else + R.ok () ) >>= fun () -> let features = Feature.of_int32 (get_footer_features buf) in @@ -531,8 +532,8 @@ module Footer = struct expected_version format_version ) ) - else - R.ok () + else + R.ok () ) >>= fun () -> let data_offset = get_footer_data_offset buf in @@ -570,8 +571,8 @@ module Footer = struct expected_checksum checksum ) ) - else - R.ok () + else + R.ok () ) >>= fun () -> R.ok @@ -1019,8 +1020,8 @@ module Header = struct ( if magic' <> magic then R.error (Failure (Printf.sprintf "Expected cookie %s, got %s" magic magic')) - else - R.ok () + else + R.ok () ) >>= fun () -> let data_offset = get_header_data_offset buf in @@ -1031,8 +1032,8 @@ module Header = struct expected_data_offset data_offset ) ) - else - R.ok () + else + R.ok () ) >>= fun () -> let table_offset = get_header_table_offset buf in @@ -1044,21 +1045,21 @@ module Header = struct expected_version header_version ) ) - else - R.ok () + else + R.ok () ) >>= fun () -> let max_table_entries = get_header_max_table_entries buf in ( if Int64.of_int32 max_table_entries > Int64.of_int Sys.max_array_length - then + then R.error (Failure (Printf.sprintf "expected max_table_entries < %d, got %ld" Sys.max_array_length max_table_entries ) ) - else - R.ok (Int32.to_int max_table_entries) + else + R.ok (Int32.to_int max_table_entries) ) >>= fun max_table_entries -> let block_size = get_header_block_size buf in @@ -1116,8 +1117,8 @@ module Header = struct expected_checksum checksum ) ) - else - R.ok () + else + R.ok () ) >>= fun () -> R.ok @@ -1284,8 +1285,8 @@ module Batmap_header = struct ( if magic' <> magic then R.error (Failure (Printf.sprintf "Expected cookie %s, got %s" magic magic')) - else - R.ok () + else + R.ok () ) >>= fun () -> let offset = get_header_offset buf in @@ -1293,17 +1294,17 @@ module Batmap_header = struct let major_version = get_header_major_version buf in let minor_version = get_header_minor_version buf in ( if - major_version <> current_major_version - || minor_version <> current_minor_version - then + major_version <> current_major_version + || minor_version <> current_minor_version + then R.error (Failure (Printf.sprintf "Unexpected BATmap version: %d.%d" major_version minor_version ) ) - else - R.ok () + else + R.ok () ) >>= fun () -> let checksum = get_header_checksum buf in @@ -1357,8 +1358,8 @@ module Batmap = struct bh.Batmap_header.checksum checksum ) ) - else - R.ok () + else + R.ok () ) >>= fun () -> R.ok needed end @@ -2003,10 +2004,10 @@ functor let l_rounded = roundup_sector l in ( if l_rounded = 0 then return (Cstruct.create 0) - else - let platform_data = Memory.alloc l_rounded in - really_read fd t.platform_data_offset platform_data >>= fun () -> - return platform_data + else + let platform_data = Memory.alloc l_rounded in + really_read fd t.platform_data_offset platform_data >>= fun () -> + return platform_data ) >>= fun platform_data -> let platform_data = Cstruct.sub platform_data 0 l in @@ -2337,8 +2338,8 @@ functor (* We avoided rewriting the footer for speed, this is where it is repaired. *) ( if t.Vhd.rw then write_metadata t >>= fun _ -> return () - else - return () + else + return () ) >>= fun () -> let rec close t = diff --git a/ocaml/libs/vhd/vhd_format_lwt/iO.ml b/ocaml/libs/vhd/vhd_format_lwt/iO.ml index 875fb0c1b31..0940e6c56c3 100644 --- a/ocaml/libs/vhd/vhd_format_lwt/iO.ml +++ b/ocaml/libs/vhd/vhd_format_lwt/iO.ml @@ -34,8 +34,8 @@ let complete name offset op fd buffer = (match offset with Some x -> Int64.to_string x | None -> "None") ( if Cstruct.length buffer > 16 then String.escaped (Cstruct.to_string (Cstruct.sub buffer 0 13)) ^ "..." - else - String.escaped (Cstruct.to_string buffer) + else + String.escaped (Cstruct.to_string buffer) ) (Cstruct.length buffer) ; if n = 0 && len <> 0 then diff --git a/ocaml/libs/vhd/vhd_format_lwt_test/patterns_lwt.ml b/ocaml/libs/vhd/vhd_format_lwt_test/patterns_lwt.ml index ea829fa4c97..914bcfb2233 100644 --- a/ocaml/libs/vhd/vhd_format_lwt_test/patterns_lwt.ml +++ b/ocaml/libs/vhd/vhd_format_lwt_test/patterns_lwt.ml @@ -132,10 +132,10 @@ let check_raw_stream_contents t expected = ( if not (List.mem_assoc sector expected) then assert_equal ~printer:cstruct_to_string ~cmp:F.cstruct_equal empty_sector actual - else - let expected = List.assoc sector expected in - assert_equal ~printer:cstruct_to_string ~cmp:F.cstruct_equal - expected actual + else + let expected = List.assoc sector expected in + assert_equal ~printer:cstruct_to_string ~cmp:F.cstruct_equal + expected actual ) ; check (i + 1) in @@ -188,8 +188,8 @@ let verify t contents = t.Vhd.footer.Footer.current_size ) ) - else - return () + else + return () ) >>= fun () -> check_written_sectors t contents >>= fun () -> diff --git a/ocaml/message-switch/cli/main.ml b/ocaml/message-switch/cli/main.ml index ed314c30223..197061a17ea 100644 --- a/ocaml/message-switch/cli/main.ml +++ b/ocaml/message-switch/cli/main.ml @@ -212,37 +212,41 @@ let diagnostics common_opts = Printf.printf "Switch started %s\n" (time in_the_past d.Diagnostics.start_time) ; ( if d.Diagnostics.permanent_queues = [] then print_endline "There are no known services (yet)." - else - let not_started = - List.filter - (fun q -> classify q = `Not_started) - d.Diagnostics.permanent_queues - in - let crashed = - List.filter - (fun q -> - match classify q with `Crashed_or_deadlocked _ -> true | _ -> false - ) - d.Diagnostics.permanent_queues - in - let ok = - List.filter (fun q -> classify q = `Ok) d.Diagnostics.permanent_queues - in - if ok = [] then - print_endline "No known services are running." - else ( - print_endline "\nThe following services are running:" ; - List.iter queue ok - ) ; - if not_started <> [] then ( - print_endline - "\nThe following services have been called but have never started:" ; - List.iter queue not_started - ) ; - if crashed <> [] then ( - print_endline "\nThe following services have crashed or deadlocked:" ; - List.iter queue crashed - ) + else + let not_started = + List.filter + (fun q -> classify q = `Not_started) + d.Diagnostics.permanent_queues + in + let crashed = + List.filter + (fun q -> + match classify q with + | `Crashed_or_deadlocked _ -> + true + | _ -> + false + ) + d.Diagnostics.permanent_queues + in + let ok = + List.filter (fun q -> classify q = `Ok) d.Diagnostics.permanent_queues + in + if ok = [] then + print_endline "No known services are running." + else ( + print_endline "\nThe following services are running:" ; + List.iter queue ok + ) ; + if not_started <> [] then ( + print_endline + "\nThe following services have been called but have never started:" ; + List.iter queue not_started + ) ; + if crashed <> [] then ( + print_endline "\nThe following services have crashed or deadlocked:" ; + List.iter queue crashed + ) ) ; (* We don't show expected empty transient queues *) let expected = diff --git a/ocaml/message-switch/switch/logging.ml b/ocaml/message-switch/switch/logging.ml index 19aabf72ad6..37101ac88fe 100644 --- a/ocaml/message-switch/switch/logging.ml +++ b/ocaml/message-switch/switch/logging.ml @@ -51,8 +51,8 @@ let get (logger : logger) = return ( if dropped <> 0 then Printf.sprintf "<-- dropped %d log lines" dropped :: all - else - all + else + all ) in (* Grab as many elements as we can without blocking *) diff --git a/ocaml/message-switch/switch/switch_main.ml b/ocaml/message-switch/switch/switch_main.ml index 9ea08e0b745..9bf78973a85 100644 --- a/ocaml/message-switch/switch/switch_main.ml +++ b/ocaml/message-switch/switch/switch_main.ml @@ -142,9 +142,9 @@ let make_server config trace_config = let redo_log_path = Filename.concat statedir _redo_log in let dump_path = Filename.concat statedir _dump_file in ( if - (not (Sys.file_exists redo_log_path)) - || not (Sys.file_exists dump_path) - then ( + (not (Sys.file_exists redo_log_path)) + || not (Sys.file_exists dump_path) + then ( info "Writing an empty set of queues to %s" dump_path ; save statedir Q.empty >>= fun () -> info "Writing an empty redo-log to %s" redo_log_path ; diff --git a/ocaml/networkd/bin/network_server.ml b/ocaml/networkd/bin/network_server.ml index e45fe5de37e..2aa2ac94fc6 100644 --- a/ocaml/networkd/bin/network_server.ml +++ b/ocaml/networkd/bin/network_server.ml @@ -14,7 +14,6 @@ open Network_utils open Network_interface - module S = Network_interface.Interface_API (Idl.Exn.GenServer ()) module D = Debug.Make (struct let name = "network_server" end) diff --git a/ocaml/networkd/bin/networkd.ml b/ocaml/networkd/bin/networkd.ml index 53933cc95db..e36113580db 100644 --- a/ocaml/networkd/bin/networkd.ml +++ b/ocaml/networkd/bin/networkd.ml @@ -122,8 +122,7 @@ let options = ; ( "json-rpc-read-timeout" , Arg.Int (fun x -> - Jsonrpc_client.json_rpc_read_timeout := - Int64.(mul 1000000L (of_int x)) + Jsonrpc_client.json_rpc_read_timeout := Int64.(mul 1000000L (of_int x)) ) , (fun () -> Int64.(to_string (div !Jsonrpc_client.json_rpc_read_timeout 1000000L)) diff --git a/ocaml/networkd/lib/network_utils.ml b/ocaml/networkd/lib/network_utils.ml index e9a5a3149db..9fe4be9944d 100644 --- a/ocaml/networkd/lib/network_utils.ml +++ b/ocaml/networkd/lib/network_utils.ml @@ -1702,15 +1702,15 @@ module Ovs = struct :: ( if halgo = "src_mac" then ["bond_mode=balance-slb"] - else if halgo = "tcpudp_ports" then - ["bond_mode=balance-tcp"] - else ( - debug - "bond %s has invalid bond-hashing-algorithm '%s'; defaulting to \ - balance-tcp" - name halgo ; - ["bond_mode=balance-tcp"] - ) + else if halgo = "tcpudp_ports" then + ["bond_mode=balance-tcp"] + else ( + debug + "bond %s has invalid bond-hashing-algorithm '%s'; defaulting \ + to balance-tcp" + name halgo ; + ["bond_mode=balance-tcp"] + ) ) else ["lacp=off"; "bond_mode=" ^ mode] @@ -2054,8 +2054,8 @@ module Modprobe = struct |> Array.to_list |> String.concat "," ) - else - Result.Error (Other, "Fail to generate options for maxvfs for " ^ driver) + else + Result.Error (Other, "Fail to generate options for maxvfs for " ^ driver) ) >>= fun option -> let need_rebuild_initrd = ref false in diff --git a/ocaml/networkd/test/network_test_lacp_properties.ml b/ocaml/networkd/test/network_test_lacp_properties.ml index eacfcc732d5..c1bb8f64612 100644 --- a/ocaml/networkd/test/network_test_lacp_properties.ml +++ b/ocaml/networkd/test/network_test_lacp_properties.ml @@ -101,7 +101,7 @@ let test_lacp_defaults_bond_create () = Alcotest.( check bool "key=value argument pairs can't have missing values" true (let open Astring.String in - arg |> trim |> is_suffix ~affix:"=" |> not + arg |> trim |> is_suffix ~affix:"=" |> not ) ) ) diff --git a/ocaml/perftest/createVM.ml b/ocaml/perftest/createVM.ml index 55aaef2e2f1..e3496223488 100644 --- a/ocaml/perftest/createVM.ml +++ b/ocaml/perftest/createVM.ml @@ -119,8 +119,8 @@ let make ~rpc ~session_id ~pool:_ ~vm ~networks ~storages = Printf.sprintf "VM %d%s%s" j ( if Array.length storages > 1 then Printf.sprintf " in SR %d" i - else - "" + else + "" ) (if vm.tag <> "" then " - " ^ vm.tag else "") in diff --git a/ocaml/perftest/histogram.ml b/ocaml/perftest/histogram.ml index 748eaef990f..19afe0db278 100644 --- a/ocaml/perftest/histogram.ml +++ b/ocaml/perftest/histogram.ml @@ -209,8 +209,8 @@ let _ = ; normal_probability_y_axis= ( if !normal then Some (!min_percentile /. 100., !max_percentile /. 100.) - else - None + else + None ) } in diff --git a/ocaml/perftest/tests.ml b/ocaml/perftest/tests.ml index dfc7e1c1d3c..5262d4be0ec 100644 --- a/ocaml/perftest/tests.ml +++ b/ocaml/perftest/tests.ml @@ -117,15 +117,15 @@ let parallel_with_vms async_op opname n vms rpc session_id test subtest_name = "Ignoring completed task which doesn't correspond to a \ VM %s" opname - else - let uuid = Hashtbl.find tasks_to_vm task in - let started = Hashtbl.find vm_to_start_time uuid in - let time_taken = Unix.gettimeofday () -. started in - results := time_taken :: !results ; - debug "%sing VM uuid '%s'" opname uuid ; - debug "Elapsed time: %f" time_taken ; - Hashtbl.remove vm_to_start_time uuid ; - Hashtbl.remove tasks_to_vm task + else + let uuid = Hashtbl.find tasks_to_vm task in + let started = Hashtbl.find vm_to_start_time uuid in + let time_taken = Unix.gettimeofday () -. started in + results := time_taken :: !results ; + debug "%sing VM uuid '%s'" opname uuid ; + debug "Elapsed time: %f" time_taken ; + Hashtbl.remove vm_to_start_time uuid ; + Hashtbl.remove tasks_to_vm task ) ; active_tasks := List.filter (fun x -> x <> task) !active_tasks ; Condition.signal c ; diff --git a/ocaml/quicktest/quicktest_vdi.ml b/ocaml/quicktest/quicktest_vdi.ml index 8acb4eb7ab5..a648495eced 100644 --- a/ocaml/quicktest/quicktest_vdi.ml +++ b/ocaml/quicktest/quicktest_vdi.ml @@ -417,8 +417,7 @@ let tests () = ) ; [("test_vdi_snapshot", `Slow, test_vdi_snapshot)] |> conn - |> sr - SR.(all |> has_capabilities Sr_capabilities.[vdi_snapshot; vdi_update]) + |> sr SR.(all |> has_capabilities Sr_capabilities.[vdi_snapshot; vdi_update]) ; [("test_vdi_clone", `Slow, test_vdi_clone)] |> conn |> sr @@ -429,8 +428,7 @@ let tests () = ) ; [("vdi_snapshot_in_pool", `Slow, vdi_snapshot_in_pool)] |> conn - |> sr - SR.(all |> has_capabilities Sr_capabilities.[vdi_snapshot; vdi_update]) + |> sr SR.(all |> has_capabilities Sr_capabilities.[vdi_snapshot; vdi_update]) ; [ ( "vdi_create_destroy_plug_checksize" , `Slow diff --git a/ocaml/quicktest/quicktest_vdi_ops_data_integrity.ml b/ocaml/quicktest/quicktest_vdi_ops_data_integrity.ml index 1d5cdab14c8..5b385d9b34e 100644 --- a/ocaml/quicktest/quicktest_vdi_ops_data_integrity.ml +++ b/ocaml/quicktest/quicktest_vdi_ops_data_integrity.ml @@ -159,9 +159,7 @@ let large_data_integrity_tests vdi_op op_name = ] let sr_with_vdi_create_destroy = - Qt_filter.SR.( - all |> allowed_operations [`vdi_create; `vdi_destroy] |> not_iso - ) + Qt_filter.SR.(all |> allowed_operations [`vdi_create; `vdi_destroy] |> not_iso) let supported_srs test_case = let open Qt_filter in diff --git a/ocaml/sdk-gen/c/gen_c_binding.ml b/ocaml/sdk-gen/c/gen_c_binding.ml index 9a920721379..0c84af4ac93 100644 --- a/ocaml/sdk-gen/c/gen_c_binding.ml +++ b/ocaml/sdk-gen/c/gen_c_binding.ml @@ -1110,8 +1110,8 @@ and write_impl {name= classname; contents; messages; _} out_chan = String.concat "\n" (( if is_event then [] - else - [sprintf "XEN_FREE(%s)" tn; sprintf "XEN_SET_ALLOC_FREE(%s)" tn] + else + [sprintf "XEN_FREE(%s)" tn; sprintf "XEN_SET_ALLOC_FREE(%s)" tn] ) @ [ sprintf "XEN_ALLOC(%s)" record_tn diff --git a/ocaml/sdk-gen/csharp/gen_csharp_binding.ml b/ocaml/sdk-gen/csharp/gen_csharp_binding.ml index b432c153fac..2d7f254fad9 100644 --- a/ocaml/sdk-gen/csharp/gen_csharp_binding.ml +++ b/ocaml/sdk-gen/csharp/gen_csharp_binding.ml @@ -1349,14 +1349,14 @@ and get_default_value_per_type ty thing = sprintf " = new %s() {%s}" (exposed_type ty) ( if thing = [] then "" - else - String.concat ", " - (List.map - (fun x -> - sprintf "new XenRef<%s>(%s)" (exposed_class_name name) x - ) - thing - ) + else + String.concat ", " + (List.map + (fun x -> + sprintf "new XenRef<%s>(%s)" (exposed_class_name name) x + ) + thing + ) ) | Set _ -> sprintf " = new %s() {%s}" (exposed_type ty) (String.concat ", " thing) diff --git a/ocaml/sdk-gen/java/main.ml b/ocaml/sdk-gen/java/main.ml index 1c8a77af57c..8efaafed4f3 100644 --- a/ocaml/sdk-gen/java/main.ml +++ b/ocaml/sdk-gen/java/main.ml @@ -306,15 +306,15 @@ let gen_method file cls message params async_version = ( if async_version then fprintf file " * @return Task\n" - else - match message.msg_result with - | None -> - () - | Some (_, "") -> - fprintf file " * @return %s\n" - (get_java_type_or_void message.msg_result) - | Some (_, desc) -> - fprintf file " * @return %s\n" desc + else + match message.msg_result with + | None -> + () + | Some (_, "") -> + fprintf file " * @return %s\n" + (get_java_type_or_void message.msg_result) + | Some (_, desc) -> + fprintf file " * @return %s\n" desc ) ; List.iter diff --git a/ocaml/sdk-gen/powershell/gen_powershell_binding.ml b/ocaml/sdk-gen/powershell/gen_powershell_binding.ml index da89c34d043..2701e190767 100644 --- a/ocaml/sdk-gen/powershell/gen_powershell_binding.ml +++ b/ocaml/sdk-gen/powershell/gen_powershell_binding.ml @@ -184,8 +184,8 @@ and gen_arg_param = function "\n [Parameter%s]\n public string %s { get; set; }\n" ( if String.lowercase_ascii x = "uuid" then "(ValueFromPipelineByPropertyName = true)" - else - "" + else + "" ) (pascal_case_ x) | Int64_query_arg x -> @@ -425,8 +425,8 @@ and print_methods_class classname has_uuid has_name = \ results.Add(record.Value);\n\ \ }\n\ \ }" - else - "" + else + "" ) ( if has_uuid then sprintf @@ -440,8 +440,8 @@ and print_methods_class classname has_uuid has_name = \ break;\n\ \ }\n\ \ }" - else - "" + else + "" ) (*********************************) @@ -478,8 +478,8 @@ and print_header_constructor message classname = (qualified_class_name classname) ( if message.msg_async then "\n [OutputType(typeof(XenAPI.Task))]" - else - "" + else + "" ) (ocaml_class_to_csharp_class classname) @@ -498,8 +498,8 @@ and print_params_constructor message obj classname = (qualified_class_name classname) ( if is_real_constructor message then gen_fields (DU.fields_of_obj obj) - else - gen_constructor_params message.msg_params + else + gen_constructor_params message.msg_params ) ( if message.msg_async then "\n\ @@ -507,8 +507,8 @@ and print_params_constructor message obj classname = \ {\n\ \ get { return true; }\n\ \ }\n" - else - "" + else + "" ) and gen_constructor_params params = @@ -562,8 +562,8 @@ and print_methods_constructor message obj classname = }\n" ( if is_real_constructor message then gen_make_record obj classname - else - gen_make_fields message obj + else + gen_make_fields message obj ) (gen_shouldprocess "New" message classname) (gen_csharp_api_call message classname "New" "passthru") @@ -786,8 +786,8 @@ and gen_destructor obj classname messages = (qualified_class_name classname) ( if List.length asyncMessages > 0 then "\n [OutputType(typeof(XenAPI.Task))]" - else - "" + else + "" ) (ocaml_class_to_csharp_class classname) (print_xenobject_params obj classname true true true) @@ -798,8 +798,8 @@ and gen_destructor obj classname messages = \ {\n\ \ get { return true; }\n\ \ }\n" - else - "" + else + "" ) (ocaml_class_to_csharp_local_var classname) (ocaml_class_to_csharp_property classname) @@ -867,8 +867,8 @@ and gen_remover obj classname messages = (qualified_class_name classname) ( if List.length asyncMessages > 0 then "\n [OutputType(typeof(XenAPI.Task))]" - else - "" + else + "" ) (ocaml_class_to_csharp_class classname) (print_xenobject_params obj classname true true true) @@ -932,8 +932,8 @@ and gen_setter obj classname messages = (qualified_class_name classname) ( if List.length asyncMessages > 0 then "\n [OutputType(typeof(XenAPI.Task))]" - else - "" + else + "" ) (ocaml_class_to_csharp_class classname) (print_xenobject_params obj classname true true true) @@ -997,8 +997,8 @@ and gen_adder obj classname messages = (qualified_class_name classname) ( if List.length asyncMessages > 0 then "\n [OutputType(typeof(XenAPI.Task))]" - else - "" + else + "" ) (ocaml_class_to_csharp_class classname) (print_xenobject_params obj classname true true true) @@ -1291,8 +1291,8 @@ and print_dynamic_params classname enum commonVerb messagesWithParams = "\n\ \ [Parameter]\n\ \ public SwitchParameter Async { get; set; }\n" - else - "" + else + "" ) (print_dynamic_param_members classname hd.msg_params commonVerb) (print_dynamic_params classname enum commonVerb tl) @@ -1398,8 +1398,8 @@ and print_xenobject_params obj classname mandatoryRef includeXenObject %s%s\n" ( if includeXenObject then print_param_xen_object (qualified_class_name classname) publicName - else - "" + else + "" ) (if mandatoryRef then ", Mandatory = true" else "") (qualified_class_name classname) @@ -1570,8 +1570,8 @@ and print_parse_xenobject_private_method obj classname includeUuidAndName = \ }" (qualified_class_name classname) localVar - else - sprintf "" + else + sprintf "" ) ( if has_name obj && includeUuidAndName then sprintf @@ -1592,14 +1592,14 @@ and print_parse_xenobject_private_method obj classname includeUuidAndName = (qualified_class_name classname) localVar (qualified_class_name classname) - else - sprintf "" + else + sprintf "" ) localVar publicProperty ( if has_uuid obj then sprintf ", 'Uuid'" - else - sprintf "" + else + sprintf "" ) publicProperty localVar @@ -1683,12 +1683,12 @@ and gen_csharp_api_call message classname commonVerb switch = sprintf "Xen%sAction%sDynamicParameters" (ocaml_class_to_csharp_class classname) (cut_msg_name (pascal_case message.msg_name) "Invoke") - else if commonVerb = "Get" then - sprintf "Xen%sProperty%sDynamicParameters" - (ocaml_class_to_csharp_class classname) - (cut_msg_name (pascal_case message.msg_name) "Get") - else - "XenServerCmdletDynamicParameters" + else if commonVerb = "Get" then + sprintf "Xen%sProperty%sDynamicParameters" + (ocaml_class_to_csharp_class classname) + (cut_msg_name (pascal_case message.msg_name) "Get") + else + "XenServerCmdletDynamicParameters" ) (gen_csharp_api_call_async message classname commonVerb) passThruTask @@ -1697,9 +1697,9 @@ and gen_csharp_api_call message classname commonVerb switch = else sprintf "%s%s%s" ( if - commonVerb = "Invoke" - && is_message_with_dynamic_params classname message - then + commonVerb = "Invoke" + && is_message_with_dynamic_params classname message + then sprintf "\n\ \ var contxt = _context as \ @@ -1708,19 +1708,19 @@ and gen_csharp_api_call message classname commonVerb switch = \ return;" (ocaml_class_to_csharp_class classname) (cut_msg_name (pascal_case message.msg_name) "Invoke") - else if - commonVerb = "Get" && is_message_with_dynamic_params classname message - then - sprintf - "\n\ - \ var contxt = _context as \ - Xen%sProperty%sDynamicParameters;\n\ - \ if (contxt == null)\n\ - \ return;" - (ocaml_class_to_csharp_class classname) - (cut_msg_name (pascal_case message.msg_name) "Get") - else - "" + else if + commonVerb = "Get" && is_message_with_dynamic_params classname message + then + sprintf + "\n\ + \ var contxt = _context as \ + Xen%sProperty%sDynamicParameters;\n\ + \ if (contxt == null)\n\ + \ return;" + (ocaml_class_to_csharp_class classname) + (cut_msg_name (pascal_case message.msg_name) "Get") + else + "" ) (gen_csharp_api_call_sync message classname commonVerb) passThruResult diff --git a/ocaml/squeezed/lib/squeeze.ml b/ocaml/squeezed/lib/squeeze.ml index 770147dbb53..e41575c1d97 100644 --- a/ocaml/squeezed/lib/squeeze.ml +++ b/ocaml/squeezed/lib/squeeze.ml @@ -348,8 +348,8 @@ module Proportional = struct surplus_memory_kib gamma ( if total_range = 0L then 0L - else - Int64.of_float (Int64.to_float total_range *. (gamma' -. gamma)) + else + Int64.of_float (Int64.to_float total_range *. (gamma' -. gamma)) ) ) ; List.map @@ -473,12 +473,12 @@ module Squeezer = struct host.free_mem_kib host_target_kib ( if success then " OK" - else if target_too_big then - " cannot free enough" - else if cant_allocate_any_more then - " cannot allocate enough" - else - "" + else if target_too_big then + " cannot free enough" + else if cant_allocate_any_more then + " cannot allocate enough" + else + "" ) (if all_targets_reached then "" else " not") (if no_target_changes then "" else "; however about to adjust targets") diff --git a/ocaml/tests/common/test_vgpu_common.ml b/ocaml/tests/common/test_vgpu_common.ml index 15c0da96c91..56dbfad4a4c 100644 --- a/ocaml/tests/common/test_vgpu_common.ml +++ b/ocaml/tests/common/test_vgpu_common.ml @@ -235,10 +235,10 @@ let make_vgpu ~__context ?(vm_ref = Ref.null) ?(gPU_group = Ref.null) Test_common.make_vm ~__context () in ( if - Xapi_vgpu_type.requires_passthrough ~__context ~self:vgpu_type_ref - = Some `PF - && Db.is_valid_ref __context resident_on - then + Xapi_vgpu_type.requires_passthrough ~__context ~self:vgpu_type_ref + = Some `PF + && Db.is_valid_ref __context resident_on + then let pci_ref = Db.PGPU.get_PCI ~__context ~self:resident_on in Db.PCI.add_attached_VMs ~__context ~self:pci_ref ~value:vm_ref ) ; diff --git a/ocaml/tests/test_clustering.ml b/ocaml/tests/test_clustering.ml index 07e67f452d8..05980045a11 100644 --- a/ocaml/tests/test_clustering.ml +++ b/ocaml/tests/test_clustering.ml @@ -310,9 +310,7 @@ let test_assert_cluster_host_is_enabled_for_matching_sms_fails_if_cluster_host_i in Alcotest.check_raises "test_assert_cluster_host_is_enabled_for_matching_sms_fails_if_cluster_host_is_disabled" - Api_errors.( - Server_error (clustering_disabled, [Ref.string_of cluster_host]) - ) + Api_errors.(Server_error (clustering_disabled, [Ref.string_of cluster_host])) (fun () -> Xapi_clustering.assert_cluster_host_is_enabled_for_matching_sms ~__context ~host ~sr_sm_type:"gfs2" @@ -468,9 +466,7 @@ let test_assert_pif_prerequisites () = Alcotest.check_raises "test_assert_pif_prerequisites : disallow_unplug set, IP and \ currently_attached to go " - Api_errors.( - Server_error (required_pif_is_unplugged, [Ref.string_of pifref]) - ) + Api_errors.(Server_error (required_pif_is_unplugged, [Ref.string_of pifref])) (fun () -> Xapi_clustering.assert_pif_prerequisites pif) ; (* Plug in PIF *) Db.PIF.set_currently_attached ~__context ~self:pifref ~value:true ; diff --git a/ocaml/tests/test_dbsync_master.ml b/ocaml/tests/test_dbsync_master.ml index c66a1de69c6..6cd17d12b8b 100644 --- a/ocaml/tests/test_dbsync_master.ml +++ b/ocaml/tests/test_dbsync_master.ml @@ -21,9 +21,7 @@ module CreateToolsSR = Generic.MakeStateful (struct type output_t = (string * string * (string * string) list) list let string_of_input_t = - Test_printers.( - list (tuple4 string string (assoc_list string string) bool) - ) + Test_printers.(list (tuple4 string string (assoc_list string string) bool)) let string_of_output_t = Test_printers.(list (tuple3 string string (assoc_list string string))) diff --git a/ocaml/tests/test_observer.ml b/ocaml/tests/test_observer.ml index 0dff6f2d340..0ea0031bb48 100644 --- a/ocaml/tests/test_observer.ml +++ b/ocaml/tests/test_observer.ml @@ -223,9 +223,7 @@ let test_endpoints ~__context ~self = (fun invalid_endpoint -> Alcotest.check_raises "Xapi_observer.set_components should fail on invalid component" - Api_errors.( - Server_error (invalid_value, ["endpoint"; invalid_endpoint]) - ) + Api_errors.(Server_error (invalid_value, ["endpoint"; invalid_endpoint])) (fun () -> Xapi_observer.set_endpoints ~__context ~self ~value:[invalid_endpoint] |> ignore diff --git a/ocaml/tests/test_platformdata.ml b/ocaml/tests/test_platformdata.ml index 8af47320199..36611a5cd5a 100644 --- a/ocaml/tests/test_platformdata.ml +++ b/ocaml/tests/test_platformdata.ml @@ -172,9 +172,7 @@ module SanityCheck = Generic.MakeStateless (struct Fmt.(Dump.list @@ pair ~sep:(any "=") fmt_fst fmt_snd) let string_of_output_t x = - Fmt.( - str "%a" Dump.(result ~ok:(pp_list_assoc string string) ~error:exn) x - ) + Fmt.(str "%a" Dump.(result ~ok:(pp_list_assoc string string) ~error:exn) x) end let transform diff --git a/ocaml/tests/test_repository_helpers.ml b/ocaml/tests/test_repository_helpers.ml index eeebee23926..197852013e4 100644 --- a/ocaml/tests/test_repository_helpers.ml +++ b/ocaml/tests/test_repository_helpers.ml @@ -3410,9 +3410,7 @@ module GetLatestUpdatesFromRedundancy = Generic.MakeStateless (struct let string_of_output_t = function | Ok pkgs -> - Fmt.( - str "%a" Dump.(list (pair (record @@ fields_of_pkg) string)) pkgs - ) + Fmt.(str "%a" Dump.(list (pair (record @@ fields_of_pkg) string)) pkgs) | Error e -> Fmt.(str "%a" exn) e end diff --git a/ocaml/tests/test_rpm.ml b/ocaml/tests/test_rpm.ml index d5cdcc61ba4..da47d9a0ce8 100644 --- a/ocaml/tests/test_rpm.ml +++ b/ocaml/tests/test_rpm.ml @@ -39,8 +39,7 @@ module PkgOfFullnameTest = Generic.MakeStateless (struct let string_of_output_t = Fmt.( - str "%a" - Dump.(result ~ok:(option @@ record @@ fields_of_pkg) ~error:exn) + str "%a" Dump.(result ~ok:(option @@ record @@ fields_of_pkg) ~error:exn) ) end diff --git a/ocaml/tests/test_vdi_cbt.ml b/ocaml/tests/test_vdi_cbt.ml index 8e89179e423..566fa18fbf5 100644 --- a/ocaml/tests/test_vdi_cbt.ml +++ b/ocaml/tests/test_vdi_cbt.ml @@ -61,7 +61,7 @@ let make_smapiv2_storage_server ?vdi_enable_cbt ?vdi_disable_cbt let clone = default Storage_skeleton.VDI.clone vdi_snapshot end end : Storage_interface.Server_impl - ) +) let register_smapiv2_server ?vdi_enable_cbt ?vdi_disable_cbt ?vdi_list_changed_blocks ?vdi_data_destroy ?vdi_snapshot ?vdi_clone sr_ref = diff --git a/ocaml/vhd-tool/src/impl.ml b/ocaml/vhd-tool/src/impl.ml index 7eb7b337ca7..6e699650cfc 100644 --- a/ocaml/vhd-tool/src/impl.ml +++ b/ocaml/vhd-tool/src/impl.ml @@ -477,8 +477,8 @@ let stream_tar _common c s _ prefix ?(progress = no_progress_bar) () = return {state with ctx; header= None} | None -> return state - else - return state + else + return state ) >>= fun state -> (* If we have unwritten data then output the next header *) @@ -1015,8 +1015,8 @@ let write_stream common s destination destination_protocol prezeroed progress let open Cohttp in ( if use_ssl then Channels.of_ssl_fd sock good_ciphersuites verify_cert - else - Channels.of_raw_fd sock + else + Channels.of_raw_fd sock ) >>= fun c -> let module Request = Request.Make (Cohttp_unbuffered_io) in @@ -1276,8 +1276,8 @@ let serve_raw_to_raw common size c dest _ progress _ _ = let block = Cstruct.sub buffer 0 rounded_n in ( if n <> rounded_n then Vhd_format_lwt.IO.really_read dest offset block - else - Lwt.return () + else + Lwt.return () ) >>= fun () -> (* Create a cstruct that's an alias to the above block, @@ -1369,8 +1369,8 @@ let serve common_options source source_fd source_format source_protocol ( if not (Sys.file_exists path) then Lwt_unix.openfile path [Unix.O_CREAT; Unix.O_RDONLY] 0o0644 >>= fun fd -> Lwt_unix.close fd - else - return () + else + return () ) >>= fun () -> Vhd_format_lwt.IO.openfile path true >>= fun fd -> diff --git a/ocaml/vhd-tool/src/nbd_input.ml b/ocaml/vhd-tool/src/nbd_input.ml index 119cce665f8..0bc88fa4c18 100644 --- a/ocaml/vhd-tool/src/nbd_input.ml +++ b/ocaml/vhd-tool/src/nbd_input.ml @@ -74,8 +74,8 @@ let raw ?(extent_reader = "/opt/xensource/libexec/get_nbd_extents.py") raw finished at incorrect offset %Ld," offset length final_offset ) - else - Lwt.return_unit + else + Lwt.return_unit ) >|= fun () -> ops in @@ -89,8 +89,8 @@ let raw ?(extent_reader = "/opt/xensource/libexec/get_nbd_extents.py") raw "Nbd_input.raw finished with offset=%Ld <> size=%Ld" offset size ) - else - Lwt.return_unit + else + Lwt.return_unit ) >>= fun () -> Lwt.return F.End | [], _ -> diff --git a/ocaml/xapi-cli-server/cli_operations.ml b/ocaml/xapi-cli-server/cli_operations.ml index fe2d86821ef..d90c244ba37 100644 --- a/ocaml/xapi-cli-server/cli_operations.ml +++ b/ocaml/xapi-cli-server/cli_operations.ml @@ -120,8 +120,8 @@ let waiter printer rpc session_id params task = (fun () -> ( if List.mem_assoc "progress" params then wait_with_progress_bar - else - wait + else + wait ) printer rpc session_id task ) @@ -3277,9 +3277,9 @@ let do_vm_op ?(include_control_vms = false) ?(include_template_vms = false) ( if not multiple then "Multiple matches VMs found. Operation can only be performed \ on one VM at a time" - else - "Multiple matches VMs found. --multiple required to complete the \ - operation" + else + "Multiple matches VMs found. --multiple required to complete \ + the operation" ) with Records.CLI_failed_to_find_param name -> failwith @@ -3303,9 +3303,9 @@ let do_host_op rpc session_id op params ?(multiple = true) ignore_params = ( if not multiple then "Multiple matching hosts found. Operation can only be performed \ on one host at a time" - else - "Multiple matching hosts found. --multiple required to complete \ - the operation" + else + "Multiple matching hosts found. --multiple required to complete \ + the operation" ) let do_sr_op rpc session_id op params ?(multiple = true) ignore_params = @@ -3323,9 +3323,9 @@ let do_sr_op rpc session_id op params ?(multiple = true) ignore_params = ( if not multiple then "Multiple matching SRs found. Operation can only be performed on \ one SR at a time" - else - "Multiple matching SRs found. --multiple required to complete the \ - operation" + else + "Multiple matching SRs found. --multiple required to complete \ + the operation" ) (* Execute f; if we get a no_hosts_available error then print a vm diagnostic table and reraise exception *) @@ -4144,8 +4144,8 @@ let vm_uninstall_common fd _printer rpc session_id params vms = Printf.sprintf "VDI: %s (%s) %s" r.API.vDI_uuid r.API.vDI_name_label ( if List.length r.API.vDI_VBDs <= 1 then "" - else - " ** WARNING: disk is shared by other VMs" + else + " ** WARNING: disk is shared by other VMs" ) in let string_of_vm vm = @@ -4413,13 +4413,13 @@ let vm_shutdown printer rpc session_id params = |> waiter printer rpc session_id params ) params ["progress"] - else - do_vm_op printer rpc session_id - (fun vm -> - Client.Async.VM.clean_shutdown ~rpc ~session_id ~vm:(vm.getref ()) - |> waiter printer rpc session_id params - ) - params ["progress"] + else + do_vm_op printer rpc session_id + (fun vm -> + Client.Async.VM.clean_shutdown ~rpc ~session_id ~vm:(vm.getref ()) + |> waiter printer rpc session_id params + ) + params ["progress"] ) let vm_reboot printer rpc session_id params = @@ -4429,10 +4429,10 @@ let vm_reboot printer rpc session_id params = do_vm_op printer rpc session_id (fun vm -> Client.VM.hard_reboot ~rpc ~session_id ~vm:(vm.getref ())) params [] - else - do_vm_op printer rpc session_id - (fun vm -> Client.VM.clean_reboot ~rpc ~session_id ~vm:(vm.getref ())) - params [] + else + do_vm_op printer rpc session_id + (fun vm -> Client.VM.clean_reboot ~rpc ~session_id ~vm:(vm.getref ())) + params [] ) let vm_compute_maximum_memory printer rpc session_id params = @@ -4897,8 +4897,8 @@ let vm_disk_list_aux vm is_cd_list printer rpc session_id params = select_fields params' vbdrecords ( if is_cd_list then ["uuid"; "vm-name-label"; "userdevice"; "empty"] - else - ["uuid"; "vm-name-label"; "userdevice"] + else + ["uuid"; "vm-name-label"; "userdevice"] ) in let params' = @@ -5636,8 +5636,8 @@ let vm_import fd _printer rpc session_id params = prefix ( if vm_metadata_only then Constants.import_metadata_uri - else - Constants.import_uri + else + Constants.import_uri ) (Ref.string_of session_id) (Ref.string_of task_id) full_restore force dry_run @@ -5896,8 +5896,8 @@ let export_common fd _printer rpc session_id params filename num ?task_uuid "%s?session_id=%s&task_id=%s&ref=%s&%s=%s&preserve_power_state=%b&export_snapshots=%b" ( if vm_metadata_only then Constants.export_metadata_uri - else - Constants.export_uri + else + Constants.export_uri ) (Ref.string_of session_id) (Ref.string_of exporttask) (Ref.string_of (vm.getref ())) @@ -7272,8 +7272,8 @@ let audit_log_get fd _printer rpc session_id params = (if since = "" then " " else Printf.sprintf " (since \"%s\") " since) ( if String.length filename <= 255 then filename (* make sure filename has a reasonable length in the logs *) - else - String.sub filename 0 255 + else + String.sub filename 0 255 ) in let query = diff --git a/ocaml/xapi-cli-server/cli_util.ml b/ocaml/xapi-cli-server/cli_util.ml index ddb077fabb6..86e3401b57a 100644 --- a/ocaml/xapi-cli-server/cli_util.ml +++ b/ocaml/xapi-cli-server/cli_util.ml @@ -154,8 +154,8 @@ let track_http_operation ?use_existing_task ?(progress_bar = false) fd rpc (* Wait for the task to complete *) ( if progress_bar then wait_for_task_completion_with_progress fd - else - wait_for_task_completion + else + wait_for_task_completion ) rpc session_id task_id ; Thread.join receive_heartbeats ; diff --git a/ocaml/xapi-cli-server/records.ml b/ocaml/xapi-cli-server/records.ml index c3d350b7cf2..591786d05eb 100644 --- a/ocaml/xapi-cli-server/records.ml +++ b/ocaml/xapi-cli-server/records.ml @@ -2979,8 +2979,8 @@ let host_record rpc session_id host = ~value: ( if s = "" then Ref.null - else - Client.SR.get_by_uuid ~rpc ~session_id ~uuid:s + else + Client.SR.get_by_uuid ~rpc ~session_id ~uuid:s ) ) () @@ -2991,8 +2991,8 @@ let host_record rpc session_id host = ~value: ( if s = "" then Ref.null - else - Client.SR.get_by_uuid ~rpc ~session_id ~uuid:s + else + Client.SR.get_by_uuid ~rpc ~session_id ~uuid:s ) ) () diff --git a/ocaml/xapi-idl/cluster/cluster_cli.ml b/ocaml/xapi-idl/cluster/cluster_cli.ml index cf9690ba9fa..1f9380bc081 100644 --- a/ocaml/xapi-idl/cluster/cluster_cli.ml +++ b/ocaml/xapi-idl/cluster/cluster_cli.ml @@ -1,7 +1,6 @@ (* Cluster CLI *) open Cluster_interface - module Cmds = LocalAPI (Cmdlinergen.Gen ()) let doc = diff --git a/ocaml/xapi-idl/guard/privileged/xapiguard_cli.ml b/ocaml/xapi-idl/guard/privileged/xapiguard_cli.ml index bb1ad85f59b..5df31b268b6 100644 --- a/ocaml/xapi-idl/guard/privileged/xapiguard_cli.ml +++ b/ocaml/xapi-idl/guard/privileged/xapiguard_cli.ml @@ -14,7 +14,6 @@ module I = Xapi_idl_guard_privileged.Interface module C = Xapi_idl_guard_privileged.Client - module Cmds = I.RPC_API (Cmdlinergen.Gen ()) let doc = diff --git a/ocaml/xapi-idl/guard/varstored/varstored_cli.ml b/ocaml/xapi-idl/guard/varstored/varstored_cli.ml index c8440187147..7e1e4c6837b 100644 --- a/ocaml/xapi-idl/guard/varstored/varstored_cli.ml +++ b/ocaml/xapi-idl/guard/varstored/varstored_cli.ml @@ -13,7 +13,6 @@ *) module Cmds = Xapi_idl_guard_varstored.Interface.RPC_API (Cmdlinergen.Gen ()) - open! Cmdliner let cli () = diff --git a/ocaml/xapi-idl/memory/memory.ml b/ocaml/xapi-idl/memory/memory.ml index 8b4f50e113e..99951f7e3e8 100644 --- a/ocaml/xapi-idl/memory/memory.ml +++ b/ocaml/xapi-idl/memory/memory.ml @@ -106,9 +106,9 @@ let mib_of_bytes_used value = divide_rounding_up value bytes_per_mib let mib_of_kib_used value = divide_rounding_up value kib_per_mib let mib_of_pages_used value = divide_rounding_up value pages_per_mib - (* === Domain memory breakdown - ======================================================= *) - (* +(* === Domain memory breakdown + ======================================================= *) +(* ╤ ╔══════════╗ ╤ │ ║ shadow ║ │ │ ╠══════════╣ │ @@ -133,7 +133,7 @@ let mib_of_pages_used value = divide_rounding_up value pages_per_mib │ ║ ║ │ ╧ ╚══════════╝ ╧ *) - [@@ocamlformat "wrap-comments=false"] +[@@ocamlformat "wrap-comments=false"] (* === Domain memory breakdown: HVM guests =========================================== *) diff --git a/ocaml/xapi-idl/memory/memory_cli.ml b/ocaml/xapi-idl/memory/memory_cli.ml index 987101e4708..0aa2719ed10 100644 --- a/ocaml/xapi-idl/memory/memory_cli.ml +++ b/ocaml/xapi-idl/memory/memory_cli.ml @@ -1,7 +1,6 @@ (* Memory CLI *) open Memory_interface - module Cmds = API (Cmdlinergen.Gen ()) let doc = diff --git a/ocaml/xapi-idl/network/network_cli.ml b/ocaml/xapi-idl/network/network_cli.ml index 7bf0010928a..4e328c8818d 100644 --- a/ocaml/xapi-idl/network/network_cli.ml +++ b/ocaml/xapi-idl/network/network_cli.ml @@ -1,7 +1,6 @@ (* Network CLI *) open Network_interface - module Cmds = Interface_API (Cmdlinergen.Gen ()) let doc = diff --git a/ocaml/xapi-storage-script/main.ml b/ocaml/xapi-storage-script/main.ml index 4a56577c031..f708bb30dfc 100644 --- a/ocaml/xapi-storage-script/main.ml +++ b/ocaml/xapi-storage-script/main.ml @@ -17,13 +17,9 @@ module B = Backtrace open Core open Async open Xapi_storage_script_types - module Plugin_client = Xapi_storage.Plugin.Plugin (Rpc_async.GenClient ()) - module Volume_client = Xapi_storage.Control.Volume (Rpc_async.GenClient ()) - module Sr_client = Xapi_storage.Control.Sr (Rpc_async.GenClient ()) - module Datapath_client = Xapi_storage.Data.Datapath (Rpc_async.GenClient ()) let ( >>>= ) = Deferred.Result.( >>= ) diff --git a/ocaml/xapi-storage/generator/lib/control.ml b/ocaml/xapi-storage/generator/lib/control.ml index 8e70614da2b..93b2800a766 100644 --- a/ocaml/xapi-storage/generator/lib/control.ml +++ b/ocaml/xapi-storage/generator/lib/control.ml @@ -589,7 +589,6 @@ module Sr (R : RPC) = struct end module V = Volume (Codegen.Gen ()) - module S = Sr (Codegen.Gen ()) let interfaces = diff --git a/ocaml/xapi-storage/generator/lib/data.ml b/ocaml/xapi-storage/generator/lib/data.ml index fb77cc9ce18..142848b4d6d 100644 --- a/ocaml/xapi-storage/generator/lib/data.ml +++ b/ocaml/xapi-storage/generator/lib/data.ml @@ -362,7 +362,6 @@ To mirror a VDI a sequence of these API calls is required: end module DPCode = Datapath (Codegen.Gen ()) - module DCode = Data (Codegen.Gen ()) let interfaces = diff --git a/ocaml/xapi/certificates.ml b/ocaml/xapi/certificates.ml index 7907c302225..6b871e686c5 100644 --- a/ocaml/xapi/certificates.ml +++ b/ocaml/xapi/certificates.ml @@ -237,9 +237,7 @@ end = struct | [] -> D.error "unable to find certificate with name='%s'" name ; raise - Api_errors.( - Server_error (invalid_value, ["certificate:name"; name]) - ) + Api_errors.(Server_error (invalid_value, ["certificate:name"; name])) | xs -> let ref_str = xs |> List.map Ref.short_string_of |> String.concat ", " diff --git a/ocaml/xapi/console.ml b/ocaml/xapi/console.ml index 149cc3a997f..f682289163d 100644 --- a/ocaml/xapi/console.ml +++ b/ocaml/xapi/console.ml @@ -51,9 +51,8 @@ let address_of_console __context console : address option = let id = Xapi_xenops.id_of_vm ~__context ~self:vm in let dbg = Context.string_of_task __context in let open Xapi_xenops_queue in - let module Client = ( val make_client (queue_of_vm ~__context ~self:vm) - : XENOPS - ) + let module Client = + (val make_client (queue_of_vm ~__context ~self:vm) : XENOPS) in let _, s = Client.VM.stat dbg id in let proto = @@ -71,8 +70,8 @@ let address_of_console __context console : address option = Some ( if console.Vm.path = "" then Port console.Vm.port - else - Path console.Vm.path + else + Path console.Vm.path ) with e -> debug "%s" (Printexc.to_string e) ; diff --git a/ocaml/xapi/export.ml b/ocaml/xapi/export.ml index f00edb1a31a..49ccc7b0c57 100644 --- a/ocaml/xapi/export.ml +++ b/ocaml/xapi/export.ml @@ -223,16 +223,16 @@ let make_vm ?(with_snapshot_metadata = false) ~preserve_power_state table ; API.vM_suspend_VDI= ( if preserve_power_state then lookup table (Ref.string_of vm.API.vM_suspend_VDI) - else - Ref.null + else + Ref.null ) ; API.vM_is_a_snapshot= (if with_snapshot_metadata then vm.API.vM_is_a_snapshot else false) ; API.vM_snapshot_of= ( if with_snapshot_metadata then lookup table (Ref.string_of vm.API.vM_snapshot_of) - else - Ref.null + else + Ref.null ) ; API.vM_snapshots= (if with_snapshot_metadata then vm.API.vM_snapshots else []) @@ -241,14 +241,14 @@ let make_vm ?(with_snapshot_metadata = false) ~preserve_power_state table ; API.vM_transportable_snapshot_id= ( if with_snapshot_metadata then vm.API.vM_transportable_snapshot_id - else - "" + else + "" ) ; API.vM_parent= ( if with_snapshot_metadata then lookup table (Ref.string_of vm.API.vM_parent) - else - Ref.null + else + Ref.null ) ; API.vM_current_operations= [] ; API.vM_allowed_operations= [] @@ -398,8 +398,8 @@ let make_vgpu table ~preserve_power_state __context self = API.vGPU_currently_attached= ( if preserve_power_state then vgpu.API.vGPU_currently_attached - else - false + else + false ) ; API.vGPU_GPU_group= lookup table (Ref.string_of vgpu.API.vGPU_GPU_group) ; API.vGPU_type= lookup table (Ref.string_of vgpu.API.vGPU_type) diff --git a/ocaml/xapi/extauth_plugin_ADpbis.ml b/ocaml/xapi/extauth_plugin_ADpbis.ml index 9191cd08f7b..dd14ab6df4c 100644 --- a/ocaml/xapi/extauth_plugin_ADpbis.ml +++ b/ocaml/xapi/extauth_plugin_ADpbis.ml @@ -1039,11 +1039,11 @@ module AuthADlw : Auth_signature.AUTH_MODULE = struct let pbis_failure = try ( if - not - (List.mem_assoc "user" config_params - && List.mem_assoc "pass" config_params - ) - then + not + (List.mem_assoc "user" config_params + && List.mem_assoc "pass" config_params + ) + then (* no windows admin+pass have been provided: leave the pbis host in the AD database *) (* execute the pbis domain-leave cmd *) (* this function will raise an exception if something goes wrong *) @@ -1051,23 +1051,23 @@ module AuthADlw : Auth_signature.AUTH_MODULE = struct pbis_common !Xapi_globs.domain_join_cli_cmd ["leave"] in () - else - (* windows admin+pass have been provided: ask pbis to remove host from AD database *) - let _user = List.assoc "user" config_params in - let pass = List.assoc "pass" config_params in - (* we need to make sure that the user passed to domaijoin-cli command is in the UPN syntax (user@domain.com) *) - let user = - convert_nt_to_upn_username - (get_full_subject_name ~use_nt_format:false _user) - in - (* execute the pbis domain-leave cmd *) - (* this function will raise an exception if something goes wrong *) - let (_ : (string * string) list) = - pbis_common_with_password pass - !Xapi_globs.domain_join_cli_cmd - ["leave"; user] - in - () + else + (* windows admin+pass have been provided: ask pbis to remove host from AD database *) + let _user = List.assoc "user" config_params in + let pass = List.assoc "pass" config_params in + (* we need to make sure that the user passed to domaijoin-cli command is in the UPN syntax (user@domain.com) *) + let user = + convert_nt_to_upn_username + (get_full_subject_name ~use_nt_format:false _user) + in + (* execute the pbis domain-leave cmd *) + (* this function will raise an exception if something goes wrong *) + let (_ : (string * string) list) = + pbis_common_with_password pass + !Xapi_globs.domain_join_cli_cmd + ["leave"; user] + in + () ) ; None (* no failure observed in pbis *) with e -> diff --git a/ocaml/xapi/import.ml b/ocaml/xapi/import.ml index cf1996e598e..5cd275d57d5 100644 --- a/ocaml/xapi/import.ml +++ b/ocaml/xapi/import.ml @@ -1020,8 +1020,8 @@ module VDI : HandlerTools = struct vdi_record.API.vDI_location ( if config.force then "ignoring error because '--force' is set" - else - "treating as fatal and abandoning import" + else + "treating as fatal and abandoning import" ) ; if config.force then Skip @@ -1326,9 +1326,9 @@ module VBD : HandlerTools = struct (false, false) in ( if - vbd_record.API.vBD_currently_attached - && not (exists vbd_record.API.vBD_VDI state.table) - then + vbd_record.API.vBD_currently_attached + && not (exists vbd_record.API.vBD_VDI state.table) + then (* It's only ok if it's a CDROM attached to an HVM guest, or it's part of SXM and we know the sender would eject it. *) let will_eject = dry_run && live && original_vm.API.vM_power_state <> `Suspended @@ -1943,8 +1943,9 @@ let update_snapshot_and_parent_links ~__context state = let aux (cls, _, ref) = let ref = Ref.of_string ref in ( if - cls = Datamodel_common._vm && Db.VM.get_is_a_snapshot ~__context ~self:ref - then + cls = Datamodel_common._vm + && Db.VM.get_is_a_snapshot ~__context ~self:ref + then let snapshot_of = Db.VM.get_snapshot_of ~__context ~self:ref in if snapshot_of <> Ref.null then ( debug "lookup for snapshot_of = '%s'" (Ref.string_of snapshot_of) ; diff --git a/ocaml/xapi/importexport.ml b/ocaml/xapi/importexport.ml index b4cb2466ef3..a7354fce45e 100644 --- a/ocaml/xapi/importexport.ml +++ b/ocaml/xapi/importexport.ml @@ -412,8 +412,8 @@ let base_vdi_of_req ~__context (req : Http.Request.t) = Some ( if Db.is_valid_ref __context (Ref.of_string base) then Ref.of_string base - else - Db.VDI.get_by_uuid ~__context ~uuid:base + else + Db.VDI.get_by_uuid ~__context ~uuid:base ) else None diff --git a/ocaml/xapi/memory_check.ml b/ocaml/xapi/memory_check.ml index 16a541e1779..51bc945904a 100644 --- a/ocaml/xapi/memory_check.ml +++ b/ocaml/xapi/memory_check.ml @@ -222,8 +222,8 @@ let host_compute_free_memory_with_maximum_compression ?(dump_stats = false) (Db.VM.get_uuid ~__context ~self:v) ( if List.mem v summary.resident then "resident here" - else - "scheduled to be resident here" + else + "scheduled to be resident here" ) reqd (mib reqd) ) diff --git a/ocaml/xapi/message_forwarding.ml b/ocaml/xapi/message_forwarding.ml index 4d08bb5933a..bcf427fdfdd 100644 --- a/ocaml/xapi/message_forwarding.ml +++ b/ocaml/xapi/message_forwarding.ml @@ -2236,7 +2236,7 @@ functor the suspend VDI: we want to minimise the probability that the operation fails part-way through. *) ( if Db.VM.get_power_state ~__context ~self:snapshot = `Suspended - then + then let suspend_VDI = Db.VM.get_suspend_VDI ~__context ~self:snapshot in diff --git a/ocaml/xapi/repository_helpers.ml b/ocaml/xapi/repository_helpers.ml index 2fe83bd20b3..7846ff4777e 100644 --- a/ocaml/xapi/repository_helpers.ml +++ b/ocaml/xapi/repository_helpers.ml @@ -212,8 +212,7 @@ let assert_url_is_valid ~url = ) ) | _, None -> - raise - Api_errors.(Server_error (internal_error, ["invalid host in url"])) + raise Api_errors.(Server_error (internal_error, ["invalid host in url"])) | _ -> raise Api_errors.(Server_error (internal_error, ["invalid scheme in url"])) diff --git a/ocaml/xapi/storage_access.ml b/ocaml/xapi/storage_access.ml index da8c07d4646..292c96b4f52 100644 --- a/ocaml/xapi/storage_access.ml +++ b/ocaml/xapi/storage_access.ml @@ -726,8 +726,8 @@ let refresh_local_vdi_activations ~__context = info "Unlocking VDI %s (because %s)" (Ref.string_of vdi_ref) ( if i_locked_it then "I locked it and then restarted" - else - "it was leaked (pool join?)" + else + "it was leaked (pool join?)" ) ; try List.iter diff --git a/ocaml/xapi/storage_smapiv1.ml b/ocaml/xapi/storage_smapiv1.ml index 4c7c382f250..f546ea10d65 100644 --- a/ocaml/xapi/storage_smapiv1.ml +++ b/ocaml/xapi/storage_smapiv1.ml @@ -90,8 +90,8 @@ let vdi_info_of_vdi_rec __context vdi_rec = ; 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 - "" + else + "" ) |> Storage_interface.Vdi.of_string ; read_only= vdi_rec.API.vDI_read_only diff --git a/ocaml/xapi/storage_smapiv1_wrapper.ml b/ocaml/xapi/storage_smapiv1_wrapper.ml index c854c761250..27588b30fcf 100644 --- a/ocaml/xapi/storage_smapiv1_wrapper.ml +++ b/ocaml/xapi/storage_smapiv1_wrapper.ml @@ -608,8 +608,8 @@ functor (Vdi_automaton.Attach ( if read_write then Vdi_automaton.RW - else - Vdi_automaton.RO + else + Vdi_automaton.RO ) ) in @@ -1090,8 +1090,8 @@ functor let errors = ( if errors <> [] then "The following errors have been logged:" - else - "No errors have been logged." + else + "No errors have been logged." ) :: errors in @@ -1385,5 +1385,4 @@ let initialise () = !host_state_path module Impl = Wrapper (Storage_smapiv1.SMAPIv1) - module Server = Storage_interface.Server (Impl) () diff --git a/ocaml/xapi/vm_platform.ml b/ocaml/xapi/vm_platform.ml index a4cd195bcce..ae43c033685 100644 --- a/ocaml/xapi/vm_platform.ml +++ b/ocaml/xapi/vm_platform.ml @@ -191,7 +191,7 @@ let sanity_check ~platformdata ~firmware ~vcpu_max ~vcpu_at_startup:_ () ) ; ( if check_cores_per_socket && List.mem_assoc "cores-per-socket" platformdata - then + then let cps_str = List.assoc "cores-per-socket" platformdata in let vcpus = Int64.to_int vcpu_max in try diff --git a/ocaml/xapi/workload_balancing.ml b/ocaml/xapi/workload_balancing.ml index 4a1f0a37b75..2d8300c45f1 100644 --- a/ocaml/xapi/workload_balancing.ml +++ b/ocaml/xapi/workload_balancing.ml @@ -266,8 +266,8 @@ let parse_result_code meth xml_data response initial_error enable_log = ) ( if enable_log then response - else - "Logging output disabled for this call." + else + "Logging output disabled for this call." ) in let message = diff --git a/ocaml/xapi/xapi_clustering.ml b/ocaml/xapi/xapi_clustering.ml index 4e498da91a2..36fe872bec6 100644 --- a/ocaml/xapi/xapi_clustering.ml +++ b/ocaml/xapi/xapi_clustering.ml @@ -175,8 +175,7 @@ let find_cluster_host ~__context ~host = (* should never happen; this indicates a bug *) let msg = "Multiple cluster_hosts found for host" in error "%s %s" msg (Db.Host.get_uuid ~__context ~self:host) ; - raise - Api_errors.(Server_error (internal_error, [msg; Ref.string_of host])) + raise Api_errors.(Server_error (internal_error, [msg; Ref.string_of host])) | _ -> None diff --git a/ocaml/xapi/xapi_diagnostics.ml b/ocaml/xapi/xapi_diagnostics.ml index 5c88358bca1..4c709f0d055 100644 --- a/ocaml/xapi/xapi_diagnostics.ml +++ b/ocaml/xapi/xapi_diagnostics.ml @@ -69,18 +69,18 @@ let network_stats ~__context ~host:_ ~params = ; (if has_param "uri" then [uri] else []) ; ( if has_param "requests" then [string_of_int stats.Http_svr.Stats.n_requests] - else - [] + else + [] ) ; ( if has_param "connections" then [string_of_int stats.Http_svr.Stats.n_connections] - else - [] + else + [] ) ; ( if has_param "framed" then [string_of_int stats.Http_svr.Stats.n_framed] - else - [] + else + [] ) ] ) diff --git a/ocaml/xapi/xapi_event.ml b/ocaml/xapi/xapi_event.ml index 4d30c8d9069..5e10d5590a1 100644 --- a/ocaml/xapi/xapi_event.ml +++ b/ocaml/xapi/xapi_event.ml @@ -550,16 +550,16 @@ let from_inner __context session subs from from_t deadline = (* mtime guaranteed to always be larger than ctime *) ( ( if created > !last_generation then (table, objref, created) :: creates - else - creates + else + creates ) , ( if - modified > !last_generation - && not (created > !last_generation) - then + modified > !last_generation + && not (created > !last_generation) + then (table, objref, modified) :: mods - else - mods + else + mods ) , (* Only have a mod event if we don't have a created event *) deletes @@ -603,7 +603,7 @@ let from_inner __context session subs from from_t deadline = with_call session subs (fun sub -> let rec grab_nonempty_range () = let ( (msg_gen, messages, _tableset, (creates, mods, deletes, last)) - as result + as result ) = Db_lock.with_lock (fun () -> grab_range (Db_backend.make ())) in diff --git a/ocaml/xapi/xapi_ha.ml b/ocaml/xapi/xapi_ha.ml index 195b535dab1..ee8253e17b6 100644 --- a/ocaml/xapi/xapi_ha.ml +++ b/ocaml/xapi/xapi_ha.ml @@ -1707,8 +1707,8 @@ let disable_internal __context = then we need to try the without-statefile procedure: *) ( if i_have_statefile_access () then exn_to_bool attempt_disable_through_statefile - else - false + else + false ) || exn_to_bool attempt_disable_without_statefile in diff --git a/ocaml/xapi/xapi_ha_vm_failover.ml b/ocaml/xapi/xapi_ha_vm_failover.ml index 043063340b3..4fbf46860f2 100644 --- a/ocaml/xapi/xapi_ha_vm_failover.ml +++ b/ocaml/xapi/xapi_ha_vm_failover.ml @@ -507,10 +507,10 @@ let compute_restart_plan ~__context ~all_protected_vms ~live_set (fun (_, (vm_ref, snapshot)) -> total_memory_of_vm ~__context ( if not $ Db.VM.get_is_control_domain ~__context ~self:vm_ref - then + then Memory_check.Static_max - else - Memory_check.Dynamic_max + else + Memory_check.Dynamic_max ) snapshot ) @@ -526,10 +526,10 @@ let compute_restart_plan ~__context ~all_protected_vms ~live_set (fun (_, (vm_ref, snapshot)) -> total_memory_of_vm ~__context ( if not $ Db.VM.get_is_control_domain ~__context ~self:vm_ref - then + then Memory_check.Static_max - else - Memory_check.Dynamic_max + else + Memory_check.Dynamic_max ) snapshot ) diff --git a/ocaml/xapi/xapi_host.ml b/ocaml/xapi/xapi_host.ml index 65884883c96..f871333bb18 100644 --- a/ocaml/xapi/xapi_host.ml +++ b/ocaml/xapi/xapi_host.ml @@ -1049,8 +1049,8 @@ let create ~__context ~uuid ~name_label ~name_description:_ ~hostname ~address ~virtual_hardware_platform_versions: ( if host_is_us then Xapi_globs.host_virtual_hardware_platform_versions - else - [0L] + else + [0L] ) ~control_domain:Ref.null ~updates_requiring_reboot:[] ~iscsi_iqn:"" ~multipathing:false ~uefi_certificates:"" ~editions:[] ~pending_guidances:[] @@ -2203,9 +2203,9 @@ let reset_networking ~__context ~host = (fun self -> debug "destroying PIF %s" (Db.PIF.get_uuid ~__context ~self) ; ( if - Db.PIF.get_physical ~__context ~self = true - || Db.PIF.get_bond_master_of ~__context ~self <> [] - then + Db.PIF.get_physical ~__context ~self = true + || Db.PIF.get_bond_master_of ~__context ~self <> [] + then let metrics = Db.PIF.get_metrics ~__context ~self in Db.PIF_metrics.destroy ~__context ~self:metrics ) ; @@ -2870,9 +2870,7 @@ let set_sched_gran ~__context ~self ~value = with e -> error "Failed to update sched-gran: %s" (Printexc.to_string e) ; raise - Api_errors.( - Server_error (internal_error, ["Failed to update sched-gran"]) - ) + Api_errors.(Server_error (internal_error, ["Failed to update sched-gran"])) let get_sched_gran ~__context ~self = if Helpers.get_localhost ~__context <> self then diff --git a/ocaml/xapi/xapi_observer.ml b/ocaml/xapi/xapi_observer.ml index 143d5b6fbf5..b00e90d223b 100644 --- a/ocaml/xapi/xapi_observer.ml +++ b/ocaml/xapi/xapi_observer.ml @@ -255,15 +255,16 @@ let startup_components () = Component.all let get_forwarder c = - let module Forwarder = ( val match c with - | Component.Xapi -> - (module Observer) - | Component.Xenopsd -> - (module Xapi_xenops.Observer) - | Component.Xapi_clusterd -> - (module Xapi_cluster.Observer) - : ObserverInterface - ) + let module Forwarder = + ( val match c with + | Component.Xapi -> + (module Observer) + | Component.Xenopsd -> + (module Xapi_xenops.Observer) + | Component.Xapi_clusterd -> + (module Xapi_cluster.Observer) + : ObserverInterface + ) in (module Forwarder : ObserverInterface) @@ -280,9 +281,7 @@ let assert_valid_hosts ~__context hosts = (fun self -> if not (Db.is_valid_ref __context self) then raise - Api_errors.( - Server_error (invalid_value, ["host"; Ref.string_of self]) - ) + Api_errors.(Server_error (invalid_value, ["host"; Ref.string_of self])) ) hosts diff --git a/ocaml/xapi/xapi_periodic_scheduler.ml b/ocaml/xapi/xapi_periodic_scheduler.ml index c560ad43309..1edcb938857 100644 --- a/ocaml/xapi/xapi_periodic_scheduler.ml +++ b/ocaml/xapi/xapi_periodic_scheduler.ml @@ -39,9 +39,7 @@ module Clock = struct t | None -> raise - Api_errors.( - Server_error (internal_error, ["clock overflow"; __LOC__]) - ) + Api_errors.(Server_error (internal_error, ["clock overflow"; __LOC__])) end let add_to_queue ?(signal = true) name ty start newfunc = diff --git a/ocaml/xapi/xapi_pif_helpers.ml b/ocaml/xapi/xapi_pif_helpers.ml index 29c91cc8055..fc6c9708511 100644 --- a/ocaml/xapi/xapi_pif_helpers.ml +++ b/ocaml/xapi/xapi_pif_helpers.ml @@ -244,8 +244,7 @@ let assert_not_vlan_slave ~__context ~self = List.map (fun self -> Db.VLAN.get_uuid ~__context ~self) vlans |> String.concat "; " |> debug "PIF has associated VLANs: [ %s ]" ; - raise - Api_errors.(Server_error (pif_vlan_still_exists, [Ref.string_of self])) + raise Api_errors.(Server_error (pif_vlan_still_exists, [Ref.string_of self])) ) let is_device_underneath_same_type ~__context pif1 pif2 = diff --git a/ocaml/xapi/xapi_pool.ml b/ocaml/xapi/xapi_pool.ml index 11a9dd76e47..04aac2ef09c 100644 --- a/ocaml/xapi/xapi_pool.ml +++ b/ocaml/xapi/xapi_pool.ml @@ -3536,8 +3536,7 @@ let configure_repository_proxy ~__context ~self ~url ~username ~password = | u, p when u <> "" && p <> "" -> if String.contains u '\n' || String.contains p '\n' then ( error "getting invalid username/password of the repository proxy" ; - raise - Api_errors.(Server_error (invalid_repository_proxy_credential, [])) + raise Api_errors.(Server_error (invalid_repository_proxy_credential, [])) ) | _ -> () diff --git a/ocaml/xapi/xapi_pool_update.ml b/ocaml/xapi/xapi_pool_update.ml index d1dfecf122e..1a9b8544bad 100644 --- a/ocaml/xapi/xapi_pool_update.ml +++ b/ocaml/xapi/xapi_pool_update.ml @@ -255,8 +255,8 @@ let create_yum_config ~__context ~self ~url = ; Printf.sprintf "baseurl=%s" url ; ( if signed then Printf.sprintf "gpgkey=file:///etc/pki/rpm-gpg/%s" key - else - "" + else + "" ) ; "" (* Newline at the end of the file *) ] diff --git a/ocaml/xapi/xapi_session.ml b/ocaml/xapi/xapi_session.ml index 2c1b33bb675..455dcef9c55 100644 --- a/ocaml/xapi/xapi_session.ml +++ b/ocaml/xapi/xapi_session.ml @@ -292,9 +292,7 @@ let do_local_auth uname pwd = try Pam.authenticate uname (Bytes.unsafe_to_string pwd) with Failure msg -> raise - Api_errors.( - Server_error (session_authentication_failed, [uname; msg]) - ) + Api_errors.(Server_error (session_authentication_failed, [uname; msg])) ) let do_local_change_password uname newpwd = @@ -1295,8 +1293,8 @@ let logout_subject_identifier ~__context ~subject_identifier = (trackid current_session) ( if Db.Session.get_is_local_superuser ~__context ~self:current_session then local_superuser - else - "" + else + "" ) (Db.Session.get_auth_user_sid ~__context ~self:current_session) subject_identifier diff --git a/ocaml/xapi/xapi_sr_operations.ml b/ocaml/xapi/xapi_sr_operations.ml index 4a2b5e1cebe..b44c8bf5916 100644 --- a/ocaml/xapi/xapi_sr_operations.ml +++ b/ocaml/xapi/xapi_sr_operations.ml @@ -142,9 +142,7 @@ let valid_operations ~__context ?op record _ref' : table = List.filter (fun f -> not - Smint.( - List.mem (capability_of_feature f) [Vdi_create; Vdi_delete] - ) + Smint.(List.mem (capability_of_feature f) [Vdi_create; Vdi_delete]) ) sm_features else diff --git a/ocaml/xapi/xapi_vif_helpers.ml b/ocaml/xapi/xapi_vif_helpers.ml index 9e5788895b1..5144ef7ef7a 100644 --- a/ocaml/xapi/xapi_vif_helpers.ml +++ b/ocaml/xapi/xapi_vif_helpers.ml @@ -350,8 +350,8 @@ let copy ~__context ~vm ~preserve_mac_address vif = ~mAC: ( if preserve_mac_address then all.API.vIF_MAC - else - "" (* leave blank = generate new mac from vm random seed *) + else + "" (* leave blank = generate new mac from vm random seed *) ) ~mTU:all.API.vIF_MTU ~other_config:all.API.vIF_other_config ~qos_algorithm_type:all.API.vIF_qos_algorithm_type diff --git a/ocaml/xapi/xapi_vm.ml b/ocaml/xapi/xapi_vm.ml index 4db86acbdef..c9aefc94b83 100644 --- a/ocaml/xapi/xapi_vm.ml +++ b/ocaml/xapi/xapi_vm.ml @@ -440,8 +440,8 @@ let shutdown ~__context ~vm = clean_shutdown_with_timeout ~__context ~vm ( if db_timeout > 0L then Int64.to_float db_timeout - else - !Xapi_globs.domain_shutdown_total_timeout + else + !Xapi_globs.domain_shutdown_total_timeout ) with e -> warn @@ -479,9 +479,8 @@ let power_state_reset ~__context ~vm = if resident = localhost then ( let open Xenops_interface in let open Xapi_xenops_queue in - let module Client = ( val make_client (queue_of_vm ~__context ~self:vm) - : XENOPS - ) + let module Client = + (val make_client (queue_of_vm ~__context ~self:vm) : XENOPS) in let running = try diff --git a/ocaml/xapi/xapi_vm_clone.ml b/ocaml/xapi/xapi_vm_clone.ml index 73c551ca07e..0d0e9be86e9 100644 --- a/ocaml/xapi/xapi_vm_clone.ml +++ b/ocaml/xapi/xapi_vm_clone.ml @@ -70,9 +70,7 @@ let wait_for_subtask ?progress_minmax ~__context task = Db.Task.get_by_uuid ~__context ~uuid:task_rec.API.task_uuid in raise - Api_errors.( - Server_error (task_cancelled, [Ref.string_of task_id]) - ) + Api_errors.(Server_error (task_cancelled, [Ref.string_of task_id])) | `failure -> ( match task_rec.API.task_error_info with | code :: params -> @@ -346,8 +344,8 @@ let copy_vm_record ?snapshot_info_record ~__context ~vm ~disk_op ~new_name ~snapshot_time: ( if is_a_snapshot then Date.of_float (Unix.gettimeofday ()) - else - Date.never + else + Date.never ) ~snapshot_info: ( match snapshot_info_record with diff --git a/ocaml/xapi/xapi_vm_helpers.ml b/ocaml/xapi/xapi_vm_helpers.ml index d6cca3b128a..538dda7bb01 100644 --- a/ocaml/xapi/xapi_vm_helpers.ml +++ b/ocaml/xapi/xapi_vm_helpers.ml @@ -82,45 +82,45 @@ let set_is_a_template ~__context ~self ~value = with _ -> warn "Could not update VM install time because metrics object was missing" - else - (* VM must be halted, or we couldn't have got this far. - * If we have a halted VM with ha_always_run = true, ha_restart_priority = "restart" - * and HA is enabled on the pool, then HA is about to restart the VM and we should - * block converting it into a template. - * - * This logic can't live in the allowed_operations code, or we'd have to update VM.allowed_operations - * across the pool when enabling or disabling HA. *) - let ha_enabled = - Db.Pool.get_ha_enabled ~__context ~self:(Helpers.get_pool ~__context) - in - if ha_enabled && Helpers.is_xha_protected ~__context ~self then - raise - (Api_errors.Server_error - (Api_errors.vm_is_protected, [Ref.string_of self]) - ) - (* If the VM is not protected then we can convert the VM to a template, - * but we should clear the ha_always_run flag - * (which will be true if the VM has ha_restart_priority = "restart" and was shut down from inside). - * - * We don't want templates to have this flag, or HA will try to start them. *) else - Db.VM.set_ha_always_run ~__context ~self ~value:false ; - (* Detach all VUSBs before set VM as a template *) - let vusbs = Db.VM.get_VUSBs ~__context ~self in - List.iter - (fun vusb -> try Db.VUSB.destroy ~__context ~self:vusb with _ -> ()) - vusbs ; - (* Destroy any attached pvs proxies *) - Db.VM.get_VIFs ~__context ~self - |> List.filter_map (fun vif -> - Pvs_proxy_control.find_proxy_for_vif ~__context ~vif - ) - |> List.rev - |> List.iter (fun p -> Db.PVS_proxy.destroy ~__context ~self:p) ; - (* delete the vm metrics associated with the vm if it exists, when we templat'ize it *) - finally - (fun () -> Db.VM_metrics.destroy ~__context ~self:m) - (fun () -> Db.VM.set_metrics ~__context ~self ~value:Ref.null) + (* VM must be halted, or we couldn't have got this far. + * If we have a halted VM with ha_always_run = true, ha_restart_priority = "restart" + * and HA is enabled on the pool, then HA is about to restart the VM and we should + * block converting it into a template. + * + * This logic can't live in the allowed_operations code, or we'd have to update VM.allowed_operations + * across the pool when enabling or disabling HA. *) + let ha_enabled = + Db.Pool.get_ha_enabled ~__context ~self:(Helpers.get_pool ~__context) + in + if ha_enabled && Helpers.is_xha_protected ~__context ~self then + raise + (Api_errors.Server_error + (Api_errors.vm_is_protected, [Ref.string_of self]) + ) + (* If the VM is not protected then we can convert the VM to a template, + * but we should clear the ha_always_run flag + * (which will be true if the VM has ha_restart_priority = "restart" and was shut down from inside). + * + * We don't want templates to have this flag, or HA will try to start them. *) + else + Db.VM.set_ha_always_run ~__context ~self ~value:false ; + (* Detach all VUSBs before set VM as a template *) + let vusbs = Db.VM.get_VUSBs ~__context ~self in + List.iter + (fun vusb -> try Db.VUSB.destroy ~__context ~self:vusb with _ -> ()) + vusbs ; + (* Destroy any attached pvs proxies *) + Db.VM.get_VIFs ~__context ~self + |> List.filter_map (fun vif -> + Pvs_proxy_control.find_proxy_for_vif ~__context ~vif + ) + |> List.rev + |> List.iter (fun p -> Db.PVS_proxy.destroy ~__context ~self:p) ; + (* delete the vm metrics associated with the vm if it exists, when we templat'ize it *) + finally + (fun () -> Db.VM_metrics.destroy ~__context ~self:m) + (fun () -> Db.VM.set_metrics ~__context ~self ~value:Ref.null) ) ; Db.VM.set_is_a_template ~__context ~self ~value diff --git a/ocaml/xapi/xapi_vm_lifecycle.ml b/ocaml/xapi/xapi_vm_lifecycle.ml index 05c7b2879e3..53f6076e89d 100644 --- a/ocaml/xapi/xapi_vm_lifecycle.ml +++ b/ocaml/xapi/xapi_vm_lifecycle.ml @@ -69,12 +69,12 @@ let allowed_power_states ~__context ~vmr ~(op : API.vm_operations) = `Halted :: ( if - vmr.Db_actions.vM_is_a_snapshot - || Helpers.clone_suspended_vm_enabled ~__context - then + vmr.Db_actions.vM_is_a_snapshot + || Helpers.clone_suspended_vm_enabled ~__context + then [`Suspended] - else - [] + else + [] ) | `create_template (* Don't touch until XMLRPC unmarshal code is able to pre-blank fields on input. *) diff --git a/ocaml/xapi/xapi_xenops.ml b/ocaml/xapi/xapi_xenops.ml index 6aa703eb933..73cb08de2cb 100644 --- a/ocaml/xapi/xapi_xenops.ml +++ b/ocaml/xapi/xapi_xenops.ml @@ -455,8 +455,8 @@ let builder_of_vm ~__context (vmref, vm) timeoffset pci_passthrough vgpu = (* XSI-804 avoid boot orders which are the empty string, as qemu * will silently fail to start the VM *) (let open Constants in - assume_default_if_null_empty vm.API.vM_HVM_boot_params - hvm_default_boot_order hvm_boot_params_order + assume_default_if_null_empty vm.API.vM_HVM_boot_params + hvm_default_boot_order hvm_boot_params_order ) ; qemu_disk_cmdline= bool vm.API.vM_platform false "qemu_disk_cmdline" ; qemu_stubdom= false (* Obsolete: implementation removed *) @@ -635,10 +635,10 @@ module MD = struct string_of_int ( if value < min then min - else if value > max then - max - else - value + else if value > max then + max + else + value ) ) ) @@ -1658,9 +1658,8 @@ module Xenopsd_metadata = struct let txt = md |> rpc_of Metadata.t |> Jsonrpc.to_string in info "xenops: VM.import_metadata %s" txt ; let dbg = Context.string_of_task_and_tracing __context in - let module Client = ( val make_client (queue_of_vm ~__context ~self) - : XENOPS - ) + let module Client = + (val make_client (queue_of_vm ~__context ~self) : XENOPS) in let id = Client.VM.import_metadata dbg txt in maybe_persist_md ~__context ~self txt ; @@ -1673,11 +1672,10 @@ module Xenopsd_metadata = struct let dbg = Context.string_of_task_and_tracing __context in info "xenops: VM.remove %s" id ; try - let module Client = ( val make_client - (queue_of_vm ~__context - ~self:(vm_of_id ~__context id) - ) : XENOPS - ) + let module Client = + ( val make_client (queue_of_vm ~__context ~self:(vm_of_id ~__context id)) + : XENOPS + ) in Client.VM.remove dbg id ; (* Once the VM has been successfully removed from xenopsd, remove the caches *) @@ -1698,11 +1696,11 @@ module Xenopsd_metadata = struct with_lock metadata_m (fun () -> info "xenops: VM.export_metadata %s" id ; let dbg = Context.string_of_task_and_tracing __context in - let module Client = ( val make_client - (queue_of_vm ~__context - ~self:(vm_of_id ~__context id) - ) : XENOPS - ) + let module Client = + ( val make_client + (queue_of_vm ~__context ~self:(vm_of_id ~__context id)) + : XENOPS + ) in let md = match @@ -1872,9 +1870,8 @@ let update_vm ~__context id = else let previous = Xenops_cache.find_vm id in let dbg = Context.string_of_task_and_tracing __context in - let module Client = ( val make_client (queue_of_vm ~__context ~self) - : XENOPS - ) + let module Client = + (val make_client (queue_of_vm ~__context ~self) : XENOPS) in let info = try Some (Client.VM.stat dbg id) with _ -> None in if Option.map snd info = previous then @@ -2429,9 +2426,8 @@ let update_vbd ~__context (id : string * string) = else let previous = Xenops_cache.find_vbd id in let dbg = Context.string_of_task_and_tracing __context in - let module Client = ( val make_client (queue_of_vm ~__context ~self:vm) - : XENOPS - ) + let module Client = + (val make_client (queue_of_vm ~__context ~self:vm) : XENOPS) in let info = try Some (Client.VBD.stat dbg id) with _ -> None in if Option.map snd info = previous then @@ -2541,9 +2537,8 @@ let update_vif ~__context id = else let previous = Xenops_cache.find_vif id in let dbg = Context.string_of_task_and_tracing __context in - let module Client = ( val make_client (queue_of_vm ~__context ~self:vm) - : XENOPS - ) + let module Client = + (val make_client (queue_of_vm ~__context ~self:vm) : XENOPS) in let info = try Some (Client.VIF.stat dbg id) with _ -> None in if Option.map snd info = previous then @@ -2657,9 +2652,8 @@ let update_pci ~__context id = else let previous = Xenops_cache.find_pci id in let dbg = Context.string_of_task_and_tracing __context in - let module Client = ( val make_client (queue_of_vm ~__context ~self:vm) - : XENOPS - ) + let module Client = + (val make_client (queue_of_vm ~__context ~self:vm) : XENOPS) in let info = try Some (Client.PCI.stat dbg id) with _ -> None in if Option.map snd info = previous then @@ -2733,9 +2727,8 @@ let update_vgpu ~__context id = else let previous = Xenops_cache.find_vgpu id in let dbg = Context.string_of_task_and_tracing __context in - let module Client = ( val make_client (queue_of_vm ~__context ~self:vm) - : XENOPS - ) + let module Client = + (val make_client (queue_of_vm ~__context ~self:vm) : XENOPS) in let info = try Some (Client.VGPU.stat dbg id) with _ -> None in if Option.map snd info = previous then @@ -2805,9 +2798,8 @@ let update_vusb ~__context (id : string * string) = else let previous = Xenops_cache.find_vusb id in let dbg = Context.string_of_task_and_tracing __context in - let module Client = ( val make_client (queue_of_vm ~__context ~self:vm) - : XENOPS - ) + let module Client = + (val make_client (queue_of_vm ~__context ~self:vm) : XENOPS) in let info = try Some (Client.VUSB.stat dbg id) with _ -> None in if Option.map snd info = previous then diff --git a/ocaml/xcp-rrdd/bin/rrdd/rrdd_http_handler.ml b/ocaml/xcp-rrdd/bin/rrdd/rrdd_http_handler.ml index 92ca8e8170e..9265084e020 100644 --- a/ocaml/xcp-rrdd/bin/rrdd/rrdd_http_handler.ml +++ b/ocaml/xcp-rrdd/bin/rrdd/rrdd_http_handler.ml @@ -149,9 +149,7 @@ let get_host_stats ?(json = false) ~(start : int64) ~(interval : int64) let sr_rrds_altered = Seq.map (fun (k, v) -> ("sr:" ^ k ^ ":", v.rrd)) srsandrrds in - List.( - concat [host_rrds; of_seq vm_rrds_altered; of_seq sr_rrds_altered] - ) + List.(concat [host_rrds; of_seq vm_rrds_altered; of_seq sr_rrds_altered]) in Rrd_updates.export ~json prefixandrrds start interval cfopt ) diff --git a/ocaml/xcp-rrdd/bin/rrdp-iostat/rrdp_iostat.ml b/ocaml/xcp-rrdd/bin/rrdp-iostat/rrdp_iostat.ml index 1168f602188..844ad7f8a17 100644 --- a/ocaml/xcp-rrdd/bin/rrdp-iostat/rrdp_iostat.ml +++ b/ocaml/xcp-rrdd/bin/rrdp-iostat/rrdp_iostat.ml @@ -667,14 +667,14 @@ module Stats_value = struct ; rd_avg_usecs= ( if stats_diff_get 0 > 0L then Int64.div (stats_diff_get 3) (stats_diff_get 0) - else - 0L + else + 0L ) ; wr_avg_usecs= ( if stats_diff_get 4 > 0L then Int64.div (stats_diff_get 7) (stats_diff_get 4) - else - 0L + else + 0L ) ; io_throughput_read_mb= to_float (stats_diff_get 13) /. 1048576. ; io_throughput_write_mb= to_float (stats_diff_get 14) /. 1048576. diff --git a/ocaml/xen-api-client/lib_test/xen_api_test.ml b/ocaml/xen-api-client/lib_test/xen_api_test.ml index 58c5c6f1831..16d4c36128e 100644 --- a/ocaml/xen-api-client/lib_test/xen_api_test.ml +++ b/ocaml/xen-api-client/lib_test/xen_api_test.ml @@ -60,10 +60,10 @@ module Fake_IO = struct return ( if Queue.is_empty ic then false - else - let chunk = Queue.pop ic in - String.blit chunk 0 buf off len ; - true + else + let chunk = Queue.pop ic in + String.blit chunk 0 buf off len ; + true ) let read_exactly ic len = diff --git a/ocaml/xen-api-client/lwt/disk.ml b/ocaml/xen-api-client/lwt/disk.ml index 053d6840a85..fb8f4fc9500 100644 --- a/ocaml/xen-api-client/lwt/disk.ml +++ b/ocaml/xen-api-client/lwt/disk.ml @@ -70,8 +70,8 @@ let start_upload ~chunked ~uri = let open Cohttp in ( if use_ssl then Data_channel.of_ssl_fd sock - else - Data_channel.of_fd ~seekable:false sock + else + Data_channel.of_fd ~seekable:false sock ) >>= fun c -> let module Request = Request.Make (Cohttp_unbuffered_io) in diff --git a/ocaml/xenopsd/cli/xn.ml b/ocaml/xenopsd/cli/xn.ml index ba1d9f456d9..ec883f3deed 100644 --- a/ocaml/xenopsd/cli/xn.ml +++ b/ocaml/xenopsd/cli/xn.ml @@ -403,8 +403,8 @@ let parse_vif vm_id (x, idx) = ; backend= ( if List.mem_assoc _bridge kvpairs then Network.Local (List.assoc _bridge kvpairs) - else - Network.Local "xenbr0" + else + Network.Local "xenbr0" ) ; other_config= [] ; locking_mode= Vif.default_locking_mode @@ -553,35 +553,35 @@ let add' _copts x () = ; bootloader_args= "" ; devices } - else if mem _kernel then - Direct - { - kernel= - find _kernel |> string |> canonicalise_filename - ; cmdline= - (if mem _root then find _root |> string else "") - ; ramdisk= - ( if mem _ramdisk then - Some - (find _ramdisk - |> string - |> canonicalise_filename - ) - else - None - ) - } - else ( - List.iter - (Printf.fprintf stderr "%s\n") - [ - "I couldn't determine how to start this VM." - ; Printf.sprintf - "A PV guest needs either %s or %s and %s" - _bootloader _kernel _ramdisk - ] ; - exit 1 - ) + else if mem _kernel then + Direct + { + kernel= + find _kernel |> string |> canonicalise_filename + ; cmdline= + (if mem _root then find _root |> string else "") + ; ramdisk= + ( if mem _ramdisk then + Some + (find _ramdisk + |> string + |> canonicalise_filename + ) + else + None + ) + } + else ( + List.iter + (Printf.fprintf stderr "%s\n") + [ + "I couldn't determine how to start this VM." + ; Printf.sprintf + "A PV guest needs either %s or %s and %s" + _bootloader _kernel _ramdisk + ] ; + exit 1 + ) ) } | false -> @@ -895,8 +895,8 @@ let export copts metadata xm filename (x : Vm.id option) () = | Some f -> ( if xm then export_metadata_xm - else - export_metadata + else + export_metadata ) copts f x ; `Ok () diff --git a/ocaml/xenopsd/lib/xenops_server.ml b/ocaml/xenopsd/lib/xenops_server.ml index 52f3f2acdcb..0d85c59c383 100644 --- a/ocaml/xenopsd/lib/xenops_server.ml +++ b/ocaml/xenopsd/lib/xenops_server.ml @@ -928,10 +928,10 @@ module Redirector = struct (string_of_operation (fst item)) ( if aliased then "aliased " - else if redirected then - "redirected " - else - "" + else if redirected then + "redirected " + else + "" ) real_tag (String.concat ", " @@ -2676,8 +2676,8 @@ and perform_exn ?subtask ?result (op : operation) (t : Xenops_task.task_handle) ] ; ( if compress_memory then [(cookie_mem_compression, cookie_mem_compression_value)] - else - [] + else + [] ) ; extra_cookies ] diff --git a/ocaml/xenopsd/lib/xenops_server_simulator.ml b/ocaml/xenopsd/lib/xenops_server_simulator.ml index 0ad9caa4bc7..c12a929392f 100644 --- a/ocaml/xenopsd/lib/xenops_server_simulator.ml +++ b/ocaml/xenopsd/lib/xenops_server_simulator.ml @@ -431,8 +431,8 @@ let set_ipv4_configuration vm vif ipv4_configuration () = Vif.ipv4_configuration= ( if this_one vif then ipv4_configuration - else - vif.Vif.ipv4_configuration + else + vif.Vif.ipv4_configuration ) } ) @@ -451,8 +451,8 @@ let set_ipv6_configuration vm vif ipv6_configuration () = Vif.ipv6_configuration= ( if this_one vif then ipv6_configuration - else - vif.Vif.ipv6_configuration + else + vif.Vif.ipv6_configuration ) } ) diff --git a/ocaml/xenopsd/lib/xenopsd.ml b/ocaml/xenopsd/lib/xenopsd.ml index 0f08581b9eb..09b936d6b1c 100644 --- a/ocaml/xenopsd/lib/xenopsd.ml +++ b/ocaml/xenopsd/lib/xenopsd.ml @@ -459,8 +459,8 @@ let main backend = (Some ( if !persist then (module Xenops_utils.FileFS : Xenops_utils.FS) - else - (module Xenops_utils.MemFS : Xenops_utils.FS) + else + (module Xenops_utils.MemFS : Xenops_utils.FS) ) ) ; Xenops_server.register_objects () ; diff --git a/ocaml/xenopsd/xc/device.ml b/ocaml/xenopsd/xc/device.ml index b547b6bcd46..775320ac466 100644 --- a/ocaml/xenopsd/xc/device.ml +++ b/ocaml/xenopsd/xc/device.ml @@ -1313,8 +1313,8 @@ module PCI = struct callscript "flr-pre" device ; ( if Sys.file_exists device_reset_file then try write_string_to_file device_reset_file "1" with _ -> () - else - try write_string_to_file doflr device with _ -> () + else + try write_string_to_file doflr device with _ -> () ) ; callscript "flr-post" device @@ -2355,12 +2355,12 @@ module Dm_Common = struct ] | None -> [] - else - match info.xen_platform with - | Some (device_id, _) -> - [sprintf "device-id=0x%04x" device_id] - | None -> - [] + else + match info.xen_platform with + | Some (device_id, _) -> + [sprintf "device-id=0x%04x" device_id] + | None -> + [] ) ] ) diff --git a/ocaml/xenopsd/xc/domain.ml b/ocaml/xenopsd/xc/domain.ml index 177d25937c5..ca1e7bcc421 100644 --- a/ocaml/xenopsd/xc/domain.ml +++ b/ocaml/xenopsd/xc/domain.ml @@ -1811,8 +1811,8 @@ let suspend (task : Xenops_task.task_handle) ~xc ~xs ~domain_type ~is_uefi ~dm ( if is_uefi then write_varstored_record task ~xs domid main_fd >>= fun () -> write_vtpm_record task ~xs ~vtpm domid main_fd - else - return () + else + return () ) >>= fun () -> (* Qemu record (if this is a hvm domain) *) @@ -1821,8 +1821,8 @@ let suspend (task : Xenops_task.task_handle) ~xc ~xs ~domain_type ~is_uefi ~dm suspend-image-writing *) ( if domain_type = `hvm then write_qemu_record domid uuid main_fd - else - return () + else + return () ) >>= fun () -> debug "Qemu record written" ; diff --git a/ocaml/xenopsd/xc/memory_breakdown.ml b/ocaml/xenopsd/xc/memory_breakdown.ml index 4af9f433508..29a287865c0 100644 --- a/ocaml/xenopsd/xc/memory_breakdown.ml +++ b/ocaml/xenopsd/xc/memory_breakdown.ml @@ -299,14 +299,14 @@ let pad_value_list guest_ids_all guest_ids values default_value = (Invalid_argument ( if List.length guest_ids <> List.length values then "Expected: length (guest_ids) = length (values)" - else if not (is_sorted String.compare guest_ids) then - "Expected: sorted (guest_ids)" - else if not (is_sorted String.compare guest_ids_all) then - "Expected: sorted (guest_ids_all)" - else if not (is_subset guest_ids guest_ids_all) then - "Expected: guest_ids subset of guest_ids_all" - else - "Unknown failure" + else if not (is_sorted String.compare guest_ids) then + "Expected: sorted (guest_ids)" + else if not (is_sorted String.compare guest_ids_all) then + "Expected: sorted (guest_ids_all)" + else if not (is_subset guest_ids guest_ids_all) then + "Expected: guest_ids subset of guest_ids_all" + else + "Unknown failure" ) ) in diff --git a/ocaml/xenopsd/xc/xenops_server_xen.ml b/ocaml/xenopsd/xc/xenops_server_xen.ml index 4a83e9b18eb..31c3f97c42c 100644 --- a/ocaml/xenopsd/xc/xenops_server_xen.ml +++ b/ocaml/xenopsd/xc/xenops_server_xen.ml @@ -2834,8 +2834,8 @@ module VM = struct Memory.bytes_of_mib ( if di.Xenctrl.hvm_guest then Memory.HVM.xen_max_offset_mib - else - Memory.Linux.xen_max_offset_mib + else + Memory.Linux.xen_max_offset_mib ) in let raw_bytes = @@ -2961,11 +2961,12 @@ module VM = struct di.Xenctrl.domid ; try xs.Xs.write path "t" with _ -> () ) - else - try - let (_ : string) = xs.Xs.read path in - xs.Xs.rm path - with _ -> () (* do not RM the 'warned' path to prevent flood *) + else + try + let (_ : string) = xs.Xs.read path in + xs.Xs.rm path + with _ -> + () (* do not RM the 'warned' path to prevent flood *) ) ; let shadow_multiplier_target = if not di.Xenctrl.hvm_guest then @@ -4408,8 +4409,8 @@ module VIF = struct (fun () -> ( if force then Device.hard_shutdown - else - Device.clean_shutdown + else + Device.clean_shutdown ) task ~xs device ) ; From 26a0f679dc0b13294b4bf32b89e8e351daf0fc0f Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Wed, 22 Nov 2023 16:28:02 +0000 Subject: [PATCH 2/2] maintenance: ignore latest reformat commit in git blames Signed-off-by: Pau Ruiz Safont --- .git-blame-ignore-revs | 1 + 1 file changed, 1 insertion(+) diff --git a/.git-blame-ignore-revs b/.git-blame-ignore-revs index 5749cb9830c..4c2762b5222 100644 --- a/.git-blame-ignore-revs +++ b/.git-blame-ignore-revs @@ -28,6 +28,7 @@ b020cf35a1f2c274f95a4118d4596043cba6113f 637d2b703e867bfdb018f228902f18ba26ff20bf ff39018fd6d91985f9c893a56928771dfe9fa48d cbb9edb17dfd122c591beb14d1275acc39492335 +d6ab15362548b8fe270bd14d5153b8d94e1b15c0 # ocp-indent d018d26d6acd4707a23288b327b49e44f732725e