this repo has no description
1(** debug command: interactive container for failed builds *)
2
3open Cmdliner
4
5let run profile_name profile_dir target keep command =
6 match Common.load_profile ~profile_dir ~name:profile_name with
7 | Error (`Msg e) -> Printf.eprintf "Error: %s\n%!" e; 1
8 | Ok (_profile, paths) ->
9 Common.with_eio @@ fun env ->
10 let os_dir = paths.os_dir in
11 (* Resolve target: hash or package name *)
12 let node =
13 match Day11_opam_layer.Build_meta.load_tree ~os_dir target with
14 | Ok n -> n
15 | Error _ ->
16 (* Try as package name -- look up from history *)
17 let packages_dir = match Common.latest_snapshot_dir paths with
18 | Some sd -> Fpath.(sd / "packages")
19 | None -> Fpath.(os_dir / "packages") in
20 let entries = Day11_lib.History.read ~packages_dir ~pkg_str:target in
21 let failure = List.find_opt (fun (e : Day11_lib.History.entry) ->
22 e.status = "failure" && e.build_hash <> "none"
23 ) entries in
24 match failure with
25 | Some e ->
26 Printf.printf "Using %s\n%!" e.build_hash;
27 (match Day11_opam_layer.Build_meta.load_tree ~os_dir e.build_hash with
28 | Ok n -> n
29 | Error (`Msg e) ->
30 Printf.eprintf "Cannot load %s: %s\n" target e;
31 exit 1)
32 | None ->
33 Printf.eprintf "No failed build found for %s\n" target;
34 exit 1
35 in
36 match Day11_opam_build.Debug.setup env ~os_dir ~keep node with
37 | Error (`Msg e) ->
38 Printf.eprintf "Setup failed: %s\n" e; 1
39 | Ok session ->
40 Printf.printf "Debug container for %s\n%!"
41 (OpamPackage.to_string session.pkg);
42 let result = match command with
43 | Some cmd -> Day11_opam_build.Debug.run_command env session cmd
44 | None -> Day11_opam_build.Debug.run_interactive env session
45 in
46 if not keep then Day11_opam_build.Debug.teardown env session;
47 if keep then
48 Printf.printf "Debug dir kept at: %s\n%!"
49 (Fpath.to_string session.temp_dir);
50 result
51
52let target_term =
53 Arg.(required & pos 0 (some string) None & info [] ~docv:"TARGET"
54 ~doc:"Package name or layer hash to debug")
55
56let keep_term =
57 let doc = "Keep debug container for re-entry" in
58 Arg.(value & flag & info [ "keep" ] ~doc)
59
60let command_term =
61 let doc = "Run command instead of interactive shell" in
62 Arg.(value & opt (some string) None & info [ "command"; "c" ] ~docv:"CMD" ~doc)
63
64let cmd =
65 let info = Cmd.info "debug" ~doc:"Launch interactive debug container" in
66 let term = Term.(const run $ Common.profile_term $ Common.profile_dir_term
67 $ target_term $ keep_term $ command_term) in
68 Cmd.v info term