From 47eef9f7378f32eb3efb26ce12d04ca895bfe6b2 Mon Sep 17 00:00:00 2001 From: Patrick Ferris Date: Fri, 23 May 2025 14:41:05 +0100 Subject: [PATCH] Features --- README.md | 7 +++++ dune | 6 ++++ dune-project | 1 + include/discover.ml | 67 +++++++++++++++++++++++++++++++++++++++++ include/dune | 4 +++ opentrace.ml | 62 ++++++++++++++++++++++++++++++-------- opentrace.opam | 7 +++++ opentrace.opam.template | 6 ++++ 8 files changed, 147 insertions(+), 13 deletions(-) create mode 100644 include/discover.ml create mode 100644 include/dune create mode 100644 opentrace.opam.template diff --git a/README.md b/README.md index 5743f09..db7f8c4 100644 --- a/README.md +++ b/README.md @@ -2,3 +2,10 @@ opentrace --------- Tracing open-like syscalls using eBPF via OCaml. + +``` +sudo opentrace exec -- opam list +cat trace.csv +``` + + diff --git a/dune b/dune index 84ae7d0..fda4449 100644 --- a/dune +++ b/dune @@ -1,6 +1,7 @@ (executable (name opentrace) (public_name opentrace) + (modules opentrace config) (preprocess (pps ppx_blob)) (preprocessor_deps @@ -29,3 +30,8 @@ arch (bash "uname -m | sed 's/x86_64/x86/' | sed 's/arm.*/arm/' | sed 's/aarch64/arm64/' | sed 's/ppc64le/powerpc/' | sed 's/mips.*/mips/' | sed 's/riscv64/riscv/' | sed 's/loongarch64/loongarch/'"))))) + +(rule + (targets config.ml) + (action + (run ./include/discover.exe))) diff --git a/dune-project b/dune-project index b48dc2c..6ea46fa 100644 --- a/dune-project +++ b/dune-project @@ -12,6 +12,7 @@ (ocaml (>= 5.2.0)) eio_main jsonm + dune-configurator libbpf libbpf_maps)) diff --git a/include/discover.ml b/include/discover.ml new file mode 100644 index 0000000..3705c85 --- /dev/null +++ b/include/discover.ml @@ -0,0 +1,67 @@ +module C = Configurator.V1 + +let () = + C.main ~name:"discover" (fun c -> + let defs = + let values = + C.C_define.import c ~c_flags:[ "-D_GNU_SOURCE" ] + ~includes:[ "fcntl.h" ] + C.C_define.Type. + [ + ("O_RDONLY", Int); + ("O_WRONLY", Int); + ("O_RDWR", Int); + ("O_CREAT", Int); + ("O_EXCL", Int); + ("O_NOCTTY", Int); + ("O_TRUNC", Int); + ("O_APPEND", Int); + ("O_NONBLOCK", Int); + ("O_DSYNC", Int); + ("O_DIRECT", Int); + (* "O_LARGEFILE", Int; *) + ("O_DIRECTORY", Int); + ("O_NOFOLLOW", Int); + ("O_NOATIME", Int); + ("O_CLOEXEC", Int); + ("O_SYNC", Int); + ("O_PATH", Int); + ("O_TMPFILE", Int); + ] + in + let defs = + List.map + (function + | name, C.C_define.Value.Int v -> + Printf.sprintf "let %s = 0x%x" (String.lowercase_ascii name) v + | _ -> assert false) + values + in + let of_string = + List.fold_left + (fun acc v -> + match v with + | name, C.C_define.Value.Int v -> + let case = Printf.sprintf "| \"%s\" -> 0x%x\n" name v in + acc ^ case + | _ -> assert false) + "let of_string = function\n" values + in + let to_string = + List.fold_left + (fun acc v -> + match v with + | name, C.C_define.Value.Int v -> + let case = Printf.sprintf "| 0x%x -> \"%s\"\n" v name in + acc ^ case + | _ -> assert false) + "let to_string = function\n" values + in + defs + @ [ + of_string ^ "| s -> invalid_arg(\"Unknown flag: \" ^ s)\n"; + to_string + ^ "| s -> invalid_arg(\"Unknown flag: \" ^ string_of_int s)\n"; + ] + in + C.Flags.write_lines "config.ml" defs) diff --git a/include/dune b/include/dune new file mode 100644 index 0000000..db98d61 --- /dev/null +++ b/include/dune @@ -0,0 +1,4 @@ +(executable + (name discover) + (modules discover) + (libraries dune-configurator)) diff --git a/opentrace.ml b/opentrace.ml index f26d051..7458853 100644 --- a/opentrace.ml +++ b/opentrace.ml @@ -28,6 +28,14 @@ let json_to_lexemes json : Jsonm.lexeme list = in loop [] json |> List.rev +module Flags = struct + type t = int + + include Config + + let mem (v : t) i = Int.equal (i land (v :> int)) (v :> int) +end + module Open_event = struct open Ctypes @@ -129,16 +137,23 @@ let ringbuffer_polling_callback ~poll rb_cb exit_cb = in bpf_callback -let all poll no_header = +let filter_event_by_flag event flags = + flags = [] + || + let fs = Open_event.get_flags event in + List.for_all (fun flag -> Flags.mem flag fs) flags + +let all poll no_header open_flags = if no_header then () else Format.printf "%s" Open_event.csv_header; let callback event = - Format.printf "%s\n%!" (Open_event.to_csv_row event); + if filter_event_by_flag event open_flags then + Format.printf "%s\n%!" (Open_event.to_csv_row event); 0 in let bpf_callback = ringbuffer_polling_callback ~poll callback (fun _ -> ()) in run_ring_buffer bpf_callback -let exec format output user poll (prog, args) = +let exec format output user poll (prog, args) open_flags_filter = let output = match output with | Some file -> file @@ -190,7 +205,10 @@ let exec format output user poll (prog, args) = match Atomic.get pid with | None -> 0 | Some pid -> - (if Int.equal (Open_event.get_pid event) pid then + (if + Int.equal (Open_event.get_pid event) pid + && filter_event_by_flag event open_flags_filter + then match format with | Csv -> Out_channel.output_string oc (Open_event.to_csv_row event); @@ -228,6 +246,21 @@ let no_header = let doc = "Disable printing the CSV header" in Arg.(value & flag & info [ "no-header" ] ~doc) +let flag_conv = + let of_string s = + try Ok (Flags.of_string s) with Invalid_argument m -> Error (`Msg m) + in + let pp ppf v = Format.pp_print_string ppf (Flags.to_string v) in + Arg.conv (of_string, pp) + +let open_flags_filter = + let doc = + "Filter open events that include these flags (e.g. O_RDONLY, O_CREAT). \ + Note the filter wants ALL of the flags to be present not just one of \ + them." + in + Arg.(value & opt (list flag_conv) [] & info [ "flags" ] ~doc) + let user = let doc = "Username or UID to execute program as" in Arg.(value & opt (some string) None & info [ "u"; "user" ] ~doc ~docv:"USER") @@ -250,13 +283,13 @@ let format = let output = let doc = "Output file for trace. Defaults to trace. depending on the \ - $(format)." + format." in Arg.( value & opt (some string) None & info [ "o"; "output" ] ~docv:"OUTPUT" ~doc) let all_cmd = - let doc = "Trace all open system calls" in + let doc = "Trace all open system calls." in let man = [ `P @@ -266,11 +299,13 @@ let all_cmd = in Cmd.v (Cmd.info ~doc ~man "all") @@ - let+ polling = polling and+ no_header = no_header in - all polling no_header + let+ polling = polling + and+ no_header = no_header + and+ open_flags_filter = open_flags_filter in + all polling no_header open_flags_filter let exec_cmd = - let doc = "Execute a program and trace its open system calls" in + let doc = "Execute a program and trace its open system calls." in let man = [ `P @@ -287,18 +322,19 @@ let exec_cmd = and+ format = format and+ output = output and+ args = Arg.(value & pos_right 0 string [] & Arg.info [] ~docv:"ARGS") + and+ open_flags_filter = open_flags_filter and+ poll = polling in - exec format output user poll (prog, args) + exec format output user poll (prog, args) open_flags_filter let opentrace_cmd = let doc = "Trace all open system calls" in let man = [ `S Manpage.s_description; - `P "$(cmd) traces all open system calls"; + `P "$(tool) traces all open system calls."; `P - "$(cmd) can be used either to run an executable directly or to trace \ - all open calls"; + "$(tool) can be used either to run an executable directly or to trace \ + all open calls."; ] in let default = Term.(ret (const (`Help (`Auto, None)))) in diff --git a/opentrace.opam b/opentrace.opam index aff7e62..edf266c 100644 --- a/opentrace.opam +++ b/opentrace.opam @@ -7,6 +7,7 @@ depends: [ "ocaml" {>= "5.2.0"} "eio_main" "jsonm" + "dune-configurator" "libbpf" "libbpf_maps" "odoc" {with-doc} @@ -25,3 +26,9 @@ build: [ "@doc" {with-doc} ] ] +pin-depends:[ + "eio.dev" "git+https://github.com/patricoferris/eio#9cb52c3c061a1bfee0c6094625415d3c95f735d5" + "eio_posix.dev" "git+https://github.com/patricoferris/eio#9cb52c3c061a1bfee0c6094625415d3c95f735d5" + "eio_linux.dev" "git+https://github.com/patricoferris/eio#9cb52c3c061a1bfee0c6094625415d3c95f735d5" + "eio_main.dev" "git+https://github.com/patricoferris/eio#9cb52c3c061a1bfee0c6094625415d3c95f735d5" +] diff --git a/opentrace.opam.template b/opentrace.opam.template new file mode 100644 index 0000000..172d7de --- /dev/null +++ b/opentrace.opam.template @@ -0,0 +1,6 @@ +pin-depends:[ + "eio.dev" "git+https://github.com/patricoferris/eio#9cb52c3c061a1bfee0c6094625415d3c95f735d5" + "eio_posix.dev" "git+https://github.com/patricoferris/eio#9cb52c3c061a1bfee0c6094625415d3c95f735d5" + "eio_linux.dev" "git+https://github.com/patricoferris/eio#9cb52c3c061a1bfee0c6094625415d3c95f735d5" + "eio_main.dev" "git+https://github.com/patricoferris/eio#9cb52c3c061a1bfee0c6094625415d3c95f735d5" +] -- 2.51.2