diff --git a/bin/builder_web_app.ml b/bin/builder_web_app.ml index 3fe65fa..22c4151 100644 --- a/bin/builder_web_app.ml +++ b/bin/builder_web_app.ml @@ -113,7 +113,7 @@ let run_batch_viz ~cachedir ~datadir ~configdir = m "Error while starting batch-viz.sh: %a" 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 datadir = Fpath.v datadir in 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 Dream.initialize_log ?level (); let dream_routes = Builder_web.( - routes ~datadir ~cachedir ~configdir + routes ~datadir ~cachedir ~configdir ~expired_jobs |> to_dream_routes ) in @@ -241,11 +241,15 @@ let run_batch_viz = log is written to CACHE_DIR/batch-viz.log" in 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 term = Term.(const setup_app $ Logs_cli.level () $ influx $ port $ host $ datadir $ - cachedir $ configdir $ run_batch_viz) + cachedir $ configdir $ run_batch_viz $ expired_jobs) in let info = Cmd.info "Builder web" ~doc:"Builder web" ~man:[] in Cmd.v info term diff --git a/lib/builder_web.ml b/lib/builder_web.ml index a09d889..c70b4a3 100644 --- a/lib/builder_web.ml +++ b/lib/builder_web.ml @@ -258,7 +258,7 @@ module Viz_aux = struct end -let routes ~datadir ~cachedir ~configdir = +let routes ~datadir ~cachedir ~configdir ~expired_jobs = let builds ~filter_builds_later_than req = Dream.sql req Model.jobs_with_section_synopsis |> 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 thirty_days_ago = - let thirty = Ptime.Span.v (30, 0L) in - let now = Ptime_clock.now () in - Ptime.Span.sub (Ptime.to_span now) thirty |> Ptime.of_span |> - Option.fold - ~none:Ptime.epoch - ~some:Fun.id + let n_days_ago = + if expired_jobs = 0 then + Ptime.epoch + else + let n = Ptime.Span.v (expired_jobs, 0L) in + let now = Ptime_clock.now () in + Ptime.Span.sub (Ptime.to_span now) n |> Ptime.of_span |> + Option.fold + ~none:Ptime.epoch + ~some:Fun.id 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/failed", (w job_with_failed); `Get, "/job/:job/build/latest/**", (w redirect_latest); diff --git a/test/router.ml b/test/router.ml index 33e45c8..b3eaccd 100644 --- a/test/router.ml +++ b/test/router.ml @@ -59,7 +59,7 @@ let router = * in the handlers which are never called here. The path /nonexistant is * assumed to not exist. *) 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) -> meth, route, Param_verification.verify (find_parameters route)) |> Builder_web.to_dream_routes