Compare commits

...

2 commits

View file

@ -306,7 +306,7 @@ let verify_data_dir () datadir =
files_untracked; files_untracked;
or_die 1 r or_die 1 r
module Verify_cache_dir = struct module Verify_cache_dir = struct
let verify_dir_exists d = let verify_dir_exists d =
let* dir_exists = Bos.OS.Dir.exists d in let* dir_exists = Bos.OS.Dir.exists d in
@ -322,7 +322,7 @@ module Verify_cache_dir = struct
let string_is_int s = match int_of_string_opt s with let string_is_int s = match int_of_string_opt s with
| None -> false | None -> false
| Some _ -> true | Some _ -> true
let verify_cache_subdir ~cachedir d = let verify_cache_subdir ~cachedir d =
match Bos.OS.Dir.exists Fpath.(cachedir // d) with match Bos.OS.Dir.exists Fpath.(cachedir // d) with
| Ok false -> () | Ok false -> ()
@ -337,7 +337,7 @@ module Verify_cache_dir = struct
let prefix = viz_prefix ^ "_" in let prefix = viz_prefix ^ "_" in
let has_prefix = String.starts_with ~prefix dir_str in let has_prefix = String.starts_with ~prefix dir_str in
let has_valid_ending = let has_valid_ending =
if not has_prefix then false else if not has_prefix then false else
let ending = let ending =
String.(sub dir_str String.(sub dir_str
(length prefix) (length prefix)
@ -353,7 +353,7 @@ module Verify_cache_dir = struct
m "Invalid cache subdirectory name: '%s'" dir_str) m "Invalid cache subdirectory name: '%s'" dir_str)
let get_latest_viz_version viz_typ = let get_latest_viz_version viz_typ =
let* v_str, run_status = begin match viz_typ with let* v_str, run_status = begin match viz_typ with
| `Treemap -> | `Treemap ->
let cmd = Bos.Cmd.(v "modulectomy" % "--version") in let cmd = Bos.Cmd.(v "modulectomy" % "--version") in
Bos.OS.Cmd.(cmd |> run_out |> out_string) Bos.OS.Cmd.(cmd |> run_out |> out_string)
@ -362,7 +362,7 @@ module Verify_cache_dir = struct
Bos.OS.Cmd.(cmd |> run_out |> out_string) Bos.OS.Cmd.(cmd |> run_out |> out_string)
end in end in
match run_status with match run_status with
| (cmd_info, `Exited 0) -> | (cmd_info, `Exited 0) ->
begin try Ok (int_of_string v_str) with Failure _ -> begin try Ok (int_of_string v_str) with Failure _ ->
let msg = let msg =
Fmt.str "Couldn't parse latest version from %a: '%s'" Fmt.str "Couldn't parse latest version from %a: '%s'"
@ -372,7 +372,7 @@ module Verify_cache_dir = struct
Error (`Msg msg) Error (`Msg msg)
end end
| (cmd_info, _) -> | (cmd_info, _) ->
let msg = let msg =
Fmt.str "Error running visualization cmd: '%a'" Fmt.str "Error running visualization cmd: '%a'"
Bos.Cmd.pp (Bos.OS.Cmd.run_info_cmd cmd_info) Bos.Cmd.pp (Bos.OS.Cmd.run_info_cmd cmd_info)
in in
@ -482,7 +482,7 @@ module Verify_cache_dir = struct
let verify_viz_file_vizdeps ~cachedir build = let verify_viz_file_vizdeps ~cachedir build =
match build.Build.hash_opam_switch with match build.Build.hash_opam_switch with
| None -> | None ->
Logs.warn (fun m -> Logs.warn (fun m ->
m "%s: uuid '%a': Doesn't support dependencies viz because of \ m "%s: uuid '%a': Doesn't support dependencies viz because of \
missing 'opam-switch'" missing 'opam-switch'"
@ -491,7 +491,7 @@ module Verify_cache_dir = struct
| Some hash_opam_switch -> | Some hash_opam_switch ->
match match
check_viz_nonempty check_viz_nonempty
~cachedir ~cachedir
~viz_typ:`Dependencies ~viz_typ:`Dependencies
~hash:hash_opam_switch ~hash:hash_opam_switch
with with
@ -512,7 +512,7 @@ module Verify_cache_dir = struct
~cachedir ~cachedir
~viz_typ:`Treemap ~viz_typ:`Treemap
~hash:hash_debug_bin ~hash:hash_debug_bin
with with
| Ok () -> () | Ok () -> ()
| Error (`Msg err) -> | Error (`Msg err) ->
Logs.warn (fun m -> Logs.warn (fun m ->
@ -567,18 +567,18 @@ module Verify_cache_dir = struct
Fpath.pp viz_path) Fpath.pp viz_path)
type msg = [ `Msg of string ] type msg = [ `Msg of string ]
let open_error_msg : ('a, msg) result -> ('a, [> msg]) result = let open_error_msg : ('a, msg) result -> ('a, [> msg]) result =
function function
| Ok _ as v -> v | Ok _ as v -> v
| Error e -> Error (e : msg :> [> msg]) | Error e -> Error (e : msg :> [> msg])
let verify () datadir cachedir = let verify () datadir cachedir =
let module Viz_aux = Builder_web.Viz_aux in let module Viz_aux = Builder_web.Viz_aux in
begin begin
let* datadir = Fpath.of_string datadir |> open_error_msg in let* datadir = Fpath.of_string datadir |> open_error_msg in
let* cachedir = match cachedir with let* cachedir = match cachedir with
| Some d -> Fpath.of_string d |> open_error_msg | Some d -> Fpath.of_string d |> open_error_msg
| None -> Ok Fpath.(datadir / "_cache") | None -> Ok Fpath.(datadir / "_cache")
in in
let* () = verify_dir_exists cachedir in let* () = verify_dir_exists cachedir in
@ -693,6 +693,49 @@ let extract_full () datadir dest uuid =
in in
or_die 1 r or_die 1 r
let time_size_graph () datadir jobname =
let dbpath = datadir ^ "/builder.sqlite3" in
let r =
let* (module Db : Caqti_blocking.CONNECTION) =
connect (Uri.make ~scheme:"sqlite3" ~path:dbpath ~query:["create", ["false"]] ())
in
let* job_id =
Result.bind (Db.find_opt Builder_db.Job.get_id_by_name jobname)
(Option.to_result ~none:(`Msg "job not found"))
in
let* shas =
Db.collect_list Builder_db.Build.get_all_artifact_sha (job_id, None)
in
let* builds =
List.fold_left (fun acc hash ->
match acc with
| Error _ as e -> e
| Ok builds ->
let* b =
Db.find Builder_db.Build.get_with_main_binary_by_hash hash
in
Ok (b :: builds))
(Ok []) shas
in
Printf.printf "# build times and binary sizes for job %s\n" jobname;
Printf.printf "# build start (seconds since epoch) <TAB> build duration (seconds) <TAB> binary size (bytes) # UUID\n";
List.iter (fun (build, file) ->
match file with
| None ->
Printf.eprintf "no file for build %s\n" (Uuidm.to_string build.Builder_db.Build.uuid)
| Some f ->
Printf.printf "%u\t%u\t%u\t# %s\n"
(match Ptime.Span.to_int_s (Ptime.to_span build.start) with
| None -> assert false | Some s -> s)
(match Ptime.Span.to_int_s (Ptime.diff build.finish build.start) with
| None -> assert false | Some s -> s)
f.Builder_db.size
(Uuidm.to_string build.Builder_db.Build.uuid))
builds;
Ok ()
in
or_die 1 r
let help man_format cmds = function let help man_format cmds = function
| None -> `Help (man_format, None) | None -> `Help (man_format, None)
| Some cmd -> | Some cmd ->
@ -876,6 +919,12 @@ let verify_cache_dir_cmd =
let info = Cmd.info ~doc "verify-cache-dir" in let info = Cmd.info ~doc "verify-cache-dir" in
Cmd.v info term Cmd.v info term
let time_size_graph_cmd =
let doc = "output the build times and binary sizes of a job" in
let term = Term.(const time_size_graph $ setup_log $ datadir $ jobname) in
let info = Cmd.info ~doc "time-size-graph" in
Cmd.v info term
let help_cmd = let help_cmd =
let topic = let topic =
let doc = "Command to get help on" in let doc = "Command to get help on" in
@ -902,6 +951,7 @@ let () =
verify_input_id_cmd; verify_input_id_cmd;
verify_data_dir_cmd; verify_data_dir_cmd;
verify_cache_dir_cmd; verify_cache_dir_cmd;
extract_full_cmd ] extract_full_cmd;
time_size_graph_cmd ]
|> Cmdliner.Cmd.eval |> Cmdliner.Cmd.eval
|> exit |> exit