···
+
type format = Csv | Json
let obj_path = "opentrace.bpf.o"
let obj_file = [%blob "opentrace.bpf.o"]
···
"tracepoint__syscalls__sys_enter_openat";
"tracepoint__syscalls__sys_enter_openat2";
+
"tracepoint__syscalls__sys_exit_openat";
+
"tracepoint__syscalls__sys_exit_openat2";
+
let json_to_lexemes json : Jsonm.lexeme list =
+
let rec loop acc = function
+
| `String _ as s -> s :: acc
+
| `Int i -> `Float (Int.to_float i) :: acc
+
(fun vacc (k, v) -> loop (`Name k :: vacc) v)
+
loop [] json |> List.rev
module Open_event = struct
···
let t : t structure typ = Ctypes.structure "event"
let ( -: ) ty label = Ctypes.field t label ty
let pid = uint32_t -: "e_pid"
+
let cgid = uint64_t -: "e_cgid"
+
let comm = array 16 char -: "e_comm"
let kind = int -: "e_kind"
let flags = int -: "e_flags"
let mode = uint32_t -: "e_mode"
let filename = array 256 char -: "e_filename"
+
let ret = int -: "e_ret"
let char_array_as_string a =
···
with Exit -> Buffer.contents b
let get_pid s = getf s pid |> Unsigned.UInt32.to_int
+
let get_cgid s = getf s cgid |> Unsigned.UInt64.to_int64
+
let get_comm s = getf s comm |> char_array_as_string
let get_flags s = getf s flags
let get_mode s = getf s mode |> Unsigned.UInt32.to_int
let get_fname s = getf s filename |> char_array_as_string
let get_kind s = getf s kind |> kind_of_int
+
let get_ret s = getf s ret
+
let csv_header = "pid,cgid,comm,kind,flags,mode,filename,return\n"
+
Format.sprintf "%i,%Ld,%S,%s,%i,%i,\"%s\",%i%!" (get_pid event)
+
(get_cgid event) (get_comm event)
+
(get_kind event |> kind_to_string)
+
(get_flags event) (get_mode event) (get_fname event) (get_ret event)
+
("pid", `Int (get_pid event));
+
("cgid", `Int (Int64.to_int @@ get_cgid event));
+
("comm", `String (get_comm event));
+
("kind", `String (get_kind event |> kind_to_string));
+
("flags", `Int (get_flags event));
+
("mode", `Int (get_mode event));
+
("fname", `String (get_fname event));
+
("ret", `Int (get_ret event));
+
let run_ring_buffer bpf_callback =
let dir = Filename.temp_dir "opentrace-" "" in
let full_obj_path = Filename.concat dir obj_path in
+
Out_channel.with_open_bin full_obj_path (fun oc ->
+
Out_channel.output_string oc obj_file);
+
with_bpf_object_open_load_link ~obj_path:full_obj_path ~program_names
+
let ringbuffer_polling_callback ~poll rb_cb exit_cb =
let bpf_callback obj _links =
(* Set signal handlers *)
let exitting = ref true in
···
Sys.(set_signal sigint sig_handler);
Sys.(set_signal sigterm sig_handler);
let map = Libbpf.bpf_object_find_map_by_name obj "rb" in
let callback : RingBuffer.callback =
let event = Ctypes.(!@(from_voidp Open_event.t data)) in
RingBuffer.init map ~callback @@ fun rb ->
let _ : int = RingBuffer.poll rb ~timeout:1 in
+
let all poll no_header =
+
if no_header then () else Format.printf "%s" Open_event.csv_header;
+
Format.printf "%s\n%!" (Open_event.to_csv_row event);
+
let bpf_callback = ringbuffer_polling_callback ~poll callback (fun _ -> ()) in
+
run_ring_buffer bpf_callback
+
let exec format output user poll (prog, args) =
+
let ext = match format with Csv -> "csv" | Json -> "json" in
+
| None -> Unix.getenv "SUDO_UID" |> int_of_string
+
match int_of_string_opt user with
+
| None -> (Unix.getpwnam user).pw_uid)
+
let start_process = Condition.create () in
+
let mutex = Mutex.create () in
+
let pid = Atomic.make None in
+
let exit_status = Atomic.make None in
+
Domain.spawn @@ fun () ->
+
Eio_main.run @@ fun env ->
+
Condition.wait start_process mutex;
+
Eio.Switch.run @@ fun sw ->
+
Eio.Process.spawn ~sw ~uid (Eio.Stdenv.process_mgr env) (prog :: args)
+
Atomic.set pid (Some (Eio.Process.pid p));
+
let status = Eio.Process.await p in
+
Atomic.set exit_status (Some status)
+
Out_channel.with_open_bin output @@ fun oc ->
+
let encoder = Jsonm.encoder ~minify:false (`Channel oc) in
+
Jsonm.encode encoder (`Lexeme l) |> function `Ok -> () | _ -> assert false
+
Jsonm.encode encoder `End |> function `Ok -> () | _ -> assert false
+
| Csv -> Out_channel.output_string oc Open_event.csv_header
+
match Atomic.get pid with
+
(if Int.equal (Open_event.get_pid event) pid then
+
Out_channel.output_string oc (Open_event.to_csv_row event);
+
Out_channel.output_char oc '\n'
+
List.iter encode (json_to_lexemes (Open_event.to_json event)));
+
let spawned = ref false in
+
let exit_callback exitting =
+
Condition.broadcast start_process;
+
(Atomic.get exit_status)
+
let bpf_callback = ringbuffer_polling_callback ~poll callback exit_callback in
+
run_ring_buffer bpf_callback
+
open Cmdliner.Term.Syntax
+
let doc = "The number of seconds to sleep between polls of the ringbuffer" in
+
Arg.(value & opt float 0.1 & info [ "p"; "poll" ] ~doc ~docv:"POLL")
+
let doc = "Disable printing the CSV header" in
+
Arg.(value & flag & info [ "no-header" ] ~doc)
+
let doc = "Username or UID to execute program as" in
+
Arg.(value & opt (some string) None & info [ "u"; "user" ] ~doc ~docv:"USER")
+
let format_conv : format Arg.conv =
+
match String.lowercase_ascii s with
+
| _ -> Error (`Msg ("Unknown format: " ^ s))
+
let to_string = function Csv -> "csv" | Json -> "json" in
+
let pp ppf v = Fmt.string ppf (to_string v) in
+
Arg.conv ~docv:"FORMAT" (of_string, pp)
+
let doc = "Output format" in
+
Arg.(value & opt format_conv Csv & info [ "f"; "format" ] ~docv:"FORMAT" ~doc)
+
"Output file for trace. Defaults to trace.<csv|json> depending on the \
+
value & opt (some string) None & info [ "o"; "output" ] ~docv:"OUTPUT" ~doc)
+
let doc = "Trace all open system calls" in
+
"All calls to open will be traced and written to standard out in CSV \
+
Cmd.v (Cmd.info ~doc ~man "all")
+
let+ polling = polling and+ no_header = no_header in
+
let doc = "Execute a program and trace its open system calls" in
+
"$(b,opentrace exec -- COMMAND) will execute COMMAND and trace only \
+
those open calls from that program.";
+
`P "Opentrace will include the children of the main process.";
+
Cmd.v (Cmd.info ~doc ~man "exec")
+
Arg.(required & pos 0 (some string) None & Arg.info [] ~docv:"PROG")
+
and+ args = Arg.(value & pos_right 0 string [] & Arg.info [] ~docv:"ARGS")
+
exec format output user poll (prog, args)
+
let doc = "Trace all open system calls" in
+
`S Manpage.s_description;
+
`P "$(cmd) traces all open system calls";
+
"$(cmd) can be used either to run an executable directly or to trace \
+
let default = Term.(ret (const (`Help (`Auto, None)))) in
+
Cmd.group (Cmd.info ~doc ~man "opentrace") ~default [ all_cmd; exec_cmd ]
+
let main () = Cmd.eval opentrace_cmd
+
let () = if !Sys.interactive then () else exit (main ())
patrick.sirref.org