From 18b93accbc6fd8a068baa0159569df3b094641d5 Mon Sep 17 00:00:00 2001 From: Mark Elvers Date: Fri, 1 Apr 2022 14:52:07 +0000 Subject: [PATCH 1/5] Added --terse option to ocluster-admin-show --- bin/admin.ml | 22 +++++++++++++++++----- 1 file changed, 17 insertions(+), 5 deletions(-) diff --git a/bin/admin.ml b/bin/admin.ml index 066f34ba..fbb3c14c 100644 --- a/bin/admin.ml +++ b/bin/admin.ml @@ -37,16 +37,21 @@ let set_rate () cap_path pool_id client_id rate = let pool = Cluster_api.Admin.pool admin_service pool_id in Cluster_api.Pool_admin.set_rate pool ~client_id rate -let show () cap_path pool = +let show () cap_path terse pool = run cap_path @@ fun admin_service -> match pool with | None -> Cluster_api.Admin.pools admin_service >|= fun pools -> List.iter print_endline pools | Some pool -> - Capability.with_ref (Cluster_api.Admin.pool admin_service pool) @@ fun pool -> - Cluster_api.Pool_admin.show pool >|= fun status -> - print_endline (String.trim status) + if terse then + Capability.with_ref (Cluster_api.Admin.pool admin_service pool) @@ fun pool -> + Cluster_api.Pool_admin.workers pool >|= fun workers -> + List.iter (fun (w:Cluster_api.Pool_admin.worker_info) -> print_endline w.name) workers + else + Capability.with_ref (Cluster_api.Admin.pool admin_service pool) @@ fun pool -> + Cluster_api.Pool_admin.show pool >|= fun status -> + print_endline (String.trim status) let with_progress label = Capability.with_ref (Cluster_api.Progress.local (Fmt.pr "%s: %s@." label)) @@ -238,6 +243,13 @@ let wait = ~doc:"Wait until no jobs are running" ["wait"] +let terse = + Arg.value @@ + Arg.flag @@ + Arg.info + ~doc:"Just list names of the workers" + ["terse"] + let add_client = let doc = "Create a new client endpoint for submitting jobs" in let info = Cmd.info "add-client" ~doc in @@ -266,7 +278,7 @@ let show = let doc = "Show information about a service, pool or worker" in let info = Cmd.info "show" ~doc in Cmd.v info - Term.(const show $ Logging.term $ connect_addr $ Arg.value pool_pos) + Term.(const show $ Logging.term $ connect_addr $ terse $ Arg.value pool_pos) let pause = let doc = "Set a worker to be unavailable for further jobs" in From e56baf598bc80cd1e32839c0fe7d7ec9a52ad544 Mon Sep 17 00:00:00 2001 From: Mark Elvers Date: Sat, 2 Apr 2022 21:57:26 +0000 Subject: [PATCH 2/5] Untidy exec --- bin/admin.ml | 37 ++++++++++++++++++++++++++++++++++--- 1 file changed, 34 insertions(+), 3 deletions(-) diff --git a/bin/admin.ml b/bin/admin.ml index fbb3c14c..87db4326 100644 --- a/bin/admin.ml +++ b/bin/admin.ml @@ -44,15 +44,32 @@ let show () cap_path terse pool = Cluster_api.Admin.pools admin_service >|= fun pools -> List.iter print_endline pools | Some pool -> + Capability.with_ref (Cluster_api.Admin.pool admin_service pool) @@ fun pool -> if terse then - Capability.with_ref (Cluster_api.Admin.pool admin_service pool) @@ fun pool -> Cluster_api.Pool_admin.workers pool >|= fun workers -> List.iter (fun (w:Cluster_api.Pool_admin.worker_info) -> print_endline w.name) workers else - Capability.with_ref (Cluster_api.Admin.pool admin_service pool) @@ fun pool -> Cluster_api.Pool_admin.show pool >|= fun status -> print_endline (String.trim status) +let check_exit_status = function + | Unix.WEXITED 0 -> () + | Unix.WEXITED x -> Fmt.failwith "Sub-process failed with exit code %d" x + | Unix.WSIGNALED x -> Fmt.failwith "Sub-process failed with signal %d" x + | Unix.WSTOPPED x -> Fmt.failwith "Sub-process stopped with signal %d" x + +let exec () cap_path pool prog = + List.iter print_endline prog; + run cap_path @@ fun admin_service -> + Capability.with_ref (Cluster_api.Admin.pool admin_service pool) @@ fun pool -> + Cluster_api.Pool_admin.workers pool >|= fun workers -> ignore( + let jobs = workers |> List.map (fun (w:Cluster_api.Pool_admin.worker_info) -> + let ar = Array.of_list prog in + let ar2 = Array.map (fun el -> if el = "{}" then w.name else el) ar in + Lwt_process.exec ("", ar2 ) >|= check_exit_status + ) in + Lwt.join jobs) + let with_progress label = Capability.with_ref (Cluster_api.Progress.local (Fmt.pr "%s: %s@." label)) @@ -250,6 +267,14 @@ let terse = ~doc:"Just list names of the workers" ["terse"] +let prog_pos = + Arg.value @@ + Arg.pos_right 0 Arg.string [] @@ + Arg.info + ~doc:"cmd to run" + ~docv:"PROG" + [] + let add_client = let doc = "Create a new client endpoint for submitting jobs" in let info = Cmd.info "add-client" ~doc in @@ -274,6 +299,12 @@ let set_rate = Cmd.v info Term.(const set_rate $ Logging.term $ connect_addr $ Arg.required pool_pos $ Arg.required (client_id ~pos:1) $ Arg.required (rate ~pos:2)) +let exec = + let doc = "Execute a command for each worker in a pool" in + let info = Cmd.info "exec" ~doc in + Cmd.v info + Term.(const exec $ Logging.term $ connect_addr $ Arg.required pool_pos $ prog_pos) + let show = let doc = "Show information about a service, pool or worker" in let info = Cmd.info "show" ~doc in @@ -305,7 +336,7 @@ let forget = Term.(const forget $ Logging.term $ connect_addr $ Arg.required pool_pos $ worker) -let cmds = [add_client; remove_client; list_clients; set_rate; show; pause; unpause; update; forget] +let cmds = [add_client; remove_client; list_clients; set_rate; show; exec; pause; unpause; update; forget] let () = let doc = "a command-line admin client for the build-scheduler" in From f061bd44aa786b34cc6a6d832426812d6bb62347 Mon Sep 17 00:00:00 2001 From: Mark Elvers Date: Sun, 3 Apr 2022 10:20:01 +0000 Subject: [PATCH 3/5] shorter version --- bin/admin.ml | 13 +++---------- 1 file changed, 3 insertions(+), 10 deletions(-) diff --git a/bin/admin.ml b/bin/admin.ml index 87db4326..de446283 100644 --- a/bin/admin.ml +++ b/bin/admin.ml @@ -52,23 +52,16 @@ let show () cap_path terse pool = Cluster_api.Pool_admin.show pool >|= fun status -> print_endline (String.trim status) -let check_exit_status = function - | Unix.WEXITED 0 -> () - | Unix.WEXITED x -> Fmt.failwith "Sub-process failed with exit code %d" x - | Unix.WSIGNALED x -> Fmt.failwith "Sub-process failed with signal %d" x - | Unix.WSTOPPED x -> Fmt.failwith "Sub-process stopped with signal %d" x - let exec () cap_path pool prog = List.iter print_endline prog; run cap_path @@ fun admin_service -> Capability.with_ref (Cluster_api.Admin.pool admin_service pool) @@ fun pool -> Cluster_api.Pool_admin.workers pool >|= fun workers -> ignore( - let jobs = workers |> List.map (fun (w:Cluster_api.Pool_admin.worker_info) -> + List.map (fun (w:Cluster_api.Pool_admin.worker_info) -> let ar = Array.of_list prog in let ar2 = Array.map (fun el -> if el = "{}" then w.name else el) ar in - Lwt_process.exec ("", ar2 ) >|= check_exit_status - ) in - Lwt.join jobs) + Lwt_process.exec ("", ar2 ) + ) workers ) let with_progress label = Capability.with_ref (Cluster_api.Progress.local (Fmt.pr "%s: %s@." label)) From 399504b649c35ea099dfa9fa9b0f3862ff66c7bc Mon Sep 17 00:00:00 2001 From: Mark Elvers Date: Sun, 3 Apr 2022 13:29:46 +0000 Subject: [PATCH 4/5] smaller ignore --- bin/admin.ml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/bin/admin.ml b/bin/admin.ml index de446283..162d6482 100644 --- a/bin/admin.ml +++ b/bin/admin.ml @@ -56,12 +56,12 @@ let exec () cap_path pool prog = List.iter print_endline prog; run cap_path @@ fun admin_service -> Capability.with_ref (Cluster_api.Admin.pool admin_service pool) @@ fun pool -> - Cluster_api.Pool_admin.workers pool >|= fun workers -> ignore( - List.map (fun (w:Cluster_api.Pool_admin.worker_info) -> + Cluster_api.Pool_admin.workers pool >|= fun workers -> + List.iter (fun (w:Cluster_api.Pool_admin.worker_info) -> let ar = Array.of_list prog in let ar2 = Array.map (fun el -> if el = "{}" then w.name else el) ar in - Lwt_process.exec ("", ar2 ) - ) workers ) + ignore( Lwt_process.exec ("", ar2 ) ) + ) workers let with_progress label = Capability.with_ref (Cluster_api.Progress.local (Fmt.pr "%s: %s@." label)) From 09a383e737d1bb11318d8c213e62d8d12c744098 Mon Sep 17 00:00:00 2001 From: Mark Elvers Date: Mon, 4 Apr 2022 14:21:08 +0000 Subject: [PATCH 5/5] exec working and tidy --- bin/admin.ml | 34 ++++++++++++++++++++-------------- 1 file changed, 20 insertions(+), 14 deletions(-) diff --git a/bin/admin.ml b/bin/admin.ml index 162d6482..ecf05c13 100644 --- a/bin/admin.ml +++ b/bin/admin.ml @@ -52,16 +52,22 @@ let show () cap_path terse pool = Cluster_api.Pool_admin.show pool >|= fun status -> print_endline (String.trim status) -let exec () cap_path pool prog = - List.iter print_endline prog; +let check_exit_status = function + | Unix.WEXITED 0 -> () + | Unix.WEXITED x -> Fmt.failwith "Sub-process failed with exit code %d" x + | Unix.WSIGNALED x -> Fmt.failwith "Sub-process failed with signal %d" x + | Unix.WSTOPPED x -> Fmt.failwith "Sub-process stopped with signal %d" x + +let exec () cap_path pool command = run cap_path @@ fun admin_service -> - Capability.with_ref (Cluster_api.Admin.pool admin_service pool) @@ fun pool -> - Cluster_api.Pool_admin.workers pool >|= fun workers -> - List.iter (fun (w:Cluster_api.Pool_admin.worker_info) -> - let ar = Array.of_list prog in - let ar2 = Array.map (fun el -> if el = "{}" then w.name else el) ar in - ignore( Lwt_process.exec ("", ar2 ) ) - ) workers + Capability.with_ref (Cluster_api.Admin.pool admin_service pool) @@ fun pool -> + Cluster_api.Pool_admin.workers pool >>= fun workers -> + let jobs = workers |> List.map (fun (w:Cluster_api.Pool_admin.worker_info) -> + let args = Array.of_list command in + let args2 = Array.map (fun el -> if el = "{}" then w.name else el) args in + Lwt_process.exec ("", args2 ) >|= check_exit_status + ) in + Lwt.join jobs let with_progress label = Capability.with_ref (Cluster_api.Progress.local (Fmt.pr "%s: %s@." label)) @@ -260,12 +266,12 @@ let terse = ~doc:"Just list names of the workers" ["terse"] -let prog_pos = - Arg.value @@ +let command_pos = + Arg.non_empty @@ Arg.pos_right 0 Arg.string [] @@ Arg.info - ~doc:"cmd to run" - ~docv:"PROG" + ~doc:"Execute command for each worker in the pool. All following arguments are arguments to the command. The string {} is replaced by the worker name everywhere it appears in the arguments. For example, exec -- ssh {} uptime" + ~docv:"CMD" [] let add_client = @@ -296,7 +302,7 @@ let exec = let doc = "Execute a command for each worker in a pool" in let info = Cmd.info "exec" ~doc in Cmd.v info - Term.(const exec $ Logging.term $ connect_addr $ Arg.required pool_pos $ prog_pos) + Term.(const exec $ Logging.term $ connect_addr $ Arg.required pool_pos $ command_pos) let show = let doc = "Show information about a service, pool or worker" in