this repo has no description
patrick.sirref.org
1open Ctypes
2module C = C
3
4let major_version =
5 C.Functions.libbpf_major_version () |> Unsigned.UInt32.to_int
6
7let minor_version =
8 C.Functions.libbpf_minor_version () |> Unsigned.UInt32.to_int
9
10let version_string = C.Functions.libbpf_version_string ()
11
12let bpf_attach_type_str attach_type =
13 C.Functions.libbpf_bpf_attach_type_str attach_type
14
15let bpf_link_type_str link_type = C.Functions.libbpf_bpf_link_type_str link_type
16let bpf_map_type_str map_type = C.Functions.libbpf_bpf_map_type_str map_type
17let bpf_prog_type_str prog_type = C.Functions.libbpf_bpf_prog_type_str prog_type
18
19type bpf_object = C.Types.bpf_object structure ptr
20
21type bpf_program = {
22 name : string;
23 fd : int;
24 ptr : C.Types.bpf_program structure ptr;
25}
26
27type bpf_map = { fd : int; ptr : C.Types.bpf_map structure ptr }
28type bpf_link = C.Types.bpf_link structure ptr
29
30let failwith_f fmt =
31 let fails s = failwith s in
32 Printf.ksprintf fails fmt
33
34let bpf_object_open obj_file =
35 match C.Functions.bpf_object__open obj_file with
36 | Some obj -> obj
37 | None -> failwith_f "Error opening object file at %s" obj_file
38
39let bpf_object_load bpf_object =
40 let ret = C.Functions.bpf_object__load bpf_object in
41 if ret = 0 then ()
42 else failwith_f "Could not load bpf_object, got exit %d" ret
43
44let bpf_object_find_program_by_name bpf_object name =
45 match C.Functions.bpf_object__find_program_by_name bpf_object name with
46 | Some prog -> { name; fd = C.Functions.bpf_program__fd prog; ptr = prog }
47 | None -> failwith_f "Program name %s not found" name
48
49let bpf_program_attach ({ name; ptr; _ } : bpf_program) =
50 match C.Functions.bpf_program__attach ptr with
51 | Some link -> link
52 | None -> failwith_f "Error attaching program %s" name
53
54let bpf_program_fd (prog : bpf_program) = prog.fd
55
56let bpf_object_find_map_by_name bpf_object name =
57 match C.Functions.bpf_object__find_map_by_name bpf_object name with
58 | Some ptr -> { fd = C.Functions.bpf_map__fd ptr; ptr }
59 | None -> failwith_f "Map %s not found" name
60
61let bpf_map_fd (map : bpf_map) = map.fd
62
63let bpf_link_destroy bpf_link =
64 match C.Functions.bpf_link__destroy bpf_link with
65 | e when e <> 0 -> Printf.eprintf "Failed to destroy link %d\n" e
66 | _ -> ()
67
68let bpf_object_close bpf_object = C.Functions.bpf_object__close bpf_object
69
70let with_bpf_object_open_load_link ~obj_path ~program_names
71 ?(before_link = Stdlib.ignore) fn =
72 let obj = bpf_object_open obj_path in
73 bpf_object_load obj;
74
75 let cleanup ?links obj =
76 Option.iter (List.iter bpf_link_destroy) links;
77 bpf_object_close obj
78 in
79
80 (* Programs to load cannot be zero *)
81 if program_names = [] then (
82 cleanup obj;
83 failwith "Need to specify at least one program to load");
84
85 (* Get list of programs *)
86 let programs, not_found =
87 List.fold_left
88 (fun (succ, fail) name ->
89 match C.Functions.bpf_object__find_program_by_name obj name with
90 | None -> (succ, name :: fail)
91 | Some prog -> ((prog, name) :: succ, fail))
92 ([], []) program_names
93 in
94 if not_found <> [] then (
95 cleanup obj;
96 failwith_f "Failed to find %s programs" (String.concat "," not_found));
97
98 (* Run before_link user initialization code *)
99 (try before_link obj
100 with e ->
101 bpf_object_close obj;
102 raise e);
103
104 (* Get list of links *)
105 let links, not_attached =
106 List.fold_left
107 (fun (succ, fail) (prog, name) ->
108 match C.Functions.bpf_program__attach prog with
109 | None -> (succ, name :: fail)
110 | Some prog -> (prog :: succ, fail))
111 ([], []) programs
112 in
113 if not_attached <> [] then (
114 (* Detached successfully attached before shutdown *)
115 cleanup ~links obj;
116 failwith_f "Failed to link %s programs" (String.concat "," not_attached));
117
118 (* Run user program *)
119 (try fn obj links
120 with e ->
121 cleanup ~links obj;
122 raise e);
123
124 (* Ensure proper shutdown *)
125 cleanup ~links obj
126
127let bpf_map_lookup_value ~key_ty ~val_ty ~val_zero bpf_map key =
128 let key = allocate key_ty key in
129 let sz_key = sizeof key_ty |> Unsigned.Size_t.of_int in
130 let value = allocate val_ty val_zero in
131 let sz_val = sizeof val_ty |> Unsigned.Size_t.of_int in
132 let err =
133 C.Functions.bpf_map__lookup_elem bpf_map.ptr (to_voidp key) sz_key
134 (to_voidp value) sz_val Unsigned.UInt64.zero
135 in
136 if err = 0 then !@value
137 else
138 let err = Printf.sprintf "bpf_map_lookup_value got %d" err in
139 raise (Sys_error err)
140
141let bpf_map_update_elem ~key_ty ~val_ty bpf_map key value =
142 let key = allocate key_ty key in
143 let sz_key = sizeof key_ty |> Unsigned.Size_t.of_int in
144 let value = allocate val_ty value in
145 let sz_val = sizeof val_ty |> Unsigned.Size_t.of_int in
146 let err =
147 C.Functions.bpf_map__update_elem bpf_map.ptr (to_voidp key) sz_key
148 (to_voidp value) sz_val Unsigned.UInt64.zero
149 in
150 if err = 0 then ()
151 else
152 let err = Printf.sprintf "bpf_map_update_value got %d" err in
153 raise (Sys_error err)