Source file ptrace.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
open! Core

external ptrace_traceme : unit -> bool = "magic_ptrace_traceme"

(* Same as [Caml.exit] but does not run at_exit handlers *)
external sys_exit : int -> 'a = "caml_sys_exit"

let fork_exec_stopped ~prog ~argv () =
  let pr_set_pdeathsig = Or_error.ok_exn Linux_ext.pr_set_pdeathsig in
  match Core_unix.fork () with
  | `In_the_child ->
    (* Don't outlive the magic-trace parent process. *)
    pr_set_pdeathsig Signal.kill;
    (* This is how we ensure the process is started in a stopped state: we mark ourselves
       as traced, so that we receive a `SIGTRAP` after `exec*` completes. *)
    if not (ptrace_traceme ()) then sys_exit 126;
    never_returns
      (try Core_unix.exec ~prog ~argv () with
      | _ -> sys_exit 127)
  | `In_the_parent pid ->
    (match Core_unix.wait_untraced (`Pid pid) with
    | _, Error (`Stop _) -> pid
    | _, result ->
      raise_s
        [%message
          "expected child to stop but it did not"
            (pid : Pid.t)
            (result : (unit, Core_unix.Exit_or_signal_or_stop.error) Result.t)])
;;

external resume : Pid.t -> unit = "magic_ptrace_detach"