this repo has no description
Features
+147
-13
+7
README.md
+7
README.md
+6
dune
+6
dune
···
1
1
(executable
2
2
(name opentrace)
3
3
(public_name opentrace)
4
+
(modules opentrace config)
4
5
(preprocess
5
6
(pps ppx_blob))
6
7
(preprocessor_deps
···
29
30
arch
30
31
(bash
31
32
"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/'")))))
33
+
34
+
(rule
35
+
(targets config.ml)
36
+
(action
37
+
(run ./include/discover.exe)))
+1
dune-project
+1
dune-project
+67
include/discover.ml
+67
include/discover.ml
···
1
+
module C = Configurator.V1
2
+
3
+
let () =
4
+
C.main ~name:"discover" (fun c ->
5
+
let defs =
6
+
let values =
7
+
C.C_define.import c ~c_flags:[ "-D_GNU_SOURCE" ]
8
+
~includes:[ "fcntl.h" ]
9
+
C.C_define.Type.
10
+
[
11
+
("O_RDONLY", Int);
12
+
("O_WRONLY", Int);
13
+
("O_RDWR", Int);
14
+
("O_CREAT", Int);
15
+
("O_EXCL", Int);
16
+
("O_NOCTTY", Int);
17
+
("O_TRUNC", Int);
18
+
("O_APPEND", Int);
19
+
("O_NONBLOCK", Int);
20
+
("O_DSYNC", Int);
21
+
("O_DIRECT", Int);
22
+
(* "O_LARGEFILE", Int; *)
23
+
("O_DIRECTORY", Int);
24
+
("O_NOFOLLOW", Int);
25
+
("O_NOATIME", Int);
26
+
("O_CLOEXEC", Int);
27
+
("O_SYNC", Int);
28
+
("O_PATH", Int);
29
+
("O_TMPFILE", Int);
30
+
]
31
+
in
32
+
let defs =
33
+
List.map
34
+
(function
35
+
| name, C.C_define.Value.Int v ->
36
+
Printf.sprintf "let %s = 0x%x" (String.lowercase_ascii name) v
37
+
| _ -> assert false)
38
+
values
39
+
in
40
+
let of_string =
41
+
List.fold_left
42
+
(fun acc v ->
43
+
match v with
44
+
| name, C.C_define.Value.Int v ->
45
+
let case = Printf.sprintf "| \"%s\" -> 0x%x\n" name v in
46
+
acc ^ case
47
+
| _ -> assert false)
48
+
"let of_string = function\n" values
49
+
in
50
+
let to_string =
51
+
List.fold_left
52
+
(fun acc v ->
53
+
match v with
54
+
| name, C.C_define.Value.Int v ->
55
+
let case = Printf.sprintf "| 0x%x -> \"%s\"\n" v name in
56
+
acc ^ case
57
+
| _ -> assert false)
58
+
"let to_string = function\n" values
59
+
in
60
+
defs
61
+
@ [
62
+
of_string ^ "| s -> invalid_arg(\"Unknown flag: \" ^ s)\n";
63
+
to_string
64
+
^ "| s -> invalid_arg(\"Unknown flag: \" ^ string_of_int s)\n";
65
+
]
66
+
in
67
+
C.Flags.write_lines "config.ml" defs)
+4
include/dune
+4
include/dune
+49
-13
opentrace.ml
+49
-13
opentrace.ml
···
28
28
in
29
29
loop [] json |> List.rev
30
30
31
+
module Flags = struct
32
+
type t = int
33
+
34
+
include Config
35
+
36
+
let mem (v : t) i = Int.equal (i land (v :> int)) (v :> int)
37
+
end
38
+
31
39
module Open_event = struct
32
40
open Ctypes
33
41
···
129
137
in
130
138
bpf_callback
131
139
132
-
let all poll no_header =
140
+
let filter_event_by_flag event flags =
141
+
flags = []
142
+
||
143
+
let fs = Open_event.get_flags event in
144
+
List.for_all (fun flag -> Flags.mem flag fs) flags
145
+
146
+
let all poll no_header open_flags =
133
147
if no_header then () else Format.printf "%s" Open_event.csv_header;
134
148
let callback event =
135
-
Format.printf "%s\n%!" (Open_event.to_csv_row event);
149
+
if filter_event_by_flag event open_flags then
150
+
Format.printf "%s\n%!" (Open_event.to_csv_row event);
136
151
0
137
152
in
138
153
let bpf_callback = ringbuffer_polling_callback ~poll callback (fun _ -> ()) in
139
154
run_ring_buffer bpf_callback
140
155
141
-
let exec format output user poll (prog, args) =
156
+
let exec format output user poll (prog, args) open_flags_filter =
142
157
let output =
143
158
match output with
144
159
| Some file -> file
···
190
205
match Atomic.get pid with
191
206
| None -> 0
192
207
| Some pid ->
193
-
(if Int.equal (Open_event.get_pid event) pid then
208
+
(if
209
+
Int.equal (Open_event.get_pid event) pid
210
+
&& filter_event_by_flag event open_flags_filter
211
+
then
194
212
match format with
195
213
| Csv ->
196
214
Out_channel.output_string oc (Open_event.to_csv_row event);
···
228
246
let doc = "Disable printing the CSV header" in
229
247
Arg.(value & flag & info [ "no-header" ] ~doc)
230
248
249
+
let flag_conv =
250
+
let of_string s =
251
+
try Ok (Flags.of_string s) with Invalid_argument m -> Error (`Msg m)
252
+
in
253
+
let pp ppf v = Format.pp_print_string ppf (Flags.to_string v) in
254
+
Arg.conv (of_string, pp)
255
+
256
+
let open_flags_filter =
257
+
let doc =
258
+
"Filter open events that include these flags (e.g. O_RDONLY, O_CREAT). \
259
+
Note the filter wants ALL of the flags to be present not just one of \
260
+
them."
261
+
in
262
+
Arg.(value & opt (list flag_conv) [] & info [ "flags" ] ~doc)
263
+
231
264
let user =
232
265
let doc = "Username or UID to execute program as" in
233
266
Arg.(value & opt (some string) None & info [ "u"; "user" ] ~doc ~docv:"USER")
···
250
283
let output =
251
284
let doc =
252
285
"Output file for trace. Defaults to trace.<csv|json> depending on the \
253
-
$(format)."
286
+
format."
254
287
in
255
288
Arg.(
256
289
value & opt (some string) None & info [ "o"; "output" ] ~docv:"OUTPUT" ~doc)
257
290
258
291
let all_cmd =
259
-
let doc = "Trace all open system calls" in
292
+
let doc = "Trace all open system calls." in
260
293
let man =
261
294
[
262
295
`P
···
266
299
in
267
300
Cmd.v (Cmd.info ~doc ~man "all")
268
301
@@
269
-
let+ polling = polling and+ no_header = no_header in
270
-
all polling no_header
302
+
let+ polling = polling
303
+
and+ no_header = no_header
304
+
and+ open_flags_filter = open_flags_filter in
305
+
all polling no_header open_flags_filter
271
306
272
307
let exec_cmd =
273
-
let doc = "Execute a program and trace its open system calls" in
308
+
let doc = "Execute a program and trace its open system calls." in
274
309
let man =
275
310
[
276
311
`P
···
287
322
and+ format = format
288
323
and+ output = output
289
324
and+ args = Arg.(value & pos_right 0 string [] & Arg.info [] ~docv:"ARGS")
325
+
and+ open_flags_filter = open_flags_filter
290
326
and+ poll = polling in
291
-
exec format output user poll (prog, args)
327
+
exec format output user poll (prog, args) open_flags_filter
292
328
293
329
let opentrace_cmd =
294
330
let doc = "Trace all open system calls" in
295
331
let man =
296
332
[
297
333
`S Manpage.s_description;
298
-
`P "$(cmd) traces all open system calls";
334
+
`P "$(tool) traces all open system calls.";
299
335
`P
300
-
"$(cmd) can be used either to run an executable directly or to trace \
301
-
all open calls";
336
+
"$(tool) can be used either to run an executable directly or to trace \
337
+
all open calls.";
302
338
]
303
339
in
304
340
let default = Term.(ret (const (`Help (`Auto, None)))) in
+7
opentrace.opam
+7
opentrace.opam
···
7
7
"ocaml" {>= "5.2.0"}
8
8
"eio_main"
9
9
"jsonm"
10
+
"dune-configurator"
10
11
"libbpf"
11
12
"libbpf_maps"
12
13
"odoc" {with-doc}
···
25
26
"@doc" {with-doc}
26
27
]
27
28
]
29
+
pin-depends:[
30
+
"eio.dev" "git+https://github.com/patricoferris/eio#9cb52c3c061a1bfee0c6094625415d3c95f735d5"
31
+
"eio_posix.dev" "git+https://github.com/patricoferris/eio#9cb52c3c061a1bfee0c6094625415d3c95f735d5"
32
+
"eio_linux.dev" "git+https://github.com/patricoferris/eio#9cb52c3c061a1bfee0c6094625415d3c95f735d5"
33
+
"eio_main.dev" "git+https://github.com/patricoferris/eio#9cb52c3c061a1bfee0c6094625415d3c95f735d5"
34
+
]
+6
opentrace.opam.template
+6
opentrace.opam.template
···
1
+
pin-depends:[
2
+
"eio.dev" "git+https://github.com/patricoferris/eio#9cb52c3c061a1bfee0c6094625415d3c95f735d5"
3
+
"eio_posix.dev" "git+https://github.com/patricoferris/eio#9cb52c3c061a1bfee0c6094625415d3c95f735d5"
4
+
"eio_linux.dev" "git+https://github.com/patricoferris/eio#9cb52c3c061a1bfee0c6094625415d3c95f735d5"
5
+
"eio_main.dev" "git+https://github.com/patricoferris/eio#9cb52c3c061a1bfee0c6094625415d3c95f735d5"
6
+
]