From 4599e876616494e0900ed023027071135c799e66 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Fran=C3=A7ois=20Thir=C3=A9?=
 <francois.thire@nomadic-labs.com>
Date: Mon, 2 Sep 2024 17:30:28 +0200
Subject: [PATCH 1/5] Tezt/Cloud: Fix EOF handling

---
 tezt/lib_cloud/cloud.ml | 38 +++++++++++++++++++++++++++-----------
 1 file changed, 27 insertions(+), 11 deletions(-)

diff --git a/tezt/lib_cloud/cloud.ml b/tezt/lib_cloud/cloud.ml
index c7781fdd9e33..fa4e38720d48 100644
--- a/tezt/lib_cloud/cloud.ml
+++ b/tezt/lib_cloud/cloud.ml
@@ -30,26 +30,38 @@ let sigint =
 module Input : sig
   (** This module should be the only one that reads on [stdin]. *)
 
-  (** [next ()] returns the next line on stdin. *)
-  val next : unit -> string Lwt.t
+  (** [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 Lwt.u list}
+  type t = {
+    mutable resolvers : string option Lwt.u list;
+    mutable stdin_closed : bool;
+  }
 
-  let state = {resolvers = []}
+  let state = {resolvers = []; stdin_closed = false}
 
   let next () =
-    let t, u = Lwt.task () in
-    state.resolvers <- u :: state.resolvers ;
-    t
+    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 input) ;
+    |> List.iter (fun resolver -> Lwt.wakeup_later resolver (Some input)) ;
     state.resolvers <- [] ;
     loop ()
 
-  let _ = 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 =
@@ -57,8 +69,12 @@ let eof =
   Lwt.dont_wait
     (fun () ->
       let rec loop () =
-        let* _ = Input.next () in
-        loop ()
+        let* input = Input.next () in
+        match input with
+        | None ->
+            Lwt.wakeup resolver () ;
+            Lwt.return_unit
+        | Some _ -> loop ()
       in
       loop ())
     (fun _ -> Lwt.wakeup resolver ()) ;
-- 
GitLab


From adaab68f134f9f9b5e19caf88333f2d907973af3 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Fran=C3=A7ois=20Thir=C3=A9?=
 <francois.thire@nomadic-labs.com>
Date: Mon, 2 Sep 2024 09:38:36 +0200
Subject: [PATCH 2/5] Tezt/Cloud: Enable an agent to not have a runner

---
 tezt/lib_cloud/agent.ml       |  2 +-
 tezt/lib_cloud/agent.mli      |  2 +-
 tezt/lib_cloud/cloud.ml       | 35 ++++++++++++++++++++---------------
 tezt/lib_cloud/deployement.ml |  4 +---
 tezt/lib_cloud/prometheus.ml  |  2 +-
 tezt/lib_cloud/proxy.ml       |  4 ++--
 tezt/lib_cloud/web.ml         | 35 ++++++++++++++++++-----------------
 tezt/tests/cloud/basic.ml     |  4 ++--
 tezt/tests/cloud/dal.ml       |  2 +-
 tezt/tests/cloud/tezos.ml     | 16 ++++++++--------
 10 files changed, 55 insertions(+), 51 deletions(-)

diff --git a/tezt/lib_cloud/agent.ml b/tezt/lib_cloud/agent.ml
index 0988f9c32e6a..af74f5fd2f7b 100644
--- a/tezt/lib_cloud/agent.ml
+++ b/tezt/lib_cloud/agent.ml
@@ -253,6 +253,6 @@ let copy =
 
 let next_available_port t = t.next_available_port ()
 
-let runner {runner; _} = runner
+let runner {runner; _} = Some runner
 
 let configuration {configuration; _} = configuration
diff --git a/tezt/lib_cloud/agent.mli b/tezt/lib_cloud/agent.mli
index 03e684ed076f..3f35c5eca204 100644
--- a/tezt/lib_cloud/agent.mli
+++ b/tezt/lib_cloud/agent.mli
@@ -59,7 +59,7 @@ val copy : ?destination:string -> t -> source:string -> string Lwt.t
 val next_available_port : t -> int
 
 (** [runner agent] returns the runner associated with the agent. *)
-val runner : t -> Runner.t
+val runner : t -> Runner.t option
 
 (** [point agent] returns the point asociated with the agent. *)
 val point : t -> string * int
diff --git a/tezt/lib_cloud/cloud.ml b/tezt/lib_cloud/cloud.ml
index fa4e38720d48..846abcb2dea2 100644
--- a/tezt/lib_cloud/cloud.ml
+++ b/tezt/lib_cloud/cloud.ml
@@ -176,18 +176,22 @@ let shutdown ?exn t =
 
 (* This function is used to ensure we can connect to the docker image on the VM. *)
 let wait_ssh_server_running agent =
-  let runner = Agent.runner agent in
   if (Agent.configuration agent).os = "debian" then Lwt.return_unit
   else
-    let is_ready _output = true in
-    let run () =
-      let cmd, args =
-        Runner.wrap_with_ssh runner (Runner.Shell.cmd [] "echo" ["-n"; "check"])
-      in
-      Process.spawn cmd (["-o"; "StrictHostKeyChecking=no"] @ args)
-    in
-    let* _ = Env.wait_process ~is_ready ~run () in
-    Lwt.return_unit
+    match Agent.runner agent with
+    | None -> Lwt.return_unit
+    | Some runner ->
+        let is_ready _output = true in
+        let run () =
+          let cmd, args =
+            Runner.wrap_with_ssh
+              runner
+              (Runner.Shell.cmd [] "echo" ["-n"; "check"])
+          in
+          Process.spawn cmd (["-o"; "StrictHostKeyChecking=no"] @ args)
+        in
+        let* _ = Env.wait_process ~is_ready ~run () in
+        Lwt.return_unit
 
 let orchestrator deployement f =
   let agents = Deployement.agents deployement in
@@ -238,7 +242,8 @@ let orchestrator deployement f =
   shutdown ?exn t
 
 let attach agent =
-  let runner = Agent.runner agent in
+  (* The proxy agent has to have a runner attached to it. *)
+  let runner = Agent.runner agent |> Option.get in
   let hooks =
     Process.
       {
@@ -360,7 +365,7 @@ let try_reattach () =
           (fun () ->
             let* status =
               Process.spawn
-                ~runner:(Agent.runner proxy_agent)
+                ?runner:(Agent.runner proxy_agent)
                 "ls"
                 ["screenlog.0"]
               |> Process.wait
@@ -410,13 +415,13 @@ let init_proxy ?(proxy_files = []) deployement =
   let runner = Agent.runner proxy_agent in
   let* () =
     (* This should not be necessary, this is to ensure there is no [screen] leftover. *)
-    let process = Process.spawn ~runner "pkill" ["screen"] in
+    let process = Process.spawn ?runner "pkill" ["screen"] in
     let* _ = Process.wait process in
     Lwt.return_unit
   in
   let* () =
     (* We start a screen session in detached mode. The orchestrator will run in this session. *)
-    Process.spawn ~runner "screen" ["-S"; "tezt-cloud"; "-d"; "-m"]
+    Process.spawn ?runner "screen" ["-S"; "tezt-cloud"; "-d"; "-m"]
     |> Process.check
   in
   let process =
@@ -566,7 +571,7 @@ let add_prometheus_source t ?metric_path ~job_name targets =
   | None -> Lwt.return_unit
   | Some prometheus ->
       let prometheus_target {agent; port; app_name} =
-        let address = agent |> Agent.runner |> Option.some |> Runner.address in
+        let address = agent |> Agent.runner |> Runner.address in
         Prometheus.{address; port; app_name}
       in
       let targets = List.map prometheus_target targets in
diff --git a/tezt/lib_cloud/deployement.ml b/tezt/lib_cloud/deployement.ml
index c332efc674ea..abb581584f40 100644
--- a/tezt/lib_cloud/deployement.ml
+++ b/tezt/lib_cloud/deployement.ml
@@ -169,9 +169,7 @@ module Remote = struct
              agents
              |> List.iter (fun agent ->
                     (* We index the table per address to identify uniquely the agent. *)
-                    let address =
-                      agent |> Agent.runner |> Option.some |> Runner.address
-                    in
+                    let address = agent |> Agent.runner |> Runner.address in
                     Hashtbl.add
                       agents_info
                       address
diff --git a/tezt/lib_cloud/prometheus.ml b/tezt/lib_cloud/prometheus.ml
index 50fcfb03855e..f319d32da48a 100644
--- a/tezt/lib_cloud/prometheus.ml
+++ b/tezt/lib_cloud/prometheus.ml
@@ -22,7 +22,7 @@ let netdata_source_of_agents agents =
   let metric_path = "/api/v1/allmetrics?format=prometheus&help=yes" in
   let target agent =
     let app_name = Agent.name agent in
-    let address = agent |> Agent.runner |> Option.some |> Runner.address in
+    let address = agent |> Agent.runner |> Runner.address in
     {address; port = 19999; app_name}
   in
   let targets = List.map target agents in
diff --git a/tezt/lib_cloud/proxy.ml b/tezt/lib_cloud/proxy.ml
index 90b0900a990f..b4009d5fa85f 100644
--- a/tezt/lib_cloud/proxy.ml
+++ b/tezt/lib_cloud/proxy.ml
@@ -71,7 +71,7 @@ let copy_files proxy_agent ~scenario_files ~proxy_deployement =
   *)
   let* output =
     Process.spawn
-      ~runner:(Agent.runner proxy_agent)
+      ?runner:(Agent.runner proxy_agent)
       "ls"
       [Path.default_binaries_path ()]
     |> Process.check_and_read_stdout
@@ -81,7 +81,7 @@ let copy_files proxy_agent ~scenario_files ~proxy_deployement =
     files
     |> List.map (fun file ->
            Process.spawn
-             ~runner:(Agent.runner proxy_agent)
+             ?runner:(Agent.runner proxy_agent)
              "ln"
              ["-s"; Path.default_binaries_path () // file; file; "-f"]
            |> Process.check)
diff --git a/tezt/lib_cloud/web.ml b/tezt/lib_cloud/web.ml
index 56668d3dc359..83313de9b07a 100644
--- a/tezt/lib_cloud/web.ml
+++ b/tezt/lib_cloud/web.ml
@@ -56,20 +56,23 @@ let configuration ~agents =
   Format.asprintf "# Configurations@.%s\n" str
 
 let string_docker_command agent =
-  let point = Agent.point agent in
-  let ssh_id = (Agent.runner agent).Runner.ssh_id in
-  String.concat
-    " "
-    [
-      "ssh";
-      Format.asprintf "root@%s" (fst point);
-      "-p";
-      string_of_int (snd point);
-      "-o";
-      "StrictHostKeyChecking=no";
-      "-i";
-      ssh_id |> Option.get;
-    ]
+  match Agent.runner agent with
+  | None -> "<no command, docker is host>"
+  | Some runner ->
+      let point = Agent.point agent in
+      let ssh_id = runner.Runner.ssh_id in
+      String.concat
+        " "
+        [
+          "ssh";
+          Format.asprintf "root@%s" (fst point);
+          "-p";
+          string_of_int (snd point);
+          "-o";
+          "StrictHostKeyChecking=no";
+          "-i";
+          ssh_id |> Option.get;
+        ]
 
 let string_vm_command agent =
   match Agent.cmd_wrapper agent with
@@ -118,9 +121,7 @@ let monitoring ~agents =
     let str =
       agents
       |> List.map (fun agent ->
-             let address =
-               Agent.runner agent |> fun runner -> Runner.address (Some runner)
-             in
+             let address = Agent.runner agent |> Runner.address in
              Format.asprintf
                "- [%s](http://%s:19999)"
                (Agent.name agent)
diff --git a/tezt/tests/cloud/basic.ml b/tezt/tests/cloud/basic.ml
index 740d05b0ae42..9b8325df3eb4 100644
--- a/tezt/tests/cloud/basic.ml
+++ b/tezt/tests/cloud/basic.ml
@@ -18,7 +18,7 @@ let simple () =
   let* output =
     Process.spawn
       ~name:"agent0"
-      ~runner:(Agent.runner agent0)
+      ?runner:(Agent.runner agent0)
       "echo"
       ["Hello world"]
     |> Process.check_and_read_stdout
@@ -27,7 +27,7 @@ let simple () =
   let* output =
     Process.spawn
       ~name:"agent1"
-      ~runner:(Agent.runner agent1)
+      ?runner:(Agent.runner agent1)
       "echo"
       ["Hello world"]
     |> Process.check_and_read_stdout
diff --git a/tezt/tests/cloud/dal.ml b/tezt/tests/cloud/dal.ml
index 3ceb594189be..7b30c3ec4a49 100644
--- a/tezt/tests/cloud/dal.ml
+++ b/tezt/tests/cloud/dal.ml
@@ -121,7 +121,7 @@ module Node = struct
             toplog "Downloading a rolling snapshot" ;
             let* () =
               Process.spawn
-                ~runner:(runner_of_agent agent)
+                ?runner:(runner_of_agent agent)
                 "wget"
                 [
                   "-O";
diff --git a/tezt/tests/cloud/tezos.ml b/tezt/tests/cloud/tezos.ml
index 7acb3c1205a5..e5819d5214e5 100644
--- a/tezt/tests/cloud/tezos.ml
+++ b/tezt/tests/cloud/tezos.ml
@@ -20,7 +20,7 @@ module Node = struct
         ?data_dir
         ?name
         ~path
-        ~runner
+        ?runner
         ~rpc_port
         ~net_port
         ~metrics_port
@@ -38,7 +38,7 @@ module Node = struct
         ?name
         ?data_dir
         ~path
-        ~runner
+        ?runner
         ~rpc_port
         ~net_port
         ~metrics_port
@@ -65,7 +65,7 @@ module Dal_node = struct
       let metrics_port = Agent.next_available_port agent in
       let metrics_addr = Format.asprintf "0.0.0.0:%d" metrics_port in
       let listen_addr = Format.asprintf "0.0.0.0:%d" net_port in
-      create ?name ~path ~runner ~rpc_port ~metrics_addr ~listen_addr ~node ()
+      create ?name ~path ?runner ~rpc_port ~metrics_addr ~listen_addr ~node ()
       |> Lwt.return
   end
 end
@@ -86,7 +86,7 @@ module Sc_rollup_node = struct
         ?default_operator
         ?dal_node
         ~path
-        ~runner
+        ?runner
         ~rpc_port
         ~metrics_addr
         ~metrics_port
@@ -110,7 +110,7 @@ module Sc_rollup_helpers = struct
       let runner = Agent.runner agent in
       prepare_installer_kernel_with_arbitrary_file
         ~smart_rollup_installer_path
-        ~runner
+        ?runner
         ~boot_sector:`Filename
         ~preimages_dir
         ?config
@@ -160,7 +160,7 @@ module Evm_node = struct
       let* path = Agent.copy agent ~source:path in
       let runner = Agent.runner agent in
       let rpc_port = Agent.next_available_port agent in
-      create ?name ~path ~runner ?data_dir ~rpc_port ?mode endpoint
+      create ?name ~path ?runner ?data_dir ~rpc_port ?mode endpoint
       |> Lwt.return
 
     let init ?patch_config ?name ?mode ?data_dir rollup_node agent =
@@ -184,7 +184,7 @@ module Client = struct
       let* path = Agent.copy agent ~source:path in
       let runner = Agent.runner agent in
       let endpoint = Option.map (fun x -> Node x) node in
-      create ~runner ~path ?endpoint () |> Lwt.return
+      create ?runner ~path ?endpoint () |> Lwt.return
   end
 end
 
@@ -200,7 +200,7 @@ module Baker = struct
       init
         ?name
         ~event_level:`Notice
-        ~runner
+        ?runner
         ~path
         ~delegates:[delegate]
         ~protocol
-- 
GitLab


From 638962379d1d7950d49340f486f4e9eabda67a38 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Fran=C3=A7ois=20Thir=C3=A9?=
 <francois.thire@nomadic-labs.com>
Date: Mon, 2 Sep 2024 09:48:37 +0200
Subject: [PATCH 3/5] Tezt/Cloud: Agent can have an optional runner

---
 tezt/lib_cloud/agent.ml | 98 +++++++++++++++++++++++------------------
 tezt/tests/cloud/dal.ml | 21 ++++++---
 2 files changed, 68 insertions(+), 51 deletions(-)

diff --git a/tezt/lib_cloud/agent.ml b/tezt/lib_cloud/agent.ml
index af74f5fd2f7b..ebb5abd705c0 100644
--- a/tezt/lib_cloud/agent.ml
+++ b/tezt/lib_cloud/agent.ml
@@ -11,7 +11,7 @@ type t = {
   vm_name : string;
   zone : string option;
   point : string * int;
-  runner : Runner.t;
+  runner : Runner.t option;
   next_available_port : unit -> int;
   configuration : Configuration.t;
 }
@@ -71,6 +71,7 @@ let encoding =
       let ssh_id = ssh_id () in
       let runner =
         Runner.create ~ssh_user:"root" ~ssh_id ~ssh_port ~address ()
+        |> Option.some
       in
       let next_available_port =
         let current_port = ref (next_available_port - 1) in
@@ -92,7 +93,9 @@ let encoding =
 let make ?zone ~ssh_id ~point:((address, ssh_port) as point) ~configuration
     ~next_available_port ~name () =
   let ssh_user = "root" in
-  let runner = Runner.create ~ssh_user ~ssh_id ~ssh_port ~address () in
+  let runner =
+    Runner.create ~ssh_user ~ssh_id ~ssh_port ~address () |> Option.some
+  in
   {
     point;
     runner;
@@ -131,32 +134,25 @@ let host_run_command agent cmd args =
       Process.spawn cmd_wrapper.Gcloud.cmd (cmd_wrapper.args @ [cmd] @ args)
 
 let docker_run_command agent cmd args =
-  let cmd, args =
-    Runner.wrap_with_ssh agent.runner (Runner.Shell.cmd [] cmd args)
-  in
-  (* The host check is very not convenient at all for this setting. This makes
-     tezt cloud sensible to man in the middle attacks. There are other options
-     like doing the check the first time only etc... But they all fail at some
-     point. I think the issue is that:
+  match agent.runner with
+  | None -> Process.spawn cmd args
+  | Some runner ->
+      let cmd, args =
+        Runner.wrap_with_ssh runner (Runner.Shell.cmd [] cmd args)
+      in
+      (* The host check is very not convenient at all for this setting. This makes
+         tezt cloud sensible to man in the middle attacks. There are other options
+         like doing the check the first time only etc... But they all fail at some
+         point. I think the issue is that:
 
-      - GCP may reuse IP addresses
-      - The docker image generates new key anytime it is generated
+          - GCP may reuse IP addresses
+          - The docker image generates new key anytime it is generated
 
-      I don't have a good proposition that keeps a nice UX and is secure at the moment.
-  *)
-  Process.spawn cmd (["-o"; "StrictHostKeyChecking=no"] @ args)
+          I don't have a good proposition that keeps a nice UX and is secure at the moment.
+      *)
+      Process.spawn cmd (["-o"; "StrictHostKeyChecking=no"] @ args)
 
 let copy agent ~source ~destination =
-  let runner = agent.runner in
-  let identity =
-    Option.fold ~none:[] ~some:(fun i -> ["-i"; i]) runner.ssh_id
-  in
-  let port =
-    Option.fold
-      ~none:[]
-      ~some:(fun p -> ["-P"; Format.sprintf "%d" p])
-      runner.ssh_port
-  in
   let* exists =
     let process = docker_run_command agent "ls" [destination] in
     let* status = process |> Process.wait in
@@ -190,25 +186,39 @@ let copy agent ~source ~destination =
   in
   if exists then Lwt.return_unit
   else
-    let destination =
-      Format.sprintf
-        "%s%s:%s"
-        (Option.fold
-           ~none:""
-           ~some:(fun u -> Format.sprintf "%s@" u)
-           runner.ssh_user)
-        runner.address
-        destination
-    in
-    let* () =
-      (* FIXME: I forgot why we enforce [-0]. *)
-      Process.run
-        "scp"
-        (["-O"]
-        @ ["-o"; "StrictHostKeyChecking=no"]
-        @ identity @ port @ [source] @ [destination])
-    in
-    Lwt.return_unit
+    match agent.runner with
+    | None ->
+        if source <> destination then Process.run "cp" [source; destination]
+        else Lwt.return_unit
+    | Some runner ->
+        let destination =
+          Format.sprintf
+            "%s%s:%s"
+            (Option.fold
+               ~none:""
+               ~some:(fun u -> Format.sprintf "%s@" u)
+               runner.Runner.ssh_user)
+            runner.address
+            destination
+        in
+        let identity =
+          Option.fold ~none:[] ~some:(fun i -> ["-i"; i]) runner.Runner.ssh_id
+        in
+        let port =
+          Option.fold
+            ~none:[]
+            ~some:(fun p -> ["-P"; Format.sprintf "%d" p])
+            runner.Runner.ssh_port
+        in
+        let* () =
+          (* FIXME: I forgot why we enforce [-0]. *)
+          Process.run
+            "scp"
+            (["-O"]
+            @ ["-o"; "StrictHostKeyChecking=no"]
+            @ identity @ port @ [source] @ [destination])
+        in
+        Lwt.return_unit
 
 let is_binary file =
   let* output = Process.run_and_read_stdout "file" [file] in
@@ -253,6 +263,6 @@ let copy =
 
 let next_available_port t = t.next_available_port ()
 
-let runner {runner; _} = Some runner
+let runner {runner; _} = runner
 
 let configuration {configuration; _} = configuration
diff --git a/tezt/tests/cloud/dal.ml b/tezt/tests/cloud/dal.ml
index 7b30c3ec4a49..766a117fa771 100644
--- a/tezt/tests/cloud/dal.ml
+++ b/tezt/tests/cloud/dal.ml
@@ -231,15 +231,22 @@ module Teztale = struct
     in
     let port = Agent.next_available_port agent in
     let configuration = make_configuration ~port in
-    let cmd =
-      Runner.Shell.(
-        redirect_stdout (cmd [] "echo" [configuration]) configuration_file)
+    let* () =
+      match runner with
+      | None ->
+          write_file configuration_file ~contents:configuration ;
+          Lwt.return_unit
+      | Some runner ->
+          let cmd =
+            Runner.Shell.(
+              redirect_stdout (cmd [] "echo" [configuration]) configuration_file)
+          in
+          let cmd, args = Runner.wrap_with_ssh runner cmd in
+          Process.spawn cmd args |> Process.check
     in
-    let cmd, args = Runner.wrap_with_ssh runner cmd in
-    let* () = Process.spawn cmd args |> Process.check in
     let* path = Agent.copy agent ~source:path in
     let server_daemon =
-      Process.spawn ~name:"teztale-server" ~runner path [configuration_file]
+      Process.spawn ~name:"teztale-server" ?runner path [configuration_file]
     in
     (* Wait a bit it starts. *)
     let* () = Lwt_unix.sleep 0.5 in
@@ -257,7 +264,7 @@ module Teztale = struct
     let archiver_daemon =
       Process.spawn
         ~name:"teztale-archiver"
-        ~runner
+        ?runner
         path
         ["--endpoint"; node_endpoint; "feed"; teztale_endpoint]
     in
-- 
GitLab


From fb5f8352f268130474e9abc0b6f44ed78fac0b1e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Fran=C3=A7ois=20Thir=C3=A9?=
 <francois.thire@nomadic-labs.com>
Date: Mon, 2 Sep 2024 09:59:46 +0200
Subject: [PATCH 4/5] Tezt/Cloud: Agent can return an optional point

---
 tezt/lib_cloud/agent.ml       | 30 ++++++++++++++++++------------
 tezt/lib_cloud/agent.mli      |  6 +++---
 tezt/lib_cloud/cloud.ml       | 34 ++++++++++++++++++++--------------
 tezt/lib_cloud/deployement.ml |  2 +-
 tezt/lib_cloud/web.ml         |  8 +++++---
 tezt/tests/cloud/dal.ml       | 10 ++++++++--
 6 files changed, 55 insertions(+), 35 deletions(-)

diff --git a/tezt/lib_cloud/agent.ml b/tezt/lib_cloud/agent.ml
index ebb5abd705c0..d018d1ac49c2 100644
--- a/tezt/lib_cloud/agent.ml
+++ b/tezt/lib_cloud/agent.ml
@@ -10,7 +10,7 @@ type t = {
   mutable name : string;
   vm_name : string;
   zone : string option;
-  point : string * int;
+  point : (string * int) option;
   runner : Runner.t option;
   next_available_port : unit -> int;
   configuration : Configuration.t;
@@ -66,19 +66,20 @@ let encoding =
          } ->
       (name, vm_name, zone, point, next_available_port (), configuration))
     (fun (name, vm_name, zone, point, next_available_port, configuration) ->
-      let ssh_port = snd point in
-      let address = fst point in
-      let ssh_id = ssh_id () in
-      let runner =
-        Runner.create ~ssh_user:"root" ~ssh_id ~ssh_port ~address ()
-        |> Option.some
-      in
       let next_available_port =
         let current_port = ref (next_available_port - 1) in
         fun () ->
           incr current_port ;
           !current_port
       in
+      let runner =
+        match point with
+        | None -> None
+        | Some (address, ssh_port) ->
+            let ssh_id = ssh_id () in
+            Runner.create ~ssh_user:"root" ~ssh_id ~ssh_port ~address ()
+            |> Option.some
+      in
       {name; vm_name; zone; point; runner; next_available_port; configuration})
     (obj6
        (req "name" Data_encoding.string)
@@ -86,15 +87,20 @@ let encoding =
        (req "zone" (Data_encoding.option Data_encoding.string))
        (req
           "point"
-          (Data_encoding.tup2 Data_encoding.string Data_encoding.int31))
+          (Data_encoding.option
+             (Data_encoding.tup2 Data_encoding.string Data_encoding.int31)))
        (req "next_available_port" Data_encoding.int31)
        (req "configuration" configuration_encoding))
 
-let make ?zone ~ssh_id ~point:((address, ssh_port) as point) ~configuration
-    ~next_available_port ~name () =
+let make ?zone ?ssh_id ?point ~configuration ~next_available_port ~name () =
   let ssh_user = "root" in
   let runner =
-    Runner.create ~ssh_user ~ssh_id ~ssh_port ~address () |> Option.some
+    match (point, ssh_id) with
+    | None, None -> None
+    | Some _, None | None, Some _ ->
+        Test.fail "Agent.make was not initialized correctly"
+    | Some (address, ssh_port), Some ssh_id ->
+        Runner.create ~ssh_user ~ssh_id ~ssh_port ~address () |> Option.some
   in
   {
     point;
diff --git a/tezt/lib_cloud/agent.mli b/tezt/lib_cloud/agent.mli
index 3f35c5eca204..b6d4fa1c3911 100644
--- a/tezt/lib_cloud/agent.mli
+++ b/tezt/lib_cloud/agent.mli
@@ -18,8 +18,8 @@ type t
     the ssh connection. *)
 val make :
   ?zone:string ->
-  ssh_id:string ->
-  point:string * int ->
+  ?ssh_id:string ->
+  ?point:string * int ->
   configuration:Configuration.t ->
   next_available_port:(unit -> int) ->
   name:string ->
@@ -62,7 +62,7 @@ val next_available_port : t -> int
 val runner : t -> Runner.t option
 
 (** [point agent] returns the point asociated with the agent. *)
-val point : t -> string * int
+val point : t -> (string * int) option
 
 (** [configuration t] the configuration of the agent. *)
 val configuration : t -> Configuration.t
diff --git a/tezt/lib_cloud/cloud.ml b/tezt/lib_cloud/cloud.ml
index 846abcb2dea2..ddce8d7c19a3 100644
--- a/tezt/lib_cloud/cloud.ml
+++ b/tezt/lib_cloud/cloud.ml
@@ -109,19 +109,21 @@ let shutdown ?exn t =
             let agents = Deployement.agents deployement in
             agents
             |> List.map (fun agent ->
-                   let point = Agent.point agent in
-                   Process.run
-                     "ssh"
-                     [
-                       "-S";
-                       Format.asprintf
-                         "~/.ssh/sockets/root@%s-%d"
-                         (fst point)
-                         (snd point);
-                       "-O";
-                       "exit";
-                       Format.asprintf "root@%s" (fst point);
-                     ])
+                   match Agent.point agent with
+                   | None -> Lwt.return_unit
+                   | Some point ->
+                       Process.run
+                         "ssh"
+                         [
+                           "-S";
+                           Format.asprintf
+                             "~/.ssh/sockets/root@%s-%d"
+                             (fst point)
+                             (snd point);
+                           "-O";
+                           "exit";
+                           Format.asprintf "root@%s" (fst point);
+                         ])
             |> Lwt.join)
       (fun _exn -> Lwt.return_unit)
   in
@@ -306,7 +308,11 @@ let attach agent =
             Gcloud.DNS.get_domain ~tezt_cloud:Env.tezt_cloud ~zone:"tezt-cloud"
           in
           Lwt.return (Format.asprintf "http://%s" domain)
-        else Lwt.return (Format.asprintf "http://%s" (Agent.point agent |> fst))
+        else
+          Lwt.return
+            (Format.asprintf
+               "http://%s"
+               (Agent.point agent |> Option.get |> fst))
       in
       Log.info "Deployement website can be accessed here: %s" uri ;
       Lwt.return_unit
diff --git a/tezt/lib_cloud/deployement.ml b/tezt/lib_cloud/deployement.ml
index abb581584f40..69400b8d229e 100644
--- a/tezt/lib_cloud/deployement.ml
+++ b/tezt/lib_cloud/deployement.ml
@@ -196,7 +196,7 @@ module Remote = struct
             Gcloud.DNS.add
               ~tezt_cloud:Env.tezt_cloud
               ~zone:"tezt-cloud"
-              ~ip:(Agent.point agent |> fst)
+              ~ip:(Agent.point agent |> Option.get |> fst)
           else Lwt.return_unit
         in
         Lwt.return {agents = agent :: agents}
diff --git a/tezt/lib_cloud/web.ml b/tezt/lib_cloud/web.ml
index 83313de9b07a..d1fa5c8a5435 100644
--- a/tezt/lib_cloud/web.ml
+++ b/tezt/lib_cloud/web.ml
@@ -59,7 +59,7 @@ let string_docker_command agent =
   match Agent.runner agent with
   | None -> "<no command, docker is host>"
   | Some runner ->
-      let point = Agent.point agent in
+      let point = Agent.point agent |> Option.get in
       let ssh_id = runner.Runner.ssh_id in
       String.concat
         " "
@@ -135,7 +135,8 @@ let monitoring ~agents =
 let prometheus ~agents =
   let domain =
     match Env.mode with
-    | `Orchestrator -> Proxy.get_agent agents |> Agent.point |> fst
+    | `Orchestrator ->
+        Proxy.get_agent agents |> Agent.point |> Option.get |> fst
     | `Host | `Localhost | `Cloud -> "localhost"
   in
   if Env.prometheus then
@@ -148,7 +149,8 @@ let prometheus ~agents =
 let grafana ~agents =
   let domain =
     match Env.mode with
-    | `Orchestrator -> Proxy.get_agent agents |> Agent.point |> fst
+    | `Orchestrator ->
+        Proxy.get_agent agents |> Agent.point |> Option.get |> fst
     | `Host | `Localhost | `Cloud -> "localhost"
   in
   if Env.grafana then
diff --git a/tezt/tests/cloud/dal.ml b/tezt/tests/cloud/dal.ml
index 766a117fa771..8122868724bd 100644
--- a/tezt/tests/cloud/dal.ml
+++ b/tezt/tests/cloud/dal.ml
@@ -1091,7 +1091,10 @@ let init_ghostnet cloud (configuration : configuration) agent =
           Endpoint.
             {
               scheme = "http";
-              host = Agent.point agent |> fst;
+              host =
+                (match Agent.point agent with
+                | None -> "127.0.0.1"
+                | Some point -> fst point);
               port = Node.rpc_port node;
             }
         in
@@ -1280,7 +1283,10 @@ let init_bootstrap_and_activate_protocol cloud (configuration : configuration)
     Endpoint.
       {
         scheme = "http";
-        host = Agent.point agent |> fst;
+        host =
+          (match Agent.point agent with
+          | None -> "127.0.0.1"
+          | Some point -> fst point);
         port = Node.rpc_port bootstrap_node;
       }
   in
-- 
GitLab


From 10cdccceaa78702cca689f9fb6e89f17395a20e1 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Fran=C3=A7ois=20Thir=C3=A9?=
 <francois.thire@nomadic-labs.com>
Date: Mon, 2 Sep 2024 11:39:43 +0200
Subject: [PATCH 5/5] Tezt/Cloud: If no VMs is specified, a default agent can
 be used

---
 tezt/lib_cloud/cloud.ml | 43 ++++++++++++++++++++++++++++++++++-------
 1 file changed, 36 insertions(+), 7 deletions(-)

diff --git a/tezt/lib_cloud/cloud.ml b/tezt/lib_cloud/cloud.ml
index ddce8d7c19a3..9b10442deb9e 100644
--- a/tezt/lib_cloud/cloud.ml
+++ b/tezt/lib_cloud/cloud.ml
@@ -473,18 +473,31 @@ let register ?proxy_files ?vms ~__FILE__ ~title ~tags ?seed f =
     (* The Cli arguments by-pass the argument given here. This enable the user
        to always have decide precisely the number of vms to be run. *)
     match (vms, Env.vms) with
-    | None, None -> None
+    | None, None | None, Some 0 -> None
+    | Some _, Some 0 when Env.mode = `Localhost || Env.mode = `Cloud ->
+        (* We don't want to go here when using the proxy mode. *)
+        None
     | None, Some i | Some _, Some i ->
         let vms = List.init i (fun _ -> Configuration.make ()) in
         Some vms
     | Some vms, None -> Some vms
   in
   match vms with
-  | None | Some [] ->
-      (* If there is no configuration, it is a similar scenario as if there were not agent. *)
+  | None ->
+      let default_agent =
+        Agent.make
+          ~configuration:(Configuration.make ())
+          ~next_available_port:
+            (let cpt = ref 30_000 in
+             fun () ->
+               incr cpt ;
+               !cpt)
+          ~name:"default agent"
+          ()
+      in
       f
         {
-          agents = [];
+          agents = [default_agent];
           website = None;
           grafana = None;
           prometheus = None;
@@ -545,11 +558,27 @@ let register ?proxy_files ?vms ~__FILE__ ~title ~tags ?seed f =
 
 let agents t =
   match Env.mode with
-  | `Orchestrator ->
+  | `Orchestrator -> (
       let proxy_agent = Proxy.get_agent t.agents in
       let proxy_vm_name = Agent.vm_name proxy_agent in
-      t.agents
-      |> List.filter (fun agent -> Agent.vm_name agent <> proxy_vm_name)
+      match
+        t.agents
+        |> List.filter (fun agent -> Agent.vm_name agent <> proxy_vm_name)
+      with
+      | [] ->
+          let default_agent =
+            Agent.make
+              ~configuration:(Configuration.make ())
+              ~next_available_port:
+                (let cpt = ref 30_000 in
+                 fun () ->
+                   incr cpt ;
+                   !cpt)
+              ~name:"default agent"
+              ()
+          in
+          [default_agent]
+      | agents -> agents)
   | `Host | `Cloud | `Localhost -> t.agents
 
 let get_configuration = Agent.configuration
-- 
GitLab