basic tracing

master_changes.md

@@ -97,6 +97,7 @@ users)
 ## Shell
 
 ## Internal
+  * Add tracing for opam itself, enabled if `TRACE_FILE` is set in the environment [#5757 @c-cube]
 
 ## Internal: Windows
 

src/client/opamAuxCommands.ml

@@ -395,6 +395,7 @@ let simulate_local_pinnings ?quiet ?(for_view=false) st to_pin =
 
 let simulate_autopin st ?quiet ?(for_view=false) ?locked ?recurse ?subpath
     atom_or_local_list =
+  OpamTrace.with_span "AuxCommands.simulate_autopin" @@ fun () ->
   let atoms, to_pin, obsolete_pins, already_pinned_set =
     autopin_aux st ?quiet ~for_view ?recurse ?subpath ?locked atom_or_local_list
   in

src/client/opamCliMain.ml

@@ -121,6 +121,7 @@ let rec preprocess_argv cli yes_args confirm args =
 
 (* Handle git-like plugins *)
 let check_and_run_external_commands () =
+  OpamTrace.with_span "CliMain.check_and_run_external_commands" @@ fun () ->
   (* Pre-process the --yes and --cli options *)
   let (cli, yes, confirm_level, argv) =
     match Array.to_list Sys.argv with
@@ -439,6 +440,7 @@ let rec main_catch_all f =
     exit exit_code
 
 let run () =
+  OpamTrace.setup ~trace_file:None ();
   OpamStd.Option.iter OpamVersion.set_git OpamGitVersion.version;
   OpamSystem.init ();
   OpamArg.preinit_opam_env_variables ();
@@ -456,14 +458,18 @@ let run () =
   let to_new_cmdliner_api (term, info) = Cmd.v info term in
   let default, default_info = default in
   let commands = List.map to_new_cmdliner_api commands in
-  match Cmd.eval_value ~catch:false ~argv (Cmd.group ~default default_info commands) with
+  match
+    OpamTrace.with_span "CliMain.Cmd.eval_value" @@ fun () ->
+    Cmd.eval_value ~catch:false ~argv (Cmd.group ~default default_info commands)
+  with
   | Error _ -> exit (OpamStd.Sys.get_exit_code `Bad_arguments)
   | Ok _    -> exit (OpamStd.Sys.get_exit_code `Success)
 
 let json_out () =
   match OpamClientConfig.(!r.json_out) with
   | None   -> ()
   | Some s ->
+    OpamTrace.with_span "cli-main.json-out" @@ fun () ->
     let file_name () =
       match OpamStd.String.cut_at s '%' with
       | None -> OpamFilename.of_string s

src/client/opamClient.ml

@@ -19,6 +19,7 @@ let slog = OpamConsole.slog
 
 (* Splits a list of atoms into the installed and uninstalled ones*)
 let get_installed_atoms t atoms =
+  OpamTrace.with_span "Client.get_installed_atoms" @@ fun () ->
   List.fold_left (fun (packages, not_installed) atom ->
       try
         let nv =
@@ -66,6 +67,7 @@ let update_dev_packages_t ?autolock ?(only_installed=false) atoms t =
 let compute_upgrade_t
     ?(strict_upgrade=true) ?(auto_install=false) ?(only_installed=false)
     ~all ~formula atoms t =
+  OpamTrace.with_span "Client.compute_upgrade" @@ fun () ->
   let packages = OpamFormula.packages_of_atoms t.packages atoms in
   let names = OpamPackage.Name.Set.of_list (List.rev_map fst atoms) in
   let atoms =
@@ -340,13 +342,15 @@ let upgrade_t
     t
 
 let upgrade t ?formula ?check ?only_installed ~all names =
+  OpamTrace.with_span "Client.upgrade" @@ fun () ->
   let atoms = OpamSolution.sanitize_atom_list t names in
   let t = update_dev_packages_t ~autolock:true ?only_installed atoms t in
   upgrade_t ?check ~strict_upgrade:(not all) ?only_installed ~all
     atoms ?formula t
 
 let fixup ?(formula=OpamFormula.Empty) t =
   (* @LG reimplement as an alias for 'opam upgrade --criteria=fixup --best-effort --update-invariant *)
+  OpamTrace.with_span "Client.fixup" @@ fun () ->
   log "FIXUP";
   let resolve pkgs =
     pkgs,
@@ -409,6 +413,7 @@ let fixup ?(formula=OpamFormula.Empty) t =
 
 let update
     gt ~repos_only ~dev_only ?(all=false) names =
+  OpamTrace.with_span "Client.update" @@ fun () ->
   log "UPDATE %a" (slog @@ String.concat ", ") names;
   let rt = OpamRepositoryState.load `Lock_none gt in
   let st, repos_only =
@@ -550,6 +555,7 @@ let update
   rt
 
 let init_checks ?(hard_fail_exn=true) init_config =
+  OpamTrace.with_span "Client.init_checks" @@ fun () ->
   (* Check for the external dependencies *)
   let check_external_dep name =
     OpamSystem.resolve_command name <> None
@@ -636,6 +642,7 @@ let init_checks ?(hard_fail_exn=true) init_config =
   else not (soft_fail || hard_fail)
 
 let windows_checks ?cygwin_setup config =
+  OpamTrace.with_span "Client.windows_checks" @@ fun () ->
   let vars = OpamFile.Config.global_variables config in
   let env =
     List.map (fun (v, c, s) -> v, (lazy (Some c), s)) vars
@@ -900,6 +907,7 @@ let reinit ?(init_config=OpamInitDefaults.init_config()) ~interactive
     ?dot_profile ?update_config ?env_hook ?completion ?inplace
     ?(check_sandbox=true) ?(bypass_checks=false) ?cygwin_setup
     config shell =
+  OpamTrace.with_span "Client.reinit" @@ fun () ->
   let root = OpamStateConfig.(!r.root_dir) in
   let config = update_with_init_config config init_config in
   let config = windows_checks ?cygwin_setup config in
@@ -945,6 +953,7 @@ let init
     ?(check_sandbox=true)
     ?cygwin_setup
     shell =
+  OpamTrace.with_span "Client.init" @@ fun () ->
   log "INIT %a"
     (slog @@ OpamStd.Option.to_string OpamRepositoryBackend.to_string) repo;
   let root = OpamStateConfig.(!r.root_dir) in
@@ -1069,6 +1078,7 @@ let init
   gt, rt, default_compiler
 
 let check_installed ~build ~post t atoms =
+  OpamTrace.with_span "Client.check_installed" @@ fun () ->
   let available = (Lazy.force t.available_packages) in
   let uninstalled = OpamPackage.Set.Op.(available -- t.installed) in
   let pkgs =
@@ -1125,6 +1135,7 @@ let check_installed ~build ~post t atoms =
     ) pkgs OpamPackage.Map.empty
 
 let assume_built_restrictions ?available_packages t atoms =
+  OpamTrace.with_span "Client.assume_built_restrictions" @@ fun () ->
   let missing = check_installed ~build:false ~post:false t atoms in
   let atoms =
     if OpamPackage.Map.is_empty missing then atoms else
@@ -1179,6 +1190,7 @@ let assume_built_restrictions ?available_packages t atoms =
   { t with available_packages }, fixed_atoms
 
 let filter_unpinned_locally t atoms f =
+  OpamTrace.with_span "Client.filter_unpinned_locally" @@ fun () ->
   OpamStd.List.filter_map (fun at ->
       let n,_ = at in
       if OpamSwitchState.is_pinned t n &&
@@ -1198,6 +1210,7 @@ let filter_unpinned_locally t atoms f =
 let install_t t ?ask ?(ignore_conflicts=false) ?(depext_only=false)
     ?(download_only=false) atoms ?(formula=OpamFormula.Empty)
     add_to_roots ~deps_only ~assume_built =
+  OpamTrace.with_span "Client.install" @@ fun () ->
   log "INSTALL %a" (slog OpamFormula.string_of_atoms) atoms;
   let available_packages = Lazy.force t.available_packages in
 
@@ -1455,6 +1468,7 @@ let install t ?formula ?autoupdate ?add_to_roots
     ~ignore_conflicts ~depext_only ~deps_only ~download_only ~assume_built
 
 let remove_t ?ask ~autoremove ~force ?(formula=OpamFormula.Empty) atoms t =
+  OpamTrace.with_span "Client.remove" @@ fun () ->
   log "REMOVE autoremove:%b %a" autoremove
     (slog OpamFormula.string_of_atoms) atoms;
 
@@ -1543,6 +1557,7 @@ let remove t ~autoremove ~force ?formula names =
   remove_t ~autoremove ~force ?formula atoms t
 
 let reinstall_t t ?ask ?(force=false) ~assume_built atoms =
+  OpamTrace.with_span "Client.reinstall" @@ fun () ->
   log "reinstall %a" (slog OpamFormula.string_of_atoms) atoms;
 
   let packages = OpamFormula.packages_of_atoms t.packages atoms in

src/client/opamCommands.ml

@@ -940,6 +940,7 @@ let show cli =
   let show global_options fields show_empty raw where
       list_files file normalise no_lint just_file all_versions sort atom_locs
       () =
+  OpamTrace.with_span "Commands.show" @@ fun () ->
     let print_just_file opamf opam =
       if not no_lint then OpamFile.OPAM.print_errors opam;
       let opam =
@@ -2569,6 +2570,7 @@ let with_repos_rt gt repos f =
 
 let switch_doc = "Manage multiple installation prefixes."
 let switch cli =
+  OpamTrace.with_span "Commands.switch" @@ fun () ->
   let shell = OpamStd.Sys.guess_shell_compat () in
   let doc = switch_doc in
   let commands = [
@@ -4403,6 +4405,7 @@ let admin =
 (* Note: for cli versionning check, all commands must be constructed with
    [OpamArg.mk_command] or [OpamArg.mk_command_ret]. *)
 let commands cli =
+  OpamTrace.with_span "Commands.commands" @@ fun () ->
   let show = show cli in
   let remove = remove cli in
   let repository = repository cli in

src/client/opamListCommand.ml

@@ -664,6 +664,7 @@ let default_package_listing_format = {
 }
 
 let display st format packages =
+  OpamTrace.with_span "ListCommand.display" @@ fun () ->
   let packages =
     if format.all_versions then packages else
       OpamPackage.Name.Set.fold (fun name ->
@@ -714,6 +715,7 @@ let display st format packages =
     OpamConsole.print_table ?cut:format.wrap stdout ~sep:format.separator
 
 let get_switch_state gt rt =
+  OpamTrace.with_span "ListCommand.get_switch_state" @@ fun () ->
   match OpamStateConfig.get_switch_opt () with
   | None -> OpamSwitchState.load_virtual gt rt
   | Some sw -> OpamSwitchState.load `Lock_none gt rt sw

src/client/opamSolution.ml

@@ -246,6 +246,7 @@ let display_error (n, error) =
 
 module Json = struct
   let output_request request user_action =
+    OpamTrace.with_span "Solution.Json.output_request" @@ fun () ->
     if OpamClientConfig.(!r.json_out = None) then () else
     let atoms =
       List.map (fun a -> `String (OpamFormula.short_string_of_atom a))
@@ -264,6 +265,7 @@ module Json = struct
     OpamJson.append "request" j
 
   let output_solution t solution =
+    OpamTrace.with_span "Solution.Json.output_solution" @@ fun () ->
     if OpamClientConfig.(!r.json_out = None) then () else
     match solution with
     | Success solution ->
@@ -1302,6 +1304,7 @@ let apply ?ask t ~requested ?print_requested ?add_roots
     ?(skip=OpamPackage.Map.empty)
     ?(assume_built=false)
     ?(download_only=false) ?force_remove solution0 =
+  OpamTrace.with_span "Solution.apply" @@ fun () ->
   let names = OpamPackage.names_of_packages requested in
   let print_requested = OpamStd.Option.default names print_requested in
   log "apply";
@@ -1454,6 +1457,7 @@ let apply ?ask t ~requested ?print_requested ?add_roots
   )
 
 let resolve t action ?reinstall ~requested request =
+  OpamTrace.with_span "Solution.resolve" @@ fun () ->
   if OpamClientConfig.(!r.json_out <> None) then
     OpamJson.append "switch" (OpamSwitch.to_json t.switch);
   OpamRepositoryState.check_last_update ();

src/client/opamSwitchCommand.ml

@@ -20,14 +20,19 @@ let log fmt = OpamConsole.log "SWITCH" fmt
 let slog = OpamConsole.slog
 
 let list gt ~print_short =
+  OpamTrace.with_span "SwitchCommand.list" @@ fun () ->
   log "list";
   let gt = OpamGlobalState.fix_switch_list gt in
   if print_short then
     List.iter (OpamConsole.msg "%s\n" @* OpamSwitch.to_string)
       (List.sort compare (OpamFile.Config.installed_switches gt.config))
   else
   let installed_switches =
+    OpamTrace.with_span "SwitchCommand.installed_switches" @@ fun () ->
     OpamGlobalState.fold_switches (fun sw sel acc ->
+        OpamTrace.with_span "fold-switch"
+          ~data:["sw", `String (OpamSwitch.to_string sw)] @@ fun () ->
+
         let opams =
           OpamPackage.Set.fold (fun nv acc ->
               match
@@ -146,6 +151,7 @@ let list gt ~print_short =
   | _ -> ()
 
 let clear_switch ?(keep_debug=false) (gt: rw global_state) switch =
+  OpamTrace.with_span "SwitchCommands.clear_switch" @@ fun () ->
   let module C = OpamFile.Config in
   let config = gt.config in
   let config =
@@ -170,6 +176,7 @@ let clear_switch ?(keep_debug=false) (gt: rw global_state) switch =
   with OpamSystem.Internal_error _ -> gt
 
 let remove gt ?(confirm = true) switch =
+  OpamTrace.with_span "SwitchCommands.remove" @@ fun () ->
   log "remove switch=%a" (slog OpamSwitch.to_string) switch;
   if not (OpamGlobalState.switch_exists gt switch) then (
     OpamConsole.msg "The compiler switch %s does not exist.\n"
@@ -185,6 +192,7 @@ let remove gt ?(confirm = true) switch =
   else gt
 
 let set_invariant_raw st invariant =
+  OpamTrace.with_span "SwitchCommands.set_invariant_raw" @@ fun () ->
   let switch_config = {st.switch_config with invariant = Some invariant} in
   let st = {st with switch_invariant = invariant; switch_config } in
   if not (OpamStateConfig.(!r.dryrun) || OpamClientConfig.(!r.show)) then
@@ -194,6 +202,7 @@ let set_invariant_raw st invariant =
 
 let install_compiler
     ?(additional_installs=[]) ?(deps_only=false) ?(ask=false) t =
+  OpamTrace.with_span "SwitchCommands.install_compiler" @@ fun () ->
   let invariant = t.switch_invariant in
   if invariant = OpamFormula.Empty && additional_installs = [] then begin
     (if not OpamClientConfig.(!r.show) &&
@@ -290,6 +299,9 @@ let install_compiler
 
 let create
     gt ~rt ?synopsis ?repos ~update_config ~invariant switch post =
+  OpamTrace.with_span "SwitchCommands.create"
+    ~data:["sw", `String (OpamSwitch.to_string switch)] @@ fun () ->
+
   let update_config = update_config && not (OpamSwitch.is_external switch) in
   let comp_dir = OpamPath.Switch.root gt.root switch in
   let simulate = OpamStateConfig.(!r.dryrun) || OpamClientConfig.(!r.show) in
@@ -359,6 +371,7 @@ let create
     OpamGlobalState.drop gt
 
 let switch lock gt switch =
+  OpamTrace.with_span "SwitchCommands.switch" @@ fun () ->
   log "switch switch=%a" (slog OpamSwitch.to_string) switch;
   if OpamGlobalState.switch_exists gt switch then
     OpamRepositoryState.with_ `Lock_none gt @@ fun rt ->
@@ -378,6 +391,7 @@ let switch lock gt switch =
     (OpamStd.Format.itemize OpamSwitch.to_string installed_switches)
 
 let switch_previous lock gt =
+  OpamTrace.with_span "SwitchCommands.switch_previous" @@ fun () ->
   match OpamFile.Config.previous_switch gt.config with
   | Some switch_name ->
     OpamConsole.msg
@@ -391,6 +405,7 @@ let switch_previous lock gt =
       "No previously used switch could be found"
 
 let import_t ?ask importfile t =
+  OpamTrace.with_span "SwitchCommands.import" @@ fun () ->
   log "import switch";
 
   let extra_files = importfile.OpamFile.SwitchExport.extra_files in
@@ -531,6 +546,7 @@ let import_t ?ask importfile t =
   t
 
 let freeze_url src_dir nv url =
+  OpamTrace.with_span "SwitchCommands.freeze_url" @@ fun () ->
   let url_t = OpamFile.URL.url url in
   match url_t.backend with
   | #OpamUrl.version_control ->
@@ -560,6 +576,7 @@ let freeze_url src_dir nv url =
       (OpamPackage.Name.to_string nv.name)
 
 let freeze_opam src_dir nv opam =
+  OpamTrace.with_span "SwitchCommands.freeze_opam" @@ fun () ->
   let url =
     OpamStd.Option.map
       (fun url -> freeze_url src_dir nv url)
@@ -576,6 +593,7 @@ let freeze_opam src_dir nv opam =
 
 let export rt ?(freeze=false) ?(full=false)
     ?(switch=OpamStateConfig.get_switch ()) filename =
+  OpamTrace.with_span "SwitchCommands.export" @@ fun () ->
   let root = OpamStateConfig.(!r.root_dir) in
   let export =
     OpamFilename.with_flock `Lock_none (OpamPath.Switch.lock root switch)
@@ -650,10 +668,12 @@ let export rt ?(freeze=false) ?(full=false)
   | Some f -> OpamFile.SwitchExport.write f export
 
 let show () =
+  OpamTrace.with_span "SwitchCommands.show" @@ fun () ->
   OpamConsole.msg "%s\n"
     (OpamSwitch.to_string (OpamStateConfig.get_switch ()))
 
 let reinstall init_st =
+  OpamTrace.with_span "SwitchCommands.reinstall" @@ fun () ->
   let switch = init_st.switch in
   log "reinstall switch=%a" (slog OpamSwitch.to_string) switch;
   let gt = init_st.switch_global in
@@ -680,6 +700,8 @@ let reinstall init_st =
     st
 
 let import st filename =
+  OpamTrace.with_span "SwitchCommands.import" @@ fun () ->
+
   let import_str = match filename with
     | None   -> OpamSystem.string_of_channel stdin
     | Some f -> OpamFilename.read (OpamFile.filename f)
@@ -698,6 +720,7 @@ let import st filename =
   import_t importfile st
 
 let set_invariant ?(force=false) st invariant =
+  OpamTrace.with_span "SwitchCommands.set_invariant" @@ fun () ->
   let satisfied = OpamFormula.satisfies_depends st.installed invariant in
   let names =
     OpamPackage.Name.Set.of_list (List.map fst (OpamFormula.atoms invariant))
@@ -717,6 +740,7 @@ let set_invariant ?(force=false) st invariant =
   set_invariant_raw st invariant
 
 let get_compiler_packages ?repos rt =
+  OpamTrace.with_span "SwitchCommands.get_compiler_packages" @@ fun () ->
   let repos = match repos with
     | None -> OpamGlobalState.repos_list rt.repos_global
     | Some r -> r
@@ -732,6 +756,7 @@ let get_compiler_packages ?repos rt =
   |> OpamPackage.keys
 
 let guess_compiler_invariant ?repos rt strings =
+  OpamTrace.with_span "SwitchCommands.guess_compiler_invariant" @@ fun () ->
   let repos = match repos with
     | None -> OpamGlobalState.repos_list rt.repos_global
     | Some r -> r