ocluster.ml 3.92 KB
Newer Older
Fardale's avatar
Fardale committed
1
open Cmdliner
Fardale's avatar
Fardale committed
2

Fardale's avatar
Fardale committed
3 4 5 6 7 8 9 10 11 12 13 14 15 16 17
let lwt_reporter () =
  let buf_fmt ~like =
    let b = Buffer.create 512 in
    ( Fmt.with_buffer ~like b
    , fun () ->
        let m = Buffer.contents b in
        Buffer.reset b ; m )
  in
  let app, app_flush = buf_fmt ~like:Fmt.stdout in
  let dst, dst_flush = buf_fmt ~like:Fmt.stderr in
  let reporter = Logs_fmt.reporter ~app ~dst () in
  let report src level ~over k msgf =
    let k () =
      let write () =
        match level with
Fardale's avatar
Fardale committed
18 19 20 21
        | Logs.App ->
            Lwt_io.write Lwt_io.stdout (app_flush ())
        | _ ->
            Lwt_io.write Lwt_io.stderr (dst_flush ())
Fardale's avatar
Fardale committed
22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37
      in
      let unblock () = over () ; Lwt.return_unit in
      Lwt.async (fun () -> Lwt.finalize write unblock) ;
      k ()
    in
    reporter.Logs.report src level ~over:(fun () -> ()) k msgf
  in
  {Logs.report}

let setup_log style_renderer level =
  Fmt_tty.setup_std_outputs ?style_renderer () ;
  Logs.set_level level ;
  Logs.set_reporter (lwt_reporter ()) ;
  ()

let setup_log =
Fardale's avatar
Fardale committed
38
  Term.(const setup_log $ Fmt_cli.style_renderer () $ Logs_cli.level ())
Fardale's avatar
Fardale committed
39

Fardale's avatar
Fardale committed
40 41 42 43
let node_cmd =
  let config =
    let doc = "Configuration of the node" in
    Arg.(required & pos 0 (some string) None & info [] ~docv:"CONF" ~doc)
Fardale's avatar
Fardale committed
44
  in
Fardale's avatar
Fardale committed
45 46 47 48 49 50 51
  let doc = "Start un computational node" in
  let exits = Term.default_exits in
  let man =
    [ `S Manpage.s_description
    ; `P
        "Start un computational node on the given port with the given password"
    ]
Fardale's avatar
Fardale committed
52
  in
Fardale's avatar
Fardale committed
53
  ( Term.(const Lwt_main.run $ (const Node.cmd $ config $ setup_log))
Fardale's avatar
Fardale committed
54
  , Term.info "node" ~doc ~sdocs:Manpage.s_common_options ~exits ~man )
Fardale's avatar
Fardale committed
55

Fardale's avatar
Fardale committed
56 57 58 59 60 61 62 63 64 65 66
let master_cmd =
  let config =
    let doc = "Configuration file of the master" in
    Arg.(required & pos 0 (some file) None & info [] ~docv:"CONF_FILE" ~doc)
  in
  let doc = "Start un master server" in
  let exits = Term.default_exits in
  let man =
    [ `S Manpage.s_description
    ; `P "Start un master server on the given port with the given password" ]
  in
Fardale's avatar
Fardale committed
67
  ( Term.(const Lwt_main.run $ (const Master.cmd $ config $ setup_log))
Fardale's avatar
Fardale committed
68
  , Term.info "master" ~doc ~sdocs:Manpage.s_common_options ~exits ~man )
69

Fardale's avatar
Fardale committed
70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86
let client_cmd =
  let cpu =
    let doc = "Number of cpu needed" in
    Arg.(value & opt int 1 & info ["c"; "cpu"] ~docv:"CPU" ~doc)
  in
  let ram =
    let doc = "Quantity of RAM needed" in
    Arg.(value & opt int 1024 & info ["r"; "ram"] ~docv:"RAM" ~doc)
  in
  let time =
    let doc = "Time limit" in
    Arg.(value & opt (some float) None & info ["t"; "time"] ~docv:"TIME" ~doc)
  in
  let iteration =
    let doc = "Number of iteration" in
    Arg.(value & opt int 1 & info ["i"; "iteration"] ~docv:"N" ~doc)
  in
87 88
  let port =
    let doc = "port on which client listen" in
Fardale's avatar
Fardale committed
89
    Arg.(value & opt int 4242 & info ["p"; "port"] ~docv:"PORT" ~doc)
90
  in
Fardale's avatar
Fardale committed
91 92 93 94
  let script =
    let doc = "Ocluster script" in
    Arg.(required & pos 0 (some file) None & info [] ~docv:"SCRIPT" ~doc)
  in
Fardale's avatar
Fardale committed
95 96
  let pass =
    let doc = "Password of the node" in
Fardale's avatar
Fardale committed
97
    Arg.(required & pos 1 (some string) None & info [] ~docv:"PASS" ~doc)
Fardale's avatar
Fardale committed
98
  in
Fardale's avatar
Fardale committed
99 100 101
  let addr =
    let doc = "Ip of the master" in
    Arg.(required & pos 2 (some string) None & info [] ~docv:"IP" ~doc)
Fardale's avatar
Fardale committed
102
  in
Fardale's avatar
Fardale committed
103 104 105 106 107 108
  let doc = "Client to use the cluster" in
  let exits = Term.default_exits in
  let man = [`S Manpage.s_description; `P "Client to use the cluster"] in
  ( Term.(
      const Lwt_main.run
      $ ( const Client.cmd $ cpu $ ram $ time $ iteration $ port $ script $ pass
109
        $ addr $ setup_log ))
Fardale's avatar
Fardale committed
110
  , Term.info "client" ~doc ~sdocs:Manpage.s_common_options ~exits ~man )
Fardale's avatar
Fardale committed
111 112

let default_cmd =
Fardale's avatar
Fardale committed
113
  let doc = "Use a pool of computer as a cluster." in
Fardale's avatar
Fardale committed
114 115 116
  let man =
    [ `S Manpage.s_bugs
    ; `P "Email bug reports to <fardale+ocluster at crans.org>." ]
Fardale's avatar
Fardale committed
117 118 119
  in
  let sdocs = Manpage.s_common_options in
  let exits = Term.default_exits in
Fardale's avatar
Fardale committed
120
  ( Term.(ret (const (fun _ -> `Help (`Pager, None)) $ const ()))
Fardale's avatar
Fardale committed
121
  , Term.info "ocluster" ~version:"v0.1.0" ~doc ~sdocs ~exits ~man )
Fardale's avatar
Fardale committed
122

Fardale's avatar
Fardale committed
123 124
let () =
  Term.(exit @@ eval_choice default_cmd [node_cmd; master_cmd; client_cmd])