this repo has no description
Plenty of work
+2870
-83
+2
-2
src/bin/main.ml
+2
-2
src/bin/main.ml
···
21
21
match Sys.argv.(1) with
22
22
| "shelter" ->
23
23
let dir = state_dir env#fs "shelter" in
24
-
Shelter.main env#clock env#process_mgr dir
24
+
Shelter.main env#fs env#clock env#process_mgr dir
25
25
| _ | (exception Invalid_argument _) ->
26
26
let dir = state_dir env#fs "passthrough" in
27
-
Pass.main env#clock env#process_mgr dir
27
+
Pass.main env#fs env#clock env#process_mgr dir
+10
-10
src/lib/cshell.ml
+10
-10
src/lib/cshell.ml
···
4
4
module Make (H : History.S) (Engine : Engine.S with type entry = H.t) = struct
5
5
module Store = Irmin_fs_unix.KV.Make (H)
6
6
7
-
let run clock proc store =
7
+
let run fs clock proc store =
8
8
let store = History.Store ((module Store), store) in
9
-
Engine.init store;
10
-
let rec loop store exit_code =
9
+
let initial_ctx = Engine.init fs proc store in
10
+
let rec loop store ctx exit_code =
11
11
let prompt = Engine.prompt exit_code store in
12
12
match LNoise.linenoise prompt with
13
13
| None -> ()
14
14
| Some input -> (
15
15
let action = Engine.action_of_command input in
16
-
match Engine.run clock proc store action with
16
+
match Engine.run fs clock proc (store, ctx) action with
17
17
| Error (Eio.Process.Child_error exit_code) ->
18
18
Fmt.epr "%a\n%!" Eio.Process.pp_status exit_code;
19
-
loop store exit_code
19
+
loop store ctx exit_code
20
20
| Error (Eio.Process.Executable_not_found m) ->
21
21
Fmt.epr "cshell: excutable not found %s\n%!" m;
22
-
loop store (`Exited 127)
23
-
| Ok store -> loop store (`Exited 0))
22
+
loop store ctx (`Exited 127)
23
+
| Ok (store, ctx) -> loop store ctx (`Exited 0))
24
24
in
25
-
loop store (`Exited 0)
25
+
loop store initial_ctx (`Exited 0)
26
26
27
-
let main clock proc directory =
27
+
let main fs clock proc directory =
28
28
Irmin_fs.run directory @@ fun () ->
29
29
let conf = Irmin_fs.config (Eio.Path.native_exn directory) in
30
30
let repo = Store.Repo.v conf in
31
31
let store = Store.main repo in
32
-
run clock proc store
32
+
run fs clock proc store
33
33
end
+12
-3
src/lib/engine.ml
+12
-3
src/lib/engine.ml
···
7
7
8
8
type entry
9
9
10
-
val init : entry History.t -> unit
10
+
type ctx
11
+
(** A context that is not persisted, but is passed through each loop of the
12
+
shell *)
13
+
14
+
val init :
15
+
_ Eio.Path.t ->
16
+
Eio_unix.Process.mgr_ty Eio_unix.Process.mgr ->
17
+
entry History.t ->
18
+
ctx
11
19
(** [init store] will be called before entering the shell loop. You may wish
12
20
to setup history completions etc. with LNoise. *)
13
21
14
22
val run :
23
+
_ Eio.Path.t ->
15
24
_ Eio.Time.clock ->
16
25
Eio_unix.Process.mgr_ty Eio_unix.Process.mgr ->
17
-
entry History.t ->
26
+
entry History.t * ctx ->
18
27
action ->
19
-
(entry History.t, Eio.Process.error) result
28
+
(entry History.t * ctx, Eio.Process.error) result
20
29
(** [run history action] runs the action in [history]. Return a new [history]
21
30
that can be persisted *)
22
31
+9
-5
src/lib/passthrough/cshell_passthrough.ml
+9
-5
src/lib/passthrough/cshell_passthrough.ml
···
16
16
let history_key = [ "history" ]
17
17
let key () = history_key @ [ string_of_float @@ Unix.gettimeofday () ]
18
18
19
-
let init (Cshell.History.Store ((module S), store) : entry Cshell.History.t) =
19
+
type ctx = unit
20
+
21
+
let init _ _ (Cshell.History.Store ((module S), store) : entry Cshell.History.t)
22
+
=
20
23
match S.list store history_key with
21
24
| [] -> ()
22
25
| xs ->
···
30
33
in
31
34
List.iter (fun v -> LNoise.history_add v |> ignore) entries
32
35
33
-
let run clock proc
34
-
((Cshell.History.Store ((module S), store) : entry Cshell.History.t) as
35
-
full_store) (Exec command) =
36
+
let run _fs clock proc
37
+
( ((Cshell.History.Store ((module S), store) : entry Cshell.History.t) as
38
+
full_store),
39
+
() ) (Exec command) =
36
40
let info () =
37
41
S.Info.v ~message:"cshell" (Eio.Time.now clock |> Int64.of_float)
38
42
in
···
47
51
if res = `Exited 0 then (
48
52
S.set_exn ~info store (key ()) command;
49
53
let _ : (unit, string) result = LNoise.history_add command in
50
-
Ok full_store)
54
+
Ok (full_store, ()))
51
55
else Error (Eio.Process.Child_error res)
52
56
with Eio.Exn.Io (Eio.Process.E e, _) -> Error e
+39
src/lib/shelter/diff.ml
+39
src/lib/shelter/diff.ml
···
1
+
type diff =
2
+
| Modified of string
3
+
| Created of string
4
+
| Renamed of string * string
5
+
| Removed of string
6
+
[@@deriving repr]
7
+
8
+
type t = diff list [@@deriving repr]
9
+
10
+
let truncate_path s =
11
+
match Astring.String.cut ~sep:"rootfs" s with Some (_, p) -> p | None -> s
12
+
13
+
let parse_row = function
14
+
| [ "M"; s ] ->
15
+
let path = truncate_path s in
16
+
if String.equal path "" then None else Some (Modified path)
17
+
| [ "+"; s ] ->
18
+
let path = truncate_path s in
19
+
if String.equal path "" then None else Some (Created path)
20
+
| [ "R"; a; b ] ->
21
+
let a_path = truncate_path a in
22
+
let b_path = truncate_path b in
23
+
Some (Renamed (a_path, b_path))
24
+
| [ "-"; s ] ->
25
+
let path = truncate_path s in
26
+
if String.equal path "" then None else Some (Removed path)
27
+
| s ->
28
+
Fmt.invalid_arg "Unknown ZFS diff: %a"
29
+
(Fmt.list ~sep:Fmt.comma Fmt.string)
30
+
s
31
+
32
+
let of_zfs s : t =
33
+
let lines = String.split_on_char '\n' s in
34
+
let tsv =
35
+
List.map (String.split_on_char '\t') lines
36
+
|> List.map (List.filter (fun s -> not (String.equal "" s)))
37
+
|> List.filter (function [] -> false | _ -> true)
38
+
in
39
+
List.filter_map parse_row tsv
+1
-1
src/lib/shelter/dune
+1
-1
src/lib/shelter/dune
+26
src/lib/shelter/fetch.ml
+26
src/lib/shelter/fetch.ml
···
1
+
let ( / ) = Eio.Path.( / )
2
+
3
+
let get_image ~dir ~proc image =
4
+
let container_id =
5
+
Eio.Process.parse_out proc Eio.Buf_read.take_all
6
+
[ "docker"; "run"; "-d"; image ]
7
+
|> String.trim
8
+
in
9
+
let tar = image ^ ".tar.gz" in
10
+
let dir_s = Eio.Path.native_exn dir in
11
+
let () =
12
+
Eio.Process.run proc
13
+
[ "docker"; "export"; container_id; "-o"; Filename.concat dir_s tar ]
14
+
in
15
+
Eio.Path.mkdir ~perm:0o777 (dir / "rootfs");
16
+
let () =
17
+
Eio.Process.run proc
18
+
[
19
+
"tar";
20
+
"-xf";
21
+
Filename.concat dir_s "alpine.tar.gz";
22
+
"-C";
23
+
Filename.concat dir_s "rootfs";
24
+
]
25
+
in
26
+
Filename.concat dir_s "rootfs"
+173
-56
src/lib/shelter/shelter.ml
+173
-56
src/lib/shelter/shelter.ml
···
1
1
open Eio
2
+
module Store = Store
3
+
module H = Cshell.History
2
4
3
-
module Build = struct
4
-
type cid = Cid.t
5
+
module History = struct
6
+
type mode = Void.mode
5
7
6
-
let cid_of_string s =
7
-
match Cid.of_string s with
8
-
| Ok v -> v
9
-
| Error (`Msg m) -> failwith m
10
-
| Error (`Unsupported _) -> failwith "unsupported cid"
8
+
let mode_t =
9
+
Repr.map Repr.string
10
+
(function
11
+
| "R" -> Void.R | "RW" -> Void.RW | _ -> failwith "Malformed Void.mode")
12
+
(function Void.R -> "R" | Void.RW -> "RW")
11
13
12
-
let cid_t = Repr.map Repr.string cid_of_string Cid.to_string
13
-
14
-
type t = Image of string | Build of cid [@@deriving repr]
15
-
end
16
-
17
-
type mode = R | RW [@@deriving repr]
18
-
19
-
module History = struct
20
-
type t = { mode : mode; build : Build.t; args : string list }
14
+
type t = {
15
+
mode : mode;
16
+
build : Store.Build.t;
17
+
args : string list;
18
+
time : int64;
19
+
diff : Diff.t;
20
+
}
21
21
[@@deriving repr]
22
22
23
23
let merge = Irmin.Merge.(default (Repr.option t))
···
26
26
type entry = History.t
27
27
28
28
type action =
29
-
| Set_mode of mode
29
+
| Set_mode of History.mode
30
30
| Set_session of string
31
31
| Exec of string list
32
32
| Info
33
+
| Undo
34
+
| Fork of string
35
+
| Replay of string
33
36
| Unknown of string list
37
+
| History
34
38
[@@deriving repr]
35
39
36
40
let split_and_remove_empty s =
···
39
43
let action = action_t
40
44
41
45
let shelter_action = function
42
-
| "set" :: "mode" :: [ "r" ] -> Set_mode R
43
-
| "set" :: "mode" :: [ "rw" ] -> Set_mode R
46
+
| "mode" :: [ "r" ] -> Set_mode R
47
+
| "mode" :: [ "rw" ] -> Set_mode R
44
48
| "session" :: [ m ] -> Set_session m
49
+
| "fork" :: [ m ] -> Fork m
50
+
| "replay" :: [ onto ] -> Replay onto
45
51
| [ "info" ] -> Info
52
+
| [ "undo" ] -> Undo
53
+
| [ "history" ] -> History
46
54
| other -> Unknown other
47
55
48
56
let action_of_command cmd =
···
54
62
let history_key = [ "history" ]
55
63
let key clock = history_key @ [ string_of_float @@ Eio.Time.now clock ]
56
64
57
-
let list (Cshell.History.Store ((module S), store) : entry Cshell.History.t) =
65
+
let list (H.Store ((module S), store) : entry H.t) =
58
66
match S.list store history_key with
59
67
| [] -> []
60
68
| xs ->
···
64
72
| [] -> List.rev acc
65
73
in
66
74
loop [] (List.map (fun (v, tree) -> (v, S.Tree.to_concrete tree)) xs)
67
-
|> List.stable_sort (fun (s1, _) (s2, _) -> String.compare s1 s2)
75
+
|> List.stable_sort (fun (s1, _) (s2, _) ->
76
+
Float.compare (Float.of_string s1) (Float.of_string s2))
68
77
|> List.rev
69
78
70
79
let with_latest ~default s f =
···
72
81
73
82
let text c = Fmt.(styled (`Fg c) string)
74
83
75
-
let sessions (Cshell.History.Store ((module S), store) : entry Cshell.History.t)
76
-
=
84
+
let sessions (H.Store ((module S), store) : entry H.t) =
77
85
S.Branch.list (S.repo store)
78
86
79
-
let commit ~message clock
80
-
(Cshell.History.Store ((module S), store) : entry Cshell.History.t) v =
87
+
let commit ~message clock (H.Store ((module S), store) : entry H.t) v =
81
88
let info () = S.Info.v ~message (Eio.Time.now clock |> Int64.of_float) in
82
89
S.set_exn ~info store (key clock) v
83
90
84
-
let which_branch
85
-
((Cshell.History.Store ((module S), session) : entry Cshell.History.t) as s)
86
-
=
91
+
let which_branch ((H.Store ((module S), session) : entry H.t) as s) =
87
92
let branches = sessions s in
88
93
let repo = S.repo session in
89
94
let heads = List.map (fun b -> (S.Branch.find repo b, b)) branches in
90
95
let head = S.Head.find session in
91
96
List.assoc_opt head heads
92
97
93
-
let prompt status
94
-
((Cshell.History.Store ((module S), _session) : entry Cshell.History.t) as
95
-
store) =
98
+
(* Reset the head of the current session by one commit *)
99
+
let reset_hard ((H.Store ((module S), session) : entry H.t) as s) =
100
+
match
101
+
List.filter_map (S.Commit.of_hash (S.repo session))
102
+
@@ S.Commit.parents (S.Head.get session)
103
+
with
104
+
| [] -> s
105
+
| p :: _ ->
106
+
S.Head.set session p;
107
+
s
108
+
109
+
(* Fork a new session from an existing one *)
110
+
let fork (H.Store ((module S), session) : entry H.t) new_branch =
111
+
let repo = S.repo session in
112
+
match (S.Head.find session, S.Branch.find repo new_branch) with
113
+
| _, Some _ ->
114
+
Error (new_branch ^ " already exists, try @ session " ^ new_branch)
115
+
| None, _ -> Error "Current branch needs at least one commit"
116
+
| Some commit, None ->
117
+
let new_store = S.of_branch (S.repo session) new_branch in
118
+
S.Branch.set repo new_branch commit;
119
+
let store = H.Store ((module S), new_store) in
120
+
Ok store
121
+
122
+
(* Fork a new session from an existing one *)
123
+
let display_history (H.Store ((module S), session) : entry H.t) =
124
+
let history = S.history ~depth:max_int session in
125
+
let content c =
126
+
H.Store ((module S), S.of_commit c) |> list |> List.hd |> snd
127
+
in
128
+
let pp_diff fmt d =
129
+
if d = [] then () else Fmt.pf fmt "\n %a" (Repr.pp Diff.t) d
130
+
in
131
+
let pp_entry fmt (e : entry) =
132
+
Fmt.pf fmt "%-10s %s%a"
133
+
Fmt.(str "%a" (styled (`Fg `Yellow) uint64_ns_span) e.time)
134
+
(String.concat " " e.args) pp_diff e.diff
135
+
in
136
+
let linearize =
137
+
S.History.fold_vertex (fun c v -> content c :: v) history [] |> List.rev
138
+
in
139
+
List.iter (fun c -> Fmt.pr "%a\n%!" pp_entry c) linearize
140
+
141
+
let prompt status ((H.Store ((module S), _session) : entry H.t) as store) =
96
142
let sesh = Option.value ~default:"main" (which_branch store) in
97
143
let prompt () =
98
144
Fmt.(styled (`Fg `Yellow) string) Format.str_formatter "shelter> ";
···
112
158
in
113
159
with_latest store ~default:prompt prompt_entry
114
160
115
-
let init s =
161
+
type ctx = Store.t
162
+
163
+
let init fs proc s =
164
+
let store = Store.init fs proc "test-pool" in
116
165
List.iter
117
166
(fun (_, { History.args; _ }) ->
118
167
LNoise.history_add (String.concat " " args) |> ignore)
119
-
(list s)
168
+
(list s);
169
+
store
120
170
121
-
let run clock proc
122
-
((Cshell.History.Store ((module S), store) : entry Cshell.History.t) as s) =
123
-
function
171
+
let run _fs clock _proc (((H.Store ((module S), store) : entry H.t) as s), ctx)
172
+
= function
124
173
| Set_mode mode ->
125
-
with_latest ~default:(fun _ -> Ok s) s @@ fun (_, entry) ->
174
+
with_latest ~default:(fun _ -> Ok (s, ctx)) s @@ fun (_, entry) ->
126
175
commit ~message:"mode change" clock s { entry with mode };
127
-
Ok s
176
+
Ok (s, ctx)
128
177
| Set_session m ->
129
-
with_latest ~default:(fun _ -> Ok s) s @@ fun (_, entry) ->
178
+
with_latest ~default:(fun _ -> Ok (s, ctx)) s @@ fun (_, entry) ->
130
179
let new_store = S.of_branch (S.repo store) m in
131
-
let new_full_store = Cshell.History.Store ((module S), new_store) in
180
+
let new_full_store = H.Store ((module S), new_store) in
132
181
commit ~message:"new session" clock new_full_store entry;
133
-
Ok new_full_store
182
+
Ok (new_full_store, ctx)
134
183
| Unknown args ->
135
184
Fmt.epr "%a: %s\n%!" (text `Red) "Unknown Shelter Action"
136
185
(String.concat " " args);
137
-
Ok s
186
+
Ok (s, ctx)
138
187
| Info ->
139
188
let sessions = sessions s in
140
189
let sesh = Option.value ~default:"main" (which_branch s) in
···
144
193
in
145
194
let commits =
146
195
S.History.fold_vertex
147
-
(fun commit acc ->
196
+
(fun commit acc ->
148
197
let info = S.Commit.info commit |> S.Info.message in
149
198
let hash = S.Commit.hash commit |> Repr.to_string S.Hash.t in
150
-
((String.sub hash 0 7), info) :: acc)
199
+
(String.sub hash 0 7, info) :: acc)
151
200
history []
152
201
in
153
-
Fmt.pr "Sessions: %a\nCurrent: %a\nCommits:@. %a\n%!"
202
+
let latest =
203
+
with_latest
204
+
~default:(fun () -> None)
205
+
s
206
+
(fun (_, e) -> Some (Repr.to_string Store.Build.t e.build))
207
+
in
208
+
Fmt.pr "Sessions: %a\nCurrent: %a\nHash: %a\nCommits:@. %a\n%!"
154
209
Fmt.(list ~sep:(Fmt.any ", ") string)
155
210
sessions (text `Green) sesh
211
+
Fmt.(option string)
212
+
latest
156
213
Fmt.(vbox ~indent:2 @@ list pp_commit)
157
214
commits;
158
-
Ok s
159
-
| Exec [] -> Ok s
215
+
Ok (s, ctx)
216
+
| Exec [] -> Ok (s, ctx)
217
+
| Undo -> Ok (reset_hard s, ctx)
218
+
| Fork new_branch -> (
219
+
match fork s new_branch with
220
+
| Error err ->
221
+
Fmt.pr "[fork]: %a\n%!" (text `Red) err;
222
+
Ok (s, ctx)
223
+
| Ok store -> Ok (store, ctx))
224
+
| Replay _ -> Ok (s, ctx)
225
+
| History ->
226
+
display_history s;
227
+
Ok (s, ctx)
160
228
| Exec command -> (
161
-
Switch.run @@ fun sw ->
229
+
let entry =
230
+
with_latest
231
+
~default:(fun () ->
232
+
History.
233
+
{
234
+
mode = Void.RW;
235
+
build = Store.Build.Image "alpine";
236
+
args = command;
237
+
time = 0L;
238
+
diff = [];
239
+
})
240
+
s
241
+
@@ fun (_, e) -> e
242
+
in
243
+
let build =
244
+
match entry.build with
245
+
| Store.Build.Image img -> Store.fetch ctx img
246
+
| Store.Build.Build cid -> cid
247
+
in
248
+
let hash_entry = { entry with build = Build build; args = command } in
249
+
let new_cid = Store.cid (Repr.to_string History.t hash_entry) in
250
+
let with_rootfs fn =
251
+
if entry.mode = R then (Store.Run.with_build ctx build fn, [])
252
+
else Store.Run.with_clone ctx ~src:build new_cid fn
253
+
in
162
254
try
163
-
let proc = Eio.Process.spawn ~sw proc [ "bash"; "-c"; String.concat " " command ] in
164
-
let res = Eio.Process.await proc in
165
-
if res = `Exited 0 then (
166
-
let entry =
167
-
History.{ mode = RW; build = Image "TODO"; args = command }
255
+
let new_entry, diff =
256
+
with_rootfs @@ fun rootfs ->
257
+
let void =
258
+
Void.empty
259
+
|> Void.rootfs ~mode:entry.mode rootfs
260
+
|> Void.exec [ "/bin/ash"; "-c"; String.concat " " command ]
261
+
in
262
+
Switch.run @@ fun sw ->
263
+
let start = Mtime_clock.now () in
264
+
let proc = Void.spawn ~sw void in
265
+
let res =
266
+
Void.exit_status proc |> Eio.Promise.await |> Void.to_eio_status
168
267
in
169
-
commit ~message:("exec " ^ (String.concat " " command)) clock s entry;
268
+
let stop = Mtime_clock.now () in
269
+
let span = Mtime.span start stop in
270
+
let time = Mtime.Span.to_uint64_ns span in
271
+
(* Add command to history regardless of exit status *)
170
272
let _ : (unit, string) result =
171
273
LNoise.history_add (String.concat " " command)
172
274
in
173
-
Ok s)
174
-
else Error (Eio.Process.Child_error res)
275
+
if res = `Exited 0 then
276
+
if entry.mode = RW then
277
+
Ok { hash_entry with build = Build new_cid; time }
278
+
else Ok hash_entry
279
+
else Error (Eio.Process.Child_error res)
280
+
in
281
+
match new_entry with
282
+
| Error e -> Error e
283
+
| Ok entry ->
284
+
(* Set diff *)
285
+
let entry = { entry with diff } in
286
+
(* Commit if RW *)
287
+
if entry.mode = RW then
288
+
commit
289
+
~message:("exec " ^ String.concat " " command)
290
+
clock s entry;
291
+
Ok (s, ctx)
175
292
with Eio.Exn.Io (Eio.Process.E e, _) -> Error e)
+8
-6
src/lib/shelter/shelter.mli
+8
-6
src/lib/shelter/shelter.mli
···
1
-
module Build : sig
2
-
type t = Image of string | Build of Cid.t [@@deriving repr]
3
-
end
4
-
5
-
type mode = R | RW
1
+
module Store = Store
6
2
7
3
module History : sig
8
-
type t = { mode : mode; build : Build.t; args : string list }
4
+
type t = {
5
+
mode : Void.mode;
6
+
build : Store.Build.t;
7
+
args : string list;
8
+
time : int64;
9
+
diff : Diff.t;
10
+
}
9
11
[@@deriving repr]
10
12
11
13
include Irmin.Contents.S with type t := t
+158
src/lib/shelter/store.ml
+158
src/lib/shelter/store.ml
···
1
+
(* A store a bit like OBuilder's but a little simplified
2
+
for our purposes *)
3
+
module Build = struct
4
+
type cid = Cid.t
5
+
6
+
let cid_of_string s =
7
+
match Cid.of_string s with
8
+
| Ok v -> v
9
+
| Error (`Msg m) -> failwith m
10
+
| Error (`Unsupported _) -> failwith "unsupported cid"
11
+
12
+
let cid_t = Repr.map Repr.string cid_of_string Cid.to_string
13
+
14
+
type t = Image of string | Build of cid [@@deriving repr]
15
+
end
16
+
17
+
type path = string list
18
+
19
+
type t = {
20
+
fs : Eio.Fs.dir_ty Eio.Path.t;
21
+
proc : Eio_unix.Process.mgr_ty Eio_unix.Process.mgr;
22
+
zfs : Zfs.Handle.t;
23
+
pool : string;
24
+
}
25
+
26
+
module Datasets : sig
27
+
type dataset = private string
28
+
type snapshot = private string
29
+
30
+
val builds : string -> dataset
31
+
val build : string -> string -> dataset
32
+
val snapshot : dataset -> snapshot
33
+
end = struct
34
+
type dataset = string
35
+
type snapshot = string
36
+
37
+
let ( / ) a b = a ^ "/" ^ b
38
+
let builds pool : dataset = pool / "builds"
39
+
let build pool path : dataset = builds pool / path
40
+
let snapshot ds = ds ^ "@snappy"
41
+
end
42
+
43
+
let with_dataset ?(typ = Zfs.Types.filesystem) t dataset f =
44
+
let exists = Zfs.exists t.zfs (dataset :> string) typ in
45
+
if not exists then Zfs.create t.zfs dataset typ;
46
+
let dataset = Zfs.open_ t.zfs dataset typ in
47
+
Fun.protect ~finally:(fun () -> Zfs.close dataset) (fun () -> f dataset)
48
+
49
+
let mount_dataset ?(typ = Zfs.Types.dataset) t (dataset : Datasets.dataset) =
50
+
match Zfs.is_mounted t.zfs (dataset :> string) with
51
+
| Some _ -> ()
52
+
| None -> with_dataset ~typ t (dataset :> string) @@ fun d -> Zfs.mount d
53
+
54
+
let unmount_dataset t (dataset : Datasets.dataset) =
55
+
match Zfs.is_mounted t.zfs (dataset :> string) with
56
+
| None -> ()
57
+
| Some _ ->
58
+
with_dataset t (dataset :> string) @@ fun d ->
59
+
let _todo () = Zfs.unmount d in
60
+
()
61
+
62
+
let create_dataset t (dataset : Datasets.dataset) =
63
+
with_dataset t (dataset :> string) (fun _ -> ())
64
+
65
+
let create_and_mount t (dataset : Datasets.dataset) =
66
+
create_dataset t dataset;
67
+
mount_dataset t dataset
68
+
69
+
let init fs proc pool =
70
+
let zfs = Zfs.init () in
71
+
Zfs.debug zfs true;
72
+
let t =
73
+
{
74
+
fs :> Eio.Fs.dir_ty Eio.Path.t;
75
+
proc :> Eio_unix.Process.mgr_ty Eio_unix.Process.mgr;
76
+
zfs;
77
+
pool;
78
+
}
79
+
in
80
+
create_and_mount t (Datasets.builds t.pool);
81
+
t
82
+
83
+
let snapshot t (snap : Datasets.snapshot) =
84
+
let exists = Zfs.exists t.zfs (snap :> string) Zfs.Types.snapshot in
85
+
if not exists then Zfs.snapshot t.zfs (snap :> string) true
86
+
87
+
let clone t (snap : Datasets.snapshot) (tgt : Datasets.dataset) =
88
+
with_dataset ~typ:Zfs.Types.snapshot t (snap :> string) @@ fun src ->
89
+
Zfs.clone src (tgt :> string)
90
+
91
+
let read_all fd =
92
+
let buf = Buffer.create 128 in
93
+
let bytes = Bytes.create 4096 in
94
+
let rec loop () =
95
+
match Unix.read fd bytes 0 4096 with
96
+
| 0 | (exception End_of_file) -> Buffer.contents buf
97
+
| n ->
98
+
Buffer.add_bytes buf (Bytes.sub bytes 0 n);
99
+
loop ()
100
+
in
101
+
loop ()
102
+
103
+
let diff t (data : Datasets.snapshot) (snap : Datasets.snapshot) =
104
+
let data_fs =
105
+
String.sub (data :> string) 0 (String.index (data :> string) '@')
106
+
in
107
+
let zh = Zfs.open_ t.zfs data_fs Zfs.Types.filesystem in
108
+
let diff =
109
+
let r, w = Unix.pipe ~cloexec:false () in
110
+
try
111
+
Zfs.show_diff zh ~from_:(data :> string) ~to_:(snap :> string) w;
112
+
let f = read_all r in
113
+
Unix.close r;
114
+
f
115
+
with e ->
116
+
Unix.close r;
117
+
raise e
118
+
in
119
+
Zfs.close zh;
120
+
Diff.of_zfs diff
121
+
122
+
let cid s =
123
+
let hash =
124
+
Multihash_digestif.of_cstruct `Sha2_256 (Cstruct.of_string s)
125
+
|> Result.get_ok
126
+
in
127
+
Cid.v ~version:`Cidv1 ~base:`Base32 ~codec:`Raw ~hash
128
+
129
+
let fetch t image =
130
+
let cid = cid image in
131
+
let cids = cid |> Cid.to_string in
132
+
let dataset = Datasets.build t.pool cids in
133
+
let dir = Eio.Path.(t.fs / ("/" ^ (Datasets.build t.pool cids :> string))) in
134
+
if Zfs.exists t.zfs (dataset :> string) Zfs.Types.filesystem then cid
135
+
else (
136
+
create_and_mount t dataset;
137
+
let _dir : string = Fetch.get_image ~dir ~proc:t.proc image in
138
+
snapshot t (Datasets.snapshot dataset);
139
+
cid)
140
+
141
+
module Run = struct
142
+
let with_build t cid fn =
143
+
let ds = Datasets.build t.pool (Cid.to_string cid) in
144
+
Fun.protect ~finally:(fun () -> unmount_dataset t ds) @@ fun () ->
145
+
mount_dataset t ds;
146
+
fn ("/" ^ (ds :> string) ^ "/rootfs")
147
+
148
+
let with_clone t ~src new_cid fn =
149
+
let ds = Datasets.build t.pool (Cid.to_string src) in
150
+
let tgt = Datasets.build t.pool (Cid.to_string new_cid) in
151
+
let src_snap = Datasets.snapshot ds in
152
+
let tgt_snap = Datasets.snapshot tgt in
153
+
clone t src_snap tgt;
154
+
let v = with_build t new_cid fn in
155
+
snapshot t tgt_snap;
156
+
let d = diff t src_snap tgt_snap in
157
+
(v, d)
158
+
end
+33
vendor/ocaml-libbpf/.gitignore
+33
vendor/ocaml-libbpf/.gitignore
···
1
+
*.annot
2
+
*.cmo
3
+
*.cma
4
+
*.cmi
5
+
*.a
6
+
*.o
7
+
*.cmx
8
+
*.cmxs
9
+
*.cmxa
10
+
11
+
# ocamlbuild working directory
12
+
_build/
13
+
14
+
# ocamlbuild targets
15
+
*.byte
16
+
*.native
17
+
18
+
# oasis generated files
19
+
setup.data
20
+
setup.log
21
+
22
+
# Merlin configuring file for Vim and Emacs
23
+
.merlin
24
+
25
+
# Dune generated files
26
+
*.install
27
+
28
+
# Local OPAM switch
29
+
_opam/
30
+
31
+
# generated files
32
+
*.txt
33
+
*.bin
+12
vendor/ocaml-libbpf/CHANGES.md
+12
vendor/ocaml-libbpf/CHANGES.md
···
1
+
## v0.1.1 (2024-07-05)
2
+
- Improve documentation
3
+
4
+
## v0.1.0 (2024-07-01)
5
+
- Initial release.
6
+
7
+
`ocaml_libbpf`:
8
+
- [supported](./supported.json) bindings
9
+
- high level API's for open/load/attach/teardown
10
+
11
+
`ocaml_libbpf_maps`:
12
+
- high level API's for BPF ring_buffer map
+15
vendor/ocaml-libbpf/LICENSE.md
+15
vendor/ocaml-libbpf/LICENSE.md
···
1
+
/*
2
+
* Copyright (C) 2024 Lee Koon Wen
3
+
*
4
+
* Permission to use, copy, modify, and distribute this software for any
5
+
* purpose with or without fee is hereby granted, provided that the above
6
+
* copyright notice and this permission notice appear in all copies.
7
+
*
8
+
* THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
9
+
* WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
10
+
* MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
11
+
* ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
12
+
* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
13
+
* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
14
+
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
15
+
*/
+220
vendor/ocaml-libbpf/README.md
+220
vendor/ocaml-libbpf/README.md
···
1
+
[](https://ocaml.ci.dev/github/koonwen/ocaml-libbpf)
2
+
- [API documentation](https://koonwen.github.io/ocaml-libbpf/)
3
+
4
+
# ocaml-libbpf
5
+
Libbpf C-bindings for loading eBPF ELF files into the kernel with OCaml.
6
+
7
+
Writing eBPF programs consist of two distinct parts. Implementing the
8
+
code that executes in-kernel **and** user-level code responsible for
9
+
loading/initializing/linking/teardown of the in-kernel code. This
10
+
OCaml library provides the latter via binding the C
11
+
[libbpf](https://github.com/libbpf/libbpf) library. It exposes both
12
+
the raw low-level bindings as well as a set of high-level API's for
13
+
handling your eBPF objects. As of now, the kernel part must still be
14
+
written in [restricted
15
+
C](https://stackoverflow.com/questions/57688344/what-is-not-allowed-in-restricted-c-for-ebpf)
16
+
and compiled with llvm to eBPF bytecode.
17
+
18
+
The full API set of Libbpf is quite large, see [supported](supported.json) for the list
19
+
of currently bound API's. Contributions are welcome.
20
+
21
+
### External dependencies
22
+
ocaml-libbpf depends on the system package of `libbpf`.
23
+
24
+
# Usage
25
+
> ⚠️ **Disambiguation:** The name of this repository and
26
+
> references to it will be "ocaml-libbpf". However, the library's
27
+
> entry module and package name is **Libbpf**. To install it, you
28
+
> would use `opam install libbpf`. To access it's High-level API's use
29
+
> `Libbpf.<api>`. To use the raw bindings, they are exposed in
30
+
> `Libbpf.C.<api>` namespace.
31
+
32
+
See `examples` directory on how ocaml-libbpf can be used to load eBPF
33
+
ELF files into the kernel and interact with the loaded kernel program.
34
+
The eBPF kernel programs are defined in *.bpf.c source files and are
35
+
compiled with clang as specified in the `dune` rules. ocaml-libbpf
36
+
exposes some high-level API's exposed by the toplevel `Libbpf` module
37
+
to make it easy to perform repetitive tasks such as
38
+
open/load/linking/initializing/teardown of bpf programs.
39
+
40
+
To run these examples, clone this repository and set up the package with
41
+
```bash
42
+
git clone git@github.com:koonwen/ocaml-libbpf.git
43
+
cd ocaml-libbpf
44
+
opam install . --deps-only
45
+
eval $(opam env)
46
+
```
47
+
48
+
then run `make < minimal | kprobe | bootstrap | tc >` to try out the
49
+
different bpf programs. These examples are all taken from
50
+
[libbpf-bootstrap](https://github.com/libbpf/libbpf-bootstrap)
51
+
repository and rewritten in OCaml.
52
+
53
+
### Open/Load/Link
54
+
Now let's run through an example of how we would use
55
+
ocaml-libbpf. This usage tutorial assumes some knowledge of how to
56
+
write eBPF kernel programs in C compile them to ELF files. If not, you
57
+
can check out this
58
+
[resource](https://nakryiko.com/posts/libbpf-bootstrap/#the-bpf-side). ocaml-libbpf
59
+
provides an easy API to install your eBPF program into the kernel. Say
60
+
your eBPF kernel program looks like this where we print something
61
+
whenever the syscall `write` event occurs. We also want to implement a
62
+
filtering mechanism to only print on `write` calls for our process. To
63
+
do this, we initialize a BPF array map with a single entry that works
64
+
like a holder for our global variable. The BPF map is neccessary to
65
+
because it allows us to communicate values between user and kernel
66
+
space.
67
+
68
+
> The libbpf C library in fact already supports declarations of global
69
+
> variables in the usual form with the ability to manage them in user
70
+
> space. However for various technical reasons, ocaml-libbpf does not
71
+
> enable that feature yet. So we use the old style of working with
72
+
> global variables here.
73
+
74
+
```c
75
+
// SPDX-License-Identifier: GPL-2.0 OR BSD-3-Clause
76
+
/* Copyright (c) 2020 Facebook */
77
+
#include <linux/bpf.h>
78
+
#include "bpf/bpf_helpers.h" /* This is from our libbpf library */
79
+
80
+
char LICENSE[] SEC("license") = "Dual BSD/GPL";
81
+
82
+
/* Globals implemented as an array */
83
+
struct {
84
+
__uint(type, BPF_MAP_TYPE_ARRAY);
85
+
__uint(max_entries, 1);
86
+
__type(key, int);
87
+
__type(value, long);
88
+
} globals SEC(".maps");
89
+
90
+
int my_pid_index = 0;
91
+
92
+
SEC("tp/syscalls/sys_enter_write")
93
+
int handle_tp(void *ctx) {
94
+
int pid = bpf_get_current_pid_tgid() >> 32;
95
+
96
+
long *my_pid;
97
+
my_pid = bpf_map_lookup_elem(&globals, &my_pid_index);
98
+
if (my_pid == NULL) {
99
+
bpf_printk("Error got NULL");
100
+
return 1;
101
+
};
102
+
103
+
if (pid != *my_pid)
104
+
return 0;
105
+
106
+
bpf_printk("Hello, BPF triggered from PID %d", pid);
107
+
108
+
return 0;
109
+
}
110
+
111
+
```
112
+
113
+
After compilation to eBPF ELF file as `minimal.o`. Users just need to
114
+
provide the path to this ELF file along with the name of the program
115
+
and optionally an initialization function. Note that the name of the
116
+
program refers to the function identifier under the SEC(...)
117
+
attribute, in this case it is "handle_tp".
118
+
119
+
```ocaml
120
+
open Libbpf
121
+
122
+
let obj_path = "minimal.bpf.o"
123
+
let program_names = [ "handle_tp" ]
124
+
125
+
let () =
126
+
with_bpf_object_open_load_link ~obj_path ~program_names ~before_link
127
+
(fun obj link ->
128
+
129
+
< user code to interact with bpf program running in kernel >
130
+
131
+
)
132
+
```
133
+
134
+
The API provided by ocaml-libbpf `with_bpf_object_open_load_link` is
135
+
a context manager that ensures the proper cleanup of resources if a
136
+
failure is encountered. Right now our loaded kernel program is
137
+
attached to the kernel and then immediately unloaded, users are
138
+
responsible for keeping the bpf program alive by looping within the
139
+
function block.
140
+
141
+
> Users may also pin the bpf program to persist after user code
142
+
> exits. Do note that if pinning is desired, users should not use the
143
+
> `with_bpf_object_open_load_link` API and instead manually load and
144
+
> attach their bpf program since the context manager shutdowns all
145
+
> resources on exit.
146
+
147
+
Now let's add some looping logic to keep the loaded bpf program alive.
148
+
149
+
```ocaml
150
+
let obj_path = "minimal.bpf.o"
151
+
let program_names = [ "handle_tp" ]
152
+
153
+
let () =
154
+
with_bpf_object_open_load_link ~obj_path ~program_names ~before_link
155
+
(fun obj link ->
156
+
157
+
(* Set up signal handlers *)
158
+
let exitting = ref true in
159
+
let sig_handler = Sys.Signal_handle (fun _ -> exitting := false) in
160
+
Sys.(set_signal sigint sig_handler);
161
+
Sys.(set_signal sigterm sig_handler);
162
+
163
+
Printf.printf
164
+
"Successfully started! Please run `sudo cat \
165
+
/sys/kernel/debug/tracing/trace_pipe` to see output of the BPF \
166
+
programs.\n\
167
+
%!"
168
+
169
+
(* Loop until Ctrl-C is called *)
170
+
while !exitting do
171
+
Printf.eprintf ".%!";
172
+
Unix.sleepf 1.0
173
+
done)
174
+
```
175
+
176
+
Our bpf program is now running in the kernel until we decide to
177
+
interrupt it. However, it doesn't do exactly what we want. In
178
+
particular, it doesn't filter for our process PID. This is because we
179
+
haven't loaded our process PID into the BPF map. To do this, we need
180
+
the name of the map we declared in the `minimal.bpf.c` program. In
181
+
this case, our BPF array map was named `globals`.
182
+
183
+
```ocaml
184
+
let map = "globals"
185
+
186
+
(* Load PID into BPF map *)
187
+
let before_link obj =
188
+
let pid = Unix.getpid () |> Signed.Long.of_int in
189
+
let global_map = bpf_object_find_map_by_name obj map in
190
+
(* When updating an element, users need to specify the type of the key and value
191
+
declared by the map which checks that the key and value size are consistent. *)
192
+
bpf_map_update_elem ~key_ty:Ctypes.int ~val_ty:Ctypes.long global_map 0 pid
193
+
```
194
+
195
+
Put together in [minimal.ml](./examples/minimal.ml), your bpf program
196
+
runs in kernel and print to the trace pipe every second.
197
+
198
+
### Maps
199
+
`libbpf_maps` is an optional convenience package that provides
200
+
wrappers for BPF maps. Currently only Ringbuffer maps are added. An
201
+
example usage of them can be found in
202
+
[examples/bootstrap.ml](./examples/bootstrap.ml). This has been
203
+
packaged separately since it drags in `libffi` dependency.
204
+
205
+
## Notes on compatibility
206
+
> The libbpf C library is designed to be kernel-agnostic and work
207
+
> across multitude of kernel versions. It has built-in mechanisms to
208
+
> gracefully handle older kernels, that are missing some of the
209
+
> features, by working around or gracefully degrading functionality.
210
+
211
+
Vendoring libbpf was a option. However, since bpf programs require
212
+
writing the kernel components that may use libbpf, we made the choice
213
+
to use the system's package versioned instead. This avoids users from
214
+
knowingly/unknowingly using libbpf API's from two different
215
+
versions. As a consequence, this library support operating systems
216
+
that package libbpf.v.1.1 and up. Check ocaml-ci for the list of
217
+
operating systems that successfully builds.
218
+
219
+
If so desired, you can also checkout the `vendored` branch in this
220
+
repo which builds ocaml-libbpf with the latest libbpf package.
+16
vendor/ocaml-libbpf/conf-bpftool.opam
+16
vendor/ocaml-libbpf/conf-bpftool.opam
···
1
+
opam-version: "2.0"
2
+
synopsis: "Virtual package for system installation of bpftool"
3
+
maintainer: ["Lee Koon Wen"]
4
+
authors: ["Lee Koon Wen"]
5
+
license: ["ISC" "BSD-3-Clause"]
6
+
homepage: "https://github.com/koonwen/ocaml-libbpf"
7
+
doc: "https://koonwen.github.io/ocaml-libbpf"
8
+
bug-reports: "https://github.com/koonwen/ocaml-libbpf/issues"
9
+
available: [ os = "linux" ]
10
+
depexts: [
11
+
[ "linux-tools-common" ] {os-distribution = "ubuntu"}
12
+
[ "bpftool" ] {os-distribution = "debian"}
13
+
[ "bpftool" ] {os-distribution = "fedora"}
14
+
]
15
+
flags: conf
16
+
x-commit-hash: "c7ac4c7ff9f2aa23c374a619990c0bdd78976102"
+17
vendor/ocaml-libbpf/conf-libbpf.opam
+17
vendor/ocaml-libbpf/conf-libbpf.opam
···
1
+
opam-version: "2.0"
2
+
synopsis: "Virtual package for system installation of libbpf"
3
+
maintainer: ["Lee Koon Wen"]
4
+
authors: ["Lee Koon Wen"]
5
+
license: ["ISC" "BSD-3-Clause"]
6
+
homepage: "https://github.com/koonwen/ocaml-libbpf"
7
+
doc: "https://koonwen.github.io/ocaml-libbpf"
8
+
bug-reports: "https://github.com/koonwen/ocaml-libbpf/issues"
9
+
available: [ os = "linux" ]
10
+
11
+
depexts: [
12
+
["libbpf-dev"] { os-distribution = "ubuntu" & os-version >= "18.04" }
13
+
["libbpf-dev"] { os-distribution = "debian" & os-version >= "9.0" }
14
+
["libbpf-devel"] { os-distribution = "fedora" & os-version >= "38" }
15
+
]
16
+
flags: conf
17
+
x-commit-hash: "c7ac4c7ff9f2aa23c374a619990c0bdd78976102"
+55
vendor/ocaml-libbpf/dune-project
+55
vendor/ocaml-libbpf/dune-project
···
1
+
(lang dune 3.13)
2
+
3
+
(name libbpf)
4
+
(source
5
+
(github koonwen/ocaml-libbpf))
6
+
(authors "Lee Koon Wen")
7
+
(maintainers "Lee Koon Wen")
8
+
(license ISC BSD-3-Clause)
9
+
(documentation https://koonwen.github.io/ocaml-libbpf)
10
+
11
+
(package
12
+
(allow_empty)
13
+
(name conf-libbpf)
14
+
(synopsis "Virtual package for system installation of libbpf"))
15
+
16
+
(package
17
+
(allow_empty)
18
+
(name conf-bpftool)
19
+
(synopsis "Virtual package for system installation of bpftool"))
20
+
21
+
(package
22
+
(name libbpf)
23
+
(synopsis "Libbpf bindings")
24
+
(description "Wrapped libbpf api's for writing BPF user programs in OCaml")
25
+
(depends
26
+
(ocaml
27
+
(>= 4.08))
28
+
dune
29
+
(ctypes
30
+
(>= 0.22.0))
31
+
ppx_deriving
32
+
ppx_expect
33
+
conf-libbpf
34
+
conf-bpftool
35
+
conf-clang)
36
+
; This is only a dependency for the examples directory
37
+
; to show how to use dune to build bpf programs, it is
38
+
; not part of the library bindings, however, we can't
39
+
; remove it since it builds alongside the library
40
+
(tags
41
+
(bindings bpf libbpf)))
42
+
43
+
(package
44
+
(name libbpf_maps)
45
+
(synopsis "Libbpf maps API")
46
+
(description "High level API's for interacting with BPF maps in OCaml")
47
+
(depends
48
+
(ctypes
49
+
(>= 0.22.0))
50
+
(ctypes-foreign
51
+
(>= 0.22.0))
52
+
(libbpf
53
+
(= :version)))
54
+
(tags
55
+
(bindings bpf libbpf)))
+29
vendor/ocaml-libbpf/examples/LICENSE.md
+29
vendor/ocaml-libbpf/examples/LICENSE.md
···
1
+
BSD 3-Clause License
2
+
3
+
Copyright (c) 2020, Andrii Nakryiko
4
+
All rights reserved.
5
+
6
+
Redistribution and use in source and binary forms, with or without
7
+
modification, are permitted provided that the following conditions are met:
8
+
9
+
1. Redistributions of source code must retain the above copyright notice, this
10
+
list of conditions and the following disclaimer.
11
+
12
+
2. Redistributions in binary form must reproduce the above copyright notice,
13
+
this list of conditions and the following disclaimer in the documentation
14
+
and/or other materials provided with the distribution.
15
+
16
+
3. Neither the name of the copyright holder nor the names of its
17
+
contributors may be used to endorse or promote products derived from
18
+
this software without specific prior written permission.
19
+
20
+
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
21
+
AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
22
+
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
23
+
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
24
+
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
25
+
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
26
+
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
27
+
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
28
+
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
29
+
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+23
vendor/ocaml-libbpf/examples/Makefile
+23
vendor/ocaml-libbpf/examples/Makefile
···
1
+
CWD=../_build/default/examples
2
+
3
+
build:
4
+
dune build
5
+
6
+
minimal: build
7
+
sudo $(CWD)/minimal.exe
8
+
9
+
kprobe: build
10
+
sudo $(CWD)/kprobe.exe
11
+
12
+
tc: build
13
+
sudo $(CWD)/tc.exe
14
+
15
+
bootstrap: build
16
+
sudo $(CWD)/bootstrap.exe
17
+
18
+
bootstrap_c: build
19
+
sudo $(CWD)/bootstrap_c.exe
20
+
21
+
clean:
22
+
dune clean
23
+
rm vmlinux.h
+111
vendor/ocaml-libbpf/examples/bootstrap.bpf.c
+111
vendor/ocaml-libbpf/examples/bootstrap.bpf.c
···
1
+
// SPDX-License-Identifier: GPL-2.0 OR BSD-3-Clause
2
+
/* Copyright (c) 2020 Facebook */
3
+
#include "vmlinux.h"
4
+
#include <bpf/bpf_helpers.h>
5
+
#include <bpf/bpf_tracing.h>
6
+
#include <bpf/bpf_core_read.h>
7
+
#include "bootstrap.h"
8
+
9
+
char LICENSE[] SEC("license") = "Dual BSD/GPL";
10
+
11
+
struct {
12
+
__uint(type, BPF_MAP_TYPE_HASH);
13
+
__uint(max_entries, 8192);
14
+
__type(key, pid_t);
15
+
__type(value, u64);
16
+
} exec_start SEC(".maps");
17
+
18
+
struct {
19
+
__uint(type, BPF_MAP_TYPE_RINGBUF);
20
+
__uint(max_entries, 256 * 1024);
21
+
} rb SEC(".maps");
22
+
23
+
const volatile unsigned long long min_duration_ns = 0;
24
+
25
+
SEC("tp/sched/sched_process_exec")
26
+
int handle_exec(struct trace_event_raw_sched_process_exec *ctx)
27
+
{
28
+
struct task_struct *task;
29
+
unsigned fname_off;
30
+
struct event *e;
31
+
pid_t pid;
32
+
u64 ts;
33
+
34
+
/* remember time exec() was executed for this PID */
35
+
pid = bpf_get_current_pid_tgid() >> 32;
36
+
ts = bpf_ktime_get_ns();
37
+
bpf_map_update_elem(&exec_start, &pid, &ts, BPF_ANY);
38
+
39
+
/* don't emit exec events when minimum duration is specified */
40
+
if (min_duration_ns)
41
+
return 0;
42
+
43
+
/* reserve sample from BPF ringbuf */
44
+
e = bpf_ringbuf_reserve(&rb, sizeof(*e), 0);
45
+
if (!e)
46
+
return 0;
47
+
48
+
/* fill out the sample with data */
49
+
task = (struct task_struct *)bpf_get_current_task();
50
+
51
+
e->exit_event = false;
52
+
e->pid = pid;
53
+
e->ppid = BPF_CORE_READ(task, real_parent, tgid);
54
+
bpf_get_current_comm(&e->comm, sizeof(e->comm));
55
+
56
+
fname_off = ctx->__data_loc_filename & 0xFFFF;
57
+
bpf_probe_read_str(&e->filename, sizeof(e->filename), (void *)ctx + fname_off);
58
+
59
+
/* successfully submit it to user-space for post-processing */
60
+
bpf_ringbuf_submit(e, 0);
61
+
return 0;
62
+
}
63
+
64
+
SEC("tp/sched/sched_process_exit")
65
+
int handle_exit(struct trace_event_raw_sched_process_template *ctx)
66
+
{
67
+
struct task_struct *task;
68
+
struct event *e;
69
+
pid_t pid, tid;
70
+
u64 id, ts, *start_ts, duration_ns = 0;
71
+
72
+
/* get PID and TID of exiting thread/process */
73
+
id = bpf_get_current_pid_tgid();
74
+
pid = id >> 32;
75
+
tid = (u32)id;
76
+
77
+
/* ignore thread exits */
78
+
if (pid != tid)
79
+
return 0;
80
+
81
+
/* if we recorded start of the process, calculate lifetime duration */
82
+
start_ts = bpf_map_lookup_elem(&exec_start, &pid);
83
+
if (start_ts)
84
+
duration_ns = bpf_ktime_get_ns() - *start_ts;
85
+
else if (min_duration_ns)
86
+
return 0;
87
+
bpf_map_delete_elem(&exec_start, &pid);
88
+
89
+
/* if process didn't live long enough, return early */
90
+
if (min_duration_ns && duration_ns < min_duration_ns)
91
+
return 0;
92
+
93
+
/* reserve sample from BPF ringbuf */
94
+
e = bpf_ringbuf_reserve(&rb, sizeof(*e), 0);
95
+
if (!e)
96
+
return 0;
97
+
98
+
/* fill out the sample with data */
99
+
task = (struct task_struct *)bpf_get_current_task();
100
+
101
+
e->exit_event = true;
102
+
e->duration_ns = duration_ns;
103
+
e->pid = pid;
104
+
e->ppid = BPF_CORE_READ(task, real_parent, tgid);
105
+
e->exit_code = (BPF_CORE_READ(task, exit_code) >> 8) & 0xff;
106
+
bpf_get_current_comm(&e->comm, sizeof(e->comm));
107
+
108
+
/* send data to user-space for post-processing */
109
+
bpf_ringbuf_submit(e, 0);
110
+
return 0;
111
+
}
+19
vendor/ocaml-libbpf/examples/bootstrap.h
+19
vendor/ocaml-libbpf/examples/bootstrap.h
···
1
+
/* SPDX-License-Identifier: (LGPL-2.1 OR BSD-2-Clause) */
2
+
/* Copyright (c) 2020 Facebook */
3
+
#ifndef __BOOTSTRAP_H
4
+
#define __BOOTSTRAP_H
5
+
6
+
#define TASK_COMM_LEN 16
7
+
#define MAX_FILENAME_LEN 127
8
+
9
+
struct event {
10
+
int pid;
11
+
int ppid;
12
+
unsigned exit_code;
13
+
unsigned long long duration_ns;
14
+
char comm[TASK_COMM_LEN];
15
+
char filename[MAX_FILENAME_LEN];
16
+
bool exit_event;
17
+
};
18
+
19
+
#endif /* __BOOTSTRAP_H */
+78
vendor/ocaml-libbpf/examples/bootstrap.ml
+78
vendor/ocaml-libbpf/examples/bootstrap.ml
···
1
+
open Libbpf
2
+
open Libbpf_maps
3
+
open Ctypes
4
+
5
+
let obj_path = "bootstrap.bpf.o"
6
+
let program_names = [ "handle_exec"; "handle_exit" ]
7
+
let rb_name = "rb"
8
+
9
+
(* event structure layout from bootstrap.h *)
10
+
let event : [ `Event ] structure typ = Ctypes.structure "event"
11
+
let ( -: ) ty label = field event label ty
12
+
let pid = int -: "pid"
13
+
let ppid = int -: "ppid"
14
+
let exit_code = uint -: "exit_code"
15
+
let duration = ullong -: "duration_ns"
16
+
let comm = array 16 char -: "comm"
17
+
let filename = array 127 char -: "filename"
18
+
let exit_event = bool -: "exit_event"
19
+
let _ = seal event
20
+
21
+
let char_array_as_string a =
22
+
let len = CArray.length a in
23
+
let b = Buffer.create len in
24
+
try
25
+
for i = 0 to len - 1 do
26
+
let c = CArray.get a i in
27
+
if c = '\x00' then raise Exit else Buffer.add_char b c
28
+
done;
29
+
Buffer.contents b
30
+
with Exit -> Buffer.contents b
31
+
32
+
(* Describe User callback event handler *)
33
+
let handle_event _ctx data _sz =
34
+
let ev = !@(from_voidp event data) in
35
+
let pid = getf ev pid in
36
+
let ppid = getf ev ppid in
37
+
let exit_code = getf ev exit_code |> Unsigned.UInt.to_string in
38
+
let duration = getf ev duration |> Unsigned.ULLong.to_int64 in
39
+
let comm = getf ev comm |> char_array_as_string in
40
+
let filename = getf ev filename |> char_array_as_string in
41
+
let exit_event = getf ev exit_event in
42
+
let tm = Unix.time () |> Unix.localtime in
43
+
let ts = Printf.sprintf "%d:%d:%d" tm.tm_hour tm.tm_min tm.tm_sec in
44
+
if exit_event then (
45
+
Printf.printf "%-8s %-5s %-16s %-7d %-7d [%s]" ts "EXIT" comm pid ppid
46
+
exit_code;
47
+
if duration >= 0L then
48
+
Printf.printf " (%Lums)" (Int64.div duration 1000000L);
49
+
print_newline ())
50
+
else
51
+
Printf.printf "%-8s %-5s %-16s %-7d %-7d %s\n" ts "EXEC" comm pid ppid
52
+
filename;
53
+
0
54
+
55
+
let () =
56
+
(* Set signal handlers *)
57
+
let exitting = ref true in
58
+
let sig_handler = Sys.Signal_handle (fun _ -> exitting := false) in
59
+
Sys.(set_signal sigint sig_handler);
60
+
Sys.(set_signal sigterm sig_handler);
61
+
62
+
(* Use auto open/load/link helper *)
63
+
with_bpf_object_open_load_link ~obj_path ~program_names (fun obj _links ->
64
+
(* Load ringbuffer map *)
65
+
let map = bpf_object_find_map_by_name obj rb_name in
66
+
67
+
(* Set up ring buffer *)
68
+
RingBuffer.init map ~callback:handle_event (fun rb ->
69
+
Printf.printf "%-8s %-5s %-16s %-7s %-7s %s\n%!" "TIME" "EVENT" "COMM"
70
+
"PID" "PPID" "FILENAME/EXIT CODE";
71
+
72
+
while !exitting do
73
+
ignore
74
+
(try RingBuffer.poll rb ~timeout:100
75
+
with _ ->
76
+
exitting := false;
77
+
-1)
78
+
done))
+109
vendor/ocaml-libbpf/examples/bootstrap_c.ml
+109
vendor/ocaml-libbpf/examples/bootstrap_c.ml
···
1
+
module F = Libbpf.C.Functions
2
+
module T = Libbpf.C.Types
3
+
4
+
let bpf_obj_path = "bootstrap.bpf.o"
5
+
let program_names = [ "handle_exec"; "handle_exit" ]
6
+
let rb_name = "rb"
7
+
8
+
exception Exit of int
9
+
10
+
let 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
+
109
+
let () = try main () with Exit i when i <> 0 -> Printf.eprintf "[Exit %d]" i
+57
vendor/ocaml-libbpf/examples/dune
+57
vendor/ocaml-libbpf/examples/dune
···
1
+
(executables
2
+
(names tc bootstrap bootstrap_c kprobe minimal)
3
+
(libraries libbpf libbpf_maps))
4
+
5
+
; Below is repetitive build rules to compile *.bpf.c eBPF C source code that runs in the kernel
6
+
7
+
(rule
8
+
(mode
9
+
(promote (until-clean)))
10
+
(targets minimal.bpf.o)
11
+
(deps arch minimal.bpf.c)
12
+
(action
13
+
(system
14
+
"clang -g -O2 -target bpf -I/usr/include/%{architecture}-linux-gnu/ -c minimal.bpf.c -D__TARGET_ARCH_%{read:arch}")))
15
+
16
+
(rule
17
+
(mode
18
+
(promote (until-clean)))
19
+
(targets kprobe.bpf.o)
20
+
(deps arch vmlinux.h kprobe.bpf.c)
21
+
(action
22
+
(system
23
+
"clang -g -O2 -target bpf -I/usr/include/%{architecture}-linux-gnu/ -c kprobe.bpf.c -D__TARGET_ARCH_%{read:arch}")))
24
+
25
+
(rule
26
+
(mode
27
+
(promote (until-clean)))
28
+
(targets tc.bpf.o)
29
+
(deps arch vmlinux.h tc.bpf.c)
30
+
(action
31
+
(system
32
+
"clang -g -O2 -target bpf -I/usr/include/%{architecture}-linux-gnu/ -c tc.bpf.c -D__TARGET_ARCH_%{read:arch}")))
33
+
34
+
(rule
35
+
(mode
36
+
(promote (until-clean)))
37
+
(targets bootstrap.bpf.o)
38
+
(deps arch vmlinux.h bootstrap.bpf.c bootstrap.h)
39
+
(action
40
+
(system
41
+
"clang -g -O2 -target bpf -I/usr/include/%{architecture}-linux-gnu/ -c bootstrap.bpf.c -D__TARGET_ARCH_%{read:arch}")))
42
+
43
+
(rule
44
+
(mode
45
+
(promote (until-clean)))
46
+
(targets vmlinux.h arch)
47
+
(action
48
+
(progn
49
+
(with-stdout-to
50
+
vmlinux.h
51
+
(run /usr/sbin/bpftool btf dump file /sys/kernel/btf/vmlinux format c))
52
+
(with-stdout-to
53
+
arch
54
+
(bash
55
+
"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/'")))))
56
+
57
+
; /usr/include/%{architecture}-linux-gnu/ Find asm/types.h for eBPF code
+30
vendor/ocaml-libbpf/examples/kprobe.bpf.c
+30
vendor/ocaml-libbpf/examples/kprobe.bpf.c
···
1
+
// SPDX-License-Identifier: GPL-2.0 OR BSD-3-Clause
2
+
/* Copyright (c) 2021 Sartura */
3
+
#include "vmlinux.h"
4
+
#include <bpf/bpf_helpers.h>
5
+
#include <bpf/bpf_tracing.h>
6
+
#include <bpf/bpf_core_read.h>
7
+
8
+
char LICENSE[] SEC("license") = "Dual BSD/GPL";
9
+
10
+
SEC("kprobe/do_unlinkat")
11
+
int BPF_KPROBE(do_unlinkat, int dfd, struct filename *name)
12
+
{
13
+
pid_t pid;
14
+
const char *filename;
15
+
16
+
pid = bpf_get_current_pid_tgid() >> 32;
17
+
filename = BPF_CORE_READ(name, name);
18
+
bpf_printk("KPROBE ENTRY pid = %d, filename = %s\n", pid, filename);
19
+
return 0;
20
+
}
21
+
22
+
SEC("kretprobe/do_unlinkat")
23
+
int BPF_KRETPROBE(do_unlinkat_exit, long ret)
24
+
{
25
+
pid_t pid;
26
+
27
+
pid = bpf_get_current_pid_tgid() >> 32;
28
+
bpf_printk("KPROBE EXIT: pid = %d, ret = %ld\n", pid, ret);
29
+
return 0;
30
+
}
+23
vendor/ocaml-libbpf/examples/kprobe.ml
+23
vendor/ocaml-libbpf/examples/kprobe.ml
···
1
+
open Libbpf
2
+
3
+
let obj_path = "kprobe.bpf.o"
4
+
let program_names = [ "do_unlinkat"; "do_unlinkat_exit" ]
5
+
6
+
let () =
7
+
with_bpf_object_open_load_link ~obj_path ~program_names (fun _obj _links ->
8
+
(* Set signal handlers *)
9
+
let exitting = ref true in
10
+
let sig_handler = Sys.Signal_handle (fun _ -> exitting := false) in
11
+
Sys.(set_signal sigint sig_handler);
12
+
Sys.(set_signal sigterm sig_handler);
13
+
14
+
Printf.printf
15
+
"Successfully started! Please run `sudo cat \
16
+
/sys/kernel/debug/tracing/trace_pipe` to see output of the BPF \
17
+
programs.\n\
18
+
%!";
19
+
20
+
while !exitting do
21
+
Unix.sleepf 1.0;
22
+
Printf.eprintf ".%!"
23
+
done)
+35
vendor/ocaml-libbpf/examples/minimal.bpf.c
+35
vendor/ocaml-libbpf/examples/minimal.bpf.c
···
1
+
// SPDX-License-Identifier: GPL-2.0 OR BSD-3-Clause
2
+
/* Copyright (c) 2020 Facebook */
3
+
#include <linux/bpf.h>
4
+
#include "bpf/bpf_helpers.h" /* This is from our libbpf library */
5
+
6
+
char LICENSE[] SEC("license") = "Dual BSD/GPL";
7
+
8
+
/* Globals implemented as an array */
9
+
struct {
10
+
__uint(type, BPF_MAP_TYPE_ARRAY);
11
+
__uint(max_entries, 5);
12
+
__type(key, int);
13
+
__type(value, long);
14
+
} globals SEC(".maps");
15
+
16
+
int my_pid_index = 0;
17
+
18
+
SEC("tp/syscalls/sys_enter_write")
19
+
int handle_tp(void *ctx) {
20
+
int pid = bpf_get_current_pid_tgid() >> 32;
21
+
22
+
long *my_pid;
23
+
my_pid = bpf_map_lookup_elem(&globals, &my_pid_index);
24
+
if (my_pid == NULL) {
25
+
bpf_printk("Error got NULL");
26
+
return 1;
27
+
};
28
+
29
+
if (pid != *my_pid)
30
+
return 0;
31
+
32
+
bpf_printk("Hello, BPF triggered from PID %d", pid);
33
+
34
+
return 0;
35
+
}
+31
vendor/ocaml-libbpf/examples/minimal.ml
+31
vendor/ocaml-libbpf/examples/minimal.ml
···
1
+
open Libbpf
2
+
3
+
let obj_path = "minimal.bpf.o"
4
+
let program_names = [ "handle_tp" ]
5
+
let map = "globals"
6
+
7
+
(* Load PID into BPF map*)
8
+
let before_link obj =
9
+
let pid = Unix.getpid () |> Signed.Long.of_int in
10
+
let global_map = bpf_object_find_map_by_name obj map in
11
+
bpf_map_update_elem ~key_ty:Ctypes.int ~val_ty:Ctypes.long global_map 0 pid
12
+
13
+
let () =
14
+
with_bpf_object_open_load_link ~obj_path ~program_names ~before_link
15
+
(fun _obj _link ->
16
+
let exitting = ref true in
17
+
let sig_handler = Sys.Signal_handle (fun _ -> exitting := false) in
18
+
Sys.(set_signal sigint sig_handler);
19
+
Sys.(set_signal sigterm sig_handler);
20
+
21
+
Printf.printf
22
+
"Successfully started! Please run `sudo cat \
23
+
/sys/kernel/debug/tracing/trace_pipe` to see output of the BPF \
24
+
programs.\n\
25
+
%!";
26
+
27
+
(* Loop until Ctrl-C is called *)
28
+
while !exitting do
29
+
Printf.eprintf ".%!";
30
+
Unix.sleepf 1.0
31
+
done)
+34
vendor/ocaml-libbpf/examples/tc.bpf.c
+34
vendor/ocaml-libbpf/examples/tc.bpf.c
···
1
+
// SPDX-License-Identifier: (LGPL-2.1 OR BSD-2-Clause)
2
+
/* Copyright (c) 2022 Hengqi Chen */
3
+
#include "vmlinux.h"
4
+
#include <bpf/bpf_endian.h>
5
+
#include <bpf/bpf_helpers.h>
6
+
#include <bpf/bpf_tracing.h>
7
+
8
+
#define TC_ACT_OK 0
9
+
#define ETH_P_IP 0x0800 /* Internet Protocol packet */
10
+
11
+
SEC("tc")
12
+
int tc_ingress(struct __sk_buff *ctx)
13
+
{
14
+
void *data_end = (void *)(__u64)ctx->data_end;
15
+
void *data = (void *)(__u64)ctx->data;
16
+
struct ethhdr *l2;
17
+
struct iphdr *l3;
18
+
19
+
if (ctx->protocol != bpf_htons(ETH_P_IP))
20
+
return TC_ACT_OK;
21
+
22
+
l2 = data;
23
+
if ((void *)(l2 + 1) > data_end)
24
+
return TC_ACT_OK;
25
+
26
+
l3 = (struct iphdr *)(l2 + 1);
27
+
if ((void *)(l3 + 1) > data_end)
28
+
return TC_ACT_OK;
29
+
30
+
bpf_printk("Got IP packet: tot_len: %d, ttl: %d", bpf_ntohs(l3->tot_len), l3->ttl);
31
+
return TC_ACT_OK;
32
+
}
33
+
34
+
char __license[] SEC("license") = "GPL";
+70
vendor/ocaml-libbpf/examples/tc.ml
+70
vendor/ocaml-libbpf/examples/tc.ml
···
1
+
(* This program monitors the traffic going through your loopback
2
+
interface, once this program is run, check your trace pipe with
3
+
`sudo cat /sys/kernel/debug/tracing/trace_pipe` and run `ping
4
+
127.0.0.1` to see the output *)
5
+
open Ctypes
6
+
open Libbpf
7
+
8
+
let obj_path = "tc.bpf.o"
9
+
let program_name = "tc_ingress"
10
+
11
+
let () =
12
+
(* Set signal handlers *)
13
+
let exitting = ref true in
14
+
let sig_handler = Sys.Signal_handle (fun _ -> exitting := false) in
15
+
Sys.(set_signal sigint sig_handler);
16
+
Sys.(set_signal sigterm sig_handler);
17
+
18
+
let hook_created = ref false in
19
+
20
+
let tc_hook = make C.Types.Bpf_tc.hook in
21
+
setf tc_hook C.Types.Bpf_tc.ifindex 1;
22
+
setf tc_hook C.Types.Bpf_tc.attach_point `INGRESS;
23
+
let sz = Ctypes.sizeof C.Types.Bpf_tc.hook in
24
+
setf tc_hook C.Types.Bpf_tc.sz (Unsigned.Size_t.of_int sz);
25
+
26
+
let tc_opts = make C.Types.Bpf_tc.Opts.t in
27
+
setf tc_opts C.Types.Bpf_tc.Opts.handle (Unsigned.UInt32.of_int 1);
28
+
setf tc_opts C.Types.Bpf_tc.Opts.priority (Unsigned.UInt32.of_int 1);
29
+
let sz = Ctypes.sizeof C.Types.Bpf_tc.Opts.t in
30
+
setf tc_opts C.Types.Bpf_tc.Opts.sz (Unsigned.Size_t.of_int sz);
31
+
32
+
(* Open and load bpf object *)
33
+
let obj = bpf_object_open obj_path in
34
+
bpf_object_load obj;
35
+
let prog = bpf_object_find_program_by_name obj program_name in
36
+
37
+
(* Try to create hook *)
38
+
(* The hook (i.e. qdisc) may already exists because: *)
39
+
(* 1. it is created by other processes or users *)
40
+
(* 2. or since we are attaching to the TC ingress ONLY, *)
41
+
(* bpf_tc_hook_destroy does NOT really remove the qdisc, *)
42
+
(* there may be an egress filter on the qdisc *)
43
+
let err = C.Functions.bpf_tc_hook_create (addr tc_hook) in
44
+
if err = 0 then hook_created := true;
45
+
46
+
if err <> 0 && err <> -17 (*EEXIST*) then (
47
+
Printf.eprintf "Failed to create tc hook: %d\n" err;
48
+
exit 1);
49
+
50
+
setf tc_opts C.Types.Bpf_tc.Opts.prog_fd prog.fd;
51
+
let err = C.Functions.bpf_tc_attach (addr tc_hook) (addr tc_opts) in
52
+
if err = 1 then (
53
+
Printf.eprintf "Failed to attach TC: %d\n" err;
54
+
C.Functions.bpf_tc_hook_destroy (addr tc_hook) |> ignore;
55
+
exit 1);
56
+
57
+
Printf.printf
58
+
"Successfully started! Please run `sudo cat \
59
+
/sys/kernel/debug/tracing/trace_pipe` to see output of the BPF program.\n\
60
+
%!";
61
+
62
+
while !exitting do
63
+
Printf.eprintf ".%!";
64
+
Unix.sleepf 1.0
65
+
done;
66
+
67
+
let err = C.Functions.bpf_tc_detach (addr tc_hook) (addr tc_opts) in
68
+
if err = 1 then Printf.eprintf "Failed to detach TC: %d\n" err;
69
+
C.Functions.bpf_tc_hook_destroy (addr tc_hook) |> ignore;
70
+
bpf_object_close obj
+44
vendor/ocaml-libbpf/libbpf.opam
+44
vendor/ocaml-libbpf/libbpf.opam
···
1
+
# This file is generated by dune, edit dune-project instead
2
+
opam-version: "2.0"
3
+
synopsis: "Libbpf bindings"
4
+
description: "Wrapped libbpf api's for writing BPF user programs in OCaml"
5
+
maintainer: ["Lee Koon Wen"]
6
+
authors: ["Lee Koon Wen"]
7
+
license: ["ISC" "BSD-3-Clause"]
8
+
tags: ["bindings" "bpf" "libbpf"]
9
+
homepage: "https://github.com/koonwen/ocaml-libbpf"
10
+
doc: "https://koonwen.github.io/ocaml-libbpf"
11
+
bug-reports: "https://github.com/koonwen/ocaml-libbpf/issues"
12
+
depends: [
13
+
"ocaml" {>= "4.08"}
14
+
"dune" {>= "3.13"}
15
+
"ctypes" {>= "0.22.0"}
16
+
"ppx_deriving"
17
+
"ppx_expect"
18
+
"conf-libbpf"
19
+
"conf-bpftool"
20
+
"conf-clang"
21
+
"odoc" {with-doc}
22
+
]
23
+
build: [
24
+
["dune" "subst"] {dev}
25
+
[
26
+
"dune"
27
+
"build"
28
+
"-p"
29
+
name
30
+
"-j"
31
+
jobs
32
+
"@install"
33
+
"@runtest" {with-test}
34
+
"@doc" {with-doc}
35
+
]
36
+
]
37
+
dev-repo: "git+https://github.com/koonwen/ocaml-libbpf.git"
38
+
# eBPF features by kernel version https://github.com/iovisor/bcc/blob/master/docs/kernel-versions.md
39
+
# Fix to kernel >= 6.1 to provide bound BPF map types
40
+
available: [ os = "linux" &
41
+
(( os-distribution = "debian" & os-version >= "12" ) # Linux 6.1 & Libbpf 1.1.0
42
+
|( os-distribution = "ubuntu" & os-version >= "23.04" ) # Linux 6.2 & Libbpf 1.1.0
43
+
|( os-distribution = "fedora" & os-version >= "38" )) # Linux 6.2 & Libbpf 1.1.0
44
+
]
+7
vendor/ocaml-libbpf/libbpf.opam.template
+7
vendor/ocaml-libbpf/libbpf.opam.template
···
1
+
# eBPF features by kernel version https://github.com/iovisor/bcc/blob/master/docs/kernel-versions.md
2
+
# Fix to kernel >= 6.1 to provide bound BPF map types
3
+
available: [ os = "linux" &
4
+
(( os-distribution = "debian" & os-version >= "12" ) # Linux 6.1 & Libbpf 1.1.0
5
+
|( os-distribution = "ubuntu" & os-version >= "23.04" ) # Linux 6.2 & Libbpf 1.1.0
6
+
|( os-distribution = "fedora" & os-version >= "38" )) # Linux 6.2 & Libbpf 1.1.0
7
+
]
+32
vendor/ocaml-libbpf/libbpf_maps.opam
+32
vendor/ocaml-libbpf/libbpf_maps.opam
···
1
+
opam-version: "2.0"
2
+
synopsis: "Libbpf maps API"
3
+
description: "High level API's for interacting with BPF maps in OCaml"
4
+
maintainer: ["Lee Koon Wen"]
5
+
authors: ["Lee Koon Wen"]
6
+
license: ["ISC" "BSD-3-Clause"]
7
+
tags: ["bindings" "bpf" "libbpf"]
8
+
homepage: "https://github.com/koonwen/ocaml-libbpf"
9
+
doc: "https://koonwen.github.io/ocaml-libbpf"
10
+
bug-reports: "https://github.com/koonwen/ocaml-libbpf/issues"
11
+
depends: [
12
+
"dune" {>= "3.13"}
13
+
"ctypes" {>= "0.22.0"}
14
+
"ctypes-foreign" {>= "0.22.0"}
15
+
"libbpf" {= version}
16
+
"odoc" {with-doc}
17
+
]
18
+
build: [
19
+
["dune" "subst"] {dev}
20
+
[
21
+
"dune"
22
+
"build"
23
+
"-p"
24
+
name
25
+
"-j"
26
+
jobs
27
+
"@install"
28
+
"@runtest" {with-test}
29
+
"@doc" {with-doc}
30
+
]
31
+
]
32
+
dev-repo: "git+https://github.com/koonwen/ocaml-libbpf.git"
+5
vendor/ocaml-libbpf/src/bindings/c.ml
+5
vendor/ocaml-libbpf/src/bindings/c.ml
+284
vendor/ocaml-libbpf/src/bindings/c_function_description.ml
+284
vendor/ocaml-libbpf/src/bindings/c_function_description.ml
···
1
+
open Ctypes
2
+
3
+
(** You probably don't mean to be looking into this section, it is
4
+
part of the stub generation process of the bindings.*)
5
+
6
+
(* The C_types_generated module is generated by the build system to
7
+
grab the type definitions from the header files in C to ensure
8
+
that offsets and structs are aligned. *)
9
+
module Types = C_type_description.Types (C_types_generated)
10
+
11
+
module Functions (F : Ctypes.FOREIGN) = struct
12
+
open F
13
+
14
+
(* ======================================== Generics ======================================== *)
15
+
let libbpf_major_version =
16
+
foreign "libbpf_major_version" (void @-> returning uint32_t)
17
+
18
+
let libbpf_minor_version =
19
+
foreign "libbpf_minor_version" (void @-> returning uint32_t)
20
+
21
+
let libbpf_version_string =
22
+
foreign "libbpf_version_string" (void @-> returning string)
23
+
24
+
let libbpf_strerror =
25
+
foreign "libbpf_strerror" (int @-> ptr char @-> size_t @-> returning int)
26
+
27
+
let libbpf_bpf_attach_type_str =
28
+
foreign "libbpf_bpf_attach_type_str"
29
+
(Types.Bpf_attach_type.t @-> returning string)
30
+
31
+
let libbpf_bpf_link_type_str =
32
+
foreign "libbpf_bpf_link_type_str"
33
+
(Types.Bpf_link_type.t @-> returning string)
34
+
35
+
let libbpf_bpf_map_type_str =
36
+
foreign "libbpf_bpf_map_type_str" (Types.Bpf_map_type.t @-> returning string)
37
+
38
+
let libbpf_bpf_prog_type_str =
39
+
foreign "libbpf_bpf_prog_type_str"
40
+
(Types.Bpf_prog_type.t @-> returning string)
41
+
42
+
let libbpf_set_print =
43
+
foreign "libbpf_set_print"
44
+
(Types.libbpf_print_fn_t @-> returning Types.libbpf_print_fn_t)
45
+
46
+
(* ================================= Open / Load / Close =================================== *)
47
+
48
+
(** [bpf_object__open path] creates a bpf_object by opening the BPF
49
+
ELF object file pointed to by the passed [path] and loading it
50
+
into memory.
51
+
52
+
Returns pointer to the new bpf_object; or NULL is returned on
53
+
error, error code is stored in errno. *)
54
+
let bpf_object__open =
55
+
foreign "bpf_object__open" (string @-> returning (ptr_opt Types.bpf_object))
56
+
57
+
(** [bpf_object__load obj_ptr] loads the BPF object into the
58
+
kernel. [obj_ptr] must be a valid BPF object instance returned
59
+
by a successful call to [bpf_object__open].
60
+
61
+
Returns 0, on success; negative error code, otherwise, error code is stored in errno *)
62
+
let bpf_object__load =
63
+
foreign "bpf_object__load" (ptr Types.bpf_object @-> returning int)
64
+
65
+
(** [bpf_object__find_program_by_name name] returns the BPF program
66
+
of the given [name], if it exists within the passed BPF object
67
+
68
+
Returns the pointer to the BPF program instance, if such program
69
+
exists within the BPF object; or NULL otherwise. *)
70
+
let bpf_object__find_program_by_name =
71
+
foreign "bpf_object__find_program_by_name"
72
+
(ptr Types.bpf_object @-> string @-> returning (ptr_opt Types.bpf_program))
73
+
74
+
(** [bpf_object__next_program obj_ptr prog_ptr] returns the next
75
+
program after [prog_ptr] found in the passed BPF object *)
76
+
let bpf_object__next_program =
77
+
foreign "bpf_object__next_program"
78
+
(ptr Types.bpf_object @-> ptr Types.bpf_program
79
+
@-> returning (ptr Types.bpf_program))
80
+
81
+
(** [bpf_program__pin prog path] pins the BPF program to a file in
82
+
the BPF FS specified by a [path]. This increments the programs
83
+
reference count, allowing it to stay loaded after the process
84
+
which loaded it has exited.
85
+
86
+
@param prog BPF program to pin, must already be loaded
87
+
@param path file path in a BPF file system
88
+
@return 0, on success; negative error code, otherwise *)
89
+
let bpf_program__pin =
90
+
foreign "bpf_program__pin"
91
+
(ptr Types.bpf_program @-> ptr char @-> returning int)
92
+
93
+
(** [bpf_program__unpin prog path] unpins the BPF program from a file in the
94
+
BPFFS specified by a path. This decrements the programs
95
+
reference count. The file pinning the BPF program can also be
96
+
unlinked by a different process in which case this function will
97
+
return an error.
98
+
99
+
@param prog BPF program to unpin
100
+
@param path file path to the pin in a BPF file system
101
+
@return 0, on success; negative error code, otherwise *)
102
+
let bpf_program__unpin =
103
+
foreign "bpf_program__unpin"
104
+
(ptr Types.bpf_program @-> ptr char @-> returning int)
105
+
106
+
(** [bpf_program__attach prog] is a generic function for
107
+
attaching a BPF program based on auto-detection of program type,
108
+
attach type, and extra paremeters, where applicable.
109
+
110
+
This is supported for:
111
+
- kprobe/kretprobe (depends on SEC() definition)
112
+
- uprobe/uretprobe (depends on SEC() definition)
113
+
- tracepoint
114
+
- raw tracepoint
115
+
- tracing programs (typed raw TP/fentry/fexit/fmod_ret)
116
+
117
+
Returns pointer to the newly created BPF link; or NULL is
118
+
returned on error, error code is stored in errno *)
119
+
let bpf_program__attach =
120
+
foreign "bpf_program__attach"
121
+
(ptr Types.bpf_program @-> returning (ptr_opt Types.bpf_link))
122
+
123
+
let bpf_program__fd =
124
+
foreign "bpf_program__fd" (ptr Types.bpf_program @-> returning int)
125
+
126
+
(** [bpf_link__pin link path] pins the BPF link to a file in the
127
+
BPF FS specified by a path. This increments the links reference
128
+
count, allowing it to stay loaded after the process which loaded
129
+
it has exited.
130
+
131
+
@param link BPF link to pin, must already be loaded
132
+
@param path file path in a BPF file system
133
+
@return 0, on success; negative error code, otherwise *)
134
+
let bpf_link__pin =
135
+
foreign "bpf_link__pin" (ptr Types.bpf_link @-> ptr char @-> returning int)
136
+
137
+
(** [bpf_link__unpin link path] unpins the BPF link from a file in
138
+
the BPFFS specified by a path. This decrements the links
139
+
reference count. The file pinning the BPF link can also be
140
+
unlinked by a different process in which case this function will
141
+
return an error.
142
+
143
+
@param prog BPF program to unpin
144
+
@param path file path to the pin in a BPF file system
145
+
@return 0, on success; negative error code, otherwise *)
146
+
let bpf_link__unpin =
147
+
foreign "bpf_link__unpin" (ptr Types.bpf_link @-> returning int)
148
+
149
+
(** [bpf_link__destroy link_ptr] Removes the link to the BPF program.
150
+
Returns 0 on success or -errno *)
151
+
let bpf_link__destroy =
152
+
foreign "bpf_link__destroy" (ptr Types.bpf_link @-> returning int)
153
+
154
+
(** [bpf_object__close obj_ptr] closes a BPF object and releases all
155
+
resources. *)
156
+
let bpf_object__close =
157
+
foreign "bpf_object__close" (ptr Types.bpf_object @-> returning void)
158
+
159
+
(* ======================================== Maps ======================================== *)
160
+
(* Not explicitly mentioned in the documentation but keys and values look
161
+
like they're copied into the internal bpf map structure, so we
162
+
don't need to be worried about keeping references around. *)
163
+
164
+
(** [bpf_object__find_map_by_name obj_ptr name] returns BPF map of the given
165
+
[name], if it exists within the passed BPF object.
166
+
167
+
Returns the pointer to the BPF map instance, if such map exists
168
+
within the BPF object; or NULL otherwise. *)
169
+
let bpf_object__find_map_by_name =
170
+
foreign "bpf_object__find_map_by_name"
171
+
(ptr Types.bpf_object @-> string @-> returning (ptr_opt Types.bpf_map))
172
+
173
+
(** [bpf_map__fd map_ptr] gets the file descriptor of the passed BPF
174
+
map
175
+
176
+
Returns the file descriptor; or -EINVAL in case of an error *)
177
+
let bpf_map__fd = foreign "bpf_map__fd" (ptr Types.bpf_map @-> returning int)
178
+
179
+
(** [bpf_map__lookup_elem map_ptr key_ptr key_sz val_ptr val_sz
180
+
flags] allows to lookup BPF map value corresponding to provided
181
+
key.
182
+
183
+
[bpf_map__lookup_elem] is high-level equivalent of
184
+
[bpf_map_lookup_elem] API with added check for key and value
185
+
size.
186
+
187
+
sizes are in bytes of key and value data. For per-CPU BPF maps
188
+
value size has to be a product of BPF map value size and number
189
+
of possible CPUs in the system (could be fetched with
190
+
libbpf_num_possible_cpus()). Note also that for per-CPU values
191
+
value size has to be aligned up to closest 8 bytes for alignment
192
+
reasons, so expected size is: round_up(value_size, 8)
193
+
194
+
Returns 0, on success; negative error, otherwise *)
195
+
let bpf_map__lookup_elem =
196
+
foreign "bpf_map__lookup_elem"
197
+
(ptr Types.bpf_map @-> ptr void @-> size_t @-> ptr void @-> size_t
198
+
@-> uint64_t @-> returning int)
199
+
200
+
(** [bpf_map__update_elem map_ptr key_ptr key_sz val_ptr val_sz
201
+
flags] allows to insert or update value in BPF map that
202
+
corresponds to provided key.
203
+
204
+
[bpf_map__update_elem] is high-level equivalent of
205
+
[bpf_map_update_elem] API with added check for key and value
206
+
size.
207
+
208
+
Check [bpf_map__lookup_elem] for details on sizes.
209
+
Returns 0, on success; negative error, otherwise *)
210
+
let bpf_map__update_elem =
211
+
foreign "bpf_map__update_elem"
212
+
(ptr Types.bpf_map @-> ptr void @-> size_t @-> ptr void @-> size_t
213
+
@-> uint64_t @-> returning int)
214
+
215
+
(** [bpf_map__delete_elem map_ptr key_ptr key_sz flags] allows to
216
+
delete element in BPF map that corresponds to provided key.
217
+
218
+
[bpf_map__delete_elem] is high-level equivalent of
219
+
[bpf_map_delete_elem] API with added check for key size.
220
+
221
+
Returns 0, on success; negative error, otherwise *)
222
+
let bpf_map__delete_elem =
223
+
foreign "bpf_map__delete_elem"
224
+
(ptr Types.bpf_map @-> ptr void @-> size_t @-> uint64_t @-> returning int)
225
+
226
+
(* ================================== Traffic control ================================== *)
227
+
228
+
let bpf_tc_hook_create =
229
+
foreign "bpf_tc_hook_create" (ptr Types.Bpf_tc.hook @-> returning int)
230
+
231
+
let bpf_tc_hook_destroy =
232
+
foreign "bpf_tc_hook_destroy" (ptr Types.Bpf_tc.hook @-> returning int)
233
+
234
+
let bpf_tc_attach =
235
+
foreign "bpf_tc_attach"
236
+
(ptr Types.Bpf_tc.hook @-> ptr Types.Bpf_tc.Opts.t @-> returning int)
237
+
238
+
let bpf_tc_detach =
239
+
foreign "bpf_tc_detach"
240
+
(ptr Types.Bpf_tc.hook @-> ptr Types.Bpf_tc.Opts.t @-> returning int)
241
+
242
+
(* ====================================== RingBuf ===================================== *)
243
+
244
+
(** [ring_buffer__new map_fd fn ctx_ptr opts] loads the callback
245
+
function [fn] into the ring buffer map provided by the file
246
+
descriptor [map_fd]. [ctx_ptr] allows the callback function to
247
+
access user provided context.
248
+
249
+
Returns pointer to the ring_buffer manager instance or NULL
250
+
otherwise *)
251
+
let ring_buffer__new =
252
+
foreign "ring_buffer__new"
253
+
(int @-> Types.ring_buffer_sample_fn @-> ptr void
254
+
@-> ptr Types.ring_buffer_opts
255
+
@-> returning (ptr_opt Types.ring_buffer))
256
+
257
+
(** [ring_buffer__poll ring_buf_ptr timeout] poll for available
258
+
data and consume records, if any are available.
259
+
260
+
Returns number of records consumed (or INT_MAX, whichever is
261
+
less), or negative number, if any of the registered callbacks
262
+
returned error. *)
263
+
let ring_buffer__poll =
264
+
foreign "ring_buffer__poll" (ptr Types.ring_buffer @-> int @-> returning int)
265
+
266
+
(** [ring_buffer__free ring_buf_ptr] Frees resources of the ring
267
+
buffer manager *)
268
+
let ring_buffer__free =
269
+
foreign "ring_buffer__free" (ptr Types.ring_buffer @-> returning void)
270
+
271
+
(** [ring_buffer__consume ring_buf_ptr] Consume available ring
272
+
buffer(s) data without event polling.
273
+
274
+
Returns number of records consumed across all registered ring
275
+
buffers (or INT_MAX, whichever is less), or negative number if
276
+
any of the callbacks return error. *)
277
+
let ring_buffer__consume =
278
+
foreign "ring_buffer__consume" (ptr Types.ring_buffer @-> returning int)
279
+
280
+
(** [ring_buffer__epoll_fd ring_buf_ptr] Gets an fd that can be used
281
+
to sleep until data is available in the ring(s) *)
282
+
let ring_buffer__epoll_fd =
283
+
foreign "ring_buffer__epoll_fd" (ptr Types.ring_buffer @-> returning int)
284
+
end
+409
vendor/ocaml-libbpf/src/bindings/c_type_description.ml
+409
vendor/ocaml-libbpf/src/bindings/c_type_description.ml
···
1
+
open Ctypes
2
+
3
+
(** You probably don't mean to be looking into this section, it is
4
+
part of the stub generation process of the bindings.*)
5
+
6
+
module Types (F : Ctypes.TYPE) = struct
7
+
open F
8
+
9
+
let c ?(prefix = "") label = constant (prefix ^ label) int64_t
10
+
11
+
let libbpf_print_level : [ `WARN | `INFO | `DEBUG | `UNEXPECTED ] typ =
12
+
let def = c ~prefix:"LIBBPF_" in
13
+
enum "libbpf_print_level"
14
+
~unexpected:(fun _ -> `UNEXPECTED)
15
+
[ (`WARN, def "WARN"); (`INFO, def "INFO"); (`DEBUG, def "DEBUG") ]
16
+
17
+
let libbpf_print_fn_t :
18
+
([ `WARN | `INFO | `DEBUG | `UNEXPECTED ] -> string -> int) static_funptr
19
+
typ =
20
+
typedef
21
+
(static_funptr (libbpf_print_level @-> string @-> returning int))
22
+
"libbpf_print_fn_t"
23
+
24
+
module Errno = struct
25
+
type t =
26
+
[ `LIBELF (* Something wrong in libelf *)
27
+
| `FORMAT (* BPF object format invalid *)
28
+
| `KVERSION (* Incorrect or no 'version' section *)
29
+
| `ENDIAN (* Endian mismatch *)
30
+
| `INTERNAL (* Internal error in libbpf *)
31
+
| `RELOC (* Relocation failed *)
32
+
| `LOAD (* Load program failure for unknown reason *)
33
+
| `VERIFY (* Kernel verifier blocks program loading *)
34
+
| `PROG2BIG (* Program too big *)
35
+
| `KVER (* Incorrect kernel version *)
36
+
| `PROGTYPE (* Kernel doesn't support this program type *)
37
+
| `WRNGPID (* Wrong pid in netlink message *)
38
+
| `INVSEQ (* Invalid netlink sequence *)
39
+
| `NLPARSE (* netlink parsing error *)
40
+
| `UNKNOWN ]
41
+
42
+
let t : t typ =
43
+
let def = c ~prefix:"LIBBPF_ERRNO__" in
44
+
enum "libbpf_errno"
45
+
~unexpected:(fun _ -> `UNKNOWN)
46
+
[
47
+
(`LIBELF, def "LIBELF");
48
+
(`FORMAT, def "FORMAT");
49
+
(`KVERSION, def "KVERSION");
50
+
(`ENDIAN, def "ENDIAN");
51
+
(`INTERNAL, def "INTERNAL");
52
+
(`RELOC, def "RELOC");
53
+
(`LOAD, def "LOAD");
54
+
(`VERIFY, def "VERIFY");
55
+
(`PROG2BIG, def "PROG2BIG");
56
+
(`KVER, def "KVER");
57
+
(`PROGTYPE, def "PROGTYPE");
58
+
(`WRNGPID, def "WRNGPID");
59
+
(`INVSEQ, def "INVSEQ");
60
+
(`NLPARSE, def "NLPARSE");
61
+
]
62
+
end
63
+
64
+
module Bpf_attach_type = struct
65
+
type cgroup =
66
+
[ `BPF_CGROUP_INET_INGRESS
67
+
| `BPF_CGROUP_INET_EGRESS
68
+
| `BPF_CGROUP_INET_SOCK_CREATE
69
+
| `BPF_CGROUP_SOCK_OPS
70
+
| `BPF_CGROUP_DEVICE
71
+
| `BPF_CGROUP_INET4_BIND
72
+
| `BPF_CGROUP_INET6_BIND
73
+
| `BPF_CGROUP_INET4_CONNECT
74
+
| `BPF_CGROUP_INET6_CONNECT
75
+
| `BPF_CGROUP_INET4_POST_BIND
76
+
| `BPF_CGROUP_INET6_POST_BIND
77
+
| `BPF_CGROUP_UDP4_SENDMSG
78
+
| `BPF_CGROUP_UDP6_SENDMSG
79
+
| `BPF_CGROUP_SYSCTL
80
+
| `BPF_CGROUP_UDP4_RECVMSG
81
+
| `BPF_CGROUP_UDP6_RECVMSG
82
+
| `BPF_CGROUP_GETSOCKOPT
83
+
| `BPF_CGROUP_SETSOCKOPT
84
+
| `BPF_CGROUP_INET4_GETPEERNAME
85
+
| `BPF_CGROUP_INET6_GETPEERNAME
86
+
| `BPF_CGROUP_INET4_GETSOCKNAME
87
+
| `BPF_CGROUP_INET6_GETSOCKNAME
88
+
| `BPF_CGROUP_INET_SOCK_RELEASE ]
89
+
90
+
type sk =
91
+
[ `BPF_SK_SKB_STREAM_PARSER
92
+
| `BPF_SK_SKB_STREAM_VERDICT
93
+
| `BPF_SK_MSG_VERDICT
94
+
| `BPF_SK_LOOKUP
95
+
| `BPF_SK_SKB_VERDICT
96
+
| `BPF_SK_REUSEPORT_SELECT
97
+
| `BPF_SK_REUSEPORT_SELECT_OR_MIGRATE ]
98
+
99
+
type trace =
100
+
[ `BPF_TRACE_RAW_TP
101
+
| `BPF_TRACE_FENTRY
102
+
| `BPF_TRACE_FEXIT
103
+
| `BPF_TRACE_ITER
104
+
| `BPF_TRACE_KPROBE_MULTI ]
105
+
106
+
type xdp = [ `BPF_XDP_DEVMAP | `BPF_XDP_CPUMAP | `BPF_XDP ]
107
+
108
+
type other =
109
+
[ `BPF_LIRC_MODE2
110
+
| `BPF_FLOW_DISSECTOR
111
+
| `BPF_MODIFY_RETURN
112
+
| `BPF_PERF_EVENT
113
+
| `BPF_LSM_MAC
114
+
| `BPF_LSM_CGROUP ]
115
+
116
+
type t = [ cgroup | sk | trace | xdp | other | `UNKNOWN ]
117
+
118
+
let t : t typ =
119
+
let cgroup = c ~prefix:"BPF_CGROUP_" in
120
+
let sk = c ~prefix:"BPF_SK_" in
121
+
let trace = c ~prefix:"BPF_TRACE_" in
122
+
let xdp = c ~prefix:"BPF_XDP_" in
123
+
enum "bpf_attach_type"
124
+
~unexpected:(fun _ -> `UNKNOWN)
125
+
[
126
+
(`BPF_CGROUP_INET_INGRESS, cgroup "INET_INGRESS");
127
+
(`BPF_CGROUP_INET_EGRESS, cgroup "INET_EGRESS");
128
+
(`BPF_CGROUP_INET_SOCK_CREATE, cgroup "INET_SOCK_CREATE");
129
+
(`BPF_CGROUP_SOCK_OPS, cgroup "SOCK_OPS");
130
+
(`BPF_CGROUP_DEVICE, cgroup "DEVICE");
131
+
(`BPF_CGROUP_INET4_BIND, cgroup "INET4_BIND");
132
+
(`BPF_CGROUP_INET6_BIND, cgroup "INET6_BIND");
133
+
(`BPF_CGROUP_INET4_CONNECT, cgroup "INET4_CONNECT");
134
+
(`BPF_CGROUP_INET6_CONNECT, cgroup "INET6_CONNECT");
135
+
(`BPF_CGROUP_INET4_POST_BIND, cgroup "INET4_POST_BIND");
136
+
(`BPF_CGROUP_INET6_POST_BIND, cgroup "INET6_POST_BIND");
137
+
(`BPF_CGROUP_UDP4_SENDMSG, cgroup "UDP4_SENDMSG");
138
+
(`BPF_CGROUP_UDP6_SENDMSG, cgroup "UDP6_SENDMSG");
139
+
(`BPF_CGROUP_SYSCTL, cgroup "SYSCTL");
140
+
(`BPF_CGROUP_UDP4_RECVMSG, cgroup "UDP4_RECVMSG");
141
+
(`BPF_CGROUP_UDP6_RECVMSG, cgroup "UDP6_RECVMSG");
142
+
(`BPF_CGROUP_GETSOCKOPT, cgroup "GETSOCKOPT");
143
+
(`BPF_CGROUP_SETSOCKOPT, cgroup "SETSOCKOPT");
144
+
(`BPF_CGROUP_INET4_GETPEERNAME, cgroup "INET4_GETPEERNAME");
145
+
(`BPF_CGROUP_INET6_GETPEERNAME, cgroup "INET6_GETPEERNAME");
146
+
(`BPF_CGROUP_INET4_GETSOCKNAME, cgroup "INET4_GETSOCKNAME");
147
+
(`BPF_CGROUP_INET6_GETSOCKNAME, cgroup "INET6_GETSOCKNAME");
148
+
(`BPF_CGROUP_INET_SOCK_RELEASE, cgroup "INET_SOCK_RELEASE");
149
+
(`BPF_SK_SKB_STREAM_PARSER, sk "SKB_STREAM_PARSER");
150
+
(`BPF_SK_SKB_STREAM_VERDICT, sk "SKB_STREAM_VERDICT");
151
+
(`BPF_SK_MSG_VERDICT, sk "MSG_VERDICT");
152
+
(`BPF_SK_LOOKUP, sk "LOOKUP");
153
+
(`BPF_SK_SKB_VERDICT, sk "SKB_VERDICT");
154
+
(`BPF_SK_REUSEPORT_SELECT, sk "REUSEPORT_SELECT");
155
+
(`BPF_SK_REUSEPORT_SELECT_OR_MIGRATE, sk "REUSEPORT_SELECT_OR_MIGRATE");
156
+
(`BPF_TRACE_RAW_TP, trace "RAW_TP");
157
+
(`BPF_TRACE_FENTRY, trace "FENTRY");
158
+
(`BPF_TRACE_FEXIT, trace "FEXIT");
159
+
(`BPF_TRACE_ITER, trace "ITER");
160
+
(`BPF_TRACE_KPROBE_MULTI, trace "KPROBE_MULTI");
161
+
(`BPF_XDP_DEVMAP, xdp "DEVMAP");
162
+
(`BPF_XDP_CPUMAP, xdp "CPUMAP");
163
+
(`BPF_XDP, c "BPF_XDP");
164
+
(`BPF_LIRC_MODE2, c "BPF_LIRC_MODE2");
165
+
(`BPF_FLOW_DISSECTOR, c "BPF_FLOW_DISSECTOR");
166
+
(`BPF_MODIFY_RETURN, c "BPF_MODIFY_RETURN");
167
+
(`BPF_PERF_EVENT, c "BPF_PERF_EVENT");
168
+
(`BPF_LSM_MAC, c "BPF_LSM_MAC");
169
+
(`BPF_LSM_CGROUP, c "BPF_LSM_CGROUP");
170
+
]
171
+
end
172
+
173
+
module Bpf_link_type = struct
174
+
type t =
175
+
[ `UNSPEC
176
+
| `RAW_TRACEPOINT
177
+
| `TRACING
178
+
| `CGROUP
179
+
| `ITER
180
+
| `NETNS
181
+
| `XDP
182
+
| `PERF_EVENT
183
+
| `KPROBE_MULTI
184
+
| `STRUCT_OPS
185
+
| `UNKNOWN ]
186
+
187
+
let t : t typ =
188
+
let def = c ~prefix:"BPF_LINK_TYPE_" in
189
+
enum "bpf_link_type"
190
+
~unexpected:(fun _ -> `UNKNOWN)
191
+
[
192
+
(`UNSPEC, def "UNSPEC");
193
+
(`RAW_TRACEPOINT, def "RAW_TRACEPOINT");
194
+
(`TRACING, def "TRACING");
195
+
(`CGROUP, def "CGROUP");
196
+
(`ITER, def "ITER");
197
+
(`NETNS, def "NETNS");
198
+
(`XDP, def "XDP");
199
+
(`PERF_EVENT, def "PERF_EVENT");
200
+
(`KPROBE_MULTI, def "KPROBE_MULTI");
201
+
(`STRUCT_OPS, def "STRUCT_OPS");
202
+
]
203
+
end
204
+
205
+
module Bpf_map_type = struct
206
+
type t =
207
+
[ `UNSPEC
208
+
| `HASH
209
+
| `ARRAY
210
+
| `PROG_ARRAY
211
+
| `PERF_EVENT_ARRAY
212
+
| `PERCPU_HASH
213
+
| `PERCPU_ARRAY
214
+
| `STACK_TRACE
215
+
| `CGROUP_ARRAY
216
+
| `LRU_HASH
217
+
| `LRU_PERCPU_HASH
218
+
| `LPM_TRIE
219
+
| `ARRAY_OF_MAPS
220
+
| `HASH_OF_MAPS
221
+
| `DEVMAP
222
+
| `SOCKMAP
223
+
| `CPUMAP
224
+
| `XSKMAP
225
+
| `SOCKHASH
226
+
| `CGROUP_STORAGE
227
+
| `REUSEPORT_SOCKARRAY
228
+
| `PERCPU_CGROUP_STORAGE
229
+
| `QUEUE
230
+
| `STACK
231
+
| `SK_STORAGE
232
+
| `DEVMAP_HASH
233
+
| `STRUCT_OPS
234
+
| `RINGBUF
235
+
| `INODE_STORAGE
236
+
| `TASK_STORAGE
237
+
| `BLOOM_FILTER
238
+
| `USER_RINGBUF
239
+
| `UNKNOWN ]
240
+
241
+
let def = c ~prefix:"BPF_MAP_TYPE_"
242
+
243
+
let t : t typ =
244
+
enum "bpf_map_type"
245
+
~unexpected:(fun _ -> `UNKNOWN)
246
+
[
247
+
(`UNSPEC, def "UNSPEC");
248
+
(`HASH, def "HASH");
249
+
(`ARRAY, def "ARRAY");
250
+
(`PROG_ARRAY, def "PROG_ARRAY");
251
+
(`PERF_EVENT_ARRAY, def "PERF_EVENT_ARRAY");
252
+
(`PERCPU_HASH, def "PERCPU_HASH");
253
+
(`PERCPU_ARRAY, def "PERCPU_ARRAY");
254
+
(`STACK_TRACE, def "STACK_TRACE");
255
+
(`CGROUP_ARRAY, def "CGROUP_ARRAY");
256
+
(`LRU_HASH, def "LRU_HASH");
257
+
(`LRU_PERCPU_HASH, def "LRU_PERCPU_HASH");
258
+
(`LPM_TRIE, def "LPM_TRIE");
259
+
(`ARRAY_OF_MAPS, def "ARRAY_OF_MAPS");
260
+
(`HASH_OF_MAPS, def "HASH_OF_MAPS");
261
+
(`DEVMAP, def "DEVMAP");
262
+
(`SOCKMAP, def "SOCKMAP");
263
+
(`CPUMAP, def "CPUMAP");
264
+
(`XSKMAP, def "XSKMAP");
265
+
(`SOCKHASH, def "SOCKHASH");
266
+
(`CGROUP_STORAGE, def "CGROUP_STORAGE");
267
+
(`REUSEPORT_SOCKARRAY, def "REUSEPORT_SOCKARRAY");
268
+
(`PERCPU_CGROUP_STORAGE, def "PERCPU_CGROUP_STORAGE");
269
+
(`QUEUE, def "QUEUE");
270
+
(`STACK, def "STACK");
271
+
(`SK_STORAGE, def "SK_STORAGE");
272
+
(`DEVMAP_HASH, def "DEVMAP_HASH");
273
+
(`STRUCT_OPS, def "STRUCT_OPS");
274
+
(`RINGBUF, def "RINGBUF");
275
+
(`INODE_STORAGE, def "INODE_STORAGE");
276
+
(`TASK_STORAGE, def "TASK_STORAGE");
277
+
(`BLOOM_FILTER, def "BLOOM_FILTER");
278
+
(`USER_RINGBUF, def "USER_RINGBUF");
279
+
]
280
+
end
281
+
282
+
module Bpf_prog_type = struct
283
+
type t =
284
+
[ `UNSPEC
285
+
| `SOCKET_FILTER
286
+
| `KPROBE
287
+
| `SCHED_CLS
288
+
| `SCHED_ACT
289
+
| `TRACEPOINT
290
+
| `XDP
291
+
| `PERF_EVENT
292
+
| `CGROUP_SKB
293
+
| `CGROUP_SOCK
294
+
| `LWT_IN
295
+
| `LWT_OUT
296
+
| `LWT_XMIT
297
+
| `SOCK_OPS
298
+
| `SK_SKB
299
+
| `CGROUP_DEVICE
300
+
| `SK_MSG
301
+
| `RAW_TRACEPOINT
302
+
| `CGROUP_SOCK_ADDR
303
+
| `LWT_SEG6LOCAL
304
+
| `LIRC_MODE2
305
+
| `SK_REUSEPORT
306
+
| `FLOW_DISSECTOR
307
+
| `CGROUP_SYSCTL
308
+
| `RAW_TRACEPOINT_WRITABLE
309
+
| `CGROUP_SOCKOPT
310
+
| `TRACING
311
+
| `STRUCT_OPS
312
+
| `EXT
313
+
| `LSM
314
+
| `SK_LOOKUP
315
+
| `SYSCALL
316
+
| `UNKNOWN ]
317
+
318
+
let t : t typ =
319
+
let def = c ~prefix:"BPF_PROG_TYPE_" in
320
+
enum "bpf_prog_type"
321
+
~unexpected:(fun _ -> `UNKNOWN)
322
+
[
323
+
(`UNSPEC, def "UNSPEC");
324
+
(`SOCKET_FILTER, def "SOCKET_FILTER");
325
+
(`KPROBE, def "KPROBE");
326
+
(`SCHED_CLS, def "SCHED_CLS");
327
+
(`SCHED_ACT, def "SCHED_ACT");
328
+
(`TRACEPOINT, def "TRACEPOINT");
329
+
(`XDP, def "XDP");
330
+
(`PERF_EVENT, def "PERF_EVENT");
331
+
(`CGROUP_SKB, def "CGROUP_SKB");
332
+
(`CGROUP_SOCK, def "CGROUP_SOCK");
333
+
(`LWT_IN, def "LWT_IN");
334
+
(`LWT_OUT, def "LWT_OUT");
335
+
(`LWT_XMIT, def "LWT_XMIT");
336
+
(`SOCK_OPS, def "SOCK_OPS");
337
+
(`SK_SKB, def "SK_SKB");
338
+
(`CGROUP_DEVICE, def "CGROUP_DEVICE");
339
+
(`SK_MSG, def "SK_MSG");
340
+
(`RAW_TRACEPOINT, def "RAW_TRACEPOINT");
341
+
(`CGROUP_SOCK_ADDR, def "CGROUP_SOCK_ADDR");
342
+
(`LWT_SEG6LOCAL, def "LWT_SEG6LOCAL");
343
+
(`LIRC_MODE2, def "LIRC_MODE2");
344
+
(`SK_REUSEPORT, def "SK_REUSEPORT");
345
+
(`FLOW_DISSECTOR, def "FLOW_DISSECTOR");
346
+
(`CGROUP_SYSCTL, def "CGROUP_SYSCTL");
347
+
(`RAW_TRACEPOINT_WRITABLE, def "RAW_TRACEPOINT_WRITABLE");
348
+
(`CGROUP_SOCKOPT, def "CGROUP_SOCKOPT");
349
+
(`TRACING, def "TRACING");
350
+
(`STRUCT_OPS, def "STRUCT_OPS");
351
+
(`EXT, def "EXT");
352
+
(`LSM, def "LSM");
353
+
(`SK_LOOKUP, def "SK_LOOKUP");
354
+
(`SYSCALL, def "SYSCALL");
355
+
]
356
+
end
357
+
358
+
type bpf_object
359
+
type bpf_program
360
+
type bpf_link
361
+
type bpf_map
362
+
363
+
let bpf_object : bpf_object structure typ = structure "bpf_object"
364
+
let bpf_program : bpf_program structure typ = structure "bpf_program"
365
+
let bpf_link : bpf_link structure typ = structure "bpf_link"
366
+
let bpf_map : bpf_map structure typ = structure "bpf_map"
367
+
368
+
let ring_buffer_sample_fn :
369
+
(unit ptr -> unit ptr -> Unsigned.size_t -> int) static_funptr typ =
370
+
typedef
371
+
(static_funptr (ptr void @-> ptr void @-> size_t @-> returning int))
372
+
"ring_buffer_sample_fn"
373
+
374
+
let ring_buffer : [ `Ring_buffer ] structure typ = structure "ring_buffer"
375
+
376
+
let ring_buffer_opts : [ `Ring_buffer_opts ] structure typ =
377
+
structure "ring_buffer_opts"
378
+
379
+
module Bpf_tc = struct
380
+
let attach_point : [ `INGRESS | `EGRESS | `CUSTOM ] typ =
381
+
let def = c ~prefix:"BPF_TC_" in
382
+
enum "bpf_tc_attach_point"
383
+
[
384
+
(`INGRESS, def "INGRESS");
385
+
(`EGRESS, def "EGRESS");
386
+
(`CUSTOM, def "CUSTOM");
387
+
]
388
+
389
+
module Opts = struct
390
+
let t : [ `Opts ] structure typ = structure "bpf_tc_opts"
391
+
let ( -: ) ty label = field t label ty
392
+
let sz = size_t -: "sz"
393
+
let prog_fd = int -: "prog_fd"
394
+
let flags = uint32_t -: "flags"
395
+
let prog_id = uint32_t -: "prog_id"
396
+
let handle = uint32_t -: "handle"
397
+
let priority = uint32_t -: "priority"
398
+
let () = seal t
399
+
end
400
+
401
+
let hook : [ `Hook ] structure typ = structure "bpf_tc_hook"
402
+
let ( -: ) ty label = field hook label ty
403
+
let sz = size_t -: "sz"
404
+
let ifindex = int -: "ifindex"
405
+
let attach_point = attach_point -: "attach_point"
406
+
let parent = uint32_t -: "parent"
407
+
let () = seal hook
408
+
end
409
+
end
+47
vendor/ocaml-libbpf/src/bindings/dune
+47
vendor/ocaml-libbpf/src/bindings/dune
···
1
+
(library
2
+
(name c_type_description)
3
+
(public_name libbpf.c_type_description)
4
+
(libraries ctypes)
5
+
(modules c_type_description))
6
+
7
+
(rule
8
+
(target c_types_generated.ml)
9
+
(deps stubgen/gen_type_bindings_from_c.exe)
10
+
(action
11
+
(with-stdout-to
12
+
%{target}
13
+
(run %{deps}))))
14
+
15
+
(library
16
+
(name c_function_description)
17
+
(public_name libbpf.c_function_description)
18
+
(libraries ctypes c_type_description)
19
+
(modules c_types_generated c_function_description))
20
+
21
+
(rule
22
+
(target c_function_generated.ml)
23
+
(deps stubgen/gen_function_bindings.exe)
24
+
(action
25
+
(with-stdout-to
26
+
%{target}
27
+
(run %{deps} ml))))
28
+
29
+
(rule
30
+
(target bpf_stubs.c)
31
+
(deps stubgen/gen_function_bindings.exe)
32
+
(action
33
+
(with-stdout-to
34
+
%{target}
35
+
(run %{deps} c))))
36
+
37
+
; This is just a level of indirection to organize functions and type bindings
38
+
39
+
(library
40
+
(name c)
41
+
(public_name libbpf.c)
42
+
(c_library_flags -lbpf)
43
+
(foreign_stubs
44
+
(language c)
45
+
(names bpf_stubs))
46
+
(libraries c_function_description)
47
+
(modules c c_function_generated))
+23
vendor/ocaml-libbpf/src/bindings/stubgen/dune
+23
vendor/ocaml-libbpf/src/bindings/stubgen/dune
···
1
+
(executable
2
+
(name gen_type_bindings)
3
+
(modules gen_type_bindings)
4
+
(libraries ctypes.stubs c_type_description))
5
+
6
+
(rule
7
+
(target gen_type_bindings.c)
8
+
(action
9
+
(with-stdout-to
10
+
%{target}
11
+
(run ./gen_type_bindings.exe))))
12
+
13
+
(rule
14
+
(targets gen_type_bindings_from_c.exe)
15
+
(deps gen_type_bindings.c)
16
+
(action
17
+
(bash
18
+
"%{cc} %{deps} -I `dirname %{lib:ctypes:ctypes_cstubs_internals.h}` -I %{ocaml_where} -o %{targets}")))
19
+
20
+
(executable
21
+
(name gen_function_bindings)
22
+
(modules gen_function_bindings)
23
+
(libraries ctypes.stubs c_function_description))
+12
vendor/ocaml-libbpf/src/bindings/stubgen/gen_function_bindings.ml
+12
vendor/ocaml-libbpf/src/bindings/stubgen/gen_function_bindings.ml
···
1
+
let () =
2
+
let concurrency = Cstubs.unlocked in
3
+
let errno = Cstubs.ignore_errno in
4
+
match Sys.argv.(1) with
5
+
| "ml" ->
6
+
Cstubs.write_ml ~concurrency Format.std_formatter ~prefix:"" ~errno
7
+
(module C_function_description.Functions)
8
+
| "c" ->
9
+
print_endline "#include <bpf/libbpf.h>";
10
+
Cstubs.write_c ~concurrency Format.std_formatter ~prefix:"" ~errno
11
+
(module C_function_description.Functions)
12
+
| s -> failwith ("unknown functions " ^ s)
+3
vendor/ocaml-libbpf/src/bindings/stubgen/gen_type_bindings.ml
+3
vendor/ocaml-libbpf/src/bindings/stubgen/gen_type_bindings.ml
+7
vendor/ocaml-libbpf/src/dune
+7
vendor/ocaml-libbpf/src/dune
+151
vendor/ocaml-libbpf/src/index.mld
+151
vendor/ocaml-libbpf/src/index.mld
···
1
+
{0 ocaml-libbpf}
2
+
3
+
OCaml bindings to {{:https://github.com/libbpf/libbpf}libbpf} C
4
+
library for loading eBPF programs into the linux kernel.
5
+
6
+
{1 Introduction}
7
+
8
+
Writing eBPF programs consist of two distinct parts. Implementing the
9
+
code that executes in-kernel and user-level code responsible for
10
+
loading/initializing/linking/teardown of the in-kernel code. This
11
+
OCaml library provides the latter via binding the C libbpf library. It
12
+
exposes both the raw low-level bindings as well as a set of high-level
13
+
API's for handling your eBPF objects. As of now, the kernel part must
14
+
still be written in
15
+
{{:https://stackoverflow.com/questions/57688344/what-is-not-allowed-in-restricted-c-for-ebpf}
16
+
restricted C} and compiled with llvm to eBPF bytecode.
17
+
18
+
For the high-level APIs: {!Libbpf}
19
+
20
+
For the low-level bindings: {!Libbpf.C}.
21
+
22
+
{1:Tutorial Tutorial}
23
+
24
+
This example assumes the user has knowledge of how to implement the
25
+
kernel part of a eBPF program. If not, you can check out this
26
+
{{:https://nakryiko.com/posts/libbpf-bootstrap/#the-bpf-side}
27
+
resource} first. Consider the following kernel eBPF program named {b
28
+
minimal.bpf.c}:
29
+
30
+
{@c[
31
+
// SPDX-License-Identifier: GPL-2.0 OR BSD-3-Clause
32
+
/* Copyright (c) 2020 Facebook */
33
+
#include <linux/bpf.h>
34
+
#include "bpf/bpf_helpers.h" /* This is from our libbpf library */
35
+
36
+
char LICENSE[] SEC("license") = "Dual BSD/GPL";
37
+
38
+
/* Globals implemented as an array */
39
+
struct {
40
+
__uint(type, BPF_MAP_TYPE_ARRAY);
41
+
__uint(max_entries, 1);
42
+
__type(key, int);
43
+
__type(value, long);
44
+
} globals SEC(".maps");
45
+
46
+
int my_pid_index = 0;
47
+
48
+
SEC("tp/syscalls/sys_enter_write")
49
+
int handle_tp(void *ctx) {
50
+
int pid = bpf_get_current_pid_tgid() >> 32;
51
+
52
+
long *my_pid;
53
+
my_pid = bpf_map_lookup_elem(&globals, &my_pid_index);
54
+
if (my_pid == NULL) {
55
+
bpf_printk("Error got NULL");
56
+
return 1;
57
+
};
58
+
59
+
if (pid != *my_pid)
60
+
return 0;
61
+
62
+
bpf_printk("Hello, BPF triggered from PID %d", pid);
63
+
64
+
return 0;
65
+
}
66
+
]}
67
+
68
+
After compilation to eBPF ELF file as {b "minimal.o"}. Users just need
69
+
to provide the path to this ELF file along with the name of the
70
+
program and optionally an initialization function. Note that the name
71
+
of the program refers to the function identifier under the SEC(...)
72
+
attribute, in this case it is {b "handle_tp"}.
73
+
74
+
{@ocaml[
75
+
open Libbpf
76
+
77
+
let obj_path = "minimal.bpf.o"
78
+
let program_names = [ "handle_tp" ]
79
+
80
+
let () =
81
+
with_bpf_object_open_load_link ~obj_path ~program_names ~before_link
82
+
(fun obj link -> (* Do something *))
83
+
]}
84
+
85
+
The context manager {{!Libbpf.with_bpf_object_open_load_link}
86
+
with_bpf_object_open_load_link} is a convenience wrapper for all the
87
+
neccessary steps to load up your eBPF program into the kernel.
88
+
89
+
If we don't specify anything in the body of the function marked with
90
+
{b (* Do something *)}, our loaded kernel program will be unloaded
91
+
immediately. In this case, we will add some looping logic to keep the
92
+
program running in the kernel and add a set of signal handlers to
93
+
escape the loop.
94
+
95
+
{@ocaml[
96
+
let obj_path = "minimal.bpf.o"
97
+
let program_names = [ "handle_tp" ]
98
+
99
+
let () =
100
+
with_bpf_object_open_load_link ~obj_path ~program_names ~before_link
101
+
(fun obj link ->
102
+
103
+
(* Set up signal handlers *)
104
+
let exitting = ref true in
105
+
let sig_handler = Sys.Signal_handle (fun _ -> exitting := false) in
106
+
Sys.(set_signal sigint sig_handler);
107
+
Sys.(set_signal sigterm sig_handler);
108
+
109
+
Printf.printf
110
+
"Successfully started! Please run `sudo cat \
111
+
/sys/kernel/debug/tracing/trace_pipe` to see output of the BPF \
112
+
programs.\n\
113
+
%!"
114
+
115
+
(* Loop until Ctrl-C is called *)
116
+
while !exitting do
117
+
Printf.eprintf ".%!";
118
+
Unix.sleepf 1.0
119
+
done)
120
+
]}
121
+
122
+
Our bpf program is now running in the kernel until we decide to
123
+
interrupt it. However, it doesn't do exactly what we want. In
124
+
particular, it doesn't filter for our process PID. This is because we
125
+
haven't loaded our process PID into the BPF map. To do this, we need
126
+
the name of the map we declared by our {b minimal.bpf.c} program. In
127
+
this case, our BPF array map was named {b globals}.
128
+
129
+
{@ocaml[
130
+
let map = "globals"
131
+
132
+
(* Load PID into BPF map *)
133
+
let before_link obj =
134
+
let pid = Unix.getpid () |> Signed.Long.of_int in
135
+
let global_map = bpf_object_find_map_by_name obj map in
136
+
(* When updating an element, users need to specify the type of the key and value
137
+
declared by the map which checks that the key and value size are consistent. *)
138
+
bpf_map_update_elem ~key_ty:Ctypes.int ~val_ty:Ctypes.long global_map 0 pid
139
+
]}
140
+
141
+
Now if we combine the two, we can run this program and see the output
142
+
interactively being printed to the trace pipe.
143
+
144
+
{1 Notice!}
145
+
146
+
root permissions are required when you run eBPF programs. This is a
147
+
consequence of the fact that they are loaded into the kernel. To offer
148
+
some assurance though, eBPF programs always have to pass through a
149
+
verifier before they can be loaded. This ensures that eBPF programs
150
+
aren't able crash to crash the kernel. For more information, read
151
+
{{:https://ebpf.io/what-is-ebpf/#ebpf-safety} here}.
+153
vendor/ocaml-libbpf/src/libbpf.ml
+153
vendor/ocaml-libbpf/src/libbpf.ml
···
1
+
open Ctypes
2
+
module C = C
3
+
4
+
let major_version =
5
+
C.Functions.libbpf_major_version () |> Unsigned.UInt32.to_int
6
+
7
+
let minor_version =
8
+
C.Functions.libbpf_minor_version () |> Unsigned.UInt32.to_int
9
+
10
+
let version_string = C.Functions.libbpf_version_string ()
11
+
12
+
let bpf_attach_type_str attach_type =
13
+
C.Functions.libbpf_bpf_attach_type_str attach_type
14
+
15
+
let bpf_link_type_str link_type = C.Functions.libbpf_bpf_link_type_str link_type
16
+
let bpf_map_type_str map_type = C.Functions.libbpf_bpf_map_type_str map_type
17
+
let bpf_prog_type_str prog_type = C.Functions.libbpf_bpf_prog_type_str prog_type
18
+
19
+
type bpf_object = C.Types.bpf_object structure ptr
20
+
21
+
type bpf_program = {
22
+
name : string;
23
+
fd : int;
24
+
ptr : C.Types.bpf_program structure ptr;
25
+
}
26
+
27
+
type bpf_map = { fd : int; ptr : C.Types.bpf_map structure ptr }
28
+
type bpf_link = C.Types.bpf_link structure ptr
29
+
30
+
let failwith_f fmt =
31
+
let fails s = failwith s in
32
+
Printf.ksprintf fails fmt
33
+
34
+
let 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
+
39
+
let 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
+
44
+
let 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
+
49
+
let 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
+
54
+
let bpf_program_fd (prog : bpf_program) = prog.fd
55
+
56
+
let 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
+
61
+
let bpf_map_fd (map : bpf_map) = map.fd
62
+
63
+
let 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
+
68
+
let bpf_object_close bpf_object = C.Functions.bpf_object__close bpf_object
69
+
70
+
let 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
+
127
+
let 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
+
141
+
let 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)
+114
vendor/ocaml-libbpf/src/libbpf.mli
+114
vendor/ocaml-libbpf/src/libbpf.mli
···
1
+
(** See {!page-index} for example usage *)
2
+
3
+
open Ctypes
4
+
5
+
module C : module type of C
6
+
(** Entry point for the underlying C primatives *)
7
+
8
+
val major_version : int
9
+
val minor_version : int
10
+
val version_string : string
11
+
val bpf_attach_type_str : C.Types.Bpf_attach_type.t -> string
12
+
val bpf_link_type_str : C.Types.Bpf_link_type.t -> string
13
+
val bpf_map_type_str : C.Types.Bpf_map_type.t -> string
14
+
val bpf_prog_type_str : C.Types.Bpf_prog_type.t -> string
15
+
16
+
type bpf_object = C.Types.bpf_object structure ptr
17
+
18
+
type bpf_program = {
19
+
name : string;
20
+
fd : int;
21
+
ptr : C.Types.bpf_program structure ptr;
22
+
}
23
+
24
+
type bpf_map = { fd : int; ptr : C.Types.bpf_map structure ptr }
25
+
type bpf_link = C.Types.bpf_link structure ptr
26
+
27
+
val bpf_object_open : string -> bpf_object
28
+
(** [bpf_object_open path] opens and tries to read the bpf_object
29
+
found at path [path] in the filesystem. Libbpf parses the BPF
30
+
object file and discovers BPF maps, BPF programs, and global
31
+
variables. After a BPF app is opened, user space apps can make
32
+
additional adjustments (setting BPF program types, if necessary;
33
+
pre-setting initial values for global variables, etc.) before all
34
+
the entities are created and loaded.
35
+
36
+
Fails if object file is in invalid format or path does not exist *)
37
+
38
+
val bpf_object_load : bpf_object -> unit
39
+
(** [bpf_object_load obj] tries to load [obj]. Libbpf parses
40
+
the BPF object file and discovers BPF maps, BPF programs, and
41
+
global variables. After a BPF app is opened, user space apps can
42
+
make additional adjustments (setting BPF program types, if
43
+
necessary; pre-setting initial values for global variables, etc.)
44
+
before all the entities are created and loaded. *)
45
+
46
+
val bpf_object_find_program_by_name : bpf_object -> string -> bpf_program
47
+
(** [bpf_object_find_program_by_name obj name] locates the
48
+
program identifier [name] within the [obj].
49
+
50
+
Fails if [name] is not found *)
51
+
52
+
val bpf_program_attach : bpf_program -> bpf_link
53
+
(** [bpf_program_attach prog] attaches the [prog] in the
54
+
kernel to start respond to events. Libbpf attaches BPF programs to
55
+
various BPF hook points (e.g., tracepoints, kprobes, cgroup hooks,
56
+
network packet processing pipeline, etc.). During this phase, BPF
57
+
programs perform useful work such as processing packets, or
58
+
updating BPF maps and global variables that can be read from user
59
+
space
60
+
61
+
Fails if link could not be attached *)
62
+
63
+
val bpf_program_fd : bpf_program -> int
64
+
(** [bpf_map_fd prog] returns the fd of the [prog] *)
65
+
66
+
val bpf_object_find_map_by_name : bpf_object -> string -> bpf_map
67
+
(** [bpf_object_find_map_by_name obj name] locates the bpf_map
68
+
identifier [name] within [obj].
69
+
70
+
Fails if map is not found *)
71
+
72
+
val bpf_map_fd : bpf_map -> int
73
+
(** [bpf_map_fd map] returns the fd of the [map] *)
74
+
75
+
val bpf_link_destroy : bpf_link -> unit
76
+
(** [bpf_link_destroy link] detaches and unloads the bpf program
77
+
associated to [link] from the kernel *)
78
+
79
+
val bpf_object_close : bpf_object -> unit
80
+
(** [bpf_object_close obj] tearsdown [obj]. BPF maps are destroyed,
81
+
and all the resources used by the BPF app are freed. *)
82
+
83
+
val with_bpf_object_open_load_link :
84
+
obj_path:string ->
85
+
program_names:string list ->
86
+
?before_link:(bpf_object -> unit) ->
87
+
(bpf_object -> bpf_link list -> unit) ->
88
+
unit
89
+
(** [with_bpf_object_open_load_link obj_path program_names
90
+
?before_link fn] performs opening and loading of the provided
91
+
filesystem path to the bpf_object [obj_path]. This helper runs
92
+
[before_link] before the program attaches the bpf programs
93
+
specified in [program_names]. Initialization code should go
94
+
here. [fn] is passed the bpf_object and the list of program links
95
+
if all steps were successful. Ensures all the proper shutdown and
96
+
cleanup of bpf_object resources and links *)
97
+
98
+
val bpf_map_lookup_value :
99
+
key_ty:'a typ -> val_ty:'b typ -> val_zero:'b -> bpf_map -> 'a -> 'b
100
+
(** [bpf_map_lookup_value key_ty val_ty val_zero map k flags] Looks
101
+
up the value associated with the key [k]. If key is invalid, no
102
+
value is found or the size of key/value is not in sync, it will
103
+
return an error. [bpf_map_lookup_value] expects [key_ty] and
104
+
[val_ty] to verify the types are coherent in your bpf map
105
+
declaration. [val_zero] is merely an initialization value that
106
+
will be overwritten. *)
107
+
108
+
val bpf_map_update_elem :
109
+
key_ty:'a typ -> val_ty:'b typ -> bpf_map -> 'a -> 'b (* -> flags *) -> unit
110
+
(** [bpf_map_update_elem key_ty val_ty map k v flags] updates the
111
+
value associated the key [k] to [v]. If key is invalid or the
112
+
size of key/value is not in sync, it will return an
113
+
error. [bpf_map_update_elem] expects [key_ty] and [val_ty] to
114
+
verify the types are coherent in your bpf map declaration. *)
+4
vendor/ocaml-libbpf/src/libbpf_maps/dune
+4
vendor/ocaml-libbpf/src/libbpf_maps/dune
+34
vendor/ocaml-libbpf/src/libbpf_maps/libbpf_maps.ml
+34
vendor/ocaml-libbpf/src/libbpf_maps/libbpf_maps.ml
···
1
+
open Libbpf
2
+
open Ctypes
3
+
4
+
module RingBuffer = struct
5
+
type t = [ `Ring_buffer ] structure ptr
6
+
7
+
type callback =
8
+
unit Ctypes_static.ptr -> unit Ctypes_static.ptr -> Unsigned.size_t -> int
9
+
10
+
let init bpf_map ~callback f =
11
+
(* Coerce it to the static_funptr so it can be passed to the C function *)
12
+
let callback_c =
13
+
coerce
14
+
(Foreign.funptr ~runtime_lock:true ~check_errno:true
15
+
(ptr void @-> ptr void @-> size_t @-> returning int))
16
+
C.Types.ring_buffer_sample_fn callback
17
+
in
18
+
let rb =
19
+
match
20
+
C.Functions.ring_buffer__new bpf_map.fd callback_c null
21
+
(from_voidp C.Types.ring_buffer_opts null)
22
+
with
23
+
| None -> failwith "Failed to create ring buffer\n"
24
+
| Some rb -> rb
25
+
in
26
+
try f rb
27
+
with e ->
28
+
C.Functions.ring_buffer__free rb;
29
+
raise e
30
+
31
+
let poll t ~timeout = C.Functions.ring_buffer__poll t timeout
32
+
let consume t = C.Functions.ring_buffer__consume t
33
+
let get_epoll_fd t = C.Functions.ring_buffer__epoll_fd t
34
+
end
+38
vendor/ocaml-libbpf/src/libbpf_maps/libbpf_maps.mli
+38
vendor/ocaml-libbpf/src/libbpf_maps/libbpf_maps.mli
···
1
+
open Libbpf
2
+
(** Libbpf_maps provide a convenient API's for handling maps,
3
+
currently only Ringbuffers are supported *)
4
+
5
+
module RingBuffer : sig
6
+
type t
7
+
8
+
type callback =
9
+
unit Ctypes_static.ptr -> unit Ctypes_static.ptr -> Unsigned.size_t -> int
10
+
11
+
val init : bpf_map -> callback:callback -> (t -> unit) -> unit
12
+
(** [init bpf_map callback] loads [callback] into the ring buffer
13
+
map provided by [bpf_map]. bpf map is freed by default when
14
+
the OCaml process exits
15
+
16
+
TO BE ADDED [ctx_ptr] allows the callback function to access
17
+
user provided context. *)
18
+
19
+
val poll : t -> timeout:int -> int
20
+
(** [poll t timeout] polls the ringbuffer to execute the loaded
21
+
callbacks on any pending entries, The function returns if
22
+
there are no entries in the given timeout,
23
+
24
+
Error code is returned if something went wrong, Ctrl-C will
25
+
cause -EINTR *)
26
+
27
+
val consume : t -> int
28
+
(** [consume t] runs callbacks on all entries in the ringbuffer
29
+
without event polling. Use this only if trying to squeeze
30
+
extra performance with busy-waiting.
31
+
32
+
Error code is returned if something went wrong Ctrl-C will
33
+
cause -EINTR *)
34
+
35
+
val get_epoll_fd : t -> int
36
+
(** [get_epoll_fd t] returns a file descriptor that can be used
37
+
to sleep until data is available in the ring(s) *)
38
+
end
+39
vendor/ocaml-libbpf/supported.json
+39
vendor/ocaml-libbpf/supported.json
···
1
+
{
2
+
"ocaml_libbpf.1.0": [
3
+
"libbpf_major_version",
4
+
"libbpf_minor_version",
5
+
"libbpf_version_string",
6
+
"libbpf_strerror",
7
+
"libbpf_bpf_attach_type_str",
8
+
"libbpf_bpf_link_type_str",
9
+
"libbpf_bpf_map_type_str",
10
+
"libbpf_bpf_prog_type_str",
11
+
"libbpf_set_print",
12
+
"bpf_object__open",
13
+
"bpf_object__load",
14
+
"bpf_object__find_program_by_name",
15
+
"bpf_object__next_program",
16
+
"bpf_program__pin",
17
+
"bpf_program__unpin",
18
+
"bpf_program_attach",
19
+
"bpf_program__fd",
20
+
"bpf_link__pin",
21
+
"bpf_link__unpin",
22
+
"bpf_link__destroy",
23
+
"bpf_object__close",
24
+
"bpf_object__find_map_by_name",
25
+
"bpf_map__fd",
26
+
"bpf_map_lookup_elem",
27
+
"bpf_map_update_elem",
28
+
"bpf_map_delete_elem",
29
+
"bpf_tc_hook_create",
30
+
"bpf_tc_hook_destroy",
31
+
"bpf_tc_attach",
32
+
"bpf_tc_detach",
33
+
"ring_buffer__new",
34
+
"ring_buffer__poll",
35
+
"ring_buffer__free",
36
+
"ring_buffer__consume",
37
+
"ring_buffer__epoll_fd"
38
+
]
39
+
}