robur/builder-web
4
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

make the expiry of jobs configurable via cli (default 30)

Browse source
This commit is contained in:
Hannes Mehnert 2023-09-18 12:12:42 +02:00 committed by Reynir Björnsson
parent 95b4856179
commit 848186bd1a
3 changed files with 20 additions and 13 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
bin/builder_web_app.ml
View file

@ -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

13
lib/builder_web.ml
View file

@ -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
Ptime.epoch
else
let n = Ptime.Span.v (expired_jobs, 0L) in
let now = Ptime_clock.now () in let now = Ptime_clock.now () in
Ptime.Span.sub (Ptime.to_span now) thirty |> Ptime.of_span |> Ptime.Span.sub (Ptime.to_span now) n |> Ptime.of_span |>
Option.fold Option.fold
~none:Ptime.epoch ~none:Ptime.epoch
~some:Fun.id ~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);

2
test/router.ml
View file

@ -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