From 4feb5c23423230b50d2d19eabec803af4a85f90e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Thir=C3=A9?= Date: Mon, 16 Dec 2024 13:29:04 +0100 Subject: [PATCH 1/3] Tezt/Cloud: Move the `input` module in its own file --- tezt/lib_cloud/cloud.ml | 37 ------------------------------------- tezt/lib_cloud/input.ml | 36 ++++++++++++++++++++++++++++++++++++ tezt/lib_cloud/input.mli | 11 +++++++++++ 3 files changed, 47 insertions(+), 37 deletions(-) create mode 100644 tezt/lib_cloud/input.ml create mode 100644 tezt/lib_cloud/input.mli diff --git a/tezt/lib_cloud/cloud.ml b/tezt/lib_cloud/cloud.ml index 48292b10c186..cffda0e7e2cc 100644 --- a/tezt/lib_cloud/cloud.ml +++ b/tezt/lib_cloud/cloud.ml @@ -27,43 +27,6 @@ let sigint = previous_behaviour := previous_handler ; promise -module Input : sig - (** This module should be the only one that reads on [stdin]. *) - - (** [next ()] returns the next line on stdin or none if stdin is closed. *) - val next : unit -> string option Lwt.t -end = struct - type t = { - mutable resolvers : string option Lwt.u list; - mutable stdin_closed : bool; - } - - let state = {resolvers = []; stdin_closed = false} - - let next () = - if state.stdin_closed then Lwt.return_none - else - let t, u = Lwt.task () in - state.resolvers <- u :: state.resolvers ; - t - - let rec loop () = - let* input = Lwt_io.read_line Lwt_io.stdin in - state.resolvers - |> List.iter (fun resolver -> Lwt.wakeup_later resolver (Some input)) ; - state.resolvers <- [] ; - loop () - - let _ = - Lwt.catch - (fun () -> loop ()) - (fun _exn -> - state.resolvers - |> List.iter (fun resolver -> Lwt.wakeup_later resolver None) ; - state.stdin_closed <- true ; - Lwt.return_unit) -end - let eof = let promise, resolver = Lwt.task () in Lwt.dont_wait diff --git a/tezt/lib_cloud/input.ml b/tezt/lib_cloud/input.ml new file mode 100644 index 000000000000..88a321d84ae3 --- /dev/null +++ b/tezt/lib_cloud/input.ml @@ -0,0 +1,36 @@ +(*****************************************************************************) +(* *) +(* SPDX-License-Identifier: MIT *) +(* SPDX-FileCopyrightText: 2024 Nomadic Labs *) +(* *) +(*****************************************************************************) + +let resolvers : string option Lwt.u list ref = ref [] + +let stdin_closed = ref false + +let next () = + if !stdin_closed then Lwt.return_none + else + let t, u = Lwt.task () in + resolvers := u :: !resolvers ; + t + +let rec loop () = + let* input = Lwt_io.read_line Lwt_io.stdin in + !resolvers + |> List.iter (fun resolver -> Lwt.wakeup_later resolver (Some input)) ; + resolvers := [] ; + loop () + +let _ = + (* This is a bit weird since this is executed outside of + `Lwt_main.run`. It works because this function only uses pure + `Lwt` code without relying on Unix dependencies. However, any + call to `next` must be done within `Lwt_main.run`. *) + Lwt.catch + (fun () -> loop ()) + (fun _exn -> + !resolvers |> List.iter (fun resolver -> Lwt.wakeup_later resolver None) ; + stdin_closed := true ; + Lwt.return_unit) diff --git a/tezt/lib_cloud/input.mli b/tezt/lib_cloud/input.mli new file mode 100644 index 000000000000..40b13eb17522 --- /dev/null +++ b/tezt/lib_cloud/input.mli @@ -0,0 +1,11 @@ +(*****************************************************************************) +(* *) +(* SPDX-License-Identifier: MIT *) +(* SPDX-FileCopyrightText: 2024 Nomadic Labs *) +(* *) +(*****************************************************************************) + +(** This module should be the only one that reads on [stdin]. *) + +(** [next ()] returns the next line on stdin or none if stdin is closed. *) +val next : unit -> string option Lwt.t -- GitLab From 354013e2eb13b1e3e00e88e981134f01a10ed852 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Thir=C3=A9?= Date: Mon, 16 Dec 2024 13:32:05 +0100 Subject: [PATCH 2/3] Tezt/Cloud: Move [eof] in its own file --- tezt/lib_cloud/cloud.ml | 20 ++------------------ tezt/lib_cloud/input.ml | 16 ++++++++++++++++ tezt/lib_cloud/input.mli | 3 +++ 3 files changed, 21 insertions(+), 18 deletions(-) diff --git a/tezt/lib_cloud/cloud.ml b/tezt/lib_cloud/cloud.ml index cffda0e7e2cc..407ec85ac8be 100644 --- a/tezt/lib_cloud/cloud.ml +++ b/tezt/lib_cloud/cloud.ml @@ -27,22 +27,6 @@ let sigint = previous_behaviour := previous_handler ; promise -let eof = - let promise, resolver = Lwt.task () in - Lwt.dont_wait - (fun () -> - let rec loop () = - let* input = Input.next () in - match input with - | None -> - Lwt.wakeup resolver () ; - Lwt.return_unit - | Some _ -> loop () - in - loop ()) - (fun _ -> Lwt.wakeup resolver ()) ; - promise - (* This exception is raised when the test is interrupted by Ctrl+C. *) exception Interrupted @@ -275,7 +259,7 @@ let attach agent = Process.spawn ~hooks cmd (["-o"; "StrictHostKeyChecking=no"] @ args) |> Process.check in - let* _ = eof in + let* _ = Input.eof in let* () = let process = Process.spawn ~runner "pkill" ["screen"] in let* _ = Process.wait process in @@ -296,7 +280,7 @@ let attach agent = Lwt.return_unit in let on_eof = - let* () = eof in + let* () = Input.eof in Log.info "Detach from the proxy process." ; if !has_sigint then on_sigint else diff --git a/tezt/lib_cloud/input.ml b/tezt/lib_cloud/input.ml index 88a321d84ae3..fb19878e0d39 100644 --- a/tezt/lib_cloud/input.ml +++ b/tezt/lib_cloud/input.ml @@ -34,3 +34,19 @@ let _ = !resolvers |> List.iter (fun resolver -> Lwt.wakeup_later resolver None) ; stdin_closed := true ; Lwt.return_unit) + +let eof = + let promise, resolver = Lwt.task () in + Lwt.dont_wait + (fun () -> + let rec loop () = + let* input = next () in + match input with + | None -> + Lwt.wakeup resolver () ; + Lwt.return_unit + | Some _ -> loop () + in + loop ()) + (fun _ -> Lwt.wakeup resolver ()) ; + promise diff --git a/tezt/lib_cloud/input.mli b/tezt/lib_cloud/input.mli index 40b13eb17522..bc70c49b5754 100644 --- a/tezt/lib_cloud/input.mli +++ b/tezt/lib_cloud/input.mli @@ -9,3 +9,6 @@ (** [next ()] returns the next line on stdin or none if stdin is closed. *) val next : unit -> string option Lwt.t + +(** [eof] is resolved when the [stdin] is closed. *) +val eof : unit Lwt.t -- GitLab From 434c00c3b28a25208cceb57f0ec22bf0ef3d36de Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Thir=C3=A9?= Date: Sat, 14 Dec 2024 15:31:46 +0100 Subject: [PATCH 3/3] Tezt/Cloud: Implement a manual-confirmation option --- tezt/lib_cloud/cli.ml | 10 ++++++++++ tezt/lib_cloud/cli.mli | 3 +++ tezt/lib_cloud/deployement.ml | 2 ++ tezt/lib_cloud/env.ml | 2 ++ tezt/lib_cloud/env.mli | 3 +++ tezt/lib_cloud/terraform.ml | 29 ++++++++++++++++++++++------- tezt/lib_cloud/terraform.mli | 1 + 7 files changed, 43 insertions(+), 7 deletions(-) diff --git a/tezt/lib_cloud/cli.ml b/tezt/lib_cloud/cli.ml index ab63df141f16..25f20b594dd8 100644 --- a/tezt/lib_cloud/cli.ml +++ b/tezt/lib_cloud/cli.ml @@ -275,3 +275,13 @@ let push_docker = VMs that are already running, it is useful to prevent those containers \ to be pushed." true + +let auto_approve = + Clap.flag + ~section + ~set_long:"auto-approve" + ~unset_long:"no-auto-approve" + ~description: + "If set to true (default), don't ask confirmation before updating a \ + deployment via terraform." + true diff --git a/tezt/lib_cloud/cli.mli b/tezt/lib_cloud/cli.mli index 9434b77b2166..b877f02fa4d1 100644 --- a/tezt/lib_cloud/cli.mli +++ b/tezt/lib_cloud/cli.mli @@ -116,3 +116,6 @@ val check_file_consistency : bool (** Specify if the docker container should be pushed. Only considered for remote mode. *) val push_docker : bool + +(** Auto approve the deployment plan. *) +val auto_approve : bool diff --git a/tezt/lib_cloud/deployement.ml b/tezt/lib_cloud/deployement.ml index 68f28d5577e7..65624de8ff5a 100644 --- a/tezt/lib_cloud/deployement.ml +++ b/tezt/lib_cloud/deployement.ml @@ -56,8 +56,10 @@ module Remote = struct let ports_per_vm = Env.ports_per_vm in let base_port = Env.vm_base_port in let os = configuration.os in + let auto_approve = Env.auto_approve in let* () = Terraform.VM.deploy + ~auto_approve ~max_run_duration ~machine_type ~base_port diff --git a/tezt/lib_cloud/env.ml b/tezt/lib_cloud/env.ml index 7ecffac7d953..ad64cab477cc 100644 --- a/tezt/lib_cloud/env.ml +++ b/tezt/lib_cloud/env.ml @@ -85,6 +85,8 @@ let check_file_consistency = Cli.check_file_consistency let push_docker = Cli.push_docker +let auto_approve = Cli.auto_approve + let project_id = Gcloud.project_id let init () = diff --git a/tezt/lib_cloud/env.mli b/tezt/lib_cloud/env.mli index 2ace4f4fab29..0a07cb68cfc0 100644 --- a/tezt/lib_cloud/env.mli +++ b/tezt/lib_cloud/env.mli @@ -117,6 +117,9 @@ val check_file_consistency : bool (** Equivalent to [Cli.push_docker]. *) val push_docker : bool +(** Equivalent to [Cli.auto_approve]. *) +val auto_approve : bool + (** Equivalent to [Gcloud.project_id]. *) val project_id : unit -> string Lwt.t diff --git a/tezt/lib_cloud/terraform.ml b/tezt/lib_cloud/terraform.ml index 2e42a41e09e1..ed673f28aa81 100644 --- a/tezt/lib_cloud/terraform.ml +++ b/tezt/lib_cloud/terraform.ml @@ -153,8 +153,8 @@ module VM = struct let init () = Process.run ~name ~color "terraform" (chdir Path.terraform_vm @ ["init"]) - let deploy ~max_run_duration ~machine_type ~base_port ~ports_per_vm - ~number_of_vms ~docker_image ~os = + let deploy ~auto_approve ~max_run_duration ~machine_type ~base_port + ~ports_per_vm ~number_of_vms ~docker_image ~os = let* project_id = Gcloud.project_id () in let max_run_duration = match max_run_duration with @@ -180,11 +180,26 @@ module VM = struct Format.asprintf "os=%s" os; ] in - Process.run - ~name - ~color - "terraform" - (chdir Path.terraform_vm @ ["apply"; "--auto-approve"] @ args) + if auto_approve then + Process.run + ~name + ~color + "terraform" + (chdir Path.terraform_vm @ ["apply"; "--auto-approve"] @ args) + else + let process, output_channel = + Process.spawn_with_stdin + ~name + ~color + "terraform" + (chdir Path.terraform_vm @ ["apply"] @ args) + in + let* input = Input.next () in + (* If the user pressed Ctrl+D, i.e. input is [None], we don't + care what the input is. *) + let input = Option.value ~default:"" input in + let* () = Lwt_io.write_line output_channel input in + Process.check process let points () = let* output = diff --git a/tezt/lib_cloud/terraform.mli b/tezt/lib_cloud/terraform.mli index 4993cd15e723..d020fad2e3e6 100644 --- a/tezt/lib_cloud/terraform.mli +++ b/tezt/lib_cloud/terraform.mli @@ -31,6 +31,7 @@ module VM : sig val init : unit -> unit Lwt.t val deploy : + auto_approve:bool -> max_run_duration:int option -> machine_type:string -> base_port:int -> -- GitLab