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

Implement builder-db vacuum except-latest-successful

Browse source 
And some minor things.
This commit is contained in:
Reynir Björnsson 2024-02-13 14:07:16 +01:00
parent d4da5a199f
commit 878acf002f
3 changed files with 95 additions and 23 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

103
bin/builder_db_app.ml
View file

@ -213,8 +213,37 @@ let vacuum datadir (module Db : Caqti_blocking.CONNECTION) platform_opt job_id p
Db.collect_list Builder_db.Build.get_builds_older_than (job_id, platform_opt, older_than)
| `Latest latest_n ->
Db.collect_list Builder_db.Build.get_builds_excluding_latest_n (job_id, platform_opt, latest_n)
(* TODO: | `Latest_successful latest_n -> ... *)
| `Latest_successful latest_n ->
(* XXX: usability wise, should it be [pred latest_n] ? *)
let* latest_n =
Db.find_opt Builder_db.Build.get_nth_latest_successful
(job_id, platform_opt, latest_n)
in
match latest_n with
| None ->
Ok []
| Some (id, latest_n) ->
let+ builds =
Db.collect_list Builder_db.Build.get_builds_older_than
(job_id, platform_opt, latest_n.finish)
in
(* Unfortunately, get_builds_older_than is non-strict comparison;
so we need to filter out [latest_n]. *)
List.filter (fun (id', _) -> id <> id') builds
in
let pp_reason ppf = function
| `Date older_than ->
Format.fprintf ppf "has no builds older than %a" (Ptime.pp_rfc3339 ()) older_than
| `Latest n ->
Format.fprintf ppf "has fewer than %d builds" n
| `Latest_successful n ->
Format.fprintf ppf "has fewer than %d successful builds" n
in
if builds = [] then
(* NOTE: this function may be called on *all* jobs, and in that case maybe
this is too verbose? *)
Logs.info (fun m -> m "Job %s %a; not removing any builds"
jobname pp_reason predicate);
let* () =
List.fold_left (fun r (build_id, build) ->
let* () = r in
@ -796,83 +825,83 @@ let help man_format cmds = function
else `Error (true, "Unknown command: " ^ cmd)
let dbpath =
let doc = "sqlite3 database path" in
let doc = "sqlite3 database path." in
Cmdliner.Arg.(value &
opt non_dir_file (Builder_system.default_datadir ^ "/builder.sqlite3") &
info ~doc ["dbpath"])
let dbpath_new =
let doc = "sqlite3 database path" in
let doc = "sqlite3 database path." in
Cmdliner.Arg.(value &
opt string (Builder_system.default_datadir ^ "/builder.sqlite3") &
info ~doc ["dbpath"])
let datadir =
let doc = "data directory" in
let doc = "Data directory." in
Cmdliner.Arg.(value &
opt dir Builder_system.default_datadir &
info ~doc ["datadir"; "d"])
let cachedir =
let doc = "cache directory" in
let doc = "Cache directory." in
Cmdliner.Arg.(value &
opt (some dir) None &
info ~doc ["cachedir"])
let jobname =
let doc = "jobname" in
let doc = "Jobname." in
Cmdliner.Arg.(required &
pos 0 (some string) None &
info ~doc ~docv:"JOBNAME" [])
let username =
let doc = "username" in
let doc = "Username." in
Cmdliner.Arg.(required &
pos 0 (some string) None &
info ~doc ~docv:"USERNAME" [])
let password_iter =
let doc = "password hash count" in
let doc = "Password hash count." in
Cmdliner.Arg.(value &
opt (some int) None &
info ~doc ["hash-count"])
let scrypt_n =
let doc = "scrypt n parameter" in
let doc = "scrypt n parameter." in
Cmdliner.Arg.(value &
opt (some int) None &
info ~doc ["scrypt-n"])
let scrypt_r =
let doc = "scrypt r parameter" in
let doc = "scrypt r parameter." in
Cmdliner.Arg.(value &
opt (some int) None &
info ~doc ["scrypt-r"])
let scrypt_p =
let doc = "scrypt p parameter" in
let doc = "scrypt p parameter." in
Cmdliner.Arg.(value &
opt (some int) None &
info ~doc ["scrypt-p"])
let unrestricted =
let doc = "unrestricted user" in
let doc = "Unrestricted user." in
Cmdliner.Arg.(value & flag & info ~doc [ "unrestricted" ])
let job =
let doc = "job" in
let doc = "Job." in
Cmdliner.Arg.(required &
pos 1 (some string) None &
info ~doc ~docv:"JOB" [])
let build =
let doc = "build uuid" in
let doc = "Build uuid." in
Cmdliner.Arg.(required &
pos 0 (some string) None &
info ~doc ~docv:"BUILD" [])
let platform =
let doc = "platform" in
let doc = "Platform." in
Cmdliner.Arg.(value &
opt (some string) None &
info ~doc ~docv:"PLATFORM" ["platform"])
@ -951,8 +980,8 @@ let job_remove_cmd =
Cmd.v info term
let vacuum_cmd =
let jobnames =
Arg.(value & opt_all string [] & info ~doc:"jobs" ~docv:"JOB" [])
let jobs =
Arg.(value & opt_all string [] & info ~doc:"Job(s). Can be passed multiple times." ~docv:"JOB" ["job"])
in
let ptime_conv =
let parse s =
@ -971,6 +1000,9 @@ let vacuum_cmd =
let doc = "cut-off date-time" in
Arg.(required & pos 0 (some ptime_conv) None & info ~doc ~docv:"OLDER-THAN" [])
in
(* TODO(reynir): for now we disallow 0 so as to avoid ending up with jobs
without builds. I'm unsure how well builder-web works with empty jobs.
Then again we don't do this check for older-than... *)
let latest_n =
let doc = "latest N" in
let latest_n =
@ -986,25 +1018,50 @@ let vacuum_cmd =
in
Arg.(required & pos 0 (some latest_n) None & info ~doc ~docv:"LATEST-N" [])
in
let latest_n_succesful =
let doc = "latest N successful" in
let latest_n =
let parse s =
match Arg.(conv_parser int) s with
| Ok n when n > 0 -> Ok (`Latest_successful n)
| Ok _ -> Error (`Msg "must be positive integer")
| Error _ as e -> e
and pp ppf (`Latest_successful n) =
Arg.(conv_printer int) ppf n
in
Arg.conv (parse, pp)
in
Arg.(required & pos 0 (some latest_n) None & info ~doc ~docv:"LATEST-N" [])
in
let vacuum_older_than =
let doc = "vacuum builds older than a date" in
let doc = "Remove builds older than a date" in
let info = Cmd.info ~doc "older-than" in
let term =
Term.(const vacuum $ setup_log $ datadir $ platform $ jobnames $ older_than)
Term.(const vacuum $ setup_log $ datadir $ platform $ jobs $ older_than)
in
Cmd.v info term
in
let vacuum_except_latest_n =
let doc = "vacuum all builds except for the latest N builds (successful or not)" in
let doc = "Remove all builds except for the latest N builds (successful or not)" in
let info = Cmd.info ~doc "except-latest" in
let term =
Term.(const vacuum $ setup_log $ datadir $ platform $ jobnames $ latest_n)
Term.(const vacuum $ setup_log $ datadir $ platform $ jobs $ latest_n)
in
Cmd.v info term
in
Cmd.group (Cmd.info "vacuum") [
let vacuum_except_latest_n_successful =
let doc = "Remove all builds except for builds newer than the Nth latest successful build" in
let info = Cmd.info ~doc "except-latest-successful" in
let term =
Term.(const vacuum $ setup_log $ datadir $ platform $ jobs $ latest_n_succesful)
in
Cmd.v info term
in
let doc = "Remove old builds" in
Cmd.group (Cmd.info ~doc "vacuum") [
vacuum_older_than;
vacuum_except_latest_n
vacuum_except_latest_n;
vacuum_except_latest_n_successful;
]
let extract_full_cmd =

13
db/builder_db.ml
View file

@ -376,6 +376,19 @@ module Build = struct
|}
(* "LIMIT -1 OFFSET n" is all rows except the first n *)
let get_nth_latest_successful =
Caqti_type.(tup3 (id `job) (option string) int) ->? Caqti_type.tup2 (id `build) t @@
{| SELECT id, uuid, start_d, start_ps, finish_d, finish_ps,
result_code, result_msg, console, script,
platform, main_binary, input_id, user, job
FROM build
WHERE job = $1
AND ($2 IS NULL OR platform = $2)
AND main_binary IS NOT NULL
ORDER BY start_d DESC, start_ps DESC
LIMIT 1 OFFSET $3
|}
let get_latest_successful =
Caqti_type.(tup2 (id `job) (option string)) ->? t @@
{| SELECT

2
db/builder_db.mli
View file

@ -133,6 +133,8 @@ sig
([`job] id * string option * Ptime.t, [`build] id * t, [ `Many | `One | `Zero ]) Caqti_request.t
val get_builds_excluding_latest_n :
([`job] id * string option * int, [`build] id * t, [ `Many | `One | `Zero ]) Caqti_request.t
val get_nth_latest_successful :
([`job] id * string option * int, [`build] id * t, [ `One | `Zero ]) Caqti_request.t
val get_previous_successful_different_output :
([`build] id, t, [ `One | `Zero ])
Caqti_request.t