feature: dune produces action traces (#13302)

When dune is executed as an action (e.g. in our test suite), the trace
file that it produces is discarded. Instead of discarding it, it is now
copied to the action trace directory to be included in the host's dune
trace. This gives us greater visibility on what is happening in the
tests.

For example, we can now write the following query to determine the
number of times we run `ocamlc -config` in our test suite:

```
$ dune trace cat | jq -s '[ .[] | select(.cat == "process" and .name == "finish" and .args.process_args == ["-config"]) ] | length'
```

The answer is 2872 times if anybody is curious. Yes, that is ridiculous.

---------

Signed-off-by: Rudi Grinberg <[email protected]>

Author: rgrinberg

boot/libs.ml

@@ -105,6 +105,12 @@ let local_libraries =
     ; special_builtin_support = None
     ; root_module = None
     }
+  ; { path = "otherlibs/dune-action-trace"
+    ; main_module_name = Some "Dune_action_trace"
+    ; include_subdirs = No
+    ; special_builtin_support = None
+    ; root_module = None
+    }
   ; { path = "vendor/bigstringaf"
     ; main_module_name = Some "Bigstringaf"
     ; include_subdirs = No
@@ -255,12 +261,6 @@ let local_libraries =
     ; special_builtin_support = None
     ; root_module = None
     }
-  ; { path = "otherlibs/dune-action-trace"
-    ; main_module_name = Some "Dune_action_trace"
-    ; include_subdirs = No
-    ; special_builtin_support = None
-    ; root_module = None
-    }
   ; { path = "src/dune_engine"
     ; main_module_name = Some "Dune_engine"
     ; include_subdirs = No

doc/changes/added/13302.md

@@ -0,0 +1,2 @@
+- Dune dune produces trace events in `DUNE_ACTION_TRACE_DIR` if this variable
+  is set. (#13302, @rgrinberg)

otherlibs/stdune/src/temp.mli

@@ -32,6 +32,8 @@ val clear_dir : Path.t -> unit
     safely use any file name there. *)
 val temp_file : dir:Path.t -> prefix:string -> suffix:string -> Path.t
 
+val temp_dir : parent_dir:Path.t -> prefix:string -> suffix:string -> Path.t
+
 (** Like [temp_file], but passes the temporary file to the callback [f], and
     makes sure the temporary file is deleted when [f] completes. If [f] raises
     an exception, the exception is re-raised (and the file is still deleted). *)

src/dune_trace/dune

@@ -3,4 +3,11 @@
  (foreign_stubs
   (language c)
   (names dune_trace_stubs))
- (libraries stdune csexp bigstringaf threads.posix spawn unix))
+ (libraries
+  stdune
+  dune_action_trace
+  csexp
+  bigstringaf
+  threads.posix
+  spawn
+  unix))

src/dune_trace/dune_trace.ml

@@ -11,7 +11,18 @@ let () =
     | None -> ()
     | Some t ->
       Out.emit t (Event.exit ());
-      Out.close t)
+      Out.close t;
+      (match Env.(get initial Dune_action_trace.Private.trace_dir_env_var) with
+       | None -> ()
+       | Some dir ->
+         let dir = Path.of_string dir in
+         Path.mkdir_p dir;
+         let dst =
+           Path.relative
+             (Temp.temp_dir ~parent_dir:dir ~prefix:"dune" ~suffix:"trace")
+             "trace.csexp"
+         in
+         Io.copy_file ~src:t.path ~dst ()))
 ;;
 
 let set_global t =

src/dune_trace/out.ml

@@ -22,6 +22,7 @@ type t =
   ; buf : Buffer.t
   ; cats : Category.Set.t
   ; mutex : Mutex.t
+  ; path : Path.t
   }
 
 (* CR-someday rgrinberg: remove this once we drop support for < 5.2 *)
@@ -70,7 +71,7 @@ let create cats path =
   in
   let cats = Category.Set.of_list cats in
   let buf = Buffer.create (1 lsl 16) in
-  { fd; cats; buf; mutex = Mutex.create () }
+  { fd; cats; buf; mutex = Mutex.create (); path }
 ;;
 
 let to_buffer t sexp =

src/dune_trace/out.mli

@@ -3,6 +3,7 @@ type t =
   ; buf : Buffer.t
   ; cats : Category.Set.t
   ; mutex : Mutex.t
+  ; path : Stdune.Path.t
   }
 
 val emit : ?buffered:bool -> t -> Event.t -> unit

test/blackbox-tests/test-cases/trace/action-traces/dune.t

@@ -0,0 +1,61 @@
+Dune itself produces action traces
+
+  $ cat >dune-project<<EOF
+  > (lang dune 3.22)
+  > EOF
+
+  $ cat >dune <<EOF
+  > (rule (with-stdout-to foo (echo bar)))
+  > (rule
+  >  (alias foo)
+  >  (deps (source_tree .))
+  >  (action (run dune build ./foo)))
+  > EOF
+
+  $ dune build @foo
+
+  $ dune trace cat | jq 'include "dune";
+  >   select(.name == "init")
+  > | { args: .args | keys, keys: keys, argv: .args.argv | .[1:] }
+  > '
+  {
+    "args": [
+      "argv",
+      "build_dir",
+      "env",
+      "initial_cwd",
+      "pid",
+      "root"
+    ],
+    "keys": [
+      "args",
+      "cat",
+      "name",
+      "ts"
+    ],
+    "argv": [
+      "build",
+      "@foo"
+    ]
+  }
+  {
+    "args": [
+      "argv",
+      "build_dir",
+      "digest",
+      "env",
+      "initial_cwd",
+      "pid",
+      "root"
+    ],
+    "keys": [
+      "args",
+      "cat",
+      "name",
+      "ts"
+    ],
+    "argv": [
+      "build",
+      "./foo"
+    ]
+  }