ocluster.ml 5.07 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
let lwt_reporter () =
  let buf_fmt ~like =
    let b = Buffer.create 512 in
Fardale's avatar
Fardale committed
6 7
    ( Fmt.with_buffer ~like b
    , fun () ->
Fardale's avatar
Fardale committed
8
        let m = Buffer.contents b in
Fardale's avatar
Fardale committed
9
        Buffer.reset b ; m )
Fardale's avatar
Fardale committed
10 11 12 13 14 15 16 17
  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
      in
Fardale's avatar
Fardale committed
23 24
      let unblock () = over () ; Lwt.return_unit in
      Lwt.async (fun () -> Lwt.finalize write unblock) ;
Fardale's avatar
Fardale committed
25 26 27 28
      k ()
    in
    reporter.Logs.report src level ~over:(fun () -> ()) k msgf
  in
Fardale's avatar
Fardale committed
29
  {Logs.report}
Fardale's avatar
Fardale committed
30 31

let setup_log style_renderer level =
Fardale's avatar
Fardale committed
32 33 34
  Fmt_tty.setup_std_outputs ?style_renderer () ;
  Logs.set_level level ;
  Logs.set_reporter (lwt_reporter ()) ;
Fardale's avatar
Fardale committed
35 36 37
  ()

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
  let doc = "Start un computational node" in
  let exits = Term.default_exits in
  let man =
Fardale's avatar
Fardale committed
48 49 50
    [ `S Manpage.s_description
    ; `P
        "Start un computational node on the given port with the given password"
Fardale's avatar
Fardale committed
51
    ]
Fardale's avatar
Fardale committed
52
  in
Fardale's avatar
Fardale committed
53 54
  ( Term.(const Lwt_main.run $ (const Node.cmd $ config $ setup_log))
  , 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
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 =
Fardale's avatar
Fardale committed
64 65
    [ `S Manpage.s_description
    ; `P "Start un master server on the given port with the given password" ]
Fardale's avatar
Fardale committed
66
  in
Fardale's avatar
Fardale committed
67 68
  ( Term.(const Lwt_main.run $ (const Master.cmd $ config $ setup_log))
  , Term.info "master" ~doc ~sdocs:Manpage.s_common_options ~exits ~man )
69

Fardale's avatar
Fardale committed
70
let submit_cmd =
Fardale's avatar
Fardale committed
71 72
  let cpu =
    let doc = "Number of cpu needed" in
Fardale's avatar
Fardale committed
73
    Arg.(value & opt int 1 & info ["c"; "cpu"] ~docv:"CPU" ~doc)
Fardale's avatar
Fardale committed
74 75 76
  in
  let ram =
    let doc = "Quantity of RAM needed" in
Fardale's avatar
Fardale committed
77
    Arg.(value & opt int 1024 & info ["r"; "ram"] ~docv:"RAM" ~doc)
Fardale's avatar
Fardale committed
78 79 80
  in
  let time =
    let doc = "Time limit" in
Fardale's avatar
Fardale committed
81
    Arg.(value & opt (some float) None & info ["t"; "time"] ~docv:"TIME" ~doc)
Fardale's avatar
Fardale committed
82 83 84
  in
  let iteration =
    let doc = "Number of iteration" in
Fardale's avatar
Fardale committed
85
    Arg.(value & opt int 1 & info ["i"; "iteration"] ~docv:"N" ~doc)
Fardale's avatar
Fardale committed
86
  in
87
  let port =
Fardale's avatar
Fardale committed
88
    let doc = "port on which master 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
103 104 105 106
  let args =
    let doc = "Arguments passed to the script" in
    Arg.(value & pos_right 2 string [] & info [] ~docv:"ARGS" ~doc)
  in
Fardale's avatar
Fardale committed
107
  let doc = "Submit jobs to the cluster" in
Fardale's avatar
Fardale committed
108
  let exits = Term.default_exits in
Fardale's avatar
Fardale committed
109
  let man = [`S Manpage.s_description; `P "Submit jobs to the cluster"] in
Fardale's avatar
Fardale committed
110 111
  ( Term.(
      const Lwt_main.run
Fardale's avatar
Fardale committed
112
      $ ( const Submit.cmd $ cpu $ ram $ time $ iteration $ port $ script $ pass
Fardale's avatar
Fardale committed
113
        $ addr $ args $ setup_log ))
Fardale's avatar
Fardale committed
114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143
  , Term.info "submit" ~doc ~sdocs:Manpage.s_common_options ~exits ~man )

let jobq_cmd =
  let id =
    let doc = "Id of the job to consider" in
    Arg.(value & opt (some int) None & info ["i"; "id"] ~docv:"ID" ~doc)
  in
  let delete =
    let doc = "Delete a job. If job id is given delete the last job." in
    Arg.(value & flag & info ["d"; "delete"] ~doc)
  in
  let port =
    let doc = "port on which master listen" in
    Arg.(value & opt int 4242 & info ["p"; "port"] ~docv:"PORT" ~doc)
  in
  let pass =
    let doc = "Password of the node" in
    Arg.(required & pos 0 (some string) None & info [] ~docv:"PASS" ~doc)
  in
  let addr =
    let doc = "Ip of the master" in
    Arg.(required & pos 1 (some string) None & info [] ~docv:"IP" ~doc)
  in
  let doc = "Interact with the job queue." in
  let exits = Term.default_exits in
  let man = [`S Manpage.s_description; `P "Interact with the job queue."] in
  ( Term.(
      const Lwt_main.run
      $ (const Jobq.cmd $ id $ delete $ addr $ port $ pass $ setup_log))
  , Term.info "jobq" ~doc ~sdocs:Manpage.s_common_options ~exits ~man )
Fardale's avatar
Fardale committed
144 145

let default_cmd =
Fardale's avatar
Fardale committed
146
  let doc = "Use a pool of computer as a cluster." in
Fardale's avatar
Fardale committed
147
  let man =
Fardale's avatar
Fardale committed
148 149
    [ `S Manpage.s_bugs
    ; `P "Email bug reports to <fardale+ocluster at crans.org>." ]
Fardale's avatar
Fardale committed
150 151 152
  in
  let sdocs = Manpage.s_common_options in
  let exits = Term.default_exits in
Fardale's avatar
Fardale committed
153
  ( Term.(ret (const (fun _ -> `Help (`Pager, None)) $ const ()))
Fardale's avatar
Fardale committed
154
  , Term.info "ocluster" ~version:"0.1.4" ~doc ~sdocs ~exits ~man )
Fardale's avatar
Fardale committed
155

Fardale's avatar
Fardale committed
156
let () =
Fardale's avatar
Fardale committed
157 158
  Term.(
    exit @@ eval_choice default_cmd [node_cmd; master_cmd; submit_cmd; jobq_cmd])