From c04935633efcd86eca6c278428268701376ca02b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Antonin=20D=C3=A9cimo?= Date: Wed, 9 Feb 2022 17:15:53 +0100 Subject: [PATCH] Cmdliner.1.1.0 --- Dockerfile | 4 +-- Dockerfile.worker | 4 +-- bin/admin.ml | 55 ++++++++++++++++++++--------------- bin/client.ml | 39 ++++++++++++------------- bin/logging.ml | 4 ++- bin/scheduler.ml | 17 ++++++----- bin/worker.ml | 19 ++++++------ dune-project | 1 + examples/obuilder_pipeline.ml | 7 +++-- obuilder | 2 +- ocluster.opam | 1 + stress/stress.ml | 6 ++-- 12 files changed, 87 insertions(+), 72 deletions(-) diff --git a/Dockerfile b/Dockerfile index 6ec6eab1..1c766352 100644 --- a/Dockerfile +++ b/Dockerfile @@ -1,6 +1,6 @@ -FROM ocaml/opam:debian-11-ocaml-4.13@sha256:0c67662714d7f398ac4a8197d61ef85749effb8681d771837e9ebe36b0d4e20a AS build +FROM ocaml/opam:debian-11-ocaml-4.13@sha256:facb9f1272610683f75580a8189116dcc4f4fff6958640e81bf568ec8ffc6302 AS build RUN sudo apt-get update && sudo apt-get install libev-dev capnproto m4 pkg-config libsqlite3-dev libgmp-dev -y --no-install-recommends -RUN cd ~/opam-repository && git pull origin -q master && git reset --hard fbc1d981740a86692a63593aa3760a61f7b5072b && opam update +RUN cd ~/opam-repository && git pull origin -q master && git reset --hard ae6aff50030492f9b7eed0cf952fdca40f4cf125 && opam update COPY --chown=opam ocluster-api.opam ocluster.opam /src/ COPY --chown=opam obuilder/obuilder.opam obuilder/obuilder-spec.opam /src/obuilder/ RUN opam pin -yn /src/obuilder/ diff --git a/Dockerfile.worker b/Dockerfile.worker index e0243c55..edd90081 100644 --- a/Dockerfile.worker +++ b/Dockerfile.worker @@ -1,6 +1,6 @@ -FROM ocaml/opam:debian-11-ocaml-4.13@sha256:0c67662714d7f398ac4a8197d61ef85749effb8681d771837e9ebe36b0d4e20a AS build +FROM ocaml/opam:debian-11-ocaml-4.13@sha256:facb9f1272610683f75580a8189116dcc4f4fff6958640e81bf568ec8ffc6302 AS build RUN sudo apt-get update && sudo apt-get install libev-dev capnproto m4 pkg-config libsqlite3-dev libgmp-dev -y --no-install-recommends -RUN cd ~/opam-repository && git pull origin -q master && git reset --hard fbc1d981740a86692a63593aa3760a61f7b5072b && opam update +RUN cd ~/opam-repository && git pull origin -q master && git reset --hard ae6aff50030492f9b7eed0cf952fdca40f4cf125 && opam update COPY --chown=opam ocluster-api.opam ocluster.opam /src/ COPY --chown=opam obuilder/obuilder.opam obuilder/obuilder-spec.opam /src/obuilder/ RUN opam pin -yn /src/obuilder/ diff --git a/bin/admin.ml b/bin/admin.ml index 1a2264fd..066f34ba 100644 --- a/bin/admin.ml +++ b/bin/admin.ml @@ -240,55 +240,62 @@ let wait = let add_client = let doc = "Create a new client endpoint for submitting jobs" in - Term.(const add_client $ Logging.term $ connect_addr $ Arg.required (client_id ~pos:0)), - Term.info "add-client" ~doc + let info = Cmd.info "add-client" ~doc in + Cmd.v info + Term.(const add_client $ Logging.term $ connect_addr $ Arg.required (client_id ~pos:0)) let remove_client = let doc = "Unregister a client." in - Term.(const remove_client $ Logging.term $ connect_addr $ Arg.required (client_id ~pos:0)), - Term.info "remove-client" ~doc + let info = Cmd.info "remove-client" ~doc in + Cmd.v info + Term.(const remove_client $ Logging.term $ connect_addr $ Arg.required (client_id ~pos:0)) let list_clients = let doc = "List registered clients" in - Term.(const list_clients $ Logging.term $ connect_addr), - Term.info "list-clients" ~doc + let info = Cmd.info "list-clients" ~doc in + Cmd.v info + Term.(const list_clients $ Logging.term $ connect_addr) let set_rate = let doc = "Set expected number of parallel jobs for a pool/client combination" in - Term.(const set_rate $ Logging.term $ connect_addr $ Arg.required pool_pos $ Arg.required (client_id ~pos:1) $ Arg.required (rate ~pos:2)), - Term.info "set-rate" ~doc + let info = Cmd.info "set-rate" ~doc in + 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 show = let doc = "Show information about a service, pool or worker" in - Term.(const show $ Logging.term $ connect_addr $ Arg.value pool_pos), - Term.info "show" ~doc + let info = Cmd.info "show" ~doc in + Cmd.v info + Term.(const show $ Logging.term $ connect_addr $ Arg.value pool_pos) let pause = let doc = "Set a worker to be unavailable for further jobs" in - Term.(const (set_active false) $ Logging.term $ all $ auto_create $ wait $ connect_addr $ Arg.required pool_pos $ worker), - Term.info "pause" ~doc + let info = Cmd.info "pause" ~doc in + Cmd.v info + Term.(const (set_active false) $ Logging.term $ all $ auto_create $ wait $ connect_addr $ Arg.required pool_pos $ worker) let unpause = let doc = "Resume a paused worker" in - Term.(const (set_active true) $ Logging.term $ all $ auto_create $ const false $ connect_addr $ Arg.required pool_pos $ worker), - Term.info "unpause" ~doc + let info = Cmd.info "unpause" ~doc in + Cmd.v info + Term.(const (set_active true) $ Logging.term $ all $ auto_create $ const false $ connect_addr $ Arg.required pool_pos $ worker) let update = let doc = "Drain and then update worker(s)" in - Term.(const update $ Logging.term $ connect_addr $ Arg.required pool_pos $ worker), - Term.info "update" ~doc + let info = Cmd.info "update" ~doc in + Cmd.v info + Term.(const update $ Logging.term $ connect_addr $ Arg.required pool_pos $ worker) let forget = let doc = "Forget about an old worker" in - Term.(const forget $ Logging.term $ connect_addr $ Arg.required pool_pos $ worker), - Term.info "forget" ~doc + let info = Cmd.info "forget" ~doc in + Cmd.v info + 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 default_cmd = +let () = let doc = "a command-line admin client for the build-scheduler" in - let sdocs = Manpage.s_common_options in - Term.(ret (const (`Help (`Pager, None)))), - Term.info "ocluster-admin" ~doc ~sdocs ~version:Version.t - -let () = Term.(exit @@ eval_choice ~argv:Options.argv default_cmd cmds) + let info = Cmd.info "ocluster-admin" ~doc ~version:Version.t in + exit (Cmd.eval ~argv:Options.argv @@ Cmd.group info cmds) diff --git a/bin/client.ml b/bin/client.ml index 17f3282d..bc865827 100644 --- a/bin/client.ml +++ b/bin/client.ml @@ -121,12 +121,12 @@ let context_dockerfile = let dockerfile = let make local_dockerfile context_dockerfile = match local_dockerfile, context_dockerfile with - | None, None -> `Ok (`Context_path "Dockerfile") - | Some local, None -> `Ok (`Local_path local) - | None, Some context -> `Ok (`Context_path context) - | Some _, Some _ -> `Error (false, "Can't use --local-dockerfile and --context-dockerfile together!") + | None, None -> Ok (`Context_path "Dockerfile") + | Some local, None -> Ok (`Local_path local) + | None, Some context -> Ok (`Context_path context) + | Some _, Some _ -> Error ("Can't use --local-dockerfile and --context-dockerfile together!") in - Term.(ret (pure make $ local_dockerfile $ context_dockerfile)) + Term.(term_result' (const make $ local_dockerfile $ context_dockerfile)) let repo = Arg.value @@ @@ -243,48 +243,47 @@ let push_to = | _, None, Some _ | _, Some _, None -> Fmt.failwith "Must use --push-user with --push-password" in - Term.(pure make $ push_to $ push_user $ push_password_file) + Term.(const make $ push_to $ push_user $ push_password_file) let build_options = let make build_args squash buildkit include_git = { Cluster_api.Docker.Spec.build_args; squash; buildkit; include_git } in - Term.(pure make $ build_args $ squash $ buildkit $ include_git) + Term.(const make $ build_args $ squash $ buildkit $ include_git) let submit_options_common = let make submission_path pool repository commits cache_hint urgent secrets = { submission_path; pool; repository; commits; cache_hint; urgent; secrets } in - Term.(pure make $ connect_addr $ pool $ repo $ commits $ cache_hint $ urgent $ secrets) + Term.(const make $ connect_addr $ pool $ repo $ commits $ cache_hint $ urgent $ secrets) let submit_docker_options = let make dockerfile push_to build_options = `Docker (dockerfile, push_to, build_options) in - Term.(pure make $ dockerfile $ push_to $ build_options) + Term.(const make $ dockerfile $ push_to $ build_options) let submit_docker = let doc = "Submit a Docker build to the scheduler" in - Term.(const submit $ Logging.term $ submit_options_common $ submit_docker_options), - Term.info "submit-docker" ~doc + let info = Cmd.info "submit-docker" ~doc in + Cmd.v info + Term.(const submit $ Logging.term $ submit_options_common $ submit_docker_options) let submit_obuilder_options = let make spec = `Obuilder spec in - Term.(pure make $ local_obuilder) + Term.(const make $ local_obuilder) let submit_obuilder = let doc = "Submit an OBuilder build to the scheduler" in - Term.(const submit $ Logging.term $ submit_options_common $ submit_obuilder_options), - Term.info "submit-obuilder" ~doc + let info = Cmd.info "submit-obuilder" ~doc in + Cmd.v info + Term.(const submit $ Logging.term $ submit_options_common $ submit_obuilder_options) let cmds = [submit_docker; submit_obuilder] -let default_cmd = +let () = let doc = "a command-line client for the build-scheduler" in - let sdocs = Manpage.s_common_options in - Term.(ret (const (`Help (`Pager, None)))), - Term.info "ocluster-client" ~doc ~sdocs ~version:Version.t - -let () = Term.(exit @@ eval_choice ~argv:Options.argv default_cmd cmds) + let info = Cmd.info "ocluster-client" ~doc ~version:Version.t in + exit (Cmd.eval ~argv:Options.argv @@ Cmd.group info cmds) diff --git a/bin/logging.ml b/bin/logging.ml index 01b578b1..c8a1c1eb 100644 --- a/bin/logging.ml +++ b/bin/logging.ml @@ -23,4 +23,6 @@ let init style_renderer level = Logs.set_reporter reporter let term = - Cmdliner.Term.(const init $ Fmt_cli.style_renderer () $ Logs_cli.level ()) + let open Cmdliner in + let docs = Manpage.s_common_options in + Term.(const init $ Fmt_cli.style_renderer ~docs () $ Logs_cli.level ~docs ()) diff --git a/bin/scheduler.ml b/bin/scheduler.ml index 3b8194ed..8cf70e8f 100644 --- a/bin/scheduler.ml +++ b/bin/scheduler.ml @@ -126,10 +126,10 @@ let main default_level ?formatter capnp secrets_dir pools prometheus_config stat let main ~install (default_level, args1) ((capnp, secrets_dir, pools, prometheus_config, state_dir, default_clients), args2) = let (name, display, text) = ("ocluster-scheduler", "OCluster Scheduler", "Manage build workers") in if install then - `Ok (Winsvc_wrapper.install name display text (args1 @args2)) + Ok (Winsvc_wrapper.install name display text (args1 @args2)) else - `Ok (Winsvc_wrapper.run name state_dir (fun ?formatter () -> - main default_level ?formatter capnp secrets_dir pools prometheus_config state_dir default_clients)) + Ok (Winsvc_wrapper.run name state_dir (fun ?formatter () -> + main default_level ?formatter capnp secrets_dir pools prometheus_config state_dir default_clients)) open Cmdliner @@ -195,13 +195,16 @@ let cmd ~install = command-line paramater to install the scheduler as a Windows \ service with the specified parameters, and '$(b,remove)' to \ remove the scheduler from the services." ] in - Term.(ret (const (main ~install) $ with_used_args (Logs_cli.level ()) $ scheduler_opts_t)), - Term.info "ocluster-scheduler" ~doc ~man ~version:Version.t + let info = Cmd.info "ocluster-scheduler" ~doc ~man ~version:Version.t in + Cmd.v info + Term.(term_result' + (const (main ~install) $ with_used_args (Logs_cli.level ()) + $ scheduler_opts_t)) let () = match Array.to_list Sys.argv with | hd :: "install" :: argv -> - Term.(exit @@ eval ~argv:(Array.of_list (hd :: argv)) (cmd ~install:true)) + exit (Cmd.eval ~argv:(Array.of_list (hd :: argv)) (cmd ~install:true)) | _ :: "remove" :: args -> if args <> [] then begin prerr_endline "'remove' should be used only once, in first position."; @@ -209,4 +212,4 @@ let () = end else Winsvc_wrapper.remove "ocluster-scheduler" | _ -> - Term.(exit @@ eval (cmd ~install:false)) + exit (Cmd.eval (cmd ~install:false)) diff --git a/bin/worker.ml b/bin/worker.ml index 4fde1d05..50ed524e 100644 --- a/bin/worker.ml +++ b/bin/worker.ml @@ -58,10 +58,10 @@ let main default_level ?formatter registration_path capacity name allow_push pru let main ~install (default_level, args1) ((registration_path, capacity, name, allow_push, prune_threshold, state_dir, obuilder), args2) = let (name', display, text) = ("ocluster-worker", "OCluster Worker", "Run a build worker") in if install then - `Ok (Winsvc_wrapper.install name' display text (args1 @ args2)) + Ok (Winsvc_wrapper.install name' display text (args1 @ args2)) else - `Ok (Winsvc_wrapper.run name' state_dir (fun ?formatter () -> - main default_level ?formatter registration_path capacity name allow_push prune_threshold state_dir obuilder)) + Ok (Winsvc_wrapper.run name' state_dir (fun ?formatter () -> + main default_level ?formatter registration_path capacity name allow_push prune_threshold state_dir obuilder)) open Cmdliner @@ -129,8 +129,7 @@ module Obuilder_config = struct | None -> None | Some store -> Some (Cluster_worker.Obuilder_config.v sandbox_config store) in - let open Cmdliner.Term in - Term.pure make $ Obuilder.Runc_sandbox.cmdliner $ store + Term.(const make $ Obuilder.Runc_sandbox.cmdliner $ store) end let worker_opts_t = @@ -147,13 +146,15 @@ let cmd ~install = command-line paramater to install the worker as a Windows \ service with the specified parameters, and '$(b,remove)' to \ remove the worker from the services." ] in - Term.(ret (const (main ~install) $ with_used_args (Logs_cli.level ()) $ worker_opts_t)), - Term.info "ocluster-worker" ~doc ~man ~version:Version.t + let info = Cmd.info "ocluster-worker" ~doc ~man ~version:Version.t in + Cmd.v info + Term.(term_result' + (const (main ~install) $ with_used_args (Logs_cli.level ()) $ worker_opts_t)) let () = match Array.to_list Sys.argv with | hd :: "install" :: argv -> - Term.(exit @@ eval ~argv:(Array.of_list (hd :: argv)) (cmd ~install:true)) + exit (Cmd.eval ~argv:(Array.of_list (hd :: argv)) (cmd ~install:true)) | _ :: "remove" :: args -> if args <> [] then begin prerr_endline "'remove' should be used only once, in first position."; @@ -161,4 +162,4 @@ let () = end else Winsvc_wrapper.remove "ocluster-worker" | _ -> - Term.(exit @@ eval (cmd ~install:false)) + exit (Cmd.eval (cmd ~install:false)) diff --git a/dune-project b/dune-project index 1461e561..861ede1b 100644 --- a/dune-project +++ b/dune-project @@ -33,6 +33,7 @@ (capnp-rpc-unix (>= 1.2)) (extunix (>= 0.3.2)) (winsvc (and (>= 1.0.1) (= :os "win32"))) + (cmdliner (>= 1.1.0)) logs fmt (conf-libev (<> :os "win32")) diff --git a/examples/obuilder_pipeline.ml b/examples/obuilder_pipeline.ml index 403d95bf..3fc21c23 100644 --- a/examples/obuilder_pipeline.ml +++ b/examples/obuilder_pipeline.ml @@ -56,7 +56,8 @@ let submission_service = let cmd = let doc = "Run an OBuilder build on a cluster." in - Term.(term_result (const main $ Current.Config.cmdliner $ Current_web.cmdliner $ submission_service)), - Term.info program_name ~doc + let info = Cmd.info program_name ~doc in + Cmd.v info + Term.(term_result (const main $ Current.Config.cmdliner $ Current_web.cmdliner $ submission_service)) -let () = Term.(exit @@ eval cmd) +let () = exit @@ Cmd.eval cmd diff --git a/obuilder b/obuilder index df44de3a..a2f4cec1 160000 --- a/obuilder +++ b/obuilder @@ -1 +1 @@ -Subproject commit df44de3a865129df9fe17d84c3006967746f3d0a +Subproject commit a2f4cec1774967a54808e6d5c9dfb6a4d77bc9c8 diff --git a/ocluster.opam b/ocluster.opam index 8cb14278..1aa81369 100644 --- a/ocluster.opam +++ b/ocluster.opam @@ -28,6 +28,7 @@ depends: [ "capnp-rpc-unix" {>= "1.2"} "extunix" {>= "0.3.2"} "winsvc" {>= "1.0.1" & os = "win32"} + "cmdliner" {>= "1.1.0"} "logs" "fmt" "conf-libev" {os != "win32"} diff --git a/stress/stress.ml b/stress/stress.ml index 7bdf8764..c220dc88 100644 --- a/stress/stress.ml +++ b/stress/stress.ml @@ -86,7 +86,7 @@ open Cmdliner let cmd = let doc = "Test the scheduler" in - Term.(const main $ Prometheus_unix.opts), - Term.info "stress" ~doc + let info = Cmd.info "stress" ~doc in + Cmd.v info Term.(const main $ Prometheus_unix.opts) -let () = Term.(exit @@ eval cmd) +let () = exit @@ Cmd.eval cmd