make the expiry of jobs configurable via cli (default 30)
This commit is contained in:
parent
95b4856179
commit
848186bd1a
3 changed files with 20 additions and 13 deletions
|
@ -113,7 +113,7 @@ let run_batch_viz ~cachedir ~datadir ~configdir =
|
||||||
m "Error while starting batch-viz.sh: %a"
|
m "Error while starting batch-viz.sh: %a"
|
||||||
Rresult.R.pp_msg err)
|
Rresult.R.pp_msg err)
|
||||||
|
|
||||||
let setup_app level influx port host datadir cachedir configdir run_batch_viz_flag =
|
let setup_app level influx port host datadir cachedir configdir run_batch_viz_flag expired_jobs =
|
||||||
let dbpath = Printf.sprintf "%s/builder.sqlite3" datadir in
|
let dbpath = Printf.sprintf "%s/builder.sqlite3" datadir in
|
||||||
let datadir = Fpath.v datadir in
|
let datadir = Fpath.v datadir in
|
||||||
let cachedir =
|
let cachedir =
|
||||||
|
@ -159,7 +159,7 @@ let setup_app level influx port host datadir cachedir configdir run_batch_viz_fl
|
||||||
let error_handler = Dream.error_template Builder_web.error_template in
|
let error_handler = Dream.error_template Builder_web.error_template in
|
||||||
Dream.initialize_log ?level ();
|
Dream.initialize_log ?level ();
|
||||||
let dream_routes = Builder_web.(
|
let dream_routes = Builder_web.(
|
||||||
routes ~datadir ~cachedir ~configdir
|
routes ~datadir ~cachedir ~configdir ~expired_jobs
|
||||||
|> to_dream_routes
|
|> to_dream_routes
|
||||||
)
|
)
|
||||||
in
|
in
|
||||||
|
@ -241,11 +241,15 @@ let run_batch_viz =
|
||||||
log is written to CACHE_DIR/batch-viz.log" in
|
log is written to CACHE_DIR/batch-viz.log" in
|
||||||
Arg.(value & flag & info [ "run-batch-viz" ] ~doc)
|
Arg.(value & flag & info [ "run-batch-viz" ] ~doc)
|
||||||
|
|
||||||
|
let expired_jobs =
|
||||||
|
let doc = "Amount of days after which a job is considered to be inactive if \
|
||||||
|
no successful build has been achieved (use 0 for infinite)" in
|
||||||
|
Arg.(value & opt int 30 & info [ "expired-jobs" ] ~doc)
|
||||||
|
|
||||||
let () =
|
let () =
|
||||||
let term =
|
let term =
|
||||||
Term.(const setup_app $ Logs_cli.level () $ influx $ port $ host $ datadir $
|
Term.(const setup_app $ Logs_cli.level () $ influx $ port $ host $ datadir $
|
||||||
cachedir $ configdir $ run_batch_viz)
|
cachedir $ configdir $ run_batch_viz $ expired_jobs)
|
||||||
in
|
in
|
||||||
let info = Cmd.info "Builder web" ~doc:"Builder web" ~man:[] in
|
let info = Cmd.info "Builder web" ~doc:"Builder web" ~man:[] in
|
||||||
Cmd.v info term
|
Cmd.v info term
|
||||||
|
|
|
@ -258,7 +258,7 @@ module Viz_aux = struct
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
let routes ~datadir ~cachedir ~configdir =
|
let routes ~datadir ~cachedir ~configdir ~expired_jobs =
|
||||||
let builds ~filter_builds_later_than req =
|
let builds ~filter_builds_later_than req =
|
||||||
Dream.sql req Model.jobs_with_section_synopsis
|
Dream.sql req Model.jobs_with_section_synopsis
|
||||||
|> if_error "Error getting jobs"
|
|> if_error "Error getting jobs"
|
||||||
|
@ -610,17 +610,20 @@ let routes ~datadir ~cachedir ~configdir =
|
||||||
|
|
||||||
let w f req = or_error_response (f req) in
|
let w f req = or_error_response (f req) in
|
||||||
|
|
||||||
let thirty_days_ago =
|
let n_days_ago =
|
||||||
let thirty = Ptime.Span.v (30, 0L) in
|
if expired_jobs = 0 then
|
||||||
let now = Ptime_clock.now () in
|
Ptime.epoch
|
||||||
Ptime.Span.sub (Ptime.to_span now) thirty |> Ptime.of_span |>
|
else
|
||||||
Option.fold
|
let n = Ptime.Span.v (expired_jobs, 0L) in
|
||||||
~none:Ptime.epoch
|
let now = Ptime_clock.now () in
|
||||||
~some:Fun.id
|
Ptime.Span.sub (Ptime.to_span now) n |> Ptime.of_span |>
|
||||||
|
Option.fold
|
||||||
|
~none:Ptime.epoch
|
||||||
|
~some:Fun.id
|
||||||
in
|
in
|
||||||
|
|
||||||
[
|
[
|
||||||
`Get, "/", (w (builds ~filter_builds_later_than:thirty_days_ago));
|
`Get, "/", (w (builds ~filter_builds_later_than:n_days_ago));
|
||||||
`Get, "/job/:job", (w job);
|
`Get, "/job/:job", (w job);
|
||||||
`Get, "/job/:job/failed", (w job_with_failed);
|
`Get, "/job/:job/failed", (w job_with_failed);
|
||||||
`Get, "/job/:job/build/latest/**", (w redirect_latest);
|
`Get, "/job/:job/build/latest/**", (w redirect_latest);
|
||||||
|
|
|
@ -59,7 +59,7 @@ let router =
|
||||||
* in the handlers which are never called here. The path /nonexistant is
|
* in the handlers which are never called here. The path /nonexistant is
|
||||||
* assumed to not exist. *)
|
* assumed to not exist. *)
|
||||||
let nodir = Fpath.v "/nonexistant" in
|
let nodir = Fpath.v "/nonexistant" in
|
||||||
Builder_web.routes ~datadir:nodir ~cachedir:nodir ~configdir:nodir
|
Builder_web.routes ~datadir:nodir ~cachedir:nodir ~configdir:nodir ~expired_jobs:0
|
||||||
|> List.map (fun (meth, route, _handler) ->
|
|> List.map (fun (meth, route, _handler) ->
|
||||||
meth, route, Param_verification.verify (find_parameters route))
|
meth, route, Param_verification.verify (find_parameters route))
|
||||||
|> Builder_web.to_dream_routes
|
|> Builder_web.to_dream_routes
|
||||||
|
|
Loading…
Reference in a new issue