this repo has no description
patrick.sirref.org
1module F = Libbpf.C.Functions
2module T = Libbpf.C.Types
3
4let bpf_obj_path = "bootstrap.bpf.o"
5let program_names = [ "handle_exec"; "handle_exit" ]
6let rb_name = "rb"
7
8exception Exit of int
9
10let main () =
11 (* Set signal handlers *)
12 let exitting = ref true in
13 let sig_handler = Sys.Signal_handle (fun _ -> exitting := false) in
14 Sys.(set_signal sigint sig_handler);
15 Sys.(set_signal sigterm sig_handler);
16
17 (* Read BPF object *)
18 let obj =
19 match F.bpf_object__open bpf_obj_path with
20 | None ->
21 Printf.eprintf "Failed to open BPF object\n";
22 raise (Exit 1)
23 | Some obj -> obj
24 in
25
26 at_exit (fun () -> F.bpf_object__close obj);
27
28 (* Load BPF object *)
29 if F.bpf_object__load obj = 1 then (
30 Printf.eprintf "Failed to load BPF object\n";
31 raise (Exit 1));
32
33 let progs =
34 let find_exn name =
35 match F.bpf_object__find_program_by_name obj name with
36 | None ->
37 Printf.eprintf "Failed to find bpf program: %s\n" name;
38 raise (Exit 1)
39 | Some p -> p
40 in
41 List.map find_exn program_names
42 in
43
44 (* Attach tracepoint *)
45 let links =
46 let attach_exn prog =
47 match F.bpf_program__attach prog with
48 | Some linkp -> linkp
49 | None ->
50 Printf.eprintf "Failed to attach BPF program\n";
51 raise (Exit 1)
52 in
53 List.map attach_exn progs
54 in
55
56 at_exit (fun () ->
57 List.iter (fun link -> F.bpf_link__destroy link |> ignore) links);
58
59 (* Load maps *)
60 let map =
61 match F.bpf_object__find_map_by_name obj rb_name with
62 | None ->
63 Printf.eprintf "Failed to find map\n";
64 raise (Exit 1)
65 | Some m -> m
66 in
67 let rb_fd = F.bpf_map__fd map in
68
69 (* Describe event handler *)
70 let handle_event _ctx _data _sz =
71 Printf.printf "Handle_event called\n%!";
72 0
73 in
74
75 (* Coerce it to the static_funptr *)
76 let handle_event_f =
77 Ctypes.(
78 coerce
79 (Foreign.funptr ~runtime_lock:false ~check_errno:true
80 (ptr void @-> ptr void @-> size_t @-> returning int))
81 T.ring_buffer_sample_fn handle_event)
82 in
83
84 (* Set up ring buffer polling *)
85 let rb =
86 match
87 F.ring_buffer__new rb_fd handle_event_f Ctypes.null
88 Ctypes.(from_voidp T.ring_buffer_opts null)
89 with
90 | None ->
91 Printf.eprintf "Failed to create ring buffer\n";
92 raise (Exit 1)
93 | Some rb -> rb
94 in
95
96 at_exit (fun () -> F.ring_buffer__free rb);
97
98 while !exitting do
99 Printf.printf "polling\n%!";
100 let err = F.ring_buffer__poll rb 100 in
101 match err with
102 | e when e = Sys.sighup -> raise (Exit 0)
103 | e when e < 0 ->
104 Printf.eprintf "Error polling ring buffer, %d\n" e;
105 raise (Exit 1)
106 | _ -> ()
107 done
108
109let () = try main () with Exit i when i <> 0 -> Printf.eprintf "[Exit %d]" i