From 87013f1d074dd7aa5c82a1d68f62be8e1faa43b0 Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Wed, 12 Oct 2022 13:44:46 +0100 Subject: [PATCH 01/13] CA-364194: use timespans for script timeouts This has two advantages: 1. Always non-negative: they represent absolute differences in time 2. Forces users to define the units of time, allowing to read the time in minutes, when appropriate Signed-off-by: Pau Ruiz Safont --- ocaml/forkexecd/lib/dune | 2 ++ ocaml/forkexecd/lib/forkhelpers.ml | 19 ++++++++----- ocaml/forkexecd/lib/forkhelpers.mli | 4 +-- ocaml/forkexecd/test/dune | 2 +- ocaml/forkexecd/test/fe_test.ml | 44 +++++++++++++++++------------ ocaml/networkd/bin/dune | 3 +- ocaml/networkd/bin/networkd.ml | 10 +++++-- ocaml/networkd/lib/network_utils.ml | 8 ++++-- ocaml/xapi/helpers.ml | 2 +- ocaml/xapi/static_vdis.ml | 4 ++- ocaml/xapi/xapi_globs.ml | 15 +++++----- ocaml/xenopsd/lib/dune | 1 + ocaml/xenopsd/lib/xenopsd.ml | 2 +- ocaml/xenopsd/xc/service.ml | 12 ++++---- 14 files changed, 77 insertions(+), 51 deletions(-) diff --git a/ocaml/forkexecd/lib/dune b/ocaml/forkexecd/lib/dune index e8dd8c8312e..662223770f4 100644 --- a/ocaml/forkexecd/lib/dune +++ b/ocaml/forkexecd/lib/dune @@ -4,7 +4,9 @@ (wrapped false) (libraries astring + clock fd-send-recv + mtime rpclib.core rpclib.json rpclib.xml diff --git a/ocaml/forkexecd/lib/forkhelpers.ml b/ocaml/forkexecd/lib/forkhelpers.ml index 7b7fc0b2247..2407b86b924 100644 --- a/ocaml/forkexecd/lib/forkhelpers.ml +++ b/ocaml/forkexecd/lib/forkhelpers.ml @@ -315,8 +315,8 @@ let safe_close_and_exec ?tracing ?env stdin stdout stderr close_fds let execute_command_get_output_inner ?tracing ?env ?stdin - ?(syslog_stdout = NoSyslogging) ?(redirect_stderr_to_stdout = false) - ?(timeout = -1.0) cmd args = + ?(syslog_stdout = NoSyslogging) ?(redirect_stderr_to_stdout = false) timeout + cmd args = let to_close = ref [] in let close fd = if List.mem fd !to_close then ( @@ -354,8 +354,13 @@ let execute_command_get_output_inner ?tracing ?env ?stdin close wr ) stdinandpipes ; - if timeout > 0. then - Unix.setsockopt_float sock Unix.SO_RCVTIMEO timeout ; + ( match timeout with + | Some span -> + let timeout = Clock.Timer.span_to_s span in + Unix.setsockopt_float sock Unix.SO_RCVTIMEO timeout + | None -> + () + ) ; with_tracing ~tracing ~name:"Forkhelpers.waitpid" @@ fun _ -> try waitpid (sock, pid) with Unix.(Unix_error ((EAGAIN | EWOULDBLOCK), _, _)) -> @@ -380,12 +385,12 @@ let execute_command_get_output_inner ?tracing ?env ?stdin let execute_command_get_output ?tracing ?env ?(syslog_stdout = NoSyslogging) ?(redirect_stderr_to_stdout = false) ?timeout cmd args = with_tracing ~tracing ~name:__FUNCTION__ @@ fun tracing -> - execute_command_get_output_inner ?tracing ?env ?stdin:None ?timeout - ~syslog_stdout ~redirect_stderr_to_stdout cmd args + execute_command_get_output_inner ?tracing ?env ?stdin:None ~syslog_stdout + ~redirect_stderr_to_stdout timeout cmd args let execute_command_get_output_send_stdin ?tracing ?env ?(syslog_stdout = NoSyslogging) ?(redirect_stderr_to_stdout = false) ?timeout cmd args stdin = with_tracing ~tracing ~name:__FUNCTION__ @@ fun tracing -> execute_command_get_output_inner ?tracing ?env ~stdin ~syslog_stdout - ~redirect_stderr_to_stdout ?timeout cmd args + ~redirect_stderr_to_stdout timeout cmd args diff --git a/ocaml/forkexecd/lib/forkhelpers.mli b/ocaml/forkexecd/lib/forkhelpers.mli index a91afa52a87..b98a03ef5e0 100644 --- a/ocaml/forkexecd/lib/forkhelpers.mli +++ b/ocaml/forkexecd/lib/forkhelpers.mli @@ -48,7 +48,7 @@ val execute_command_get_output : -> ?env:string array -> ?syslog_stdout:syslog_stdout -> ?redirect_stderr_to_stdout:bool - -> ?timeout:float + -> ?timeout:Mtime.Span.t -> string -> string list -> string * string @@ -61,7 +61,7 @@ val execute_command_get_output_send_stdin : -> ?env:string array -> ?syslog_stdout:syslog_stdout -> ?redirect_stderr_to_stdout:bool - -> ?timeout:float + -> ?timeout:Mtime.Span.t -> string -> string list -> string diff --git a/ocaml/forkexecd/test/dune b/ocaml/forkexecd/test/dune index 7ab49f0e214..91c90e64188 100644 --- a/ocaml/forkexecd/test/dune +++ b/ocaml/forkexecd/test/dune @@ -1,7 +1,7 @@ (executable (modes exe) (name fe_test) - (libraries forkexec uuid xapi-stdext-unix fd-send-recv)) + (libraries fmt forkexec mtime clock mtime.clock.os uuid xapi-stdext-unix fd-send-recv)) (rule (alias runtest) diff --git a/ocaml/forkexecd/test/fe_test.ml b/ocaml/forkexecd/test/fe_test.ml index 870ac591601..57455ed5dc4 100644 --- a/ocaml/forkexecd/test/fe_test.ml +++ b/ocaml/forkexecd/test/fe_test.ml @@ -115,12 +115,6 @@ let one fds x = :: string_of_int (fds - (x.max_extra - number_of_extra)) :: shuffle cmdline_names in - (* Printf.fprintf stderr "stdin = %s\n" (if x.stdin then "Some" else "None"); - Printf.fprintf stderr "stdout = %s\n" (if x.stdout then "Some" else "None"); - Printf.fprintf stderr "stderr = %s\n" (if x.stderr then "Some" else "None"); - List.iter (fun (uuid, _) -> Printf.fprintf stderr "uuid %s -> stdin\n" uuid) table; - Printf.fprintf stderr "%s %s\n" exe (String.concat " " args); - *) Forkhelpers.waitpid_fail_if_bad_exit (Forkhelpers.safe_close_and_exec (if x.stdin then Some fd else None) @@ -129,26 +123,43 @@ let one fds x = table exe args ) +type in_range = In_range | Longer | Shorter + +let in_range ~e:leeway ~around span = + let upper = Mtime.Span.add around leeway in + if Clock.Timer.span_is_shorter ~than:around span then + Shorter + else if Clock.Timer.span_is_longer ~than:upper span then + Longer + else + In_range + let test_delay () = - let start = Unix.gettimeofday () in + let start = Mtime_clock.counter () in let args = ["sleep"] in (* Need to have fractional part because some internal usage split integer and fractional and do computation. Better to have a high fractional part (> 0.5) to more probably exceed the unit. *) - let timeout = 1.7 in + let timeout = Mtime.Span.(1700 * ms) in try Forkhelpers.execute_command_get_output ~timeout exe args |> ignore ; fail "Failed to timeout" with - | Forkhelpers.Subprocess_timeout -> - let elapsed = Unix.gettimeofday () -. start in - Printf.printf "Caught timeout exception after %f seconds\n%!" elapsed ; - if elapsed < timeout then - failwith "Process exited too soon" ; - if elapsed > timeout +. 0.2 then - failwith "Excessive time elapsed" + | Forkhelpers.Subprocess_timeout -> ( + let elapsed = Mtime_clock.count start in + Printf.printf "Caught timeout exception after %s seconds\n%!" + Fmt.(to_to_string Mtime.Span.pp elapsed) ; + + match in_range ~e:Mtime.Span.(200 * ms) ~around:timeout elapsed with + | In_range -> + () + | Shorter -> + failwith "Process exited too soon" + | Longer -> + failwith "Process took too long to exit" + ) | e -> fail "Failed with unexpected exception: %s" (Printexc.to_string e) @@ -289,9 +300,6 @@ let slave = function ) fds ; (* Check that we have the expected number *) - (* - Printf.fprintf stderr "%s %d\n" total_fds (List.length present - 1) - *) if total_fds <> List.length filtered then fail "Expected %d fds; /proc/self/fd has %d: %s" total_fds (List.length filtered) ls diff --git a/ocaml/networkd/bin/dune b/ocaml/networkd/bin/dune index 9d755a10e37..be140076b58 100644 --- a/ocaml/networkd/bin/dune +++ b/ocaml/networkd/bin/dune @@ -14,10 +14,11 @@ (modes exe) (libraries astring - + clock forkexec http_lib integers + mtime netlink networklibs rpclib.core diff --git a/ocaml/networkd/bin/networkd.ml b/ocaml/networkd/bin/networkd.ml index 3b3163a8a7a..bd4b813f6c9 100644 --- a/ocaml/networkd/bin/networkd.ml +++ b/ocaml/networkd/bin/networkd.ml @@ -105,8 +105,14 @@ let options = , "Path to the Unix command dracut" ) ; ( "dracut-timeout" - , Arg.Set_float Network_utils.dracut_timeout - , (fun () -> string_of_float !Network_utils.dracut_timeout) + , Arg.Float + (fun x -> + let x = Float.to_int (x *. 1000.) in + Network_utils.dracut_timeout := Mtime.Span.(x * ms) + ) + , (fun () -> + Float.to_string (Clock.Timer.span_to_s !Network_utils.dracut_timeout) + ) , "Default value for the dracut command timeout" ) ; ( "modinfo-cmd-path" diff --git a/ocaml/networkd/lib/network_utils.ml b/ocaml/networkd/lib/network_utils.ml index 4a473b29579..5a135e55084 100644 --- a/ocaml/networkd/lib/network_utils.ml +++ b/ocaml/networkd/lib/network_utils.ml @@ -67,7 +67,7 @@ let dracut = ref "/sbin/dracut" let modinfo = ref "/sbin/modinfo" -let dracut_timeout = ref 180.0 +let dracut_timeout = ref Mtime.Span.(3 * min) let fcoedriver = ref "/opt/xensource/libexec/fcoe_driver" @@ -128,7 +128,8 @@ let check_n_run ?(on_error = default_error_handler) ?(log = true) run_func | Forkhelpers.Spawn_internal_error (stderr, stdout, status) -> on_error script args stdout stderr status -let call_script ?(timeout = Some 60.0) ?on_error ?log script args = +let call_script ?(timeout = Some Mtime.Span.(1 * min)) ?on_error ?log script + args = let call_script_internal env script args = let out, _err = Forkhelpers.execute_command_get_output ~env ?timeout script args @@ -1064,7 +1065,8 @@ end = struct end module Fcoe = struct - let call ?log args = call_script ?log ~timeout:(Some 10.0) !fcoedriver args + let call ?log args = + call_script ?log ~timeout:(Some Mtime.Span.(10 * s)) !fcoedriver args let get_capabilities name = try diff --git a/ocaml/xapi/helpers.ml b/ocaml/xapi/helpers.ml index 68368754e72..68dde2a1c48 100644 --- a/ocaml/xapi/helpers.ml +++ b/ocaml/xapi/helpers.ml @@ -71,7 +71,7 @@ let call_script ?(log_output = Always) ?env ?stdin ?timeout script args = | None -> "without a timeout" | Some t -> - Printf.sprintf "with a timeout of %.3f seconds" t + Fmt.str "with a timeout of %a" Mtime.Span.pp t in debug "about to call script %s: %s %s" timeout_msg script (String.concat " " (filter_args args)) ; diff --git a/ocaml/xapi/static_vdis.ml b/ocaml/xapi/static_vdis.ml index 049708e9c71..2197ac559a5 100644 --- a/ocaml/xapi/static_vdis.ml +++ b/ocaml/xapi/static_vdis.ml @@ -37,7 +37,9 @@ let permanent_vdi_attach ~__context ~vdi ~reason = ) ) ; ignore - (Helpers.call_script ~timeout:60.0 !Xapi_globs.static_vdis + (Helpers.call_script + ~timeout:Mtime.Span.(1 * min) + !Xapi_globs.static_vdis ["add"; Db.VDI.get_uuid ~__context ~self:vdi; reason] ) ; (* VDI will be attached on next boot; attach it now too *) diff --git a/ocaml/xapi/xapi_globs.ml b/ocaml/xapi/xapi_globs.ml index efdcabfbdb6..2c279f6fc8d 100644 --- a/ocaml/xapi/xapi_globs.ml +++ b/ocaml/xapi/xapi_globs.ml @@ -994,7 +994,7 @@ let winbind_allow_kerberos_auth_fallback = ref false let winbind_keep_configuration = ref false -let winbind_ldap_query_subject_timeout = ref 20. +let winbind_ldap_query_subject_timeout = ref Mtime.Span.(20 * s) let tdb_tool = ref "/usr/bin/tdbtool" @@ -1145,7 +1145,13 @@ let xapi_globs_spec = ; ("test-open", Int test_open) (* for consistency with xenopsd *) ] -let xapi_globs_spec_with_descriptions = [] +let xapi_globs_spec_with_descriptions = + [ + ( "winbind_ldap_query_subject_timeout" + , ShortDurationFromSeconds winbind_ldap_query_subject_timeout + , "Timeout to perform ldap query for subject information" + ) + ] let option_of_xapi_globs_spec ?(description = None) (name, ty) = let spec = @@ -1466,11 +1472,6 @@ let other_options = , "Whether to clear winbind configuration when join domain failed or leave \ domain" ) - ; ( "winbind_ldap_query_subject_timeout" - , Arg.Set_float winbind_ldap_query_subject_timeout - , (fun () -> string_of_float !winbind_ldap_query_subject_timeout) - , "Timeout to perform ldap query for subject information" - ) ; ( "hsts_max_age" , Arg.Set_int hsts_max_age , (fun () -> string_of_int !hsts_max_age) diff --git a/ocaml/xenopsd/lib/dune b/ocaml/xenopsd/lib/dune index 2810eb88ef3..f7226792549 100644 --- a/ocaml/xenopsd/lib/dune +++ b/ocaml/xenopsd/lib/dune @@ -9,6 +9,7 @@ fd-send-recv fmt forkexec + mtime re gzip zstd diff --git a/ocaml/xenopsd/lib/xenopsd.ml b/ocaml/xenopsd/lib/xenopsd.ml index 8d3c9b75f88..a0b192e6824 100644 --- a/ocaml/xenopsd/lib/xenopsd.ml +++ b/ocaml/xenopsd/lib/xenopsd.ml @@ -37,7 +37,7 @@ let vgpu_ready_timeout = ref 30. let varstored_ready_timeout = ref 30. -let swtpm_ready_timeout = ref 60 +let swtpm_ready_timeout = ref Mtime.Span.(1 * min) let use_upstream_qemu = ref false diff --git a/ocaml/xenopsd/xc/service.ml b/ocaml/xenopsd/xc/service.ml index 98c942d13a9..6462852cf4a 100644 --- a/ocaml/xenopsd/xc/service.ml +++ b/ocaml/xenopsd/xc/service.ml @@ -40,7 +40,7 @@ type t = { ; exec_path: string ; pid_filename: string ; chroot: Chroot.t - ; timeout_seconds: int + ; timeout: Mtime.Span.t ; args: string list ; execute: path:string -> args:string list -> domid:Xenctrl.domid -> unit -> string @@ -180,7 +180,7 @@ let start_and_wait_for_readyness ~task ~service = Xenops_task.check_cancelling task ; - let amount = Mtime.Span.(service.timeout_seconds * s) in + let amount = service.timeout in (* wait for pidfile to appear *) Result.iter_error raise_e (wait ~amount ~service_name:syslog_key) ; @@ -797,16 +797,14 @@ module Swtpm = struct swtpm-wrapper runs as a service and getting the exact error back is difficult. *) let needs_init = check_state_needs_init task vtpm_uuid in - let timeout_seconds = !Xenopsd.swtpm_ready_timeout in + let timeout = !Xenopsd.swtpm_ready_timeout in if needs_init then ( debug "vTPM %s is empty, needs to be created" (Uuidm.to_string vtpm_uuid) ; let key = Printf.sprintf "%s-%d" (Filename.basename exec_path) domid in let _, _ = Forkhelpers.execute_command_get_output ~syslog_stdout:(Forkhelpers.Syslog_WithKey key) - ~redirect_stderr_to_stdout:true - ~timeout:(float_of_int timeout_seconds) - exec_path (args true) + ~redirect_stderr_to_stdout:true ~timeout exec_path (args true) in let state_file = Filename.concat tpm_root "tpm2-00.permall" in let state = Unixext.string_of_file state_file |> Base64.encode_exn in @@ -825,7 +823,7 @@ module Swtpm = struct ; chroot ; args= args false ; execute - ; timeout_seconds + ; timeout } in From 5689150c6fa34039a55a6f4581ae34d887e17ab3 Mon Sep 17 00:00:00 2001 From: Christian Lindig Date: Tue, 17 Dec 2024 12:54:19 +0000 Subject: [PATCH 02/13] CA-403700 use iso9660 file system for updates Be explicit about the file system of an update ISO. Remove dead code. Signed-off-by: Christian Lindig --- ocaml/xapi/xapi_pool_update.ml | 2 +- ocaml/xenopsd/xc/xenops_server_xen.ml | 5 ++--- 2 files changed, 3 insertions(+), 4 deletions(-) diff --git a/ocaml/xapi/xapi_pool_update.ml b/ocaml/xapi/xapi_pool_update.ml index daed914ccdf..c7f3b4ebdfb 100644 --- a/ocaml/xapi/xapi_pool_update.ml +++ b/ocaml/xapi/xapi_pool_update.ml @@ -291,7 +291,7 @@ let attach_helper ~__context ~uuid ~vdi ~use_localhost_proxy = "/dev/" ^ Client.VBD.get_device ~rpc ~session_id ~self:vbd ) in - with_api_errors (mount device) mount_point ; + with_api_errors (mount ~ty:(Some "iso9660") device) mount_point ; debug "pool_update.attach_helper Mounted %s" mount_point ) ; let ip = diff --git a/ocaml/xenopsd/xc/xenops_server_xen.ml b/ocaml/xenopsd/xc/xenops_server_xen.ml index d97ddede77b..7f6ede23895 100644 --- a/ocaml/xenopsd/xc/xenops_server_xen.ml +++ b/ocaml/xenopsd/xc/xenops_server_xen.ml @@ -2465,9 +2465,8 @@ module VM = struct | true -> Unixext.with_file path [Unix.O_RDONLY] 0o600 f_synced | false -> - with_mounted_dir_ro path @@ fun dir -> - let filename = Filename.concat dir "suspend-image" in - Unixext.with_file filename [Unix.O_RDONLY] 0o600 f_synced + error "%s: can't mount %s" __FUNCTION__ path ; + internal_error "can't mount %s (not a file or block dev)" path ) let wait_ballooning task vm = From 02ca33e2c444909db358fa1b5ef2eac1ee6a2d42 Mon Sep 17 00:00:00 2001 From: Vincent Liu Date: Wed, 8 Jan 2025 21:32:15 +0000 Subject: [PATCH 03/13] CA-404512: Add feature flag to the new clustering interface The new clustering interface uses a constructor `Extended` address when a cluster hots is trying to join a cluster. This causes problems during upgrades as a newly upgraded host might send out the new address format to old hosts, which do not understand this format, causing the new hosts not able to join. The fix would be to use a new cluster_address feature flag/pool restrictions to control the use of the new clustering interface. This makes sure that the new interface would only be used if all of the hosts understand this new interface, i.e. have this feature enabled. The cluster_address feature is controlled by v6d and is pool-wide, therefore the new interface would only be enabled if all v6ds are updated to the correct level, which also implies that the accompanying xapi are updated to the correct level. Signed-off-by: Vincent Liu --- ocaml/xapi-types/features.ml | 2 ++ ocaml/xapi-types/features.mli | 1 + ocaml/xapi/xapi_cluster.ml | 9 ++------- ocaml/xapi/xapi_cluster_helpers.ml | 8 ++++++++ ocaml/xapi/xapi_cluster_host.ml | 19 ++++--------------- ocaml/xapi/xapi_cluster_host_helpers.ml | 14 ++++++++++++++ 6 files changed, 31 insertions(+), 22 deletions(-) diff --git a/ocaml/xapi-types/features.ml b/ocaml/xapi-types/features.ml index c80d3c833a5..52469387acc 100644 --- a/ocaml/xapi-types/features.ml +++ b/ocaml/xapi-types/features.ml @@ -58,6 +58,7 @@ type feature = | USB_passthrough | Network_sriov | Corosync + | Cluster_address | Zstd_export | Pool_secret_rotation | Certificate_verification @@ -123,6 +124,7 @@ let keys_of_features = ; (USB_passthrough, ("restrict_usb_passthrough", Negative, "USB_passthrough")) ; (Network_sriov, ("restrict_network_sriov", Negative, "Network_sriov")) ; (Corosync, ("restrict_corosync", Negative, "Corosync")) + ; (Cluster_address, ("restrict_cluster_address", Negative, "Cluster_address")) ; (Zstd_export, ("restrict_zstd_export", Negative, "Zstd_export")) ; ( Pool_secret_rotation , ("restrict_pool_secret_rotation", Negative, "Pool_secret_rotation") diff --git a/ocaml/xapi-types/features.mli b/ocaml/xapi-types/features.mli index f6efce3f0a5..018749cb685 100644 --- a/ocaml/xapi-types/features.mli +++ b/ocaml/xapi-types/features.mli @@ -65,6 +65,7 @@ type feature = | USB_passthrough (** Enable the use of USB passthrough. *) | Network_sriov (** Enable the use of Network SRIOV. *) | Corosync (** Enable the use of corosync. *) + | Cluster_address (** Enable the use of extended cluster address interface *) | Zstd_export (** Enable the use of VM export with zstd compression. *) | Pool_secret_rotation (** Enable Pool Secret Rotation *) | Certificate_verification (** Used by XenCenter *) diff --git a/ocaml/xapi/xapi_cluster.ml b/ocaml/xapi/xapi_cluster.ml index 498a0ea4111..1968e5f0774 100644 --- a/ocaml/xapi/xapi_cluster.ml +++ b/ocaml/xapi/xapi_cluster.ml @@ -13,7 +13,6 @@ *) open Xapi_clustering -open Ipaddr_rpc_type module D = Debug.Make (struct let name = "xapi_cluster" end) @@ -65,12 +64,8 @@ let create ~__context ~pIF ~cluster_stack ~pool_auto_join ~token_timeout let hostuuid = Inventory.lookup Inventory._installation_uuid in let hostname = Db.Host.get_hostname ~__context ~self:host in let member = - Extended - { - ip= Ipaddr.of_string_exn (ipstr_of_address ip_addr) - ; hostuuid - ; hostname - } + Xapi_cluster_host_helpers.get_cluster_host_address ~__context ~ip_addr + ~hostuuid ~hostname in let token_timeout_ms = Int64.of_float (token_timeout *. 1000.0) in let token_timeout_coefficient_ms = diff --git a/ocaml/xapi/xapi_cluster_helpers.ml b/ocaml/xapi/xapi_cluster_helpers.ml index 954b946b0fa..a4d30bcedaa 100644 --- a/ocaml/xapi/xapi_cluster_helpers.ml +++ b/ocaml/xapi/xapi_cluster_helpers.ml @@ -12,6 +12,8 @@ * GNU Lesser General Public License for more details. *) +module D = Debug.Make (struct let name = __MODULE__ end) + let finally = Xapi_stdext_pervasives.Pervasiveext.finally let all_cluster_operations = [`add; `remove; `enable; `disable; `destroy] @@ -104,6 +106,12 @@ let with_cluster_operation ~__context ~(self : [`Cluster] API.Ref.t) ~doc ~op with _ -> () ) +let cluster_address_enabled ~__context = + let r = Pool_features.is_enabled ~__context Features.Cluster_address in + D.debug "%s extended cluster address is %s" __FUNCTION__ + (if r then "enabled" else "disabled") ; + r + let corosync3_enabled ~__context = let pool = Helpers.get_pool ~__context in let restrictions = Db.Pool.get_restrictions ~__context ~self:pool in diff --git a/ocaml/xapi/xapi_cluster_host.ml b/ocaml/xapi/xapi_cluster_host.ml index e022f75c706..713261931a4 100644 --- a/ocaml/xapi/xapi_cluster_host.ml +++ b/ocaml/xapi/xapi_cluster_host.ml @@ -13,7 +13,6 @@ *) open Xapi_clustering -open Ipaddr_rpc_type module D = Debug.Make (struct let name = "xapi_cluster_host" end) @@ -126,12 +125,8 @@ let join_internal ~__context ~self = let host = Db.Cluster_host.get_host ~__context ~self in let hostname = Db.Host.get_hostname ~__context ~self:host in let member = - Extended - { - ip= Ipaddr.of_string_exn (ipstr_of_address ip_addr) - ; hostuuid - ; hostname - } + Xapi_cluster_host_helpers.get_cluster_host_address ~__context ~ip_addr + ~hostuuid ~hostname in let ip_list = List.filter_map @@ -338,14 +333,8 @@ let enable ~__context ~self = let hostuuid = Inventory.lookup Inventory._installation_uuid in let hostname = Db.Host.get_hostname ~__context ~self:host in let member = - Cluster_interface.( - Extended - { - ip= Ipaddr.of_string_exn (ipstr_of_address ip_addr) - ; hostuuid - ; hostname - } - ) + Xapi_cluster_host_helpers.get_cluster_host_address ~__context ~ip_addr + ~hostuuid ~hostname in let cluster_ref = Db.Cluster_host.get_cluster ~__context ~self in let cluster_stack = diff --git a/ocaml/xapi/xapi_cluster_host_helpers.ml b/ocaml/xapi/xapi_cluster_host_helpers.ml index 37e16d43178..59e5141da73 100644 --- a/ocaml/xapi/xapi_cluster_host_helpers.ml +++ b/ocaml/xapi/xapi_cluster_host_helpers.ml @@ -106,3 +106,17 @@ let with_cluster_host_operation ~__context ~(self : [`Cluster_host] API.Ref.t) (Datamodel_common._cluster_host, Ref.string_of self) with _ -> () ) + +let get_cluster_host_address ~__context ~ip_addr ~hostuuid ~hostname = + let open Ipaddr_rpc_type in + if Xapi_cluster_helpers.cluster_address_enabled ~__context then + Cluster_interface.( + Extended + { + ip= Ipaddr.of_string_exn (ipstr_of_address ip_addr) + ; hostuuid + ; hostname + } + ) + else + Cluster_interface.(IPv4 (ipstr_of_address ip_addr)) From 142137d1726d6a3d74a1e98801203711fbd3e2d7 Mon Sep 17 00:00:00 2001 From: Rob Hoes Date: Tue, 14 Jan 2025 14:57:45 +0000 Subject: [PATCH 04/13] Remove unused Unixext.Direct module Signed-off-by: Rob Hoes --- .../xapi-stdext/lib/xapi-stdext-unix/dune | 4 +- .../lib/xapi-stdext-unix/unixext.ml | 29 ------- .../lib/xapi-stdext-unix/unixext.mli | 30 -------- .../lib/xapi-stdext-unix/unixext_open_stubs.c | 75 ------------------- .../xapi-stdext-unix/unixext_write_stubs.c | 65 ---------------- 5 files changed, 1 insertion(+), 202 deletions(-) delete mode 100644 ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext_open_stubs.c delete mode 100644 ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext_write_stubs.c diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/dune b/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/dune index 92b77753a86..e73e4d47fa3 100644 --- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/dune +++ b/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/dune @@ -16,7 +16,5 @@ (language c) (names blkgetsize_stubs - unixext_open_stubs - unixext_stubs - unixext_write_stubs)) + unixext_stubs)) ) diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext.ml b/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext.ml index c63a61ff783..4a8dc687989 100644 --- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext.ml +++ b/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext.ml @@ -925,35 +925,6 @@ let test_open n = done ) -module Direct = struct - type t = Unix.file_descr - - external openfile : string -> Unix.open_flag list -> Unix.file_perm -> t - = "stub_stdext_unix_open_direct" - - let close = Unix.close - - let with_openfile path flags perms f = - let t = openfile path flags perms in - finally (fun () -> f t) (fun () -> close t) - - external unsafe_write : t -> bytes -> int -> int -> int - = "stub_stdext_unix_write" - - let write fd buf ofs len = - if ofs < 0 || len < 0 || ofs > Bytes.length buf - len then - invalid_arg "Unixext.write" - else - unsafe_write fd buf ofs len - - let copy_from_fd ?limit socket fd = - copy_file_internal ?limit (Unix.read socket) (write fd) - - let fsync x = fsync x - - let lseek fd x cmd = Unix.LargeFile.lseek fd x cmd -end - (* --------------------------------------------------------------------------------------- *) module Daemon = struct diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext.mli b/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext.mli index fa8eb331f25..bec31c222a6 100644 --- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext.mli +++ b/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext.mli @@ -266,36 +266,6 @@ val test_open : int -> unit The file descriptors will stay open until the program exits. *) -module Direct : sig - (** Perform I/O in O_DIRECT mode using 4KiB page-aligned buffers *) - - (** represents a file open in O_DIRECT mode *) - type t - - val openfile : string -> Unix.open_flag list -> Unix.file_perm -> t - (** [openfile name flags perm] behaves the same as [Unix.openfile] but includes the O_DIRECT flag *) - - val close : t -> unit - (** [close t] closes [t], a file open in O_DIRECT mode *) - - val with_openfile : - string -> Unix.open_flag list -> Unix.file_perm -> (t -> 'a) -> 'a - (** [with_openfile name flags perm f] opens [name], applies the result to [f] and closes *) - - val write : t -> bytes -> int -> int -> int - (** [write t buf ofs len] writes [len] bytes at offset [ofs] from buffer [buf] to - [t] using page-aligned buffers. *) - - val copy_from_fd : ?limit:int64 -> Unix.file_descr -> t -> int64 - (** [copy_from_fd ?limit fd t] copies from [fd] to [t] up to [limit] *) - - val fsync : t -> unit - (** [fsync t] commits all outstanding writes, throwing an error if necessary. *) - - val lseek : t -> int64 -> Unix.seek_command -> int64 - (** [lseek t offset command]: see Unix.LargeFile.lseek *) -end - module Daemon : sig (** OCaml interface to libsystemd. diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext_open_stubs.c b/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext_open_stubs.c deleted file mode 100644 index d15cfeff0b1..00000000000 --- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext_open_stubs.c +++ /dev/null @@ -1,75 +0,0 @@ -/***********************************************************************/ -/* */ -/* Objective Caml */ -/* */ -/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ -/* */ -/* Copyright 1996 Institut National de Recherche en Informatique et */ -/* en Automatique. All rights reserved. This file is distributed */ -/* under the terms of the GNU Library General Public License, with */ -/* the special exception on linking described in file ../../LICENSE. */ -/* */ -/***********************************************************************/ - -/* $Id: open.c 9547 2010-01-22 12:48:24Z doligez $ */ - -#define _GNU_SOURCE /* O_DIRECT */ - -#include -#include -#include -#include -#include -#include -#include - -#ifndef O_NONBLOCK -#define O_NONBLOCK O_NDELAY -#endif -#ifndef O_DSYNC -#define O_DSYNC 0 -#endif -#ifndef O_SYNC -#define O_SYNC 0 -#endif -#ifndef O_RSYNC -#define O_RSYNC 0 -#endif - -static int open_flag_table[] = { - O_RDONLY, O_WRONLY, O_RDWR, O_NONBLOCK, O_APPEND, O_CREAT, O_TRUNC, O_EXCL, - O_NOCTTY, O_DSYNC, O_SYNC, O_RSYNC -}; - -CAMLprim value stub_stdext_unix_open_direct(value path, value flags, value perm) -{ - CAMLparam3(path, flags, perm); - int fd, cv_flags; -#ifndef O_DIRECT - int ret; -#endif - char * p; - - cv_flags = caml_convert_flag_list(flags, open_flag_table); - -#ifdef O_DIRECT - cv_flags |= O_DIRECT; -#endif - p = caml_stat_alloc(caml_string_length(path) + 1); - strcpy(p, String_val(path)); - /* open on a named FIFO can block (PR#1533) */ - caml_enter_blocking_section(); - fd = open(p, cv_flags, Int_val(perm)); -#ifndef O_DIRECT - if (fd != -1) - ret = fcntl(fd, F_NOCACHE); -#endif - caml_leave_blocking_section(); - caml_stat_free(p); - if (fd == -1) uerror("open", path); -#ifndef O_DIRECT - if (ret == -1) uerror("fcntl", path); -#endif - - CAMLreturn (Val_int(fd)); -} diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext_write_stubs.c b/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext_write_stubs.c deleted file mode 100644 index e4be9f68018..00000000000 --- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext_write_stubs.c +++ /dev/null @@ -1,65 +0,0 @@ -/***********************************************************************/ -/* */ -/* Objective Caml */ -/* */ -/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ -/* */ -/* Copyright 1996 Institut National de Recherche en Informatique et */ -/* en Automatique. All rights reserved. This file is distributed */ -/* under the terms of the GNU Library General Public License, with */ -/* the special exception on linking described in file ../../LICENSE. */ -/* */ -/***********************************************************************/ - -/* $Id: write.c 9547 2010-01-22 12:48:24Z doligez $ */ - -#include -#include -#include -#include -#include -#include - -#define PAGE_SIZE 4096 - -#ifndef EAGAIN -#define EAGAIN (-1) -#endif -#ifndef EWOULDBLOCK -#define EWOULDBLOCK (-1) -#endif - -CAMLprim value stub_stdext_unix_write(value fd, value buf, value vofs, value vlen) -{ - long ofs, len, written; - int numbytes, ret; - void *iobuf = NULL; - - Begin_root (buf); - ofs = Long_val(vofs); - len = Long_val(vlen); - written = 0; - while (len > 0) { - numbytes = len > UNIX_BUFFER_SIZE ? UNIX_BUFFER_SIZE : len; - ret = posix_memalign(&iobuf, PAGE_SIZE, numbytes); - if (ret != 0) - uerror("write/posix_memalign", Nothing); - - memmove (iobuf, &Byte(buf, ofs), numbytes); - caml_enter_blocking_section(); - ret = write(Int_val(fd), iobuf, numbytes); - caml_leave_blocking_section(); - free(iobuf); - - if (ret == -1) { - if ((errno == EAGAIN || errno == EWOULDBLOCK) && written > 0) break; - uerror("write", Nothing); - } - written += ret; - ofs += ret; - len -= ret; - } - End_roots(); - return Val_long(written); -} - From 8992f9d88697563e1d1f86a2ed580b9538bbe0a8 Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Wed, 15 Jan 2025 10:25:02 +0000 Subject: [PATCH 05/13] github: update release for ubuntu 24.04 The package dune has been replaced with ocaml-dune Signed-off-by: Pau Ruiz Safont --- .github/workflows/release.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/release.yml b/.github/workflows/release.yml index 919cf406127..b27787c719f 100644 --- a/.github/workflows/release.yml +++ b/.github/workflows/release.yml @@ -22,7 +22,7 @@ jobs: - name: Install build dependencies run: | pip install build - sudo apt-get install ocaml dune libfindlib-ocaml-dev libdune-ocaml-dev libcmdliner-ocaml-dev + sudo apt-get install ocaml ocaml-dune libfindlib-ocaml-dev libdune-ocaml-dev libcmdliner-ocaml-dev - name: Generate python package for XenAPI run: | From de7e1eb1cf7ba5d60f8a6be8397c4f87c168f4aa Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Wed, 15 Jan 2025 15:56:31 +0000 Subject: [PATCH 06/13] github: remove dependency of python wheel's on dune Ubuntu's dune is way too old for the version generally used. On top of that the command doesn't fail when this happens, making the setup brittle. Instead write the version variable to config.mk and run make. Signed-off-by: Pau Ruiz Safont --- .github/workflows/release.yml | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/.github/workflows/release.yml b/.github/workflows/release.yml index b27787c719f..5c3f1cd5502 100644 --- a/.github/workflows/release.yml +++ b/.github/workflows/release.yml @@ -20,13 +20,11 @@ jobs: python-version: "3.x" - name: Install build dependencies - run: | - pip install build - sudo apt-get install ocaml ocaml-dune libfindlib-ocaml-dev libdune-ocaml-dev libcmdliner-ocaml-dev + run: pip install build - name: Generate python package for XenAPI run: | - ./configure --xapi_version=${{ github.ref_name }} + echo "export XAPI_VERSION=${{ github.ref_name }}" > config.mk make python - name: Store python distribution artifacts From aac5802acc075a0d4b8a04f1c7089015ca0cf009 Mon Sep 17 00:00:00 2001 From: Christian Lindig Date: Tue, 14 Jan 2025 15:24:43 +0000 Subject: [PATCH 07/13] CA-404640 XSI-1781 accept in PEM key/cert in any order We have so far hard-coded the exectation that in a PEM file a private key is followed by a certficate but this is actually not required by the PEM standard and let to a failure in XSI-1781. This is a simple fix first collects all keys and certificates while skipping over other content and the uses the first key and certificate. Signed-off-by: Christian Lindig --- ocaml/gencert/pem.ml | 45 +++++-- ocaml/gencert/test_data/pems/fail-06.pem | 93 ++++++++++++++- .../pems/{fail-01.pem => pass-05.pem} | 0 ocaml/gencert/test_data/pems/pass-06.pem | 109 +++++++++++++++++ .../test_data/pems/pass-xsi-1781-reformat.pem | 51 ++++++++ .../gencert/test_data/pems/pass-xsi-1781.pem | 111 ++++++++++++++++++ ocaml/gencert/test_data/reformat.sh | 27 +++++ 7 files changed, 423 insertions(+), 13 deletions(-) rename ocaml/gencert/test_data/pems/{fail-01.pem => pass-05.pem} (100%) create mode 100644 ocaml/gencert/test_data/pems/pass-06.pem create mode 100644 ocaml/gencert/test_data/pems/pass-xsi-1781-reformat.pem create mode 100644 ocaml/gencert/test_data/pems/pass-xsi-1781.pem create mode 100755 ocaml/gencert/test_data/reformat.sh diff --git a/ocaml/gencert/pem.ml b/ocaml/gencert/pem.ml index 86182c2dfd6..9a9354babdb 100644 --- a/ocaml/gencert/pem.ml +++ b/ocaml/gencert/pem.ml @@ -24,6 +24,10 @@ let data = take_while1 is_data type kind = RSA | EC | OTHER +type block = Key of string | Cert of string + +let fail_fmt fmt = Printf.ksprintf (fun str -> fail str) fmt + let kind = string " RSA " *> return RSA <|> string " EC " *> return EC @@ -60,24 +64,39 @@ let key = key_footer kind *> return (String.concat "" [header kind; body; footer kind]) "key" -let line = take_till is_eol *> end_of_line - -(* try to read a key, or skip a line and try again *) -let until_key = fix (fun m -> key <|> line *> m) "until_key" - let cert = cert_header >>= fun hd -> data >>= fun body -> cert_footer >>= fun tl -> return (String.concat "" [hd; body; tl]) "cert" -(* try to read a cert, or skip a line and try again *) -let until_cert = fix (fun m -> cert <|> line *> m) "until_cert" +let line = take_till is_eol *> end_of_line +let any_block = + cert >>= (fun c -> return (Cert c)) <|> (key >>= fun k -> return (Key k)) + +(* this skips over junk until we succeed finding the next block *) +let block = fix (fun m -> any_block <|> line *> m) "until_block" + +(* collect and tag all blocks *) +let blocks = many block "PEM blocks" + +(* decompose blocks into certs and keys *) let pem = - until_key >>= fun private_key -> - until_cert >>= fun host_cert -> - many until_cert >>= fun other_certs -> - many end_of_line *> return {private_key; host_cert; other_certs} "pem" + let ( let* ) = ( >>= ) in + let strip = function Cert c -> c | Key k -> k in + blocks >>= fun bs -> + match List.partition (function Key _ -> true | Cert _ -> false) bs with + | [Key k], Cert c :: xs -> + return {private_key= k; host_cert= c; other_certs= List.map strip xs} + | [_], [] -> + let* p = pos in + fail_fmt "PEM is lacking a certificate (at offset %d)" p + | [], _ -> + let* p = pos in + fail_fmt "PEM is missing a private key (at offset %d)" p + | _ :: _, _ -> + let* p = pos in + fail_fmt "PEM has more than one private key (at offset %d)" p let defer f = Fun.protect ~finally:f @@ -86,6 +105,10 @@ let read_file path = defer (fun () -> close_in ic) @@ fun () -> really_input_string ic (in_channel_length ic) +let _parse_with t path = + let consume = Consume.Prefix in + read_file path |> parse_string ~consume t + let parse_string str = let consume = Consume.Prefix in parse_string ~consume pem str diff --git a/ocaml/gencert/test_data/pems/fail-06.pem b/ocaml/gencert/test_data/pems/fail-06.pem index 6b63e248c1b..05a638c7a02 100644 --- a/ocaml/gencert/test_data/pems/fail-06.pem +++ b/ocaml/gencert/test_data/pems/fail-06.pem @@ -1,4 +1,74 @@ ------BEGIN RSA PRIVATE KEY----- +This fails because we have two keys (rather than just one). + +-----BEGIN CERTIFICATE----- +MIIC5jCCAc6gAwIBAgIIaYRSm3Q7zc8wDQYJKoZIhvcNAQELBQAwIDEeMBwGA1UE +AwwVbGN5Mi1kdDExMC54ZW5ydGNsb3VkMB4XDTIwMTAxNDE1NTc1MloXDTMwMTAx +MjE1NTc1MlowIDEeMBwGA1UEAwwVbGN5Mi1kdDExMC54ZW5ydGNsb3VkMIIBIjAN +BgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEA+5SOY1AKwqp3B7c3EhSvjiYFzL9e +gItLI7CypsVFQp5RJXp/9FRCMk1sLB3gfqMcQ5bhhPM4QfW0iK9wtcRxFILYI/oH ++vwNEJ5f3yBpIbjhbD6IaJcV1xpNkJD0JRqxPRUcRTRkKSLq9Hp4nqScOCvkjKgG +hlL3cFn3uOKWIzrJgEtyFixEXaY8XLqYLxy8BJ5PuM4Xsqafd4lb5qsK1/KJC4iS +WWqdXsOhICs3itpsPR1HneHdABigpAIYIcxk5fyLC8+EDjhXrK2OGsEMMytUsAbx +ePcQLjokW1EXc7fiuxrKDdJZuT/AsWZqw0hqRkdQSAqzEmrUhjdDbjgifQIDAQAB +oyQwIjAgBgNVHREEGTAXghVsY3kyLWR0MTEwLnhlbnJ0Y2xvdWQwDQYJKoZIhvcN +AQELBQADggEBAHEkeEjHilXdVgQhD/z46prXObB26uO97yFUcUIalzhb/P3zmfjb +LFatTFn5jgienMmdP90uj7Ly1R6VOa+tX/o+XtSJaZwuNMtixv9qwo3nrFZdw8yF +GgsmbAR+1hu0TG3RNpDIiES4D3JmVP8MgmwLw1kN3cBVptx73lE3uc8vZnNtIDOl +erJb9fD3IOv/RZ78mxMnajZTHY5kg2e96d/a6HgY39vXMwycjp8wIE/+4g94fIc/ +/a2+BGYjCWJZyoLgmHcXEU8fOxe9yUWbFQf0wnqsLJIqzaQU1w2w6mkh4+xsI/nA +JwFfXQKd3fzsvgmufpAbXt/AHljFvC/qjTI= +-----END CERTIFICATE----- + +-----BEGIN CERTIFICATE----- +MIIC5jCCAc6gAwIBAgIIaYRSm3Q7zc8wDQYJKoZIhvcNAQELBQAwIDEeMBwGA1UE +AwwVbGN5Mi1kdDExMC54ZW5ydGNsb3VkMB4XDTIwMTAxNDE1NTc1MloXDTMwMTAx +MjE1NTc1MlowIDEeMBwGA1UEAwwVbGN5Mi1kdDExMC54ZW5ydGNsb3VkMIIBIjAN +BgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEA+5SOY1AKwqp3B7c3EhSvjiYFzL9e +gItLI7CypsVFQp5RJXp/9FRCMk1sLB3gfqMcQ5bhhPM4QfW0iK9wtcRxFILYI/oH ++vwNEJ5f3yBpIbjhbD6IaJcV1xpNkJD0JRqxPRUcRTRkKSLq9Hp4nqScOCvkjKgG +hlL3cFn3uOKWIzrJgEtyFixEXaY8XLqYLxy8BJ5PuM4Xsqafd4lb5qsK1/KJC4iS +WWqdXsOhICs3itpsPR1HneHdABigpAIYIcxk5fyLC8+EDjhXrK2OGsEMMytUsAbx +ePcQLjokW1EXc7fiuxrKDdJZuT/AsWZqw0hqRkdQSAqzEmrUhjdDbjgifQIDAQAB +oyQwIjAgBgNVHREEGTAXghVsY3kyLWR0MTEwLnhlbnJ0Y2xvdWQwDQYJKoZIhvcN +AQELBQADggEBAHEkeEjHilXdVgQhD/z46prXObB26uO97yFUcUIalzhb/P3zmfjb +LFatTFn5jgienMmdP90uj7Ly1R6VOa+tX/o+XtSJaZwuNMtixv9qwo3nrFZdw8yF +GgsmbAR+1hu0TG3RNpDIiES4D3JmVP8MgmwLw1kN3cBVptx73lE3uc8vZnNtIDOl +erJb9fD3IOv/RZ78mxMnajZTHY5kg2e96d/a6HgY39vXMwycjp8wIE/+4g94fIc/ +/a2+BGYjCWJZyoLgmHcXEU8fOxe9yUWbFQf0wnqsLJIqzaQU1w2w6mkh4+xsI/nA +JwFfXQKd3fzsvgmufpAbXt/AHljFvC/qjTI= +-----END CERTIFICATE----- + +-----BEGIN PRIVATE KEY----- +MIIEvAIBADANBgkqhkiG9w0BAQEFAASCBKYwggSiAgEAAoIBAQD7lI5jUArCqncH +tzcSFK+OJgXMv16Ai0sjsLKmxUVCnlElen/0VEIyTWwsHeB+oxxDluGE8zhB9bSI +r3C1xHEUgtgj+gf6/A0Qnl/fIGkhuOFsPoholxXXGk2QkPQlGrE9FRxFNGQpIur0 +eniepJw4K+SMqAaGUvdwWfe44pYjOsmAS3IWLERdpjxcupgvHLwEnk+4zheypp93 +iVvmqwrX8okLiJJZap1ew6EgKzeK2mw9HUed4d0AGKCkAhghzGTl/IsLz4QOOFes +rY4awQwzK1SwBvF49xAuOiRbURdzt+K7GsoN0lm5P8CxZmrDSGpGR1BICrMSatSG +N0NuOCJ9AgMBAAECggEATgm51VKZ0+Kew5Twjzo9bqGawPVHsiYDK9H+yL5+inij +gTWrhTWxxvq/KDwoS//6n3ipAd2UQNmfo5qQIsIJtawUsaw4V4Fh6BrIcGUUV3KK +8lG/bHoZOz0cfFCKewv5mJH4z/q9awk6ypVG3yb+kmoDHiJsy7Pmr0IpFn+qxMg1 +EYZU91G10DguXekciRtNcZJRL0wCQR3s2OwDdQUC+XIotvAsKiuhWl++MLwn42ad +EwhzLuLd312qWg58ByCcNq8/XJkHJUbKDTWmBRGopWRliduP+Kb6vJZ16KL0G2B+ +OKuTQxMOzVVmumXdEVj3kH54cjpn7kCq9jwhhSJiQQKBgQD94ZFOzsUzZfmNlDZ3 +hFmkFuFpQCacH58FQX/vD6JQ84HwEHJx69aHYI6olCNaKcNwMhsOw+0KqBRWZnCf +A6oMWUf3pkogV5JZJy7DyHNOmkfI/w8NcWtqJ03pCoA237f5RH0sul2ady9BVzsJ +/8rb3B5uDw8+XesnG8Ryj6BCsQKBgQD9rhKfHxJgsZUzyassIumYcLTefgdoeCq5 +awd+YaM9jrGGN1ty8dTEzo3rbovnz8y+ZJMzaDRbCUeNTQjKDox8mWffRTpjxcks +rJzImY7coBdnZT8K4C5OMoeCAr30FI1veXBk/XFfr56h1X8QbmM2kuJwpsf5bOaf +CTfL2q2XjQKBgHem4pvYuXoC2n1OV+k2GCVMn0nCcS/tez234/qgTKiISzoAFl/4 +fW/qIvHyd0LcIf7zrmrkDgiStJsPxo465N7TCSb/WToq649W9yRQiX+HGMPy6X41 +cSFjisWFLG4wO/2fuLrmzoypFT1fRjTtOAcsk67dLBsBmn0hChHP/QDRAoGASXS7 +XaogpzEk1A8kaq5dV8/i/74cpQqOzIwKanUZULzd+NBUwa72/loVTEQBbQmF7ueu +nCcjae0A9BCHaALYeUfuhP9Fzhg6jZ4Z9BhK/uW4gS8XFy4dGnWVOXdTy7ab0din +TAb7akqvM4tftMFSJz5XJWmV5Eq9aPXBW10iAQ0CgYBl6PsdqWBjvPnqX3NCyAGH +ZO4iUcrqODdeTcKpILgqBmh9/IepClgCtwW1Iluna7QTDtVqotKcft1BtHJzeKWT +6TvCgje2k0RWo6TkzroaF74lyAojzWOrmuq+skVbWTiebc4bCA1KtLMLaQHIEtdo +FIPEq03cDKVNDCgABw4mkw== +-----END PRIVATE KEY----- + + +-----BEGIN PRIVATE KEY----- MIIEvAIBADANBgkqhkiG9w0BAQEFAASCBKYwggSiAgEAAoIBAQD7lI5jUArCqncH tzcSFK+OJgXMv16Ai0sjsLKmxUVCnlElen/0VEIyTWwsHeB+oxxDluGE8zhB9bSI r3C1xHEUgtgj+gf6/A0Qnl/fIGkhuOFsPoholxXXGk2QkPQlGrE9FRxFNGQpIur0 @@ -25,8 +95,26 @@ TAb7akqvM4tftMFSJz5XJWmV5Eq9aPXBW10iAQ0CgYBl6PsdqWBjvPnqX3NCyAGH ZO4iUcrqODdeTcKpILgqBmh9/IepClgCtwW1Iluna7QTDtVqotKcft1BtHJzeKWT 6TvCgje2k0RWo6TkzroaF74lyAojzWOrmuq+skVbWTiebc4bCA1KtLMLaQHIEtdo FIPEq03cDKVNDCgABw4mkw== ------END EC PRIVATE KEY----- +-----END PRIVATE KEY----- +-----BEGIN CERTIFICATE----- +MIIC5jCCAc6gAwIBAgIIaYRSm3Q7zc8wDQYJKoZIhvcNAQELBQAwIDEeMBwGA1UE +AwwVbGN5Mi1kdDExMC54ZW5ydGNsb3VkMB4XDTIwMTAxNDE1NTc1MloXDTMwMTAx +MjE1NTc1MlowIDEeMBwGA1UEAwwVbGN5Mi1kdDExMC54ZW5ydGNsb3VkMIIBIjAN +BgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEA+5SOY1AKwqp3B7c3EhSvjiYFzL9e +gItLI7CypsVFQp5RJXp/9FRCMk1sLB3gfqMcQ5bhhPM4QfW0iK9wtcRxFILYI/oH ++vwNEJ5f3yBpIbjhbD6IaJcV1xpNkJD0JRqxPRUcRTRkKSLq9Hp4nqScOCvkjKgG +hlL3cFn3uOKWIzrJgEtyFixEXaY8XLqYLxy8BJ5PuM4Xsqafd4lb5qsK1/KJC4iS +WWqdXsOhICs3itpsPR1HneHdABigpAIYIcxk5fyLC8+EDjhXrK2OGsEMMytUsAbx +ePcQLjokW1EXc7fiuxrKDdJZuT/AsWZqw0hqRkdQSAqzEmrUhjdDbjgifQIDAQAB +oyQwIjAgBgNVHREEGTAXghVsY3kyLWR0MTEwLnhlbnJ0Y2xvdWQwDQYJKoZIhvcN +AQELBQADggEBAHEkeEjHilXdVgQhD/z46prXObB26uO97yFUcUIalzhb/P3zmfjb +LFatTFn5jgienMmdP90uj7Ly1R6VOa+tX/o+XtSJaZwuNMtixv9qwo3nrFZdw8yF +GgsmbAR+1hu0TG3RNpDIiES4D3JmVP8MgmwLw1kN3cBVptx73lE3uc8vZnNtIDOl +erJb9fD3IOv/RZ78mxMnajZTHY5kg2e96d/a6HgY39vXMwycjp8wIE/+4g94fIc/ +/a2+BGYjCWJZyoLgmHcXEU8fOxe9yUWbFQf0wnqsLJIqzaQU1w2w6mkh4+xsI/nA +JwFfXQKd3fzsvgmufpAbXt/AHljFvC/qjTI= +-----END CERTIFICATE----- -----BEGIN CERTIFICATE----- MIIC5jCCAc6gAwIBAgIIaYRSm3Q7zc8wDQYJKoZIhvcNAQELBQAwIDEeMBwGA1UE @@ -47,3 +135,4 @@ erJb9fD3IOv/RZ78mxMnajZTHY5kg2e96d/a6HgY39vXMwycjp8wIE/+4g94fIc/ JwFfXQKd3fzsvgmufpAbXt/AHljFvC/qjTI= -----END CERTIFICATE----- + diff --git a/ocaml/gencert/test_data/pems/fail-01.pem b/ocaml/gencert/test_data/pems/pass-05.pem similarity index 100% rename from ocaml/gencert/test_data/pems/fail-01.pem rename to ocaml/gencert/test_data/pems/pass-05.pem diff --git a/ocaml/gencert/test_data/pems/pass-06.pem b/ocaml/gencert/test_data/pems/pass-06.pem new file mode 100644 index 00000000000..18d7d7e0a96 --- /dev/null +++ b/ocaml/gencert/test_data/pems/pass-06.pem @@ -0,0 +1,109 @@ +Multiple certificates and one key. + +-----BEGIN CERTIFICATE----- +MIIC5jCCAc6gAwIBAgIIaYRSm3Q7zc8wDQYJKoZIhvcNAQELBQAwIDEeMBwGA1UE +AwwVbGN5Mi1kdDExMC54ZW5ydGNsb3VkMB4XDTIwMTAxNDE1NTc1MloXDTMwMTAx +MjE1NTc1MlowIDEeMBwGA1UEAwwVbGN5Mi1kdDExMC54ZW5ydGNsb3VkMIIBIjAN +BgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEA+5SOY1AKwqp3B7c3EhSvjiYFzL9e +gItLI7CypsVFQp5RJXp/9FRCMk1sLB3gfqMcQ5bhhPM4QfW0iK9wtcRxFILYI/oH ++vwNEJ5f3yBpIbjhbD6IaJcV1xpNkJD0JRqxPRUcRTRkKSLq9Hp4nqScOCvkjKgG +hlL3cFn3uOKWIzrJgEtyFixEXaY8XLqYLxy8BJ5PuM4Xsqafd4lb5qsK1/KJC4iS +WWqdXsOhICs3itpsPR1HneHdABigpAIYIcxk5fyLC8+EDjhXrK2OGsEMMytUsAbx +ePcQLjokW1EXc7fiuxrKDdJZuT/AsWZqw0hqRkdQSAqzEmrUhjdDbjgifQIDAQAB +oyQwIjAgBgNVHREEGTAXghVsY3kyLWR0MTEwLnhlbnJ0Y2xvdWQwDQYJKoZIhvcN +AQELBQADggEBAHEkeEjHilXdVgQhD/z46prXObB26uO97yFUcUIalzhb/P3zmfjb +LFatTFn5jgienMmdP90uj7Ly1R6VOa+tX/o+XtSJaZwuNMtixv9qwo3nrFZdw8yF +GgsmbAR+1hu0TG3RNpDIiES4D3JmVP8MgmwLw1kN3cBVptx73lE3uc8vZnNtIDOl +erJb9fD3IOv/RZ78mxMnajZTHY5kg2e96d/a6HgY39vXMwycjp8wIE/+4g94fIc/ +/a2+BGYjCWJZyoLgmHcXEU8fOxe9yUWbFQf0wnqsLJIqzaQU1w2w6mkh4+xsI/nA +JwFfXQKd3fzsvgmufpAbXt/AHljFvC/qjTI= +-----END CERTIFICATE----- + +-----BEGIN CERTIFICATE----- +MIIC5jCCAc6gAwIBAgIIaYRSm3Q7zc8wDQYJKoZIhvcNAQELBQAwIDEeMBwGA1UE +AwwVbGN5Mi1kdDExMC54ZW5ydGNsb3VkMB4XDTIwMTAxNDE1NTc1MloXDTMwMTAx +MjE1NTc1MlowIDEeMBwGA1UEAwwVbGN5Mi1kdDExMC54ZW5ydGNsb3VkMIIBIjAN +BgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEA+5SOY1AKwqp3B7c3EhSvjiYFzL9e +gItLI7CypsVFQp5RJXp/9FRCMk1sLB3gfqMcQ5bhhPM4QfW0iK9wtcRxFILYI/oH ++vwNEJ5f3yBpIbjhbD6IaJcV1xpNkJD0JRqxPRUcRTRkKSLq9Hp4nqScOCvkjKgG +hlL3cFn3uOKWIzrJgEtyFixEXaY8XLqYLxy8BJ5PuM4Xsqafd4lb5qsK1/KJC4iS +WWqdXsOhICs3itpsPR1HneHdABigpAIYIcxk5fyLC8+EDjhXrK2OGsEMMytUsAbx +ePcQLjokW1EXc7fiuxrKDdJZuT/AsWZqw0hqRkdQSAqzEmrUhjdDbjgifQIDAQAB +oyQwIjAgBgNVHREEGTAXghVsY3kyLWR0MTEwLnhlbnJ0Y2xvdWQwDQYJKoZIhvcN +AQELBQADggEBAHEkeEjHilXdVgQhD/z46prXObB26uO97yFUcUIalzhb/P3zmfjb +LFatTFn5jgienMmdP90uj7Ly1R6VOa+tX/o+XtSJaZwuNMtixv9qwo3nrFZdw8yF +GgsmbAR+1hu0TG3RNpDIiES4D3JmVP8MgmwLw1kN3cBVptx73lE3uc8vZnNtIDOl +erJb9fD3IOv/RZ78mxMnajZTHY5kg2e96d/a6HgY39vXMwycjp8wIE/+4g94fIc/ +/a2+BGYjCWJZyoLgmHcXEU8fOxe9yUWbFQf0wnqsLJIqzaQU1w2w6mkh4+xsI/nA +JwFfXQKd3fzsvgmufpAbXt/AHljFvC/qjTI= +-----END CERTIFICATE----- + + +-----BEGIN PRIVATE KEY----- +MIIEvAIBADANBgkqhkiG9w0BAQEFAASCBKYwggSiAgEAAoIBAQD7lI5jUArCqncH +tzcSFK+OJgXMv16Ai0sjsLKmxUVCnlElen/0VEIyTWwsHeB+oxxDluGE8zhB9bSI +r3C1xHEUgtgj+gf6/A0Qnl/fIGkhuOFsPoholxXXGk2QkPQlGrE9FRxFNGQpIur0 +eniepJw4K+SMqAaGUvdwWfe44pYjOsmAS3IWLERdpjxcupgvHLwEnk+4zheypp93 +iVvmqwrX8okLiJJZap1ew6EgKzeK2mw9HUed4d0AGKCkAhghzGTl/IsLz4QOOFes +rY4awQwzK1SwBvF49xAuOiRbURdzt+K7GsoN0lm5P8CxZmrDSGpGR1BICrMSatSG +N0NuOCJ9AgMBAAECggEATgm51VKZ0+Kew5Twjzo9bqGawPVHsiYDK9H+yL5+inij +gTWrhTWxxvq/KDwoS//6n3ipAd2UQNmfo5qQIsIJtawUsaw4V4Fh6BrIcGUUV3KK +8lG/bHoZOz0cfFCKewv5mJH4z/q9awk6ypVG3yb+kmoDHiJsy7Pmr0IpFn+qxMg1 +EYZU91G10DguXekciRtNcZJRL0wCQR3s2OwDdQUC+XIotvAsKiuhWl++MLwn42ad +EwhzLuLd312qWg58ByCcNq8/XJkHJUbKDTWmBRGopWRliduP+Kb6vJZ16KL0G2B+ +OKuTQxMOzVVmumXdEVj3kH54cjpn7kCq9jwhhSJiQQKBgQD94ZFOzsUzZfmNlDZ3 +hFmkFuFpQCacH58FQX/vD6JQ84HwEHJx69aHYI6olCNaKcNwMhsOw+0KqBRWZnCf +A6oMWUf3pkogV5JZJy7DyHNOmkfI/w8NcWtqJ03pCoA237f5RH0sul2ady9BVzsJ +/8rb3B5uDw8+XesnG8Ryj6BCsQKBgQD9rhKfHxJgsZUzyassIumYcLTefgdoeCq5 +awd+YaM9jrGGN1ty8dTEzo3rbovnz8y+ZJMzaDRbCUeNTQjKDox8mWffRTpjxcks +rJzImY7coBdnZT8K4C5OMoeCAr30FI1veXBk/XFfr56h1X8QbmM2kuJwpsf5bOaf +CTfL2q2XjQKBgHem4pvYuXoC2n1OV+k2GCVMn0nCcS/tez234/qgTKiISzoAFl/4 +fW/qIvHyd0LcIf7zrmrkDgiStJsPxo465N7TCSb/WToq649W9yRQiX+HGMPy6X41 +cSFjisWFLG4wO/2fuLrmzoypFT1fRjTtOAcsk67dLBsBmn0hChHP/QDRAoGASXS7 +XaogpzEk1A8kaq5dV8/i/74cpQqOzIwKanUZULzd+NBUwa72/loVTEQBbQmF7ueu +nCcjae0A9BCHaALYeUfuhP9Fzhg6jZ4Z9BhK/uW4gS8XFy4dGnWVOXdTy7ab0din +TAb7akqvM4tftMFSJz5XJWmV5Eq9aPXBW10iAQ0CgYBl6PsdqWBjvPnqX3NCyAGH +ZO4iUcrqODdeTcKpILgqBmh9/IepClgCtwW1Iluna7QTDtVqotKcft1BtHJzeKWT +6TvCgje2k0RWo6TkzroaF74lyAojzWOrmuq+skVbWTiebc4bCA1KtLMLaQHIEtdo +FIPEq03cDKVNDCgABw4mkw== +-----END PRIVATE KEY----- + +-----BEGIN CERTIFICATE----- +MIIC5jCCAc6gAwIBAgIIaYRSm3Q7zc8wDQYJKoZIhvcNAQELBQAwIDEeMBwGA1UE +AwwVbGN5Mi1kdDExMC54ZW5ydGNsb3VkMB4XDTIwMTAxNDE1NTc1MloXDTMwMTAx +MjE1NTc1MlowIDEeMBwGA1UEAwwVbGN5Mi1kdDExMC54ZW5ydGNsb3VkMIIBIjAN +BgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEA+5SOY1AKwqp3B7c3EhSvjiYFzL9e +gItLI7CypsVFQp5RJXp/9FRCMk1sLB3gfqMcQ5bhhPM4QfW0iK9wtcRxFILYI/oH ++vwNEJ5f3yBpIbjhbD6IaJcV1xpNkJD0JRqxPRUcRTRkKSLq9Hp4nqScOCvkjKgG +hlL3cFn3uOKWIzrJgEtyFixEXaY8XLqYLxy8BJ5PuM4Xsqafd4lb5qsK1/KJC4iS +WWqdXsOhICs3itpsPR1HneHdABigpAIYIcxk5fyLC8+EDjhXrK2OGsEMMytUsAbx +ePcQLjokW1EXc7fiuxrKDdJZuT/AsWZqw0hqRkdQSAqzEmrUhjdDbjgifQIDAQAB +oyQwIjAgBgNVHREEGTAXghVsY3kyLWR0MTEwLnhlbnJ0Y2xvdWQwDQYJKoZIhvcN +AQELBQADggEBAHEkeEjHilXdVgQhD/z46prXObB26uO97yFUcUIalzhb/P3zmfjb +LFatTFn5jgienMmdP90uj7Ly1R6VOa+tX/o+XtSJaZwuNMtixv9qwo3nrFZdw8yF +GgsmbAR+1hu0TG3RNpDIiES4D3JmVP8MgmwLw1kN3cBVptx73lE3uc8vZnNtIDOl +erJb9fD3IOv/RZ78mxMnajZTHY5kg2e96d/a6HgY39vXMwycjp8wIE/+4g94fIc/ +/a2+BGYjCWJZyoLgmHcXEU8fOxe9yUWbFQf0wnqsLJIqzaQU1w2w6mkh4+xsI/nA +JwFfXQKd3fzsvgmufpAbXt/AHljFvC/qjTI= +-----END CERTIFICATE----- + +-----BEGIN CERTIFICATE----- +MIIC5jCCAc6gAwIBAgIIaYRSm3Q7zc8wDQYJKoZIhvcNAQELBQAwIDEeMBwGA1UE +AwwVbGN5Mi1kdDExMC54ZW5ydGNsb3VkMB4XDTIwMTAxNDE1NTc1MloXDTMwMTAx +MjE1NTc1MlowIDEeMBwGA1UEAwwVbGN5Mi1kdDExMC54ZW5ydGNsb3VkMIIBIjAN +BgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEA+5SOY1AKwqp3B7c3EhSvjiYFzL9e +gItLI7CypsVFQp5RJXp/9FRCMk1sLB3gfqMcQ5bhhPM4QfW0iK9wtcRxFILYI/oH ++vwNEJ5f3yBpIbjhbD6IaJcV1xpNkJD0JRqxPRUcRTRkKSLq9Hp4nqScOCvkjKgG +hlL3cFn3uOKWIzrJgEtyFixEXaY8XLqYLxy8BJ5PuM4Xsqafd4lb5qsK1/KJC4iS +WWqdXsOhICs3itpsPR1HneHdABigpAIYIcxk5fyLC8+EDjhXrK2OGsEMMytUsAbx +ePcQLjokW1EXc7fiuxrKDdJZuT/AsWZqw0hqRkdQSAqzEmrUhjdDbjgifQIDAQAB +oyQwIjAgBgNVHREEGTAXghVsY3kyLWR0MTEwLnhlbnJ0Y2xvdWQwDQYJKoZIhvcN +AQELBQADggEBAHEkeEjHilXdVgQhD/z46prXObB26uO97yFUcUIalzhb/P3zmfjb +LFatTFn5jgienMmdP90uj7Ly1R6VOa+tX/o+XtSJaZwuNMtixv9qwo3nrFZdw8yF +GgsmbAR+1hu0TG3RNpDIiES4D3JmVP8MgmwLw1kN3cBVptx73lE3uc8vZnNtIDOl +erJb9fD3IOv/RZ78mxMnajZTHY5kg2e96d/a6HgY39vXMwycjp8wIE/+4g94fIc/ +/a2+BGYjCWJZyoLgmHcXEU8fOxe9yUWbFQf0wnqsLJIqzaQU1w2w6mkh4+xsI/nA +JwFfXQKd3fzsvgmufpAbXt/AHljFvC/qjTI= +-----END CERTIFICATE----- + + diff --git a/ocaml/gencert/test_data/pems/pass-xsi-1781-reformat.pem b/ocaml/gencert/test_data/pems/pass-xsi-1781-reformat.pem new file mode 100644 index 00000000000..b0e3cf8288f --- /dev/null +++ b/ocaml/gencert/test_data/pems/pass-xsi-1781-reformat.pem @@ -0,0 +1,51 @@ +-----BEGIN PRIVATE KEY----- +MIIEvQIBADANBgkqhkiG9w0BAQEFAASCBKcwggSjAgEAAoIBAQC7qKYiCfucgzLI +X78/NTAtFXA97Cp3PfnQwpi90tF0YmWUObOdVdxP2FHvUTyMhItpvimsvztX503D +C0Q7lI9/omK3AbPPy51lhRCKTMiz8ic2fmiHU9lePmkZMZJv0p/eHgAIcOmIl5Kc +uvoKvOutLnFTRKrYhUQMu2eyBz0f8rzY/4yhLLNflkQUJ3zc3W0jeMuAUei7Zmtz +jpj+s3Ll5rwzVYG3xLbndzpCR7NaP5uZcchByhsirohR90m3dQtrFdtLTkiDJ8vJ +hW7z3AzAA0Btw/CtH1/Ef/rHt3XHKGMJoJ3nQ2zRvSutdrRSAknNqYONe0hyrLvy +MRGno7SjAgMBAAECggEANHjKw1fRQAk7aOXE3xKrPt/wu4/Oq/rrYGEZPnK1WHqu +9oxP2d2JNdZBys4HRS9GoDGpC4GJQWIOz0vWL2ax3Tl1qsBSG/dOMnXLkzA3KoG6 +TzV3WueqLvz6fC3tSVE2nG/9CF8yHZxsRWDOy7PZnloPG/5mWxagWYMJUrFNeSH2 +nXd40Rff5uM43OzKtiOOzoKv2bKlKReyJVcI98MkyqSbUiie6qO1/NqrOUhq7rsV +zFmbtjy8UL4gXR2VVz0itb/w/iV/SDVHdMQ36obo8EM9eyxUFu4QPscrbK0FvjHV +lsKTnzu1zj/fm68NafXDy/KL5I9jethsj8ReNaQzoQKBgQDLkaIxBtNtAZfcFK7S +dXtR7fIQfUTtgDrxznYXPqCkCy/0wp53hj7aShX2C/rfFQVElBUPkf2E/P6v7Xnf +b+M/Zj6TH7XYbScoVu+8cqfIm1ySd3evK4GoqGIUiJeuSYEfeLqZSTp1XxO05lGb +ZmAEtZUHor24Co9HIV/3P86EcwKBgQDr/fqn6b6V1O64r7/cnOmWhW1+5MjoWO2K ++y0fSutrPMOFK4ItJIk4Q5JbHA42cwyYRMe+oElGXzWJXGbqxyorFhW0Er/+roTa +6GXwNrRkdA3S0rgPAE7IS42WLDsAO9/muiZJ4heXtk8i0xDoyy3Y8UQ/6hR4h1px +jtn9Bs4zEQKBgBdW+TuZxr/mwNyQ2oJyydLY7zoIwtBgNWHoBA4iNhTY24S6k6Ss +laQ9fksZkIfnRxVXzRpd6K1IvIK7PY/qqilotZ/0sMrBqQ2s+gunMamEdpasb+J7 +oIAP3j7wckOfVdif5PUSOkuevQmupoiksjmYACBB/nKNc2P6ZaBZhnoVAoGBAJuc +4z777BeCzFNuWJaRxZniq9wj4rMLiL+/dvaOgYQ6EjdrBDDeSbmXHRgE/P48iQ6T +NB9oNEk6GORV0Ot5nz3AF1mhj4bR73smCaoHeJZQzJi7KHGD429CGr/utI0n7jGH +iB3p/2Kj7bTp9tl6uOW32ihHI26C2knNR8MITMnxAoGAZ+Dpg1a6u2ZMTSgOn9Vc +pECwENGtOQP4RKyXmnq3ET5ykx1hMMCf9uoA09TXDRuJ/20hVfsAGvLZdbQq/9DL +C3bckcoalhy8RXC/OV9c6SC/xgoYiggxmZtzV34wnQSLM4Cr+Q/lhOaj7sop6iJi +apYRps2sXbUdu3pDTub/zSI= +-----END PRIVATE KEY----- +-----BEGIN CERTIFICATE----- +MIIDwzCCAqugAwIBAgIUZeSD7KNhTFOoqpI7cWxxWcN417EwDQYJKoZIhvcNAQEL +BQAwcTELMAkGA1UEBhMCVUsxEzARBgNVBAgMClNvbWUtU3RhdGUxEjAQBgNVBAcM +CUNhbWJyaWRnZTEPMA0GA1UECgwGQ2l0cml4MRIwEAYDVQQLDAlYZW5TZXJ2ZXIx +FDASBgNVBAMMC2V4YW1wbGUuY29tMB4XDTI1MDExNDE1NDIwMFoXDTM1MDExMjE1 +NDIwMFowcTELMAkGA1UEBhMCVUsxEzARBgNVBAgMClNvbWUtU3RhdGUxEjAQBgNV +BAcMCUNhbWJyaWRnZTEPMA0GA1UECgwGQ2l0cml4MRIwEAYDVQQLDAlYZW5TZXJ2 +ZXIxFDASBgNVBAMMC2V4YW1wbGUuY29tMIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8A +MIIBCgKCAQEAu6imIgn7nIMyyF+/PzUwLRVwPewqdz350MKYvdLRdGJllDmznVXc +T9hR71E8jISLab4prL87V+dNwwtEO5SPf6JitwGzz8udZYUQikzIs/InNn5oh1PZ +Xj5pGTGSb9Kf3h4ACHDpiJeSnLr6CrzrrS5xU0Sq2IVEDLtnsgc9H/K82P+MoSyz +X5ZEFCd83N1tI3jLgFHou2Zrc46Y/rNy5ea8M1WBt8S253c6QkezWj+bmXHIQcob +Iq6IUfdJt3ULaxXbS05IgyfLyYVu89wMwANAbcPwrR9fxH/6x7d1xyhjCaCd50Ns +0b0rrXa0UgJJzamDjXtIcqy78jERp6O0owIDAQABo1MwUTAdBgNVHQ4EFgQUK3or +CHusUjk/eheKHz6JMuYQBkAwHwYDVR0jBBgwFoAUK3orCHusUjk/eheKHz6JMuYQ +BkAwDwYDVR0TAQH/BAUwAwEB/zANBgkqhkiG9w0BAQsFAAOCAQEATq7rhHQE3xSk +NUsD1dIFUwz7NJ1eIbdNQ8kJGybcTkIsBY9PrUcrnXFozEE05dZaZizCK/F0To3v +903kVAwaBe04sZuIqAVDHAjewH2yfCAIRkgA6RPnSHio6NTCLMi3Ukqrhj5bIFGy +eqcAKy0akXeV3uLIKKY/ZdNpPRP5gW2UZpC+p9ZBEcVDNKAWEK+GVLDar1MLdyIp +XyCp4wimx4iK+TyXEYKRK7G5+/HPtYOU2OrHtuUFnppz4G5/QuyuDO7yDAJaK8X/ +9hIuR4tcxzt3FdBMVXju5PViMpKbpw5XslbGxdAFFCSrkSRvzYw98tq7HkUB5IyV +OgjjLNHdJg== +-----END CERTIFICATE----- diff --git a/ocaml/gencert/test_data/pems/pass-xsi-1781.pem b/ocaml/gencert/test_data/pems/pass-xsi-1781.pem new file mode 100644 index 00000000000..7623c6e5cf0 --- /dev/null +++ b/ocaml/gencert/test_data/pems/pass-xsi-1781.pem @@ -0,0 +1,111 @@ +Certificate: + Data: + Version: 3 (0x2) + Serial Number: + 65:e4:83:ec:a3:61:4c:53:a8:aa:92:3b:71:6c:71:59:c3:78:d7:b1 + Signature Algorithm: sha256WithRSAEncryption + Issuer: C = UK, ST = Some-State, L = Cambridge, O = Citrix, OU = XenServer, CN = example.com + Validity + Not Before: Jan 14 15:42:00 2025 GMT + Not After : Jan 12 15:42:00 2035 GMT + Subject: C = UK, ST = Some-State, L = Cambridge, O = Citrix, OU = XenServer, CN = example.com + Subject Public Key Info: + Public Key Algorithm: rsaEncryption + Public-Key: (2048 bit) + Modulus: + 00:bb:a8:a6:22:09:fb:9c:83:32:c8:5f:bf:3f:35: + 30:2d:15:70:3d:ec:2a:77:3d:f9:d0:c2:98:bd:d2: + d1:74:62:65:94:39:b3:9d:55:dc:4f:d8:51:ef:51: + 3c:8c:84:8b:69:be:29:ac:bf:3b:57:e7:4d:c3:0b: + 44:3b:94:8f:7f:a2:62:b7:01:b3:cf:cb:9d:65:85: + 10:8a:4c:c8:b3:f2:27:36:7e:68:87:53:d9:5e:3e: + 69:19:31:92:6f:d2:9f:de:1e:00:08:70:e9:88:97: + 92:9c:ba:fa:0a:bc:eb:ad:2e:71:53:44:aa:d8:85: + 44:0c:bb:67:b2:07:3d:1f:f2:bc:d8:ff:8c:a1:2c: + b3:5f:96:44:14:27:7c:dc:dd:6d:23:78:cb:80:51: + e8:bb:66:6b:73:8e:98:fe:b3:72:e5:e6:bc:33:55: + 81:b7:c4:b6:e7:77:3a:42:47:b3:5a:3f:9b:99:71: + c8:41:ca:1b:22:ae:88:51:f7:49:b7:75:0b:6b:15: + db:4b:4e:48:83:27:cb:c9:85:6e:f3:dc:0c:c0:03: + 40:6d:c3:f0:ad:1f:5f:c4:7f:fa:c7:b7:75:c7:28: + 63:09:a0:9d:e7:43:6c:d1:bd:2b:ad:76:b4:52:02: + 49:cd:a9:83:8d:7b:48:72:ac:bb:f2:31:11:a7:a3: + b4:a3 + Exponent: 65537 (0x10001) + X509v3 extensions: + X509v3 Subject Key Identifier: + 2B:7A:2B:08:7B:AC:52:39:3F:7A:17:8A:1F:3E:89:32:E6:10:06:40 + X509v3 Authority Key Identifier: + 2B:7A:2B:08:7B:AC:52:39:3F:7A:17:8A:1F:3E:89:32:E6:10:06:40 + X509v3 Basic Constraints: critical + CA:TRUE + Signature Algorithm: sha256WithRSAEncryption + Signature Value: + 4e:ae:eb:84:74:04:df:14:a4:35:4b:03:d5:d2:05:53:0c:fb: + 34:9d:5e:21:b7:4d:43:c9:09:1b:26:dc:4e:42:2c:05:8f:4f: + ad:47:2b:9d:71:68:cc:41:34:e5:d6:5a:66:2c:c2:2b:f1:74: + 4e:8d:ef:f7:4d:e4:54:0c:1a:05:ed:38:b1:9b:88:a8:05:43: + 1c:08:de:c0:7d:b2:7c:20:08:46:48:00:e9:13:e7:48:78:a8: + e8:d4:c2:2c:c8:b7:52:4a:ab:86:3e:5b:20:51:b2:7a:a7:00: + 2b:2d:1a:91:77:95:de:e2:c8:28:a6:3f:65:d3:69:3d:13:f9: + 81:6d:94:66:90:be:a7:d6:41:11:c5:43:34:a0:16:10:af:86: + 54:b0:da:af:53:0b:77:22:29:5f:20:a9:e3:08:a6:c7:88:8a: + f9:3c:97:11:82:91:2b:b1:b9:fb:f1:cf:b5:83:94:d8:ea:c7: + b6:e5:05:9e:9a:73:e0:6e:7f:42:ec:ae:0c:ee:f2:0c:02:5a: + 2b:c5:ff:f6:12:2e:47:8b:5c:c7:3b:77:15:d0:4c:55:78:ee: + e4:f5:62:32:92:9b:a7:0e:57:b2:56:c6:c5:d0:05:14:24:ab: + 91:24:6f:cd:8c:3d:f2:da:bb:1e:45:01:e4:8c:95:3a:08:e3: + 2c:d1:dd:26 +-----BEGIN CERTIFICATE----- +MIIDwzCCAqugAwIBAgIUZeSD7KNhTFOoqpI7cWxxWcN417EwDQYJKoZIhvcNAQEL +BQAwcTELMAkGA1UEBhMCVUsxEzARBgNVBAgMClNvbWUtU3RhdGUxEjAQBgNVBAcM +CUNhbWJyaWRnZTEPMA0GA1UECgwGQ2l0cml4MRIwEAYDVQQLDAlYZW5TZXJ2ZXIx +FDASBgNVBAMMC2V4YW1wbGUuY29tMB4XDTI1MDExNDE1NDIwMFoXDTM1MDExMjE1 +NDIwMFowcTELMAkGA1UEBhMCVUsxEzARBgNVBAgMClNvbWUtU3RhdGUxEjAQBgNV +BAcMCUNhbWJyaWRnZTEPMA0GA1UECgwGQ2l0cml4MRIwEAYDVQQLDAlYZW5TZXJ2 +ZXIxFDASBgNVBAMMC2V4YW1wbGUuY29tMIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8A +MIIBCgKCAQEAu6imIgn7nIMyyF+/PzUwLRVwPewqdz350MKYvdLRdGJllDmznVXc +T9hR71E8jISLab4prL87V+dNwwtEO5SPf6JitwGzz8udZYUQikzIs/InNn5oh1PZ +Xj5pGTGSb9Kf3h4ACHDpiJeSnLr6CrzrrS5xU0Sq2IVEDLtnsgc9H/K82P+MoSyz +X5ZEFCd83N1tI3jLgFHou2Zrc46Y/rNy5ea8M1WBt8S253c6QkezWj+bmXHIQcob +Iq6IUfdJt3ULaxXbS05IgyfLyYVu89wMwANAbcPwrR9fxH/6x7d1xyhjCaCd50Ns +0b0rrXa0UgJJzamDjXtIcqy78jERp6O0owIDAQABo1MwUTAdBgNVHQ4EFgQUK3or +CHusUjk/eheKHz6JMuYQBkAwHwYDVR0jBBgwFoAUK3orCHusUjk/eheKHz6JMuYQ +BkAwDwYDVR0TAQH/BAUwAwEB/zANBgkqhkiG9w0BAQsFAAOCAQEATq7rhHQE3xSk +NUsD1dIFUwz7NJ1eIbdNQ8kJGybcTkIsBY9PrUcrnXFozEE05dZaZizCK/F0To3v +903kVAwaBe04sZuIqAVDHAjewH2yfCAIRkgA6RPnSHio6NTCLMi3Ukqrhj5bIFGy +eqcAKy0akXeV3uLIKKY/ZdNpPRP5gW2UZpC+p9ZBEcVDNKAWEK+GVLDar1MLdyIp +XyCp4wimx4iK+TyXEYKRK7G5+/HPtYOU2OrHtuUFnppz4G5/QuyuDO7yDAJaK8X/ +9hIuR4tcxzt3FdBMVXju5PViMpKbpw5XslbGxdAFFCSrkSRvzYw98tq7HkUB5IyV +OgjjLNHdJg== +-----END CERTIFICATE----- + + +-----BEGIN PRIVATE KEY----- +MIIEvQIBADANBgkqhkiG9w0BAQEFAASCBKcwggSjAgEAAoIBAQC7qKYiCfucgzLI +X78/NTAtFXA97Cp3PfnQwpi90tF0YmWUObOdVdxP2FHvUTyMhItpvimsvztX503D +C0Q7lI9/omK3AbPPy51lhRCKTMiz8ic2fmiHU9lePmkZMZJv0p/eHgAIcOmIl5Kc +uvoKvOutLnFTRKrYhUQMu2eyBz0f8rzY/4yhLLNflkQUJ3zc3W0jeMuAUei7Zmtz +jpj+s3Ll5rwzVYG3xLbndzpCR7NaP5uZcchByhsirohR90m3dQtrFdtLTkiDJ8vJ +hW7z3AzAA0Btw/CtH1/Ef/rHt3XHKGMJoJ3nQ2zRvSutdrRSAknNqYONe0hyrLvy +MRGno7SjAgMBAAECggEANHjKw1fRQAk7aOXE3xKrPt/wu4/Oq/rrYGEZPnK1WHqu +9oxP2d2JNdZBys4HRS9GoDGpC4GJQWIOz0vWL2ax3Tl1qsBSG/dOMnXLkzA3KoG6 +TzV3WueqLvz6fC3tSVE2nG/9CF8yHZxsRWDOy7PZnloPG/5mWxagWYMJUrFNeSH2 +nXd40Rff5uM43OzKtiOOzoKv2bKlKReyJVcI98MkyqSbUiie6qO1/NqrOUhq7rsV +zFmbtjy8UL4gXR2VVz0itb/w/iV/SDVHdMQ36obo8EM9eyxUFu4QPscrbK0FvjHV +lsKTnzu1zj/fm68NafXDy/KL5I9jethsj8ReNaQzoQKBgQDLkaIxBtNtAZfcFK7S +dXtR7fIQfUTtgDrxznYXPqCkCy/0wp53hj7aShX2C/rfFQVElBUPkf2E/P6v7Xnf +b+M/Zj6TH7XYbScoVu+8cqfIm1ySd3evK4GoqGIUiJeuSYEfeLqZSTp1XxO05lGb +ZmAEtZUHor24Co9HIV/3P86EcwKBgQDr/fqn6b6V1O64r7/cnOmWhW1+5MjoWO2K ++y0fSutrPMOFK4ItJIk4Q5JbHA42cwyYRMe+oElGXzWJXGbqxyorFhW0Er/+roTa +6GXwNrRkdA3S0rgPAE7IS42WLDsAO9/muiZJ4heXtk8i0xDoyy3Y8UQ/6hR4h1px +jtn9Bs4zEQKBgBdW+TuZxr/mwNyQ2oJyydLY7zoIwtBgNWHoBA4iNhTY24S6k6Ss +laQ9fksZkIfnRxVXzRpd6K1IvIK7PY/qqilotZ/0sMrBqQ2s+gunMamEdpasb+J7 +oIAP3j7wckOfVdif5PUSOkuevQmupoiksjmYACBB/nKNc2P6ZaBZhnoVAoGBAJuc +4z777BeCzFNuWJaRxZniq9wj4rMLiL+/dvaOgYQ6EjdrBDDeSbmXHRgE/P48iQ6T +NB9oNEk6GORV0Ot5nz3AF1mhj4bR73smCaoHeJZQzJi7KHGD429CGr/utI0n7jGH +iB3p/2Kj7bTp9tl6uOW32ihHI26C2knNR8MITMnxAoGAZ+Dpg1a6u2ZMTSgOn9Vc +pECwENGtOQP4RKyXmnq3ET5ykx1hMMCf9uoA09TXDRuJ/20hVfsAGvLZdbQq/9DL +C3bckcoalhy8RXC/OV9c6SC/xgoYiggxmZtzV34wnQSLM4Cr+Q/lhOaj7sop6iJi +apYRps2sXbUdu3pDTub/zSI= +-----END PRIVATE KEY----- diff --git a/ocaml/gencert/test_data/reformat.sh b/ocaml/gencert/test_data/reformat.sh new file mode 100755 index 00000000000..67bb040f08c --- /dev/null +++ b/ocaml/gencert/test_data/reformat.sh @@ -0,0 +1,27 @@ +#!/usr/bin/env bash +# parse a PEM file for certificate and key and emit them again as a PEM +# to stdout. This is in response to XSI-1781. + +set -o errexit +set -o pipefail +if [[ -n "$TRACE" ]]; then set -o xtrace; fi +set -o nounset + +if [[ "${1-}" =~ ^-*h(elp)?$ ]]; then + cat < Date: Tue, 14 Jan 2025 15:24:43 +0000 Subject: [PATCH 08/13] CA-404640 XSI-1781 bring back fail-06.pem Add back a unit test. Signed-off-by: Christian Lindig --- ocaml/gencert/test_data/pems/fail-06.pem | 93 +----------------------- 1 file changed, 2 insertions(+), 91 deletions(-) diff --git a/ocaml/gencert/test_data/pems/fail-06.pem b/ocaml/gencert/test_data/pems/fail-06.pem index 05a638c7a02..6b63e248c1b 100644 --- a/ocaml/gencert/test_data/pems/fail-06.pem +++ b/ocaml/gencert/test_data/pems/fail-06.pem @@ -1,74 +1,4 @@ -This fails because we have two keys (rather than just one). - ------BEGIN CERTIFICATE----- -MIIC5jCCAc6gAwIBAgIIaYRSm3Q7zc8wDQYJKoZIhvcNAQELBQAwIDEeMBwGA1UE -AwwVbGN5Mi1kdDExMC54ZW5ydGNsb3VkMB4XDTIwMTAxNDE1NTc1MloXDTMwMTAx -MjE1NTc1MlowIDEeMBwGA1UEAwwVbGN5Mi1kdDExMC54ZW5ydGNsb3VkMIIBIjAN -BgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEA+5SOY1AKwqp3B7c3EhSvjiYFzL9e -gItLI7CypsVFQp5RJXp/9FRCMk1sLB3gfqMcQ5bhhPM4QfW0iK9wtcRxFILYI/oH -+vwNEJ5f3yBpIbjhbD6IaJcV1xpNkJD0JRqxPRUcRTRkKSLq9Hp4nqScOCvkjKgG -hlL3cFn3uOKWIzrJgEtyFixEXaY8XLqYLxy8BJ5PuM4Xsqafd4lb5qsK1/KJC4iS -WWqdXsOhICs3itpsPR1HneHdABigpAIYIcxk5fyLC8+EDjhXrK2OGsEMMytUsAbx -ePcQLjokW1EXc7fiuxrKDdJZuT/AsWZqw0hqRkdQSAqzEmrUhjdDbjgifQIDAQAB -oyQwIjAgBgNVHREEGTAXghVsY3kyLWR0MTEwLnhlbnJ0Y2xvdWQwDQYJKoZIhvcN -AQELBQADggEBAHEkeEjHilXdVgQhD/z46prXObB26uO97yFUcUIalzhb/P3zmfjb -LFatTFn5jgienMmdP90uj7Ly1R6VOa+tX/o+XtSJaZwuNMtixv9qwo3nrFZdw8yF -GgsmbAR+1hu0TG3RNpDIiES4D3JmVP8MgmwLw1kN3cBVptx73lE3uc8vZnNtIDOl -erJb9fD3IOv/RZ78mxMnajZTHY5kg2e96d/a6HgY39vXMwycjp8wIE/+4g94fIc/ -/a2+BGYjCWJZyoLgmHcXEU8fOxe9yUWbFQf0wnqsLJIqzaQU1w2w6mkh4+xsI/nA -JwFfXQKd3fzsvgmufpAbXt/AHljFvC/qjTI= ------END CERTIFICATE----- - ------BEGIN CERTIFICATE----- -MIIC5jCCAc6gAwIBAgIIaYRSm3Q7zc8wDQYJKoZIhvcNAQELBQAwIDEeMBwGA1UE -AwwVbGN5Mi1kdDExMC54ZW5ydGNsb3VkMB4XDTIwMTAxNDE1NTc1MloXDTMwMTAx -MjE1NTc1MlowIDEeMBwGA1UEAwwVbGN5Mi1kdDExMC54ZW5ydGNsb3VkMIIBIjAN -BgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEA+5SOY1AKwqp3B7c3EhSvjiYFzL9e -gItLI7CypsVFQp5RJXp/9FRCMk1sLB3gfqMcQ5bhhPM4QfW0iK9wtcRxFILYI/oH -+vwNEJ5f3yBpIbjhbD6IaJcV1xpNkJD0JRqxPRUcRTRkKSLq9Hp4nqScOCvkjKgG -hlL3cFn3uOKWIzrJgEtyFixEXaY8XLqYLxy8BJ5PuM4Xsqafd4lb5qsK1/KJC4iS -WWqdXsOhICs3itpsPR1HneHdABigpAIYIcxk5fyLC8+EDjhXrK2OGsEMMytUsAbx -ePcQLjokW1EXc7fiuxrKDdJZuT/AsWZqw0hqRkdQSAqzEmrUhjdDbjgifQIDAQAB -oyQwIjAgBgNVHREEGTAXghVsY3kyLWR0MTEwLnhlbnJ0Y2xvdWQwDQYJKoZIhvcN -AQELBQADggEBAHEkeEjHilXdVgQhD/z46prXObB26uO97yFUcUIalzhb/P3zmfjb -LFatTFn5jgienMmdP90uj7Ly1R6VOa+tX/o+XtSJaZwuNMtixv9qwo3nrFZdw8yF -GgsmbAR+1hu0TG3RNpDIiES4D3JmVP8MgmwLw1kN3cBVptx73lE3uc8vZnNtIDOl -erJb9fD3IOv/RZ78mxMnajZTHY5kg2e96d/a6HgY39vXMwycjp8wIE/+4g94fIc/ -/a2+BGYjCWJZyoLgmHcXEU8fOxe9yUWbFQf0wnqsLJIqzaQU1w2w6mkh4+xsI/nA -JwFfXQKd3fzsvgmufpAbXt/AHljFvC/qjTI= ------END CERTIFICATE----- - ------BEGIN PRIVATE KEY----- -MIIEvAIBADANBgkqhkiG9w0BAQEFAASCBKYwggSiAgEAAoIBAQD7lI5jUArCqncH -tzcSFK+OJgXMv16Ai0sjsLKmxUVCnlElen/0VEIyTWwsHeB+oxxDluGE8zhB9bSI -r3C1xHEUgtgj+gf6/A0Qnl/fIGkhuOFsPoholxXXGk2QkPQlGrE9FRxFNGQpIur0 -eniepJw4K+SMqAaGUvdwWfe44pYjOsmAS3IWLERdpjxcupgvHLwEnk+4zheypp93 -iVvmqwrX8okLiJJZap1ew6EgKzeK2mw9HUed4d0AGKCkAhghzGTl/IsLz4QOOFes -rY4awQwzK1SwBvF49xAuOiRbURdzt+K7GsoN0lm5P8CxZmrDSGpGR1BICrMSatSG -N0NuOCJ9AgMBAAECggEATgm51VKZ0+Kew5Twjzo9bqGawPVHsiYDK9H+yL5+inij -gTWrhTWxxvq/KDwoS//6n3ipAd2UQNmfo5qQIsIJtawUsaw4V4Fh6BrIcGUUV3KK -8lG/bHoZOz0cfFCKewv5mJH4z/q9awk6ypVG3yb+kmoDHiJsy7Pmr0IpFn+qxMg1 -EYZU91G10DguXekciRtNcZJRL0wCQR3s2OwDdQUC+XIotvAsKiuhWl++MLwn42ad -EwhzLuLd312qWg58ByCcNq8/XJkHJUbKDTWmBRGopWRliduP+Kb6vJZ16KL0G2B+ -OKuTQxMOzVVmumXdEVj3kH54cjpn7kCq9jwhhSJiQQKBgQD94ZFOzsUzZfmNlDZ3 -hFmkFuFpQCacH58FQX/vD6JQ84HwEHJx69aHYI6olCNaKcNwMhsOw+0KqBRWZnCf -A6oMWUf3pkogV5JZJy7DyHNOmkfI/w8NcWtqJ03pCoA237f5RH0sul2ady9BVzsJ -/8rb3B5uDw8+XesnG8Ryj6BCsQKBgQD9rhKfHxJgsZUzyassIumYcLTefgdoeCq5 -awd+YaM9jrGGN1ty8dTEzo3rbovnz8y+ZJMzaDRbCUeNTQjKDox8mWffRTpjxcks -rJzImY7coBdnZT8K4C5OMoeCAr30FI1veXBk/XFfr56h1X8QbmM2kuJwpsf5bOaf -CTfL2q2XjQKBgHem4pvYuXoC2n1OV+k2GCVMn0nCcS/tez234/qgTKiISzoAFl/4 -fW/qIvHyd0LcIf7zrmrkDgiStJsPxo465N7TCSb/WToq649W9yRQiX+HGMPy6X41 -cSFjisWFLG4wO/2fuLrmzoypFT1fRjTtOAcsk67dLBsBmn0hChHP/QDRAoGASXS7 -XaogpzEk1A8kaq5dV8/i/74cpQqOzIwKanUZULzd+NBUwa72/loVTEQBbQmF7ueu -nCcjae0A9BCHaALYeUfuhP9Fzhg6jZ4Z9BhK/uW4gS8XFy4dGnWVOXdTy7ab0din -TAb7akqvM4tftMFSJz5XJWmV5Eq9aPXBW10iAQ0CgYBl6PsdqWBjvPnqX3NCyAGH -ZO4iUcrqODdeTcKpILgqBmh9/IepClgCtwW1Iluna7QTDtVqotKcft1BtHJzeKWT -6TvCgje2k0RWo6TkzroaF74lyAojzWOrmuq+skVbWTiebc4bCA1KtLMLaQHIEtdo -FIPEq03cDKVNDCgABw4mkw== ------END PRIVATE KEY----- - - ------BEGIN PRIVATE KEY----- +-----BEGIN RSA PRIVATE KEY----- MIIEvAIBADANBgkqhkiG9w0BAQEFAASCBKYwggSiAgEAAoIBAQD7lI5jUArCqncH tzcSFK+OJgXMv16Ai0sjsLKmxUVCnlElen/0VEIyTWwsHeB+oxxDluGE8zhB9bSI r3C1xHEUgtgj+gf6/A0Qnl/fIGkhuOFsPoholxXXGk2QkPQlGrE9FRxFNGQpIur0 @@ -95,26 +25,8 @@ TAb7akqvM4tftMFSJz5XJWmV5Eq9aPXBW10iAQ0CgYBl6PsdqWBjvPnqX3NCyAGH ZO4iUcrqODdeTcKpILgqBmh9/IepClgCtwW1Iluna7QTDtVqotKcft1BtHJzeKWT 6TvCgje2k0RWo6TkzroaF74lyAojzWOrmuq+skVbWTiebc4bCA1KtLMLaQHIEtdo FIPEq03cDKVNDCgABw4mkw== ------END PRIVATE KEY----- +-----END EC PRIVATE KEY----- ------BEGIN CERTIFICATE----- -MIIC5jCCAc6gAwIBAgIIaYRSm3Q7zc8wDQYJKoZIhvcNAQELBQAwIDEeMBwGA1UE -AwwVbGN5Mi1kdDExMC54ZW5ydGNsb3VkMB4XDTIwMTAxNDE1NTc1MloXDTMwMTAx -MjE1NTc1MlowIDEeMBwGA1UEAwwVbGN5Mi1kdDExMC54ZW5ydGNsb3VkMIIBIjAN -BgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEA+5SOY1AKwqp3B7c3EhSvjiYFzL9e -gItLI7CypsVFQp5RJXp/9FRCMk1sLB3gfqMcQ5bhhPM4QfW0iK9wtcRxFILYI/oH -+vwNEJ5f3yBpIbjhbD6IaJcV1xpNkJD0JRqxPRUcRTRkKSLq9Hp4nqScOCvkjKgG -hlL3cFn3uOKWIzrJgEtyFixEXaY8XLqYLxy8BJ5PuM4Xsqafd4lb5qsK1/KJC4iS -WWqdXsOhICs3itpsPR1HneHdABigpAIYIcxk5fyLC8+EDjhXrK2OGsEMMytUsAbx -ePcQLjokW1EXc7fiuxrKDdJZuT/AsWZqw0hqRkdQSAqzEmrUhjdDbjgifQIDAQAB -oyQwIjAgBgNVHREEGTAXghVsY3kyLWR0MTEwLnhlbnJ0Y2xvdWQwDQYJKoZIhvcN -AQELBQADggEBAHEkeEjHilXdVgQhD/z46prXObB26uO97yFUcUIalzhb/P3zmfjb -LFatTFn5jgienMmdP90uj7Ly1R6VOa+tX/o+XtSJaZwuNMtixv9qwo3nrFZdw8yF -GgsmbAR+1hu0TG3RNpDIiES4D3JmVP8MgmwLw1kN3cBVptx73lE3uc8vZnNtIDOl -erJb9fD3IOv/RZ78mxMnajZTHY5kg2e96d/a6HgY39vXMwycjp8wIE/+4g94fIc/ -/a2+BGYjCWJZyoLgmHcXEU8fOxe9yUWbFQf0wnqsLJIqzaQU1w2w6mkh4+xsI/nA -JwFfXQKd3fzsvgmufpAbXt/AHljFvC/qjTI= ------END CERTIFICATE----- -----BEGIN CERTIFICATE----- MIIC5jCCAc6gAwIBAgIIaYRSm3Q7zc8wDQYJKoZIhvcNAQELBQAwIDEeMBwGA1UE @@ -135,4 +47,3 @@ erJb9fD3IOv/RZ78mxMnajZTHY5kg2e96d/a6HgY39vXMwycjp8wIE/+4g94fIc/ JwFfXQKd3fzsvgmufpAbXt/AHljFvC/qjTI= -----END CERTIFICATE----- - From 5b86063ccfc77c49e82b097b6b0608bf41025e66 Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Tue, 14 Jan 2025 15:32:18 +0000 Subject: [PATCH 09/13] Log proper names for POSIX signals The integer values that OCaml uses for signals should never be printed as they are. They can cause confusion because they don't match the C POSIX values. Change the unixext function that converts them to string to stop building a list and finding a value in the list to instead use pattern-matching. Also added some more values that got introduced in OCaml 4.03, and return a more compact value for unknown signals, following the same format as Fmt.Dump.signal Signed-off-by: Pau Ruiz Safont --- doc/content/design/coverage/index.md | 39 +++++---- .../lib/xapi-stdext-unix/unixext.ml | 86 ++++++++++++------- ocaml/nbd/src/cleanup.ml | 8 +- ocaml/nbd/src/dune | 2 +- ocaml/networkd/bin/network_server.ml | 3 +- ocaml/xapi-guard/lib/server_interface.ml | 3 +- ocaml/xapi/helpers.ml | 5 +- ocaml/xcp-rrdd/bin/rrdd/dune | 2 - ocaml/xcp-rrdd/bin/rrdd/xcp_rrdd.ml | 2 +- ocaml/xcp-rrdd/lib/plugin/utils.ml | 5 +- ocaml/xenopsd/lib/cancellable_subprocess.ml | 11 +-- ocaml/xenopsd/lib/xenopsd.ml | 7 +- 12 files changed, 107 insertions(+), 66 deletions(-) diff --git a/doc/content/design/coverage/index.md b/doc/content/design/coverage/index.md index 3b3f6ec3ec7..fae989b4867 100644 --- a/doc/content/design/coverage/index.md +++ b/doc/content/design/coverage/index.md @@ -8,7 +8,7 @@ revision: 2 We would like to add optional coverage profiling to existing [OCaml] projects in the context of [XenServer] and [XenAPI]. This article -presents how we do it. +presents how we do it. Binaries instrumented for coverage profiling in the XenServer project need to run in an environment where several services act together as @@ -21,7 +21,7 @@ isolation. To build binaries with coverage profiling, do: ./configure --enable-coverage - make + make Binaries will log coverage data to `/tmp/bisect*.out` from which a coverage report can be generated in `coverage/`: @@ -38,7 +38,7 @@ and logs during execution data to in-memory data structures. Before an instrumented binary terminates, it writes the logged data to a file. This data can then be analysed with the `bisect-ppx-report` tool, to produce a summary of annotated code that highlights what part of a -codebase was executed. +codebase was executed. [BisectPPX] has several desirable properties: @@ -65,13 +65,13 @@ abstracted by OCamlfind (OCaml's library manager) and OCamlbuild # build it with instrumentation from bisect_ppx ocamlbuild -use-ocamlfind -pkg bisect_ppx -pkg unix example.native - + # execute it - generates files ./bisect*.out ./example.native - + # generate report bisect-ppx-report -I _build -html coverage bisect000* - + # view coverage/index.html Summary: @@ -86,7 +86,7 @@ will be instrumented during compilation. Behind the scenes `ocamlfind` makes sure that the compiler uses a preprocessing step that instruments the code. -## Signal Handling +## Signal Handling During execution the code instrumentation leads to the collection of data. This code registers a function with `at_exit` that writes the data @@ -98,7 +98,8 @@ terminated by receiving the `TERM` signal, a signal handler must be installed: let stop signal = - printf "caught signal %d\n" signal; + let name = Xapi_stdext_unix.Unixext.string_of_signal signal in + printf "caught signal %s\n" name; exit 0 Sys.set_signal Sys.sigterm (Sys.Signal_handle stop) @@ -149,8 +150,8 @@ environment variable. This can happen on the command line: BISECT_FILE=/tmp/example ./example.native -In the context of XenServer we could do this in startup scripts. -However, we added a bit of code +In the context of XenServer we could do this in startup scripts. +However, we added a bit of code val Coverage.init: string -> unit @@ -176,12 +177,12 @@ Goals for instrumentation are: * what files are instrumented should be obvious and easy to manage * instrumentation must be optional, yet easy to activate -* avoid methods that require to keep several files in sync like multiple +* avoid methods that require to keep several files in sync like multiple `_oasis` files * avoid separate Git branches for instrumented and non-instrumented code -In the ideal case, we could introduce a configuration switch +In the ideal case, we could introduce a configuration switch `./configure --enable-coverage` that would prepare compilation for coverage instrumentation. While [Oasis] supports the creation of such switches, they cannot be used to control build dependencies like @@ -196,7 +197,7 @@ rules in file `_tags.coverage` that cause files to be instrumented: leads to the execution of this code during preparation: - coverage: _tags _tags.coverage + coverage: _tags _tags.coverage test ! -f _tags.orig && mv _tags _tags.orig || true cat _tags.coverage _tags.orig > _tags @@ -207,7 +208,7 @@ could be tweaked to instrument only some files: <**/*.native>: pkg_bisect_ppx When `make coverage` is not called, these rules are not active and -hence, code is not instrumented for coverage. We believe that this +hence, code is not instrumented for coverage. We believe that this solution to control instrumentation meets the goals from above. In particular, what files are instrumented and when is controlled by very few lines of declarative code that lives in the main repository of a @@ -226,14 +227,14 @@ coverage analysis are: The `_oasis` file bundles the files under `profiling/` into an internal library which executables then depend on: - # Support files for profiling + # Support files for profiling Library profiling CompiledObject: best Path: profiling Install: false Findlibname: profiling Modules: Coverage - BuildDepends: + BuildDepends: Executable set_domain_uuid CompiledObject: best @@ -243,8 +244,8 @@ library which executables then depend on: MainIs: set_domain_uuid.ml Install: false BuildDepends: - xenctrl, - uuidm, + xenctrl, + uuidm, cmdliner, profiling # <-- here @@ -252,7 +253,7 @@ The `Makefile` target `coverage` primes the project for a profiling build: # make coverage - prepares for building with coverage analysis - coverage: _tags _tags.coverage + coverage: _tags _tags.coverage test ! -f _tags.orig && mv _tags _tags.orig || true cat _tags.coverage _tags.orig > _tags diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext.ml b/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext.ml index 4a8dc687989..caa5e620b4a 100644 --- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext.ml +++ b/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext.ml @@ -371,35 +371,63 @@ let kill_and_wait ?(signal = Sys.sigterm) ?(timeout = 10.) pid = raise Process_still_alive ) -let string_of_signal x = - let table = - [ - (Sys.sigabrt, "SIGABRT") - ; (Sys.sigalrm, "SIGALRM") - ; (Sys.sigfpe, "SIGFPE") - ; (Sys.sighup, "SIGHUP") - ; (Sys.sigill, "SIGILL") - ; (Sys.sigint, "SIGINT") - ; (Sys.sigkill, "SIGKILL") - ; (Sys.sigpipe, "SIGPIPE") - ; (Sys.sigquit, "SIGQUIT") - ; (Sys.sigsegv, "SIGSEGV") - ; (Sys.sigterm, "SIGTERM") - ; (Sys.sigusr1, "SIGUSR1") - ; (Sys.sigusr2, "SIGUSR2") - ; (Sys.sigchld, "SIGCHLD") - ; (Sys.sigcont, "SIGCONT") - ; (Sys.sigstop, "SIGSTOP") - ; (Sys.sigttin, "SIGTTIN") - ; (Sys.sigttou, "SIGTTOU") - ; (Sys.sigvtalrm, "SIGVTALRM") - ; (Sys.sigprof, "SIGPROF") - ] - in - if List.mem_assoc x table then - List.assoc x table - else - Printf.sprintf "(ocaml signal %d with an unknown name)" x +let string_of_signal = function + | s when s = Sys.sigabrt -> + "SIGABRT" + | s when s = Sys.sigalrm -> + "SIGALRM" + | s when s = Sys.sigfpe -> + "SIGFPE" + | s when s = Sys.sighup -> + "SIGHUP" + | s when s = Sys.sigill -> + "SIGILL" + | s when s = Sys.sigint -> + "SIGINT" + | s when s = Sys.sigkill -> + "SIGKILL" + | s when s = Sys.sigpipe -> + "SIGPIPE" + | s when s = Sys.sigquit -> + "SIGQUIT" + | s when s = Sys.sigsegv -> + "SIGSEGV" + | s when s = Sys.sigterm -> + "SIGTERM" + | s when s = Sys.sigusr1 -> + "SIGUSR1" + | s when s = Sys.sigusr2 -> + "SIGUSR2" + | s when s = Sys.sigchld -> + "SIGCHLD" + | s when s = Sys.sigcont -> + "SIGCONT" + | s when s = Sys.sigstop -> + "SIGSTOP" + | s when s = Sys.sigttin -> + "SIGTTIN" + | s when s = Sys.sigttou -> + "SIGTTOU" + | s when s = Sys.sigvtalrm -> + "SIGVTALRM" + | s when s = Sys.sigprof -> + "SIGPROF" + | s when s = Sys.sigbus -> + "SIGBUS" + | s when s = Sys.sigpoll -> + "SIGPOLL" + | s when s = Sys.sigsys -> + "SIGSYS" + | s when s = Sys.sigtrap -> + "SIGTRAP" + | s when s = Sys.sigurg -> + "SIGURG" + | s when s = Sys.sigxcpu -> + "SIGXCPU" + | s when s = Sys.sigxfsz -> + "SIGXFSZ" + | s -> + Printf.sprintf "SIG(%d)" s let with_polly f = let polly = Polly.create () in diff --git a/ocaml/nbd/src/cleanup.ml b/ocaml/nbd/src/cleanup.ml index a3c0fd60d35..15294e3a02d 100644 --- a/ocaml/nbd/src/cleanup.ml +++ b/ocaml/nbd/src/cleanup.ml @@ -218,6 +218,11 @@ module Runtime = struct Printf.eprintf "SIGINT received - exiting" ; flush stderr ; exit 0 + | Signal n -> + Printf.eprintf "unexpected signal %s in signal handler - exiting" + (Xapi_stdext_unix.Unixext.string_of_signal n) ; + flush stderr ; + exit 1 | e -> Printf.eprintf "unexpected exception %s in signal handler - exiting" (Printexc.to_string e) ; @@ -225,8 +230,9 @@ module Runtime = struct exit 1 let cleanup_resources signal = + let name = Xapi_stdext_unix.Unixext.string_of_signal signal in let cleanup () = - Lwt_log.warning_f "Caught signal %d, cleaning up" signal >>= fun () -> + Lwt_log.warning_f "Caught signal %s, cleaning up" name >>= fun () -> (* First we have to close the open file descriptors corresponding to the VDIs we plugged to dom0. Otherwise the VDI.unplug call would hang. *) ignore_exn_log_error "Caught exception while closing open block devices" diff --git a/ocaml/nbd/src/dune b/ocaml/nbd/src/dune index 076e6884786..6c8c576295f 100644 --- a/ocaml/nbd/src/dune +++ b/ocaml/nbd/src/dune @@ -4,7 +4,6 @@ (libraries cmdliner consts - local_xapi_session lwt lwt.unix @@ -20,6 +19,7 @@ xapi-consts xapi-inventory xapi-types + xapi-stdext-unix xen-api-client-lwt ) ) diff --git a/ocaml/networkd/bin/network_server.ml b/ocaml/networkd/bin/network_server.ml index b398ca93b8c..8c3b78946f3 100644 --- a/ocaml/networkd/bin/network_server.ml +++ b/ocaml/networkd/bin/network_server.ml @@ -53,7 +53,8 @@ let on_shutdown signal = let dbg = "shutdown" in Debug.with_thread_associated dbg (fun () -> - debug "xcp-networkd caught signal %d; performing cleanup actions." signal ; + debug "xcp-networkd caught signal %s; performing cleanup actions." + (Xapi_stdext_unix.Unixext.string_of_signal signal) ; write_config () ) () diff --git a/ocaml/xapi-guard/lib/server_interface.ml b/ocaml/xapi-guard/lib/server_interface.ml index c6f70769313..fc09c32c520 100644 --- a/ocaml/xapi-guard/lib/server_interface.ml +++ b/ocaml/xapi-guard/lib/server_interface.ml @@ -38,7 +38,8 @@ let shutdown = Lwt_switch.create () let () = let cleanup n = - debug "Triggering cleanup on signal %d, and waiting for servers to stop" n ; + let n = Fmt.(to_to_string Dump.signal n) in + debug "Triggering cleanup on signal %s, and waiting for servers to stop" n ; Lwt.async (fun () -> let* () = Lwt_switch.turn_off shutdown in info "Cleanup complete, exiting" ; diff --git a/ocaml/xapi/helpers.ml b/ocaml/xapi/helpers.ml index 68dde2a1c48..3323788a856 100644 --- a/ocaml/xapi/helpers.ml +++ b/ocaml/xapi/helpers.ml @@ -104,14 +104,15 @@ let call_script ?(log_output = Always) ?env ?stdin ?timeout script args = (ExnHelper.string_of_exn e) ; raise e | Forkhelpers.Spawn_internal_error (stderr, stdout, status) as e -> + let signal = Unixext.string_of_signal in let message = match status with | Unix.WEXITED n -> Printf.sprintf "exited with code %d" n | Unix.WSIGNALED n -> - Printf.sprintf "was killed by signal %d" n + Printf.sprintf "was killed by signal %s" (signal n) | Unix.WSTOPPED n -> - Printf.sprintf "was stopped by signal %d" n + Printf.sprintf "was stopped by signal %s" (signal n) in if should_log_output_on_failure then debug "%s %s %s [stdout = '%s'; stderr = '%s']" script diff --git a/ocaml/xcp-rrdd/bin/rrdd/dune b/ocaml/xcp-rrdd/bin/rrdd/dune index c31182e4142..b8419b12fb8 100644 --- a/ocaml/xcp-rrdd/bin/rrdd/dune +++ b/ocaml/xcp-rrdd/bin/rrdd/dune @@ -5,7 +5,6 @@ (modules (:standard \ xcp_rrdd)) (libraries astring - ezxenstore gzip http_lib @@ -41,7 +40,6 @@ (modules xcp_rrdd) (libraries astring - ezxenstore.core ezxenstore.watch forkexec diff --git a/ocaml/xcp-rrdd/bin/rrdd/xcp_rrdd.ml b/ocaml/xcp-rrdd/bin/rrdd/xcp_rrdd.ml index bb0285b4b18..4cdc21a289f 100644 --- a/ocaml/xcp-rrdd/bin/rrdd/xcp_rrdd.ml +++ b/ocaml/xcp-rrdd/bin/rrdd/xcp_rrdd.ml @@ -735,7 +735,7 @@ let configure_writers () = (** we need to make sure we call exit on fatal signals to make sure profiling data is dumped *) let stop err writers signal = - debug "caught signal %d" signal ; + debug "caught signal %s" (Xapi_stdext_unix.Unixext.string_of_signal signal) ; List.iter (fun (_, writer) -> writer.Rrd_writer.cleanup ()) writers ; exit err diff --git a/ocaml/xcp-rrdd/lib/plugin/utils.ml b/ocaml/xcp-rrdd/lib/plugin/utils.ml index d647c25fd67..a0db8d6269f 100644 --- a/ocaml/xcp-rrdd/lib/plugin/utils.ml +++ b/ocaml/xcp-rrdd/lib/plugin/utils.ml @@ -59,12 +59,13 @@ let exec_cmd (module D : Debug.DEBUG) ~cmdstring ~(f : string -> 'a option) = (try loop () with End_of_file -> ()) ; Unix.close out_readme ; let pid, status = Forkhelpers.waitpid pid in + let signal = Xapi_stdext_unix.Unixext.string_of_signal in ( match status with | Unix.WEXITED n -> D.debug "Process %d exited normally with code %d" pid n | Unix.WSIGNALED s -> - D.debug "Process %d was killed by signal %d" pid s + D.debug "Process %d was killed by signal %s" pid (signal s) | Unix.WSTOPPED s -> - D.debug "Process %d was stopped by signal %d" pid s + D.debug "Process %d was stopped by signal %s" pid (signal s) ) ; List.rev !vals diff --git a/ocaml/xenopsd/lib/cancellable_subprocess.ml b/ocaml/xenopsd/lib/cancellable_subprocess.ml index 0ba4edeb71c..097be7d3014 100644 --- a/ocaml/xenopsd/lib/cancellable_subprocess.ml +++ b/ocaml/xenopsd/lib/cancellable_subprocess.ml @@ -76,16 +76,17 @@ let run (task : Xenops_task.task_handle) ?env ?stdin fds raise (Spawn_internal_error (err, out, Unix.WEXITED n)) | Unix.WSTOPPED n -> raise (Spawn_internal_error (err, out, Unix.WSTOPPED n)) - | Unix.WSIGNALED n -> + | Unix.WSIGNALED s -> + let signal = Unixext.string_of_signal s in if !cancelled then ( debug - "Subprocess %s exited with signal %d and cancel requested; \ + "Subprocess %s exited with signal %s and cancel requested; \ raising Cancelled" - cmd n ; + cmd signal ; Xenops_task.raise_cancelled task ) else ( - debug "Subprocess %s exited with signal %d" cmd n ; - raise (Spawn_internal_error (err, out, Unix.WSIGNALED n)) + debug "Subprocess %s exited with signal %s" cmd signal ; + raise (Spawn_internal_error (err, out, Unix.WSIGNALED s)) ) ) | Success (_, Failure (_, exn)) | Failure (_, exn) -> diff --git a/ocaml/xenopsd/lib/xenopsd.ml b/ocaml/xenopsd/lib/xenopsd.ml index a0b192e6824..6f3b2bff058 100644 --- a/ocaml/xenopsd/lib/xenopsd.ml +++ b/ocaml/xenopsd/lib/xenopsd.ml @@ -459,8 +459,11 @@ let main backend = ~rpc_fn () in (* we need to catch this to make sure at_exit handlers are triggered. In - particuar, triggers for the bisect_ppx coverage profiling *) - let signal_handler n = debug "caught signal %d" n ; exit 0 in + particular, triggers for the bisect_ppx coverage profiling *) + let signal_handler n = + debug "caught signal %s" (Unixext.string_of_signal n) ; + exit 0 + in Sys.set_signal Sys.sigpipe Sys.Signal_ignore ; Sys.set_signal Sys.sigterm (Sys.Signal_handle signal_handler) ; Xenops_utils.set_fs_backend From c0fbb69d391b2d2341ba9e50dc04d7c02611e234 Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Tue, 14 Jan 2025 16:46:48 +0000 Subject: [PATCH 10/13] Debug: add pretty-printing function for signals When signals are are written to logs, the POSIX name should be used to minimize confusion. It makes sense that the function that does this is in the logging library instead of the unix one, as most users will be already be using the logging library, but not all the unix one. Moving it there also allows for a more ergonomic usage with the logging functions. Signed-off-by: Pau Ruiz Safont --- doc/content/design/coverage/index.md | 3 +- ocaml/forkexecd/src/child.ml | 4 +- ocaml/libs/log/debug.ml | 6 +- ocaml/libs/log/debug.mli | 4 ++ .../libs/xapi-compression/xapi_compression.ml | 9 +-- .../lib/xapi-stdext-unix/unixext.ml | 58 ------------------- .../lib/xapi-stdext-unix/unixext.mli | 4 -- ocaml/nbd/src/cleanup.ml | 4 +- ocaml/nbd/src/dune | 2 +- ocaml/networkd/bin/network_server.ml | 4 +- ocaml/xapi-guard/lib/server_interface.ml | 4 +- ocaml/xapi/helpers.ml | 5 +- ocaml/xapi/sm_exec.ml | 2 +- ocaml/xapi/xapi_extensions.ml | 3 +- ocaml/xapi/xapi_plugins.ml | 7 +-- ocaml/xcp-rrdd/bin/rrdd/xcp_rrdd.ml | 2 +- ocaml/xcp-rrdd/lib/plugin/utils.ml | 5 +- ocaml/xenopsd/lib/cancellable_subprocess.ml | 7 +-- ocaml/xenopsd/lib/suspend_image.ml | 8 +-- ocaml/xenopsd/lib/xenopsd.ml | 2 +- 20 files changed, 37 insertions(+), 106 deletions(-) diff --git a/doc/content/design/coverage/index.md b/doc/content/design/coverage/index.md index fae989b4867..27ccd0d469a 100644 --- a/doc/content/design/coverage/index.md +++ b/doc/content/design/coverage/index.md @@ -98,8 +98,7 @@ terminated by receiving the `TERM` signal, a signal handler must be installed: let stop signal = - let name = Xapi_stdext_unix.Unixext.string_of_signal signal in - printf "caught signal %s\n" name; + printf "caught signal %a\n" Debug.Pp.signal signal; exit 0 Sys.set_signal Sys.sigterm (Sys.Signal_handle stop) diff --git a/ocaml/forkexecd/src/child.ml b/ocaml/forkexecd/src/child.ml index 1512e3af851..5f79f2fb6c9 100644 --- a/ocaml/forkexecd/src/child.ml +++ b/ocaml/forkexecd/src/child.ml @@ -111,11 +111,11 @@ let report_child_exit comms_sock args child_pid status = Fe.WEXITED n | Unix.WSIGNALED n -> log_failure args child_pid - (Printf.sprintf "exited with signal: %s" (Unixext.string_of_signal n)) ; + (Printf.sprintf "exited with signal: %a" Debug.Pp.signal n) ; Fe.WSIGNALED n | Unix.WSTOPPED n -> log_failure args child_pid - (Printf.sprintf "stopped with signal: %s" (Unixext.string_of_signal n)) ; + (Printf.sprintf "stopped with signal: %a" Debug.Pp.signal n) ; Fe.WSTOPPED n in let result = Fe.Finished pr in diff --git a/ocaml/libs/log/debug.ml b/ocaml/libs/log/debug.ml index 5e63bc2b008..2f73cd47aca 100644 --- a/ocaml/libs/log/debug.ml +++ b/ocaml/libs/log/debug.ml @@ -353,4 +353,8 @@ functor with e -> log_backtrace_internal ~level:Syslog.Debug ~msg:"debug" e () end -module Pp = struct let mtime_span () = Fmt.str "%a" Mtime.Span.pp end +module Pp = struct + let mtime_span () = Fmt.to_to_string Mtime.Span.pp + + let signal () = Fmt.(to_to_string Dump.signal) +end diff --git a/ocaml/libs/log/debug.mli b/ocaml/libs/log/debug.mli index f6301c3d587..4ba72886ce6 100644 --- a/ocaml/libs/log/debug.mli +++ b/ocaml/libs/log/debug.mli @@ -91,4 +91,8 @@ val is_disabled : string -> Syslog.level -> bool module Pp : sig val mtime_span : unit -> Mtime.Span.t -> string + + val signal : unit -> int -> string + (** signal pretty-prints an ocaml signal number as its POSIX name, see + {Fmt.Dump.signal} *) end diff --git a/ocaml/libs/xapi-compression/xapi_compression.ml b/ocaml/libs/xapi-compression/xapi_compression.ml index a0ca8bdc6d5..7349cdef732 100644 --- a/ocaml/libs/xapi-compression/xapi_compression.ml +++ b/ocaml/libs/xapi-compression/xapi_compression.ml @@ -123,7 +123,6 @@ module Make (Algorithm : ALGORITHM) = struct error "%s" msg ; failwith msg in Unixfd.safe_close close_later ; - let open Xapi_stdext_unix in match snd (Forkhelpers.waitpid pid) with | Unix.WEXITED 0 -> () @@ -131,14 +130,10 @@ module Make (Algorithm : ALGORITHM) = struct failwith_error (Printf.sprintf "exit code %d" i) | Unix.WSIGNALED i -> failwith_error - (Printf.sprintf "killed by signal: %s" - (Unixext.string_of_signal i) - ) + (Printf.sprintf "killed by signal: %a" Debug.Pp.signal i) | Unix.WSTOPPED i -> failwith_error - (Printf.sprintf "stopped by signal: %s" - (Unixext.string_of_signal i) - ) + (Printf.sprintf "stopped by signal: %a" Debug.Pp.signal i) ) let compress fd f = go Compress Active fd f diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext.ml b/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext.ml index caa5e620b4a..111599f89d5 100644 --- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext.ml +++ b/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext.ml @@ -371,64 +371,6 @@ let kill_and_wait ?(signal = Sys.sigterm) ?(timeout = 10.) pid = raise Process_still_alive ) -let string_of_signal = function - | s when s = Sys.sigabrt -> - "SIGABRT" - | s when s = Sys.sigalrm -> - "SIGALRM" - | s when s = Sys.sigfpe -> - "SIGFPE" - | s when s = Sys.sighup -> - "SIGHUP" - | s when s = Sys.sigill -> - "SIGILL" - | s when s = Sys.sigint -> - "SIGINT" - | s when s = Sys.sigkill -> - "SIGKILL" - | s when s = Sys.sigpipe -> - "SIGPIPE" - | s when s = Sys.sigquit -> - "SIGQUIT" - | s when s = Sys.sigsegv -> - "SIGSEGV" - | s when s = Sys.sigterm -> - "SIGTERM" - | s when s = Sys.sigusr1 -> - "SIGUSR1" - | s when s = Sys.sigusr2 -> - "SIGUSR2" - | s when s = Sys.sigchld -> - "SIGCHLD" - | s when s = Sys.sigcont -> - "SIGCONT" - | s when s = Sys.sigstop -> - "SIGSTOP" - | s when s = Sys.sigttin -> - "SIGTTIN" - | s when s = Sys.sigttou -> - "SIGTTOU" - | s when s = Sys.sigvtalrm -> - "SIGVTALRM" - | s when s = Sys.sigprof -> - "SIGPROF" - | s when s = Sys.sigbus -> - "SIGBUS" - | s when s = Sys.sigpoll -> - "SIGPOLL" - | s when s = Sys.sigsys -> - "SIGSYS" - | s when s = Sys.sigtrap -> - "SIGTRAP" - | s when s = Sys.sigurg -> - "SIGURG" - | s when s = Sys.sigxcpu -> - "SIGXCPU" - | s when s = Sys.sigxfsz -> - "SIGXFSZ" - | s -> - Printf.sprintf "SIG(%d)" s - let with_polly f = let polly = Polly.create () in let finally () = Polly.close polly in diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext.mli b/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext.mli index bec31c222a6..047935b475c 100644 --- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext.mli +++ b/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext.mli @@ -122,10 +122,6 @@ exception Process_still_alive val kill_and_wait : ?signal:int -> ?timeout:float -> int -> unit -val string_of_signal : int -> string -(** [string_of_signal x] translates an ocaml signal number into - * a string suitable for logging. *) - val proxy : Unix.file_descr -> Unix.file_descr -> unit val really_read : Unix.file_descr -> bytes -> int -> int -> unit diff --git a/ocaml/nbd/src/cleanup.ml b/ocaml/nbd/src/cleanup.ml index 15294e3a02d..c4affe38628 100644 --- a/ocaml/nbd/src/cleanup.ml +++ b/ocaml/nbd/src/cleanup.ml @@ -220,7 +220,7 @@ module Runtime = struct exit 0 | Signal n -> Printf.eprintf "unexpected signal %s in signal handler - exiting" - (Xapi_stdext_unix.Unixext.string_of_signal n) ; + Fmt.(to_to_string Dump.signal n) ; flush stderr ; exit 1 | e -> @@ -230,7 +230,7 @@ module Runtime = struct exit 1 let cleanup_resources signal = - let name = Xapi_stdext_unix.Unixext.string_of_signal signal in + let name = Fmt.(to_to_string Dump.signal signal) in let cleanup () = Lwt_log.warning_f "Caught signal %s, cleaning up" name >>= fun () -> (* First we have to close the open file descriptors corresponding to the diff --git a/ocaml/nbd/src/dune b/ocaml/nbd/src/dune index 6c8c576295f..02c9dc6a0ed 100644 --- a/ocaml/nbd/src/dune +++ b/ocaml/nbd/src/dune @@ -4,6 +4,7 @@ (libraries cmdliner consts + fmt local_xapi_session lwt lwt.unix @@ -19,7 +20,6 @@ xapi-consts xapi-inventory xapi-types - xapi-stdext-unix xen-api-client-lwt ) ) diff --git a/ocaml/networkd/bin/network_server.ml b/ocaml/networkd/bin/network_server.ml index 8c3b78946f3..8cc5e9ea908 100644 --- a/ocaml/networkd/bin/network_server.ml +++ b/ocaml/networkd/bin/network_server.ml @@ -53,8 +53,8 @@ let on_shutdown signal = let dbg = "shutdown" in Debug.with_thread_associated dbg (fun () -> - debug "xcp-networkd caught signal %s; performing cleanup actions." - (Xapi_stdext_unix.Unixext.string_of_signal signal) ; + debug "xcp-networkd caught signal %a; performing cleanup actions." + Debug.Pp.signal signal ; write_config () ) () diff --git a/ocaml/xapi-guard/lib/server_interface.ml b/ocaml/xapi-guard/lib/server_interface.ml index fc09c32c520..8a64a576897 100644 --- a/ocaml/xapi-guard/lib/server_interface.ml +++ b/ocaml/xapi-guard/lib/server_interface.ml @@ -38,8 +38,8 @@ let shutdown = Lwt_switch.create () let () = let cleanup n = - let n = Fmt.(to_to_string Dump.signal n) in - debug "Triggering cleanup on signal %s, and waiting for servers to stop" n ; + debug "Triggering cleanup on signal %a, and waiting for servers to stop" + Debug.Pp.signal n ; Lwt.async (fun () -> let* () = Lwt_switch.turn_off shutdown in info "Cleanup complete, exiting" ; diff --git a/ocaml/xapi/helpers.ml b/ocaml/xapi/helpers.ml index 3323788a856..4d1ede48abd 100644 --- a/ocaml/xapi/helpers.ml +++ b/ocaml/xapi/helpers.ml @@ -104,15 +104,14 @@ let call_script ?(log_output = Always) ?env ?stdin ?timeout script args = (ExnHelper.string_of_exn e) ; raise e | Forkhelpers.Spawn_internal_error (stderr, stdout, status) as e -> - let signal = Unixext.string_of_signal in let message = match status with | Unix.WEXITED n -> Printf.sprintf "exited with code %d" n | Unix.WSIGNALED n -> - Printf.sprintf "was killed by signal %s" (signal n) + Printf.sprintf "was killed by signal %a" Debug.Pp.signal n | Unix.WSTOPPED n -> - Printf.sprintf "was stopped by signal %s" (signal n) + Printf.sprintf "was stopped by signal %a" Debug.Pp.signal n in if should_log_output_on_failure then debug "%s %s %s [stdout = '%s'; stderr = '%s']" script diff --git a/ocaml/xapi/sm_exec.ml b/ocaml/xapi/sm_exec.ml index 28cdd11e07b..d97e8f41e9b 100644 --- a/ocaml/xapi/sm_exec.ml +++ b/ocaml/xapi/sm_exec.ml @@ -393,7 +393,7 @@ let exec_xmlrpc ~dbg ?context:_ ?(needs_session = true) (driver : string) (Backend_error ( Api_errors.sr_backend_failure , [ - "received signal: " ^ Unixext.string_of_signal i + Printf.sprintf "received signal: %a" Debug.Pp.signal i ; output ; log ] diff --git a/ocaml/xapi/xapi_extensions.ml b/ocaml/xapi/xapi_extensions.ml index dbc38349bdc..301a0a5e686 100644 --- a/ocaml/xapi/xapi_extensions.ml +++ b/ocaml/xapi/xapi_extensions.ml @@ -50,8 +50,7 @@ let call_extension rpc = ( Api_errors.internal_error , [ path - ; Printf.sprintf "signal: %s" - (Xapi_stdext_unix.Unixext.string_of_signal i) + ; Printf.sprintf "signal: %a" Debug.Pp.signal i ; output ; log ] diff --git a/ocaml/xapi/xapi_plugins.ml b/ocaml/xapi/xapi_plugins.ml index 68447081136..3d9b7f0a2d0 100644 --- a/ocaml/xapi/xapi_plugins.ml +++ b/ocaml/xapi/xapi_plugins.ml @@ -49,12 +49,7 @@ let call_plugin session_id plugin_name fn_name args = raise (Api_errors.Server_error ( Api_errors.xenapi_plugin_failure - , [ - Printf.sprintf "signal: %s" - (Xapi_stdext_unix.Unixext.string_of_signal i) - ; output - ; log - ] + , [Printf.sprintf "signal: %a" Debug.Pp.signal i; output; log] ) ) | Forkhelpers.Spawn_internal_error (log, output, Unix.WEXITED _) -> diff --git a/ocaml/xcp-rrdd/bin/rrdd/xcp_rrdd.ml b/ocaml/xcp-rrdd/bin/rrdd/xcp_rrdd.ml index 4cdc21a289f..afca11c3ced 100644 --- a/ocaml/xcp-rrdd/bin/rrdd/xcp_rrdd.ml +++ b/ocaml/xcp-rrdd/bin/rrdd/xcp_rrdd.ml @@ -735,7 +735,7 @@ let configure_writers () = (** we need to make sure we call exit on fatal signals to make sure profiling data is dumped *) let stop err writers signal = - debug "caught signal %s" (Xapi_stdext_unix.Unixext.string_of_signal signal) ; + debug "caught signal %a" Debug.Pp.signal signal ; List.iter (fun (_, writer) -> writer.Rrd_writer.cleanup ()) writers ; exit err diff --git a/ocaml/xcp-rrdd/lib/plugin/utils.ml b/ocaml/xcp-rrdd/lib/plugin/utils.ml index a0db8d6269f..1f0f6f153e9 100644 --- a/ocaml/xcp-rrdd/lib/plugin/utils.ml +++ b/ocaml/xcp-rrdd/lib/plugin/utils.ml @@ -59,13 +59,12 @@ let exec_cmd (module D : Debug.DEBUG) ~cmdstring ~(f : string -> 'a option) = (try loop () with End_of_file -> ()) ; Unix.close out_readme ; let pid, status = Forkhelpers.waitpid pid in - let signal = Xapi_stdext_unix.Unixext.string_of_signal in ( match status with | Unix.WEXITED n -> D.debug "Process %d exited normally with code %d" pid n | Unix.WSIGNALED s -> - D.debug "Process %d was killed by signal %s" pid (signal s) + D.debug "Process %d was killed by signal %a" pid Debug.Pp.signal s | Unix.WSTOPPED s -> - D.debug "Process %d was stopped by signal %s" pid (signal s) + D.debug "Process %d was stopped by signal %a" pid Debug.Pp.signal s ) ; List.rev !vals diff --git a/ocaml/xenopsd/lib/cancellable_subprocess.ml b/ocaml/xenopsd/lib/cancellable_subprocess.ml index 097be7d3014..4e80c34ac28 100644 --- a/ocaml/xenopsd/lib/cancellable_subprocess.ml +++ b/ocaml/xenopsd/lib/cancellable_subprocess.ml @@ -77,15 +77,14 @@ let run (task : Xenops_task.task_handle) ?env ?stdin fds | Unix.WSTOPPED n -> raise (Spawn_internal_error (err, out, Unix.WSTOPPED n)) | Unix.WSIGNALED s -> - let signal = Unixext.string_of_signal s in if !cancelled then ( debug - "Subprocess %s exited with signal %s and cancel requested; \ + "Subprocess %s exited with signal %a and cancel requested; \ raising Cancelled" - cmd signal ; + cmd Debug.Pp.signal s ; Xenops_task.raise_cancelled task ) else ( - debug "Subprocess %s exited with signal %s" cmd signal ; + debug "Subprocess %s exited with signal %a" cmd Debug.Pp.signal s ; raise (Spawn_internal_error (err, out, Unix.WSIGNALED s)) ) ) diff --git a/ocaml/xenopsd/lib/suspend_image.ml b/ocaml/xenopsd/lib/suspend_image.ml index e08cb53c268..8733b9155cf 100644 --- a/ocaml/xenopsd/lib/suspend_image.ml +++ b/ocaml/xenopsd/lib/suspend_image.ml @@ -275,15 +275,15 @@ let with_conversion_script task name hvm fd f = | Unix.WSIGNALED n -> Error (Failure - (Printf.sprintf "Conversion script exited with signal %s" - (Unixext.string_of_signal n) + (Printf.sprintf "Conversion script exited with signal %a" + Debug.Pp.signal n ) ) | Unix.WSTOPPED n -> Error (Failure - (Printf.sprintf "Conversion script stopped with signal %s" - (Unixext.string_of_signal n) + (Printf.sprintf "Conversion script stopped with signal %a" + Debug.Pp.signal n ) ) ) diff --git a/ocaml/xenopsd/lib/xenopsd.ml b/ocaml/xenopsd/lib/xenopsd.ml index 6f3b2bff058..cb79fd20991 100644 --- a/ocaml/xenopsd/lib/xenopsd.ml +++ b/ocaml/xenopsd/lib/xenopsd.ml @@ -461,7 +461,7 @@ let main backend = (* we need to catch this to make sure at_exit handlers are triggered. In particular, triggers for the bisect_ppx coverage profiling *) let signal_handler n = - debug "caught signal %s" (Unixext.string_of_signal n) ; + debug "caught signal %a" Debug.Pp.signal n ; exit 0 in Sys.set_signal Sys.sigpipe Sys.Signal_ignore ; From 0326d2785b0b643492e9d42b42a44f4c8a01ee7e Mon Sep 17 00:00:00 2001 From: Andrii Sultanov Date: Wed, 15 Jan 2025 16:01:45 +0000 Subject: [PATCH 11/13] CA-404597: rrd/lib_test - Verify that RRD handles non-rate data sources correctly Other unit tests only verify the interoperability of the RRDs - dumping them to JSON/XML and reading back in, verifying that the same data was decoded. We're now seeing a problem where Gauge data sources, which should be absolute values provided by the plugin, fluctuate wildly when processed by the RRD library. Ensure we have an easy way to test this for both Gauge and Absolute data sources - these values should be passed as-is by the RRD library, without any time-based transformations. This test currently fails and will be passing with the fix commits. Signed-off-by: Andrii Sultanov --- ocaml/libs/xapi-rrd/lib_test/unit_tests.ml | 109 ++++++++++++++++++++- 1 file changed, 108 insertions(+), 1 deletion(-) diff --git a/ocaml/libs/xapi-rrd/lib_test/unit_tests.ml b/ocaml/libs/xapi-rrd/lib_test/unit_tests.ml index f9cb5765b9f..1bcd65ad7d3 100644 --- a/ocaml/libs/xapi-rrd/lib_test/unit_tests.ml +++ b/ocaml/libs/xapi-rrd/lib_test/unit_tests.ml @@ -107,6 +107,110 @@ let test_length_invariants rrd () = let check_length dss rra = check_length_of_fring dss rra.rra_data in Array.iter (check_length rrd.rrd_dss) rrd.rrd_rras +let absolute_rrd = + let rra = rra_create CF_Average 100 1 0.5 in + let rra2 = rra_create CF_Average 100 10 0.5 in + let rra3 = rra_create CF_Average 100 100 0.5 in + let rra4 = rra_create CF_Average 100 1000 0.5 in + let ts = 1000000000.0 in + let ds = ds_create "foo" Absolute ~mrhb:10.0 (VT_Float 0.0) in + let ds2 = ds_create "bar" Absolute ~mrhb:10.0 (VT_Float 0.0) in + let ds3 = ds_create "baz" Absolute ~mrhb:10.0 (VT_Float 0.0) in + let ds4 = ds_create "boo" Absolute ~mrhb:10.0 (VT_Float 0.0) in + let rrd = rrd_create [|ds; ds2; ds3; ds4|] [|rra; rra2; rra3; rra4|] 1L ts in + let id = Identity in + for i = 1 to 100000 do + let t = 1000000.0 +. (0.7 *. float_of_int i) in + let v1 = + (0, {value= VT_Float (0.5 +. (0.5 *. sin (t /. 10.0))); transform= id}) + in + let v2 = + (1, {value= VT_Float (1.5 +. (0.5 *. cos (t /. 80.0))); transform= id}) + in + let v3 = + (2, {value= VT_Float (3.5 +. (0.5 *. sin (t /. 700.0))); transform= id}) + in + let v4 = + (3, {value= VT_Float (6.5 +. (0.5 *. cos (t /. 5000.0))); transform= id}) + in + ds_update rrd t [|v1; v2; v3; v4|] false + done ; + rrd + +let absolute_rrd_CA_404597 () = + let rra = rra_create CF_Average 100 1 0.5 in + let rra2 = rra_create CF_Average 100 10 0.5 in + let rra3 = rra_create CF_Average 100 100 0.5 in + let rra4 = rra_create CF_Average 100 1000 0.5 in + let ts = 1000000000.0 in + let ds = ds_create "foo" Absolute ~mrhb:10.0 (VT_Float 0.0) in + let ds2 = ds_create "bar" Absolute ~mrhb:10.0 (VT_Float 0.0) in + let ds3 = ds_create "baz" Absolute ~mrhb:10.0 (VT_Float 0.0) in + let ds4 = ds_create "boo" Absolute ~mrhb:10.0 (VT_Float 0.0) in + let rrd = rrd_create [|ds; ds2; ds3; ds4|] [|rra; rra2; rra3; rra4|] 1L ts in + let id = Identity in + for i = 1 to 100000 do + let t = 1000000.0 +. (0.7 *. float_of_int i) in + let ((_, val1) as v1) = + (0, {value= VT_Float (0.5 +. (0.5 *. sin (t /. 10.0))); transform= id}) + in + let ((_, val2) as v2) = + (1, {value= VT_Float (1.5 +. (0.5 *. cos (t /. 80.0))); transform= id}) + in + let ((_, val3) as v3) = + (2, {value= VT_Float (3.5 +. (0.5 *. sin (t /. 700.0))); transform= id}) + in + let ((_, val4) as v4) = + (3, {value= VT_Float (6.5 +. (0.5 *. cos (t /. 5000.0))); transform= id}) + in + ds_update rrd t [|v1; v2; v3; v4|] false ; + + Array.iter2 + (fun ds value -> + compare_float __LOC__ ds.ds_value + (float_of_string (ds_value_to_string value.value)) + ) + rrd.rrd_dss [|val1; val2; val3; val4|] + done + +(** Verify that Gauge data soruce values are correctly handled by the RRD lib + and that timestamps do not cause absolute values to fluctuate *) +let gauge_rrd_CA_404597 () = + let rra = rra_create CF_Average 100 1 0.5 in + let rra2 = rra_create CF_Average 100 10 0.5 in + let rra3 = rra_create CF_Average 100 100 0.5 in + let rra4 = rra_create CF_Average 100 1000 0.5 in + let ts = 1000000000.0 in + let ds = ds_create "foo" Gauge ~mrhb:10.0 (VT_Float 0.0) in + let ds2 = ds_create "bar" Gauge ~mrhb:10.0 (VT_Float 0.0) in + let ds3 = ds_create "baz" Gauge ~mrhb:10.0 (VT_Float 0.0) in + let ds4 = ds_create "boo" Gauge ~mrhb:10.0 (VT_Float 0.0) in + let rrd = rrd_create [|ds; ds2; ds3; ds4|] [|rra; rra2; rra3; rra4|] 1L ts in + let id = Identity in + for i = 1 to 100000 do + let t = 1000000.0 +. (0.7 *. float_of_int i) in + let ((_, val1) as v1) = + (0, {value= VT_Float (0.5 +. (0.5 *. sin (t /. 10.0))); transform= id}) + in + let ((_, val2) as v2) = + (1, {value= VT_Float (1.5 +. (0.5 *. cos (t /. 80.0))); transform= id}) + in + let ((_, val3) as v3) = + (2, {value= VT_Float (3.5 +. (0.5 *. sin (t /. 700.0))); transform= id}) + in + let ((_, val4) as v4) = + (3, {value= VT_Float (6.5 +. (0.5 *. cos (t /. 5000.0))); transform= id}) + in + ds_update rrd t [|v1; v2; v3; v4|] false ; + + Array.iter2 + (fun ds value -> + compare_float __LOC__ ds.ds_value + (float_of_string (ds_value_to_string value.value)) + ) + rrd.rrd_dss [|val1; val2; val3; val4|] + done + let gauge_rrd = let rra = rra_create CF_Average 100 1 0.5 in let rra2 = rra_create CF_Average 100 10 0.5 in @@ -328,12 +432,15 @@ let regression_suite = ; ("CA-329043 (1)", `Quick, test_ranges ca_329043_rrd_1) ; ("CA-329043 (2)", `Quick, test_ranges ca_329043_rrd_2) ; ("CA-329813", `Quick, test_ranges ca_329813_rrd) + ; ("CA-404597 (1)", `Quick, gauge_rrd_CA_404597) + ; ("CA-404597 (2)", `Quick, absolute_rrd_CA_404597) ] let () = Alcotest.run "Test RRD library" [ - ("Gauge RRD", rrd_suite gauge_rrd) + ("Absolute RRD", rrd_suite absolute_rrd) + ; ("Gauge RRD", rrd_suite gauge_rrd) ; ("RRD for CA-322008", rrd_suite ca_322008_rrd) ; ("RRD for CA-329043", rrd_suite ca_329043_rrd_1) ; ("RRD for CA-329813", rrd_suite ca_329813_rrd) From 73ca3cca49fd604a2cd408c332078535f0f694fe Mon Sep 17 00:00:00 2001 From: Andrii Sultanov Date: Thu, 16 Jan 2025 13:08:45 +0000 Subject: [PATCH 12/13] CA-404597: rrd - Pass Gauge and Absolute data source values as-is Some recent changes related to RRDs likely exposed a long-standing latent issue where the RRD library would process the passed-in values for Gauge and Absolute data sources incorrectly leading to constant values changing from update to update, for example: ``` $ rrd2csv memory_total_kib timestamp, AVERAGE:host:8b533333-91e1-4698-bd17-95b9732ffbb6:memory_total_kib 2025-01-15T08:41:40Z, 33351000 2025-01-15T08:41:45Z, 33350000 2025-01-15T08:41:50Z, 33346000 2025-01-15T08:41:55Z, 33352000 ``` Instead of treating Gauge and Absolute data sources as a variation on the rate-based Derive data source type, expecting time-based calculations to cancel each other out, do not undertake any calculations on non-rate data sources at all. This makes the unit test added in the previous commit pass. Signed-off-by: Andrii Sultanov --- ocaml/libs/xapi-rrd/lib/rrd.ml | 36 ++++++++++++++++++++++++---------- 1 file changed, 26 insertions(+), 10 deletions(-) diff --git a/ocaml/libs/xapi-rrd/lib/rrd.ml b/ocaml/libs/xapi-rrd/lib/rrd.ml index 75610964fc1..6667f2a4f5c 100644 --- a/ocaml/libs/xapi-rrd/lib/rrd.ml +++ b/ocaml/libs/xapi-rrd/lib/rrd.ml @@ -341,9 +341,10 @@ let rra_update rrd proc_pdp_st elapsed_pdp_st pdps = Array.iter updatefn rrd.rrd_rras (* We assume that the data being given is of the form of a rate; that is, - it's dependent on the time interval between updates. To be able to - deal with gauge DSs, we multiply by the interval so that it cancels - the subsequent divide by interval later on *) + it's dependent on the time interval between updates. + Gauge and Absolute data sources are simply kept as is without any + time-based calculations, while Derive data sources will be changed according + to the time passed since the last measurement. (see CA-404597) *) let process_ds_value ds value interval new_rrd = if interval > ds.ds_mrhb then nan @@ -360,10 +361,8 @@ let process_ds_value ds value interval new_rrd = let rate = match (ds.ds_ty, new_rrd) with - | Absolute, _ | Derive, true -> + | Absolute, _ | Derive, true | Gauge, _ -> value_raw - | Gauge, _ -> - value_raw *. interval | Derive, false -> ( match (ds.ds_last, value) with | VT_Int64 x, VT_Int64 y -> @@ -433,7 +432,14 @@ let ds_update rrd timestamp valuesandtransforms new_rrd = if Utils.isnan value then ds.ds_unknown_sec <- pre_int else - ds.ds_value <- ds.ds_value +. (pre_int *. value /. interval) + (* CA-404597 - Gauge and Absolute values should be passed as-is, + without being involved in time-based calculations at all. + This applies to calculations below as well *) + match ds.ds_ty with + | Gauge | Absolute -> + ds.ds_value <- value + | Derive -> + ds.ds_value <- ds.ds_value +. (pre_int *. value /. interval) ) v2s ; @@ -450,7 +456,13 @@ let ds_update rrd timestamp valuesandtransforms new_rrd = let raw = let proc_pdp_st = get_float_time last_updated rrd.timestep in let occu_pdp_st = get_float_time timestamp rrd.timestep in - ds.ds_value /. (occu_pdp_st -. proc_pdp_st -. ds.ds_unknown_sec) + + match ds.ds_ty with + | Gauge | Absolute -> + ds.ds_value + | Derive -> + ds.ds_value + /. (occu_pdp_st -. proc_pdp_st -. ds.ds_unknown_sec) in (* Apply the transform after the raw value has been calculated *) let raw = apply_transform_function transform raw in @@ -473,8 +485,12 @@ let ds_update rrd timestamp valuesandtransforms new_rrd = ds.ds_value <- 0.0 ; ds.ds_unknown_sec <- post_int ) else ( - ds.ds_value <- post_int *. value /. interval ; - ds.ds_unknown_sec <- 0.0 + ds.ds_unknown_sec <- 0.0 ; + match ds.ds_ty with + | Gauge | Absolute -> + ds.ds_value <- value + | Derive -> + ds.ds_value <- post_int *. value /. interval ) ) v2s From 731ede746b0ff28561c064ca1c470800cde96d35 Mon Sep 17 00:00:00 2001 From: Andrii Sultanov Date: Fri, 17 Jan 2025 14:18:32 +0000 Subject: [PATCH 13/13] CA-404591 - rrd: Do not lose precision when converting floats to strings lastupdate field in the XML RRD blob file, in particular, was getting truncated floats representing the number of seconds, which loses A LOT of precision, meaning RRDs could not be checked to have been produced with the 5-second frequency. Signed-off-by: Andrii Sultanov --- ocaml/libs/xapi-rrd/lib/rrd_utils.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ocaml/libs/xapi-rrd/lib/rrd_utils.ml b/ocaml/libs/xapi-rrd/lib/rrd_utils.ml index aa959a042dd..ffa35939da0 100644 --- a/ocaml/libs/xapi-rrd/lib/rrd_utils.ml +++ b/ocaml/libs/xapi-rrd/lib/rrd_utils.ml @@ -69,7 +69,7 @@ let array_remove n a = let f_to_s f = match classify_float f with | FP_normal | FP_subnormal -> - Printf.sprintf "%0.5g" f + Printf.sprintf "%0.15g" f | FP_nan -> "NaN" | FP_infinite ->