commit 0812102c1cde06dacb31f60714d6e3d279b136be · anil.recoil.org/shelter

+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
       24
       -
             Shelter.main env#clock env#process_mgr dir

     

       24
       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
       27
       -
             Pass.main env#clock env#process_mgr dir

     

       27
       27
       +
             Pass.main env#fs env#clock env#process_mgr dir

+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
       7
       -
         let run clock proc store =

     

       7
       7
       +
         let run fs clock proc store =

     

       8
       8
        
           let store = History.Store ((module Store), store) in

     

       9
       9
       -
           Engine.init store;

     

       10
       10
       -
           let rec loop store exit_code =

     

       9
       9
       +
           let initial_ctx = Engine.init fs proc store in

     

       10
       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
       16
       -
                 match Engine.run clock proc store action with

     

       16
       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
       19
       -
                     loop store exit_code

     

       19
       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
       22
       -
                     loop store (`Exited 127)

     

       23
       23
       -
                 | Ok store -> loop store (`Exited 0))

     

       22
       22
       +
                     loop store ctx (`Exited 127)

     

       23
       23
       +
                 | Ok (store, ctx) -> loop store ctx (`Exited 0))

     

       24
       24
        
           in

     

       25
       25
       -
           loop store (`Exited 0)

     

       25
       25
       +
           loop store initial_ctx (`Exited 0)

     

       26
       26
        
       

     

       27
       27
       -
         let main clock proc directory =

     

       27
       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
       32
       -
           run clock proc store

     

       32
       32
       +
           run fs clock proc store

     

       33
       33
        
       end

+12 -3

src/lib/engine.ml

···

       7
       7
        
       

     

       8
       8
        
         type entry

     

       9
       9
        
       

     

       10
       10
       -
         val init : entry History.t -> unit

     

       10
       10
       +
         type ctx

     

       11
       11
       +
         (** A context that is not persisted, but is passed through each loop of the

     

       12
       12
       +
             shell *)

     

       13
       13
       +
       

     

       14
       14
       +
         val init :

     

       15
       15
       +
           _ Eio.Path.t ->

     

       16
       16
       +
           Eio_unix.Process.mgr_ty Eio_unix.Process.mgr ->

     

       17
       17
       +
           entry History.t ->

     

       18
       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
       23
       +
           _ Eio.Path.t ->

     

       15
       24
        
           _ Eio.Time.clock ->

     

       16
       25
        
           Eio_unix.Process.mgr_ty Eio_unix.Process.mgr ->

     

       17
       17
       -
           entry History.t ->

     

       26
       26
       +
           entry History.t * ctx ->

     

       18
       27
        
           action ->

     

       19
       19
       -
           (entry History.t, Eio.Process.error) result

     

       28
       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

···

       16
       16
        
       let history_key = [ "history" ]

     

       17
       17
        
       let key () = history_key @ [ string_of_float @@ Unix.gettimeofday () ]

     

       18
       18
        
       

     

       19
       19
       -
       let init (Cshell.History.Store ((module S), store) : entry Cshell.History.t) =

     

       19
       19
       +
       type ctx = unit

     

       20
       20
       +
       

     

       21
       21
       +
       let init _ _ (Cshell.History.Store ((module S), store) : entry Cshell.History.t)

     

       22
       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
       33
       -
       let run clock proc

     

       34
       34
       -
           ((Cshell.History.Store ((module S), store) : entry Cshell.History.t) as

     

       35
       35
       -
            full_store) (Exec command) =

     

       36
       36
       +
       let run _fs clock proc

     

       37
       37
       +
           ( ((Cshell.History.Store ((module S), store) : entry Cshell.History.t) as

     

       38
       38
       +
              full_store),

     

       39
       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
       50
       -
             Ok full_store)

     

       54
       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

···

       1
       1
       +
       type diff =

     

       2
       2
       +
         | Modified of string

     

       3
       3
       +
         | Created of string

     

       4
       4
       +
         | Renamed of string * string

     

       5
       5
       +
         | Removed of string

     

       6
       6
       +
       [@@deriving repr]

     

       7
       7
       +
       

     

       8
       8
       +
       type t = diff list [@@deriving repr]

     

       9
       9
       +
       

     

       10
       10
       +
       let truncate_path s =

     

       11
       11
       +
         match Astring.String.cut ~sep:"rootfs" s with Some (_, p) -> p | None -> s

     

       12
       12
       +
       

     

       13
       13
       +
       let parse_row = function

     

       14
       14
       +
         | [ "M"; s ] ->

     

       15
       15
       +
             let path = truncate_path s in

     

       16
       16
       +
             if String.equal path "" then None else Some (Modified path)

     

       17
       17
       +
         | [ "+"; s ] ->

     

       18
       18
       +
             let path = truncate_path s in

     

       19
       19
       +
             if String.equal path "" then None else Some (Created path)

     

       20
       20
       +
         | [ "R"; a; b ] ->

     

       21
       21
       +
             let a_path = truncate_path a in

     

       22
       22
       +
             let b_path = truncate_path b in

     

       23
       23
       +
             Some (Renamed (a_path, b_path))

     

       24
       24
       +
         | [ "-"; s ] ->

     

       25
       25
       +
             let path = truncate_path s in

     

       26
       26
       +
             if String.equal path "" then None else Some (Removed path)

     

       27
       27
       +
         | s ->

     

       28
       28
       +
             Fmt.invalid_arg "Unknown ZFS diff: %a"

     

       29
       29
       +
               (Fmt.list ~sep:Fmt.comma Fmt.string)

     

       30
       30
       +
               s

     

       31
       31
       +
       

     

       32
       32
       +
       let of_zfs s : t =

     

       33
       33
       +
         let lines = String.split_on_char '\n' s in

     

       34
       34
       +
         let tsv =

     

       35
       35
       +
           List.map (String.split_on_char '\t') lines

     

       36
       36
       +
           |> List.map (List.filter (fun s -> not (String.equal "" s)))

     

       37
       37
       +
           |> List.filter (function [] -> false | _ -> true)

     

       38
       38
       +
         in

     

       39
       39
       +
         List.filter_map parse_row tsv

+1 -1

src/lib/shelter/dune

···

       3
       3
        
        (public_name cshell.shelter)

     

       4
       4
        
        (preprocess

     

       5
       5
        
         (pps ppx_repr))

     

       6
       6
       -
        (libraries cshell cid void))

     

       6
       6
       +
        (libraries cshell cid void zfs))

+26

src/lib/shelter/fetch.ml

···

       1
       1
       +
       let ( / ) = Eio.Path.( / )

     

       2
       2
       +
       

     

       3
       3
       +
       let get_image ~dir ~proc image =

     

       4
       4
       +
         let container_id =

     

       5
       5
       +
           Eio.Process.parse_out proc Eio.Buf_read.take_all

     

       6
       6
       +
             [ "docker"; "run"; "-d"; image ]

     

       7
       7
       +
           |> String.trim

     

       8
       8
       +
         in

     

       9
       9
       +
         let tar = image ^ ".tar.gz" in

     

       10
       10
       +
         let dir_s = Eio.Path.native_exn dir in

     

       11
       11
       +
         let () =

     

       12
       12
       +
           Eio.Process.run proc

     

       13
       13
       +
             [ "docker"; "export"; container_id; "-o"; Filename.concat dir_s tar ]

     

       14
       14
       +
         in

     

       15
       15
       +
         Eio.Path.mkdir ~perm:0o777 (dir / "rootfs");

     

       16
       16
       +
         let () =

     

       17
       17
       +
           Eio.Process.run proc

     

       18
       18
       +
             [

     

       19
       19
       +
               "tar";

     

       20
       20
       +
               "-xf";

     

       21
       21
       +
               Filename.concat dir_s "alpine.tar.gz";

     

       22
       22
       +
               "-C";

     

       23
       23
       +
               Filename.concat dir_s "rootfs";

     

       24
       24
       +
             ]

     

       25
       25
       +
         in

     

       26
       26
       +
         Filename.concat dir_s "rootfs"

+173 -56

src/lib/shelter/shelter.ml

···

       1
       1
        
       open Eio

     

       2
       2
       +
       module Store = Store

     

       3
       3
       +
       module H = Cshell.History

     

       2
       4
        
       

     

       3
       3
       -
       module Build = struct

     

       4
       4
       -
         type cid = Cid.t

     

       5
       5
       +
       module History = struct

     

       6
       6
       +
         type mode = Void.mode

     

       5
       7
        
       

     

       6
       6
       -
         let cid_of_string s =

     

       7
       7
       -
           match Cid.of_string s with

     

       8
       8
       -
           | Ok v -> v

     

       9
       9
       -
           | Error (`Msg m) -> failwith m

     

       10
       10
       -
           | Error (`Unsupported _) -> failwith "unsupported cid"

     

       8
       8
       +
         let mode_t =

     

       9
       9
       +
           Repr.map Repr.string

     

       10
       10
       +
             (function

     

       11
       11
       +
               | "R" -> Void.R | "RW" -> Void.RW | _ -> failwith "Malformed Void.mode")

     

       12
       12
       +
             (function Void.R -> "R" | Void.RW -> "RW")

     

       11
       13
        
       

     

       12
       12
       -
         let cid_t = Repr.map Repr.string cid_of_string Cid.to_string

     

       13
       13
       -
       

     

       14
       14
       -
         type t = Image of string | Build of cid [@@deriving repr]

     

       15
       15
       -
       end

     

       16
       16
       -
       

     

       17
       17
       -
       type mode = R | RW [@@deriving repr]

     

       18
       18
       -
       

     

       19
       19
       -
       module History = struct

     

       20
       20
       -
         type t = { mode : mode; build : Build.t; args : string list }

     

       14
       14
       +
         type t = {

     

       15
       15
       +
           mode : mode;

     

       16
       16
       +
           build : Store.Build.t;

     

       17
       17
       +
           args : string list;

     

       18
       18
       +
           time : int64;

     

       19
       19
       +
           diff : Diff.t;

     

       20
       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
       29
       -
         | Set_mode of mode

     

       29
       29
       +
         | Set_mode of History.mode

     

       30
       30
        
         | Set_session of string

     

       31
       31
        
         | Exec of string list

     

       32
       32
        
         | Info

     

       33
       33
       +
         | Undo

     

       34
       34
       +
         | Fork of string

     

       35
       35
       +
         | Replay of string

     

       33
       36
        
         | Unknown of string list

     

       37
       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
       42
       -
         | "set" :: "mode" :: [ "r" ] -> Set_mode R

     

       43
       43
       -
         | "set" :: "mode" :: [ "rw" ] -> Set_mode R

     

       46
       46
       +
         | "mode" :: [ "r" ] -> Set_mode R

     

       47
       47
       +
         | "mode" :: [ "rw" ] -> Set_mode R

     

       44
       48
        
         | "session" :: [ m ] -> Set_session m

     

       49
       49
       +
         | "fork" :: [ m ] -> Fork m

     

       50
       50
       +
         | "replay" :: [ onto ] -> Replay onto

     

       45
       51
        
         | [ "info" ] -> Info

     

       52
       52
       +
         | [ "undo" ] -> Undo

     

       53
       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
       57
       -
       let list (Cshell.History.Store ((module S), store) : entry Cshell.History.t) =

     

       65
       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
       67
       -
             |> List.stable_sort (fun (s1, _) (s2, _) -> String.compare s1 s2)

     

       75
       75
       +
             |> List.stable_sort (fun (s1, _) (s2, _) ->

     

       76
       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
       75
       -
       let sessions (Cshell.History.Store ((module S), store) : entry Cshell.History.t)

     

       76
       76
       -
           =

     

       84
       84
       +
       let sessions (H.Store ((module S), store) : entry H.t) =

     

       77
       85
        
         S.Branch.list (S.repo store)

     

       78
       86
        
       

     

       79
       79
       -
       let commit ~message clock

     

       80
       80
       -
           (Cshell.History.Store ((module S), store) : entry Cshell.History.t) v =

     

       87
       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
       84
       -
       let which_branch

     

       85
       85
       -
           ((Cshell.History.Store ((module S), session) : entry Cshell.History.t) as s)

     

       86
       86
       -
           =

     

       91
       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
       93
       -
       let prompt status

     

       94
       94
       -
           ((Cshell.History.Store ((module S), _session) : entry Cshell.History.t) as

     

       95
       95
       -
            store) =

     

       98
       98
       +
       (* Reset the head of the current session by one commit *)

     

       99
       99
       +
       let reset_hard ((H.Store ((module S), session) : entry H.t) as s) =

     

       100
       100
       +
         match

     

       101
       101
       +
           List.filter_map (S.Commit.of_hash (S.repo session))

     

       102
       102
       +
           @@ S.Commit.parents (S.Head.get session)

     

       103
       103
       +
         with

     

       104
       104
       +
         | [] -> s

     

       105
       105
       +
         | p :: _ ->

     

       106
       106
       +
             S.Head.set session p;

     

       107
       107
       +
             s

     

       108
       108
       +
       

     

       109
       109
       +
       (* Fork a new session from an existing one *)

     

       110
       110
       +
       let fork (H.Store ((module S), session) : entry H.t) new_branch =

     

       111
       111
       +
         let repo = S.repo session in

     

       112
       112
       +
         match (S.Head.find session, S.Branch.find repo new_branch) with

     

       113
       113
       +
         | _, Some _ ->

     

       114
       114
       +
             Error (new_branch ^ " already exists, try @ session " ^ new_branch)

     

       115
       115
       +
         | None, _ -> Error "Current branch needs at least one commit"

     

       116
       116
       +
         | Some commit, None ->

     

       117
       117
       +
             let new_store = S.of_branch (S.repo session) new_branch in

     

       118
       118
       +
             S.Branch.set repo new_branch commit;

     

       119
       119
       +
             let store = H.Store ((module S), new_store) in

     

       120
       120
       +
             Ok store

     

       121
       121
       +
       

     

       122
       122
       +
       (* Fork a new session from an existing one *)

     

       123
       123
       +
       let display_history (H.Store ((module S), session) : entry H.t) =

     

       124
       124
       +
         let history = S.history ~depth:max_int session in

     

       125
       125
       +
         let content c =

     

       126
       126
       +
           H.Store ((module S), S.of_commit c) |> list |> List.hd |> snd

     

       127
       127
       +
         in

     

       128
       128
       +
         let pp_diff fmt d =

     

       129
       129
       +
           if d = [] then () else Fmt.pf fmt "\n  %a" (Repr.pp Diff.t) d

     

       130
       130
       +
         in

     

       131
       131
       +
         let pp_entry fmt (e : entry) =

     

       132
       132
       +
           Fmt.pf fmt "%-10s %s%a"

     

       133
       133
       +
             Fmt.(str "%a" (styled (`Fg `Yellow) uint64_ns_span) e.time)

     

       134
       134
       +
             (String.concat " " e.args) pp_diff e.diff

     

       135
       135
       +
         in

     

       136
       136
       +
         let linearize =

     

       137
       137
       +
           S.History.fold_vertex (fun c v -> content c :: v) history [] |> List.rev

     

       138
       138
       +
         in

     

       139
       139
       +
         List.iter (fun c -> Fmt.pr "%a\n%!" pp_entry c) linearize

     

       140
       140
       +
       

     

       141
       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
       115
       -
       let init s =

     

       161
       161
       +
       type ctx = Store.t

     

       162
       162
       +
       

     

       163
       163
       +
       let init fs proc s =

     

       164
       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
       119
       -
           (list s)

     

       168
       168
       +
           (list s);

     

       169
       169
       +
         store

     

       120
       170
        
       

     

       121
       121
       -
       let run clock proc

     

       122
       122
       -
           ((Cshell.History.Store ((module S), store) : entry Cshell.History.t) as s) =

     

       123
       123
       -
         function

     

       171
       171
       +
       let run _fs clock _proc (((H.Store ((module S), store) : entry H.t) as s), ctx)

     

       172
       172
       +
           = function

     

       124
       173
        
         | Set_mode mode ->

     

       125
       125
       -
             with_latest ~default:(fun _ -> Ok s) s @@ fun (_, entry) ->

     

       174
       174
       +
             with_latest ~default:(fun _ -> Ok (s, ctx)) s @@ fun (_, entry) ->

     

       126
       175
        
             commit ~message:"mode change" clock s { entry with mode };

     

       127
       127
       -
             Ok s

     

       176
       176
       +
             Ok (s, ctx)

     

       128
       177
        
         | Set_session m ->

     

       129
       129
       -
             with_latest ~default:(fun _ -> Ok s) s @@ fun (_, entry) ->

     

       178
       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
       131
       -
             let new_full_store = Cshell.History.Store ((module S), new_store) in

     

       180
       180
       +
             let new_full_store = H.Store ((module S), new_store) in

     

       132
       181
        
             commit ~message:"new session" clock new_full_store entry;

     

       133
       133
       -
             Ok new_full_store

     

       182
       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
       137
       -
             Ok s

     

       186
       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
       147
       -
                 (fun commit acc -> 

     

       196
       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
       150
       -
                   ((String.sub hash 0 7), info) :: acc)

     

       199
       199
       +
                   (String.sub hash 0 7, info) :: acc)

     

       151
       200
        
                 history []

     

       152
       201
        
             in

     

       153
       153
       -
             Fmt.pr "Sessions: %a\nCurrent: %a\nCommits:@.  %a\n%!"

     

       202
       202
       +
             let latest =

     

       203
       203
       +
               with_latest

     

       204
       204
       +
                 ~default:(fun () -> None)

     

       205
       205
       +
                 s

     

       206
       206
       +
                 (fun (_, e) -> Some (Repr.to_string Store.Build.t e.build))

     

       207
       207
       +
             in

     

       208
       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
       211
       +
               Fmt.(option string)

     

       212
       212
       +
               latest

     

       156
       213
        
               Fmt.(vbox ~indent:2 @@ list pp_commit)

     

       157
       214
        
               commits;

     

       158
       158
       -
             Ok s

     

       159
       159
       -
         | Exec [] -> Ok s

     

       215
       215
       +
             Ok (s, ctx)

     

       216
       216
       +
         | Exec [] -> Ok (s, ctx)

     

       217
       217
       +
         | Undo -> Ok (reset_hard s, ctx)

     

       218
       218
       +
         | Fork new_branch -> (

     

       219
       219
       +
             match fork s new_branch with

     

       220
       220
       +
             | Error err ->

     

       221
       221
       +
                 Fmt.pr "[fork]: %a\n%!" (text `Red) err;

     

       222
       222
       +
                 Ok (s, ctx)

     

       223
       223
       +
             | Ok store -> Ok (store, ctx))

     

       224
       224
       +
         | Replay _ -> Ok (s, ctx)

     

       225
       225
       +
         | History ->

     

       226
       226
       +
             display_history s;

     

       227
       227
       +
             Ok (s, ctx)

     

       160
       228
        
         | Exec command -> (

     

       161
       161
       -
             Switch.run @@ fun sw ->

     

       229
       229
       +
             let entry =

     

       230
       230
       +
               with_latest

     

       231
       231
       +
                 ~default:(fun () ->

     

       232
       232
       +
                   History.

     

       233
       233
       +
                     {

     

       234
       234
       +
                       mode = Void.RW;

     

       235
       235
       +
                       build = Store.Build.Image "alpine";

     

       236
       236
       +
                       args = command;

     

       237
       237
       +
                       time = 0L;

     

       238
       238
       +
                       diff = [];

     

       239
       239
       +
                     })

     

       240
       240
       +
                 s

     

       241
       241
       +
               @@ fun (_, e) -> e

     

       242
       242
       +
             in

     

       243
       243
       +
             let build =

     

       244
       244
       +
               match entry.build with

     

       245
       245
       +
               | Store.Build.Image img -> Store.fetch ctx img

     

       246
       246
       +
               | Store.Build.Build cid -> cid

     

       247
       247
       +
             in

     

       248
       248
       +
             let hash_entry = { entry with build = Build build; args = command } in

     

       249
       249
       +
             let new_cid = Store.cid (Repr.to_string History.t hash_entry) in

     

       250
       250
       +
             let with_rootfs fn =

     

       251
       251
       +
               if entry.mode = R then (Store.Run.with_build ctx build fn, [])

     

       252
       252
       +
               else Store.Run.with_clone ctx ~src:build new_cid fn

     

       253
       253
       +
             in

     

       162
       254
        
             try

     

       163
       163
       -
               let proc = Eio.Process.spawn ~sw proc [ "bash"; "-c"; String.concat " " command ] in

     

       164
       164
       -
               let res = Eio.Process.await proc in

     

       165
       165
       -
               if res = `Exited 0 then (

     

       166
       166
       -
                 let entry =

     

       167
       167
       -
                   History.{ mode = RW; build = Image "TODO"; args = command }

     

       255
       255
       +
               let new_entry, diff =

     

       256
       256
       +
                 with_rootfs @@ fun rootfs ->

     

       257
       257
       +
                 let void =

     

       258
       258
       +
                   Void.empty

     

       259
       259
       +
                   |> Void.rootfs ~mode:entry.mode rootfs

     

       260
       260
       +
                   |> Void.exec [ "/bin/ash"; "-c"; String.concat " " command ]

     

       261
       261
       +
                 in

     

       262
       262
       +
                 Switch.run @@ fun sw ->

     

       263
       263
       +
                 let start = Mtime_clock.now () in

     

       264
       264
       +
                 let proc = Void.spawn ~sw void in

     

       265
       265
       +
                 let res =

     

       266
       266
       +
                   Void.exit_status proc |> Eio.Promise.await |> Void.to_eio_status

     

       168
       267
        
                 in

     

       169
       169
       -
                 commit ~message:("exec " ^ (String.concat " " command)) clock s entry;

     

       268
       268
       +
                 let stop = Mtime_clock.now () in

     

       269
       269
       +
                 let span = Mtime.span start stop in

     

       270
       270
       +
                 let time = Mtime.Span.to_uint64_ns span in

     

       271
       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
       173
       -
                 Ok s)

     

       174
       174
       -
               else Error (Eio.Process.Child_error res)

     

       275
       275
       +
                 if res = `Exited 0 then

     

       276
       276
       +
                   if entry.mode = RW then

     

       277
       277
       +
                     Ok { hash_entry with build = Build new_cid; time }

     

       278
       278
       +
                   else Ok hash_entry

     

       279
       279
       +
                 else Error (Eio.Process.Child_error res)

     

       280
       280
       +
               in

     

       281
       281
       +
               match new_entry with

     

       282
       282
       +
               | Error e -> Error e

     

       283
       283
       +
               | Ok entry ->

     

       284
       284
       +
                   (* Set diff *)

     

       285
       285
       +
                   let entry = { entry with diff } in

     

       286
       286
       +
                   (* Commit if RW *)

     

       287
       287
       +
                   if entry.mode = RW then

     

       288
       288
       +
                     commit

     

       289
       289
       +
                       ~message:("exec " ^ String.concat " " command)

     

       290
       290
       +
                       clock s entry;

     

       291
       291
       +
                   Ok (s, ctx)

     

       175
       292
        
             with Eio.Exn.Io (Eio.Process.E e, _) -> Error e)

+8 -6

src/lib/shelter/shelter.mli

···

       1
       1
       -
       module Build : sig

     

       2
       2
       -
         type t = Image of string | Build of Cid.t [@@deriving repr]

     

       3
       3
       -
       end

     

       4
       4
       -
       

     

       5
       5
       -
       type mode = R | RW

     

       1
       1
       +
       module Store = Store

     

       6
       2
        
       

     

       7
       3
        
       module History : sig

     

       8
       8
       -
         type t = { mode : mode; build : Build.t; args : string list }

     

       4
       4
       +
         type t = {

     

       5
       5
       +
           mode : Void.mode;

     

       6
       6
       +
           build : Store.Build.t;

     

       7
       7
       +
           args : string list;

     

       8
       8
       +
           time : int64;

     

       9
       9
       +
           diff : Diff.t;

     

       10
       10
       +
         }

     

       9
       11
        
         [@@deriving repr]

     

       10
       12
        
       

     

       11
       13
        
         include Irmin.Contents.S with type t := t

+158

src/lib/shelter/store.ml

···

       1
       1
       +
       (* A store a bit like OBuilder's but a little simplified

     

       2
       2
       +
          for our purposes *)

     

       3
       3
       +
       module Build = struct

     

       4
       4
       +
         type cid = Cid.t

     

       5
       5
       +
       

     

       6
       6
       +
         let cid_of_string s =

     

       7
       7
       +
           match Cid.of_string s with

     

       8
       8
       +
           | Ok v -> v

     

       9
       9
       +
           | Error (`Msg m) -> failwith m

     

       10
       10
       +
           | Error (`Unsupported _) -> failwith "unsupported cid"

     

       11
       11
       +
       

     

       12
       12
       +
         let cid_t = Repr.map Repr.string cid_of_string Cid.to_string

     

       13
       13
       +
       

     

       14
       14
       +
         type t = Image of string | Build of cid [@@deriving repr]

     

       15
       15
       +
       end

     

       16
       16
       +
       

     

       17
       17
       +
       type path = string list

     

       18
       18
       +
       

     

       19
       19
       +
       type t = {

     

       20
       20
       +
         fs : Eio.Fs.dir_ty Eio.Path.t;

     

       21
       21
       +
         proc : Eio_unix.Process.mgr_ty Eio_unix.Process.mgr;

     

       22
       22
       +
         zfs : Zfs.Handle.t;

     

       23
       23
       +
         pool : string;

     

       24
       24
       +
       }

     

       25
       25
       +
       

     

       26
       26
       +
       module Datasets : sig

     

       27
       27
       +
         type dataset = private string

     

       28
       28
       +
         type snapshot = private string

     

       29
       29
       +
       

     

       30
       30
       +
         val builds : string -> dataset

     

       31
       31
       +
         val build : string -> string -> dataset

     

       32
       32
       +
         val snapshot : dataset -> snapshot

     

       33
       33
       +
       end = struct

     

       34
       34
       +
         type dataset = string

     

       35
       35
       +
         type snapshot = string

     

       36
       36
       +
       

     

       37
       37
       +
         let ( / ) a b = a ^ "/" ^ b

     

       38
       38
       +
         let builds pool : dataset = pool / "builds"

     

       39
       39
       +
         let build pool path : dataset = builds pool / path

     

       40
       40
       +
         let snapshot ds = ds ^ "@snappy"

     

       41
       41
       +
       end

     

       42
       42
       +
       

     

       43
       43
       +
       let with_dataset ?(typ = Zfs.Types.filesystem) t dataset f =

     

       44
       44
       +
         let exists = Zfs.exists t.zfs (dataset :> string) typ in

     

       45
       45
       +
         if not exists then Zfs.create t.zfs dataset typ;

     

       46
       46
       +
         let dataset = Zfs.open_ t.zfs dataset typ in

     

       47
       47
       +
         Fun.protect ~finally:(fun () -> Zfs.close dataset) (fun () -> f dataset)

     

       48
       48
       +
       

     

       49
       49
       +
       let mount_dataset ?(typ = Zfs.Types.dataset) t (dataset : Datasets.dataset) =

     

       50
       50
       +
         match Zfs.is_mounted t.zfs (dataset :> string) with

     

       51
       51
       +
         | Some _ -> ()

     

       52
       52
       +
         | None -> with_dataset ~typ t (dataset :> string) @@ fun d -> Zfs.mount d

     

       53
       53
       +
       

     

       54
       54
       +
       let unmount_dataset t (dataset : Datasets.dataset) =

     

       55
       55
       +
         match Zfs.is_mounted t.zfs (dataset :> string) with

     

       56
       56
       +
         | None -> ()

     

       57
       57
       +
         | Some _ ->

     

       58
       58
       +
             with_dataset t (dataset :> string) @@ fun d ->

     

       59
       59
       +
             let _todo () = Zfs.unmount d in

     

       60
       60
       +
             ()

     

       61
       61
       +
       

     

       62
       62
       +
       let create_dataset t (dataset : Datasets.dataset) =

     

       63
       63
       +
         with_dataset t (dataset :> string) (fun _ -> ())

     

       64
       64
       +
       

     

       65
       65
       +
       let create_and_mount t (dataset : Datasets.dataset) =

     

       66
       66
       +
         create_dataset t dataset;

     

       67
       67
       +
         mount_dataset t dataset

     

       68
       68
       +
       

     

       69
       69
       +
       let init fs proc pool =

     

       70
       70
       +
         let zfs = Zfs.init () in

     

       71
       71
       +
         Zfs.debug zfs true;

     

       72
       72
       +
         let t =

     

       73
       73
       +
           {

     

       74
       74
       +
             fs :> Eio.Fs.dir_ty Eio.Path.t;

     

       75
       75
       +
             proc :> Eio_unix.Process.mgr_ty Eio_unix.Process.mgr;

     

       76
       76
       +
             zfs;

     

       77
       77
       +
             pool;

     

       78
       78
       +
           }

     

       79
       79
       +
         in

     

       80
       80
       +
         create_and_mount t (Datasets.builds t.pool);

     

       81
       81
       +
         t

     

       82
       82
       +
       

     

       83
       83
       +
       let snapshot t (snap : Datasets.snapshot) =

     

       84
       84
       +
         let exists = Zfs.exists t.zfs (snap :> string) Zfs.Types.snapshot in

     

       85
       85
       +
         if not exists then Zfs.snapshot t.zfs (snap :> string) true

     

       86
       86
       +
       

     

       87
       87
       +
       let clone t (snap : Datasets.snapshot) (tgt : Datasets.dataset) =

     

       88
       88
       +
         with_dataset ~typ:Zfs.Types.snapshot t (snap :> string) @@ fun src ->

     

       89
       89
       +
         Zfs.clone src (tgt :> string)

     

       90
       90
       +
       

     

       91
       91
       +
       let read_all fd =

     

       92
       92
       +
         let buf = Buffer.create 128 in

     

       93
       93
       +
         let bytes = Bytes.create 4096 in

     

       94
       94
       +
         let rec loop () =

     

       95
       95
       +
           match Unix.read fd bytes 0 4096 with

     

       96
       96
       +
           | 0 | (exception End_of_file) -> Buffer.contents buf

     

       97
       97
       +
           | n ->

     

       98
       98
       +
               Buffer.add_bytes buf (Bytes.sub bytes 0 n);

     

       99
       99
       +
               loop ()

     

       100
       100
       +
         in

     

       101
       101
       +
         loop ()

     

       102
       102
       +
       

     

       103
       103
       +
       let diff t (data : Datasets.snapshot) (snap : Datasets.snapshot) =

     

       104
       104
       +
         let data_fs =

     

       105
       105
       +
           String.sub (data :> string) 0 (String.index (data :> string) '@')

     

       106
       106
       +
         in

     

       107
       107
       +
         let zh = Zfs.open_ t.zfs data_fs Zfs.Types.filesystem in

     

       108
       108
       +
         let diff =

     

       109
       109
       +
           let r, w = Unix.pipe ~cloexec:false () in

     

       110
       110
       +
           try

     

       111
       111
       +
             Zfs.show_diff zh ~from_:(data :> string) ~to_:(snap :> string) w;

     

       112
       112
       +
             let f = read_all r in

     

       113
       113
       +
             Unix.close r;

     

       114
       114
       +
             f

     

       115
       115
       +
           with e ->

     

       116
       116
       +
             Unix.close r;

     

       117
       117
       +
             raise e

     

       118
       118
       +
         in

     

       119
       119
       +
         Zfs.close zh;

     

       120
       120
       +
         Diff.of_zfs diff

     

       121
       121
       +
       

     

       122
       122
       +
       let cid s =

     

       123
       123
       +
         let hash =

     

       124
       124
       +
           Multihash_digestif.of_cstruct `Sha2_256 (Cstruct.of_string s)

     

       125
       125
       +
           |> Result.get_ok

     

       126
       126
       +
         in

     

       127
       127
       +
         Cid.v ~version:`Cidv1 ~base:`Base32 ~codec:`Raw ~hash

     

       128
       128
       +
       

     

       129
       129
       +
       let fetch t image =

     

       130
       130
       +
         let cid = cid image in

     

       131
       131
       +
         let cids = cid |> Cid.to_string in

     

       132
       132
       +
         let dataset = Datasets.build t.pool cids in

     

       133
       133
       +
         let dir = Eio.Path.(t.fs / ("/" ^ (Datasets.build t.pool cids :> string))) in

     

       134
       134
       +
         if Zfs.exists t.zfs (dataset :> string) Zfs.Types.filesystem then cid

     

       135
       135
       +
         else (

     

       136
       136
       +
           create_and_mount t dataset;

     

       137
       137
       +
           let _dir : string = Fetch.get_image ~dir ~proc:t.proc image in

     

       138
       138
       +
           snapshot t (Datasets.snapshot dataset);

     

       139
       139
       +
           cid)

     

       140
       140
       +
       

     

       141
       141
       +
       module Run = struct

     

       142
       142
       +
         let with_build t cid fn =

     

       143
       143
       +
           let ds = Datasets.build t.pool (Cid.to_string cid) in

     

       144
       144
       +
           Fun.protect ~finally:(fun () -> unmount_dataset t ds) @@ fun () ->

     

       145
       145
       +
           mount_dataset t ds;

     

       146
       146
       +
           fn ("/" ^ (ds :> string) ^ "/rootfs")

     

       147
       147
       +
       

     

       148
       148
       +
         let with_clone t ~src new_cid fn =

     

       149
       149
       +
           let ds = Datasets.build t.pool (Cid.to_string src) in

     

       150
       150
       +
           let tgt = Datasets.build t.pool (Cid.to_string new_cid) in

     

       151
       151
       +
           let src_snap = Datasets.snapshot ds in

     

       152
       152
       +
           let tgt_snap = Datasets.snapshot tgt in

     

       153
       153
       +
           clone t src_snap tgt;

     

       154
       154
       +
           let v = with_build t new_cid fn in

     

       155
       155
       +
           snapshot t tgt_snap;

     

       156
       156
       +
           let d = diff t src_snap tgt_snap in

     

       157
       157
       +
           (v, d)

     

       158
       158
       +
       end

+33

vendor/ocaml-libbpf/.gitignore

···

       1
       1
       +
       *.annot

     

       2
       2
       +
       *.cmo

     

       3
       3
       +
       *.cma

     

       4
       4
       +
       *.cmi

     

       5
       5
       +
       *.a

     

       6
       6
       +
       *.o

     

       7
       7
       +
       *.cmx

     

       8
       8
       +
       *.cmxs

     

       9
       9
       +
       *.cmxa

     

       10
       10
       +
       

     

       11
       11
       +
       # ocamlbuild working directory

     

       12
       12
       +
       _build/

     

       13
       13
       +
       

     

       14
       14
       +
       # ocamlbuild targets

     

       15
       15
       +
       *.byte

     

       16
       16
       +
       *.native

     

       17
       17
       +
       

     

       18
       18
       +
       # oasis generated files

     

       19
       19
       +
       setup.data

     

       20
       20
       +
       setup.log

     

       21
       21
       +
       

     

       22
       22
       +
       # Merlin configuring file for Vim and Emacs

     

       23
       23
       +
       .merlin

     

       24
       24
       +
       

     

       25
       25
       +
       # Dune generated files

     

       26
       26
       +
       *.install

     

       27
       27
       +
       

     

       28
       28
       +
       # Local OPAM switch

     

       29
       29
       +
       _opam/

     

       30
       30
       +
       

     

       31
       31
       +
       # generated files

     

       32
       32
       +
       *.txt

     

       33
       33
       +
       *.bin

vendor/ocaml-libbpf/.ocamlformat

···

       1
       1
       +
       version=0.26.2

     

       2
       2
       +
       profile=default

+12

vendor/ocaml-libbpf/CHANGES.md

···

       1
       1
       +
       ## v0.1.1 (2024-07-05)

     

       2
       2
       +
       - Improve documentation

     

       3
       3
       +
       

     

       4
       4
       +
       ## v0.1.0 (2024-07-01)

     

       5
       5
       +
       - Initial release.

     

       6
       6
       +
       

     

       7
       7
       +
       	`ocaml_libbpf`:

     

       8
       8
       +
       	- [supported](./supported.json) bindings

     

       9
       9
       +
       	- high level API's for open/load/attach/teardown

     

       10
       10
       +
       

     

       11
       11
       +
       	`ocaml_libbpf_maps`:

     

       12
       12
       +
       	- high level API's for BPF ring_buffer map

+15

vendor/ocaml-libbpf/LICENSE.md

···

       1
       1
       +
       /*

     

       2
       2
       +
        * Copyright (C) 2024 Lee Koon Wen

     

       3
       3
       +
        *

     

       4
       4
       +
        * Permission to use, copy, modify, and distribute this software for any

     

       5
       5
       +
        * purpose with or without fee is hereby granted, provided that the above

     

       6
       6
       +
        * copyright notice and this permission notice appear in all copies.

     

       7
       7
       +
        *

     

       8
       8
       +
        * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES

     

       9
       9
       +
        * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF

     

       10
       10
       +
        * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR

     

       11
       11
       +
        * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES

     

       12
       12
       +
        * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN

     

       13
       13
       +
        * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF

     

       14
       14
       +
        * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

     

       15
       15
       +
        */

+220

vendor/ocaml-libbpf/README.md

···

       1
       1
       +
       [![OCaml-CI Build Status](https://img.shields.io/endpoint?url=https://ocaml.ci.dev/badge/koonwen/ocaml-libbpf/main&logo=ocaml)](https://ocaml.ci.dev/github/koonwen/ocaml-libbpf)

     

       2
       2
       +
       - [API documentation](https://koonwen.github.io/ocaml-libbpf/)

     

       3
       3
       +
       

     

       4
       4
       +
       # ocaml-libbpf

     

       5
       5
       +
       Libbpf C-bindings for loading eBPF ELF files into the kernel with OCaml.

     

       6
       6
       +
       

     

       7
       7
       +
       Writing eBPF programs consist of two distinct parts. Implementing the

     

       8
       8
       +
       code that executes in-kernel **and** user-level code responsible for

     

       9
       9
       +
       loading/initializing/linking/teardown of the in-kernel code. This

     

       10
       10
       +
       OCaml library provides the latter via binding the C

     

       11
       11
       +
       [libbpf](https://github.com/libbpf/libbpf) library. It exposes both

     

       12
       12
       +
       the raw low-level bindings as well as a set of high-level API's for

     

       13
       13
       +
       handling your eBPF objects. As of now, the kernel part must still be

     

       14
       14
       +
       written in [restricted

     

       15
       15
       +
       C](https://stackoverflow.com/questions/57688344/what-is-not-allowed-in-restricted-c-for-ebpf)

     

       16
       16
       +
       and compiled with llvm to eBPF bytecode.

     

       17
       17
       +
       

     

       18
       18
       +
       The full API set of Libbpf is quite large, see [supported](supported.json) for the list

     

       19
       19
       +
       of currently bound API's. Contributions are welcome.

     

       20
       20
       +
       

     

       21
       21
       +
       ### External dependencies

     

       22
       22
       +
       ocaml-libbpf depends on the system package of `libbpf`.

     

       23
       23
       +
       

     

       24
       24
       +
       # Usage

     

       25
       25
       +
       > ⚠️ **Disambiguation:** The name of this repository and

     

       26
       26
       +
       > references to it will be "ocaml-libbpf". However, the library's

     

       27
       27
       +
       > entry module and package name is **Libbpf**. To install it, you

     

       28
       28
       +
       > would use `opam install libbpf`. To access it's High-level API's use

     

       29
       29
       +
       > `Libbpf.<api>`. To use the raw bindings, they are exposed in

     

       30
       30
       +
       > `Libbpf.C.<api>` namespace.

     

       31
       31
       +
       

     

       32
       32
       +
       See `examples` directory on how ocaml-libbpf can be used to load eBPF

     

       33
       33
       +
       ELF files into the kernel and interact with the loaded kernel program.

     

       34
       34
       +
       The eBPF kernel programs are defined in *.bpf.c source files and are

     

       35
       35
       +
       compiled with clang as specified in the `dune` rules. ocaml-libbpf

     

       36
       36
       +
       exposes some high-level API's exposed by the toplevel `Libbpf` module

     

       37
       37
       +
       to make it easy to perform repetitive tasks such as

     

       38
       38
       +
       open/load/linking/initializing/teardown of bpf programs.

     

       39
       39
       +
       

     

       40
       40
       +
       To run these examples, clone this repository and set up the package with

     

       41
       41
       +
       ```bash

     

       42
       42
       +
       git clone git@github.com:koonwen/ocaml-libbpf.git

     

       43
       43
       +
       cd ocaml-libbpf

     

       44
       44
       +
       opam install . --deps-only

     

       45
       45
       +
       eval $(opam env)

     

       46
       46
       +
       ```

     

       47
       47
       +
       

     

       48
       48
       +
       then run `make < minimal | kprobe | bootstrap | tc >` to try out the

     

       49
       49
       +
       different bpf programs. These examples are all taken from

     

       50
       50
       +
       [libbpf-bootstrap](https://github.com/libbpf/libbpf-bootstrap)

     

       51
       51
       +
       repository and rewritten in OCaml.

     

       52
       52
       +
       

     

       53
       53
       +
       ### Open/Load/Link

     

       54
       54
       +
       Now let's run through an example of how we would use

     

       55
       55
       +
       ocaml-libbpf. This usage tutorial assumes some knowledge of how to

     

       56
       56
       +
       write eBPF kernel programs in C compile them to ELF files. If not, you

     

       57
       57
       +
       can check out this

     

       58
       58
       +
       [resource](https://nakryiko.com/posts/libbpf-bootstrap/#the-bpf-side). ocaml-libbpf

     

       59
       59
       +
       provides an easy API to install your eBPF program into the kernel. Say

     

       60
       60
       +
       your eBPF kernel program looks like this where we print something

     

       61
       61
       +
       whenever the syscall `write` event occurs. We also want to implement a

     

       62
       62
       +
       filtering mechanism to only print on `write` calls for our process. To

     

       63
       63
       +
       do this, we initialize a BPF array map with a single entry that works

     

       64
       64
       +
       like a holder for our global variable. The BPF map is neccessary to

     

       65
       65
       +
       because it allows us to communicate values between user and kernel

     

       66
       66
       +
       space.

     

       67
       67
       +
       

     

       68
       68
       +
       > The libbpf C library in fact already supports declarations of global

     

       69
       69
       +
       > variables in the usual form with the ability to manage them in user

     

       70
       70
       +
       > space. However for various technical reasons, ocaml-libbpf does not

     

       71
       71
       +
       > enable that feature yet. So we use the old style of working with

     

       72
       72
       +
       > global variables here.

     

       73
       73
       +
       

     

       74
       74
       +
       ```c

     

       75
       75
       +
       // SPDX-License-Identifier: GPL-2.0 OR BSD-3-Clause

     

       76
       76
       +
       /* Copyright (c) 2020 Facebook */

     

       77
       77
       +
       #include <linux/bpf.h>

     

       78
       78
       +
       #include "bpf/bpf_helpers.h" /* This is from our libbpf library */

     

       79
       79
       +
       

     

       80
       80
       +
       char LICENSE[] SEC("license") = "Dual BSD/GPL";

     

       81
       81
       +
       

     

       82
       82
       +
       /* Globals implemented as an array */

     

       83
       83
       +
       struct {

     

       84
       84
       +
         __uint(type, BPF_MAP_TYPE_ARRAY);

     

       85
       85
       +
         __uint(max_entries, 1);

     

       86
       86
       +
         __type(key, int);

     

       87
       87
       +
         __type(value, long);

     

       88
       88
       +
       } globals SEC(".maps");

     

       89
       89
       +
       

     

       90
       90
       +
       int my_pid_index = 0;

     

       91
       91
       +
       

     

       92
       92
       +
       SEC("tp/syscalls/sys_enter_write")

     

       93
       93
       +
       int handle_tp(void *ctx) {

     

       94
       94
       +
         int pid = bpf_get_current_pid_tgid() >> 32;

     

       95
       95
       +
       

     

       96
       96
       +
         long *my_pid;

     

       97
       97
       +
         my_pid = bpf_map_lookup_elem(&globals, &my_pid_index);

     

       98
       98
       +
         if (my_pid == NULL) {

     

       99
       99
       +
           bpf_printk("Error got NULL");

     

       100
       100
       +
           return 1;

     

       101
       101
       +
         };

     

       102
       102
       +
       

     

       103
       103
       +
         if (pid != *my_pid)

     

       104
       104
       +
           return 0;

     

       105
       105
       +
       

     

       106
       106
       +
         bpf_printk("Hello, BPF triggered from PID %d", pid);

     

       107
       107
       +
       

     

       108
       108
       +
         return 0;

     

       109
       109
       +
       }

     

       110
       110
       +
       

     

       111
       111
       +
       ```

     

       112
       112
       +
       

     

       113
       113
       +
       After compilation to eBPF ELF file as `minimal.o`. Users just need to

     

       114
       114
       +
       provide the path to this ELF file along with the name of the program

     

       115
       115
       +
       and optionally an initialization function. Note that the name of the

     

       116
       116
       +
       program refers to the function identifier under the SEC(...)

     

       117
       117
       +
       attribute, in this case it is "handle_tp".

     

       118
       118
       +
       

     

       119
       119
       +
       ```ocaml

     

       120
       120
       +
       open Libbpf

     

       121
       121
       +
       

     

       122
       122
       +
       let obj_path = "minimal.bpf.o"

     

       123
       123
       +
       let program_names = [ "handle_tp" ]

     

       124
       124
       +
       

     

       125
       125
       +
       let () =

     

       126
       126
       +
         with_bpf_object_open_load_link ~obj_path ~program_names ~before_link

     

       127
       127
       +
           (fun obj link ->

     

       128
       128
       +
       

     

       129
       129
       +
       	< user code to interact with bpf program running in kernel >

     

       130
       130
       +
       

     

       131
       131
       +
       	)

     

       132
       132
       +
       ```

     

       133
       133
       +
       

     

       134
       134
       +
       The API provided by ocaml-libbpf `with_bpf_object_open_load_link` is

     

       135
       135
       +
       a context manager that ensures the proper cleanup of resources if a

     

       136
       136
       +
       failure is encountered. Right now our loaded kernel program is

     

       137
       137
       +
       attached to the kernel and then immediately unloaded, users are

     

       138
       138
       +
       responsible for keeping the bpf program alive by looping within the

     

       139
       139
       +
       function block.

     

       140
       140
       +
       

     

       141
       141
       +
       > Users may also pin the bpf program to persist after user code

     

       142
       142
       +
       > exits. Do note that if pinning is desired, users should not use the

     

       143
       143
       +
       > `with_bpf_object_open_load_link` API and instead manually load and

     

       144
       144
       +
       > attach their bpf program since the context manager shutdowns all

     

       145
       145
       +
       > resources on exit.

     

       146
       146
       +
       

     

       147
       147
       +
       Now let's add some looping logic to keep the loaded bpf program alive.

     

       148
       148
       +
       

     

       149
       149
       +
       ```ocaml

     

       150
       150
       +
       let obj_path = "minimal.bpf.o"

     

       151
       151
       +
       let program_names = [ "handle_tp" ]

     

       152
       152
       +
       

     

       153
       153
       +
       let () =

     

       154
       154
       +
         with_bpf_object_open_load_link ~obj_path ~program_names ~before_link

     

       155
       155
       +
           (fun obj link ->

     

       156
       156
       +
       

     

       157
       157
       +
       	(* Set up signal handlers *)

     

       158
       158
       +
             let exitting = ref true in

     

       159
       159
       +
             let sig_handler = Sys.Signal_handle (fun _ -> exitting := false) in

     

       160
       160
       +
             Sys.(set_signal sigint sig_handler);

     

       161
       161
       +
             Sys.(set_signal sigterm sig_handler);

     

       162
       162
       +
       

     

       163
       163
       +
             Printf.printf

     

       164
       164
       +
               "Successfully started! Please run `sudo cat \

     

       165
       165
       +
                /sys/kernel/debug/tracing/trace_pipe` to see output of the BPF \

     

       166
       166
       +
                programs.\n\

     

       167
       167
       +
                %!"

     

       168
       168
       +
       

     

       169
       169
       +
           (* Loop until Ctrl-C is called *)

     

       170
       170
       +
             while !exitting do

     

       171
       171
       +
               Printf.eprintf ".%!";

     

       172
       172
       +
               Unix.sleepf 1.0

     

       173
       173
       +
             done)

     

       174
       174
       +
       ```

     

       175
       175
       +
       

     

       176
       176
       +
       Our bpf program is now running in the kernel until we decide to

     

       177
       177
       +
       interrupt it. However, it doesn't do exactly what we want. In

     

       178
       178
       +
       particular, it doesn't filter for our process PID. This is because we

     

       179
       179
       +
       haven't loaded our process PID into the BPF map. To do this, we need

     

       180
       180
       +
       the name of the map we declared in the `minimal.bpf.c` program. In

     

       181
       181
       +
       this case, our BPF array map was named `globals`.

     

       182
       182
       +
       

     

       183
       183
       +
       ```ocaml

     

       184
       184
       +
       let map = "globals"

     

       185
       185
       +
       

     

       186
       186
       +
       (* Load PID into BPF map *)

     

       187
       187
       +
       let before_link obj =

     

       188
       188
       +
         let pid = Unix.getpid () |> Signed.Long.of_int in

     

       189
       189
       +
         let global_map = bpf_object_find_map_by_name obj map in

     

       190
       190
       +
         (* When updating an element, users need to specify the type of the key and value

     

       191
       191
       +
            declared by the map which checks that the key and value size are consistent. *)

     

       192
       192
       +
         bpf_map_update_elem ~key_ty:Ctypes.int ~val_ty:Ctypes.long global_map 0 pid

     

       193
       193
       +
       ```

     

       194
       194
       +
       

     

       195
       195
       +
       Put together in [minimal.ml](./examples/minimal.ml), your bpf program

     

       196
       196
       +
       runs in kernel and print to the trace pipe every second.

     

       197
       197
       +
       

     

       198
       198
       +
       ### Maps

     

       199
       199
       +
       `libbpf_maps` is an optional convenience package that provides

     

       200
       200
       +
       wrappers for BPF maps. Currently only Ringbuffer maps are added. An

     

       201
       201
       +
       example usage of them can be found in

     

       202
       202
       +
       [examples/bootstrap.ml](./examples/bootstrap.ml). This has been

     

       203
       203
       +
       packaged separately since it drags in `libffi` dependency.

     

       204
       204
       +
       

     

       205
       205
       +
       ## Notes on compatibility

     

       206
       206
       +
       > The libbpf C library is designed to be kernel-agnostic and work

     

       207
       207
       +
       > across multitude of kernel versions. It has built-in mechanisms to

     

       208
       208
       +
       > gracefully handle older kernels, that are missing some of the

     

       209
       209
       +
       > features, by working around or gracefully degrading functionality.

     

       210
       210
       +
       

     

       211
       211
       +
       Vendoring libbpf was a option. However, since bpf programs require

     

       212
       212
       +
       writing the kernel components that may use libbpf, we made the choice

     

       213
       213
       +
       to use the system's package versioned instead. This avoids users from

     

       214
       214
       +
       knowingly/unknowingly using libbpf API's from two different

     

       215
       215
       +
       versions. As a consequence, this library support operating systems

     

       216
       216
       +
       that package libbpf.v.1.1 and up. Check ocaml-ci for the list of

     

       217
       217
       +
       operating systems that successfully builds.

     

       218
       218
       +
       

     

       219
       219
       +
       If so desired, you can also checkout the `vendored` branch in this

     

       220
       220
       +
       repo which builds ocaml-libbpf with the latest libbpf package.

+16

vendor/ocaml-libbpf/conf-bpftool.opam

···

       1
       1
       +
       opam-version: "2.0"

     

       2
       2
       +
       synopsis: "Virtual package for system installation of bpftool"

     

       3
       3
       +
       maintainer: ["Lee Koon Wen"]

     

       4
       4
       +
       authors: ["Lee Koon Wen"]

     

       5
       5
       +
       license: ["ISC" "BSD-3-Clause"]

     

       6
       6
       +
       homepage: "https://github.com/koonwen/ocaml-libbpf"

     

       7
       7
       +
       doc: "https://koonwen.github.io/ocaml-libbpf"

     

       8
       8
       +
       bug-reports: "https://github.com/koonwen/ocaml-libbpf/issues"

     

       9
       9
       +
       available: [ os = "linux" ]

     

       10
       10
       +
       depexts: [

     

       11
       11
       +
         [ "linux-tools-common" ] {os-distribution = "ubuntu"}

     

       12
       12
       +
         [ "bpftool" ]            {os-distribution = "debian"}

     

       13
       13
       +
         [ "bpftool" ]		   {os-distribution = "fedora"}

     

       14
       14
       +
       ]

     

       15
       15
       +
       flags: conf

     

       16
       16
       +
       x-commit-hash: "c7ac4c7ff9f2aa23c374a619990c0bdd78976102"

+17

vendor/ocaml-libbpf/conf-libbpf.opam

···

       1
       1
       +
       opam-version: "2.0"

     

       2
       2
       +
       synopsis: "Virtual package for system installation of libbpf"

     

       3
       3
       +
       maintainer: ["Lee Koon Wen"]

     

       4
       4
       +
       authors: ["Lee Koon Wen"]

     

       5
       5
       +
       license: ["ISC" "BSD-3-Clause"]

     

       6
       6
       +
       homepage: "https://github.com/koonwen/ocaml-libbpf"

     

       7
       7
       +
       doc: "https://koonwen.github.io/ocaml-libbpf"

     

       8
       8
       +
       bug-reports: "https://github.com/koonwen/ocaml-libbpf/issues"

     

       9
       9
       +
       available: [ os = "linux" ]

     

       10
       10
       +
       

     

       11
       11
       +
       depexts: [

     

       12
       12
       +
         ["libbpf-dev"]   { os-distribution = "ubuntu" & os-version >= "18.04" }

     

       13
       13
       +
         ["libbpf-dev"]   { os-distribution = "debian" & os-version >= "9.0" }

     

       14
       14
       +
         ["libbpf-devel"] { os-distribution = "fedora" & os-version >= "38" }

     

       15
       15
       +
       ]

     

       16
       16
       +
       flags: conf

     

       17
       17
       +
       x-commit-hash: "c7ac4c7ff9f2aa23c374a619990c0bdd78976102"

+55

vendor/ocaml-libbpf/dune-project

···

       1
       1
       +
       (lang dune 3.13)

     

       2
       2
       +
       

     

       3
       3
       +
       (name libbpf)

     

       4
       4
       +
       (source

     

       5
       5
       +
        (github koonwen/ocaml-libbpf))

     

       6
       6
       +
       (authors "Lee Koon Wen")

     

       7
       7
       +
       (maintainers "Lee Koon Wen")

     

       8
       8
       +
       (license ISC BSD-3-Clause)

     

       9
       9
       +
       (documentation https://koonwen.github.io/ocaml-libbpf)

     

       10
       10
       +
       

     

       11
       11
       +
       (package

     

       12
       12
       +
        (allow_empty)

     

       13
       13
       +
        (name conf-libbpf)

     

       14
       14
       +
        (synopsis "Virtual package for system installation of libbpf"))

     

       15
       15
       +
       

     

       16
       16
       +
       (package

     

       17
       17
       +
        (allow_empty)

     

       18
       18
       +
        (name conf-bpftool)

     

       19
       19
       +
        (synopsis "Virtual package for system installation of bpftool"))

     

       20
       20
       +
       

     

       21
       21
       +
       (package

     

       22
       22
       +
        (name libbpf)

     

       23
       23
       +
        (synopsis "Libbpf bindings")

     

       24
       24
       +
        (description "Wrapped libbpf api's for writing BPF user programs in OCaml")

     

       25
       25
       +
        (depends

     

       26
       26
       +
         (ocaml

     

       27
       27
       +
          (>= 4.08))

     

       28
       28
       +
         dune

     

       29
       29
       +
         (ctypes

     

       30
       30
       +
          (>= 0.22.0))

     

       31
       31
       +
         ppx_deriving

     

       32
       32
       +
         ppx_expect

     

       33
       33
       +
         conf-libbpf

     

       34
       34
       +
         conf-bpftool

     

       35
       35
       +
         conf-clang)

     

       36
       36
       +
        ; This is only a dependency for the examples directory

     

       37
       37
       +
        ; to show how to use dune to build bpf programs, it is

     

       38
       38
       +
        ; not part of the library bindings, however, we can't

     

       39
       39
       +
        ; remove it since it builds alongside the library

     

       40
       40
       +
        (tags

     

       41
       41
       +
         (bindings bpf libbpf)))

     

       42
       42
       +
       

     

       43
       43
       +
       (package

     

       44
       44
       +
        (name libbpf_maps)

     

       45
       45
       +
        (synopsis "Libbpf maps API")

     

       46
       46
       +
        (description "High level API's for interacting with BPF maps in OCaml")

     

       47
       47
       +
        (depends

     

       48
       48
       +
         (ctypes

     

       49
       49
       +
          (>= 0.22.0))

     

       50
       50
       +
         (ctypes-foreign

     

       51
       51
       +
          (>= 0.22.0))

     

       52
       52
       +
         (libbpf

     

       53
       53
       +
          (= :version)))

     

       54
       54
       +
        (tags

     

       55
       55
       +
         (bindings bpf libbpf)))

+29

vendor/ocaml-libbpf/examples/LICENSE.md

···

       1
       1
       +
       BSD 3-Clause License

     

       2
       2
       +
       

     

       3
       3
       +
       Copyright (c) 2020, Andrii Nakryiko

     

       4
       4
       +
       All rights reserved.

     

       5
       5
       +
       

     

       6
       6
       +
       Redistribution and use in source and binary forms, with or without

     

       7
       7
       +
       modification, are permitted provided that the following conditions are met:

     

       8
       8
       +
       

     

       9
       9
       +
       1. Redistributions of source code must retain the above copyright notice, this

     

       10
       10
       +
          list of conditions and the following disclaimer.

     

       11
       11
       +
       

     

       12
       12
       +
       2. Redistributions in binary form must reproduce the above copyright notice,

     

       13
       13
       +
          this list of conditions and the following disclaimer in the documentation

     

       14
       14
       +
          and/or other materials provided with the distribution.

     

       15
       15
       +
       

     

       16
       16
       +
       3. Neither the name of the copyright holder nor the names of its

     

       17
       17
       +
          contributors may be used to endorse or promote products derived from

     

       18
       18
       +
          this software without specific prior written permission.

     

       19
       19
       +
       

     

       20
       20
       +
       THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"

     

       21
       21
       +
       AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE

     

       22
       22
       +
       IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE

     

       23
       23
       +
       DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE

     

       24
       24
       +
       FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL

     

       25
       25
       +
       DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR

     

       26
       26
       +
       SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER

     

       27
       27
       +
       CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,

     

       28
       28
       +
       OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE

     

       29
       29
       +
       OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+23

vendor/ocaml-libbpf/examples/Makefile

···

       1
       1
       +
       CWD=../_build/default/examples

     

       2
       2
       +
       

     

       3
       3
       +
       build:

     

       4
       4
       +
       	dune build

     

       5
       5
       +
       

     

       6
       6
       +
       minimal: build

     

       7
       7
       +
       	sudo $(CWD)/minimal.exe

     

       8
       8
       +
       

     

       9
       9
       +
       kprobe: build

     

       10
       10
       +
       	sudo $(CWD)/kprobe.exe

     

       11
       11
       +
       

     

       12
       12
       +
       tc: build

     

       13
       13
       +
       	sudo $(CWD)/tc.exe

     

       14
       14
       +
       

     

       15
       15
       +
       bootstrap: build

     

       16
       16
       +
       	sudo $(CWD)/bootstrap.exe

     

       17
       17
       +
       

     

       18
       18
       +
       bootstrap_c: build

     

       19
       19
       +
       	sudo $(CWD)/bootstrap_c.exe

     

       20
       20
       +
       

     

       21
       21
       +
       clean:

     

       22
       22
       +
       	dune clean

     

       23
       23
       +
       	rm vmlinux.h

+111

vendor/ocaml-libbpf/examples/bootstrap.bpf.c

···

       1
       1
       +
       // SPDX-License-Identifier: GPL-2.0 OR BSD-3-Clause

     

       2
       2
       +
       /* Copyright (c) 2020 Facebook */

     

       3
       3
       +
       #include "vmlinux.h"

     

       4
       4
       +
       #include <bpf/bpf_helpers.h>

     

       5
       5
       +
       #include <bpf/bpf_tracing.h>

     

       6
       6
       +
       #include <bpf/bpf_core_read.h>

     

       7
       7
       +
       #include "bootstrap.h"

     

       8
       8
       +
       

     

       9
       9
       +
       char LICENSE[] SEC("license") = "Dual BSD/GPL";

     

       10
       10
       +
       

     

       11
       11
       +
       struct {

     

       12
       12
       +
       	__uint(type, BPF_MAP_TYPE_HASH);

     

       13
       13
       +
       	__uint(max_entries, 8192);

     

       14
       14
       +
       	__type(key, pid_t);

     

       15
       15
       +
       	__type(value, u64);

     

       16
       16
       +
       } exec_start SEC(".maps");

     

       17
       17
       +
       

     

       18
       18
       +
       struct {

     

       19
       19
       +
       	__uint(type, BPF_MAP_TYPE_RINGBUF);

     

       20
       20
       +
       	__uint(max_entries, 256 * 1024);

     

       21
       21
       +
       } rb SEC(".maps");

     

       22
       22
       +
       

     

       23
       23
       +
       const volatile unsigned long long min_duration_ns = 0;

     

       24
       24
       +
       

     

       25
       25
       +
       SEC("tp/sched/sched_process_exec")

     

       26
       26
       +
       int handle_exec(struct trace_event_raw_sched_process_exec *ctx)

     

       27
       27
       +
       {

     

       28
       28
       +
       	struct task_struct *task;

     

       29
       29
       +
       	unsigned fname_off;

     

       30
       30
       +
       	struct event *e;

     

       31
       31
       +
       	pid_t pid;

     

       32
       32
       +
       	u64 ts;

     

       33
       33
       +
       

     

       34
       34
       +
       	/* remember time exec() was executed for this PID */

     

       35
       35
       +
       	pid = bpf_get_current_pid_tgid() >> 32;

     

       36
       36
       +
       	ts = bpf_ktime_get_ns();

     

       37
       37
       +
       	bpf_map_update_elem(&exec_start, &pid, &ts, BPF_ANY);

     

       38
       38
       +
       

     

       39
       39
       +
       	/* don't emit exec events when minimum duration is specified */

     

       40
       40
       +
       	if (min_duration_ns)

     

       41
       41
       +
       		return 0;

     

       42
       42
       +
       

     

       43
       43
       +
       	/* reserve sample from BPF ringbuf */

     

       44
       44
       +
       	e = bpf_ringbuf_reserve(&rb, sizeof(*e), 0);

     

       45
       45
       +
       	if (!e)

     

       46
       46
       +
       		return 0;

     

       47
       47
       +
       

     

       48
       48
       +
       	/* fill out the sample with data */

     

       49
       49
       +
       	task = (struct task_struct *)bpf_get_current_task();

     

       50
       50
       +
       

     

       51
       51
       +
       	e->exit_event = false;

     

       52
       52
       +
       	e->pid = pid;

     

       53
       53
       +
       	e->ppid = BPF_CORE_READ(task, real_parent, tgid);

     

       54
       54
       +
       	bpf_get_current_comm(&e->comm, sizeof(e->comm));

     

       55
       55
       +
       

     

       56
       56
       +
       	fname_off = ctx->__data_loc_filename & 0xFFFF;

     

       57
       57
       +
       	bpf_probe_read_str(&e->filename, sizeof(e->filename), (void *)ctx + fname_off);

     

       58
       58
       +
       

     

       59
       59
       +
       	/* successfully submit it to user-space for post-processing */

     

       60
       60
       +
       	bpf_ringbuf_submit(e, 0);

     

       61
       61
       +
       	return 0;

     

       62
       62
       +
       }

     

       63
       63
       +
       

     

       64
       64
       +
       SEC("tp/sched/sched_process_exit")

     

       65
       65
       +
       int handle_exit(struct trace_event_raw_sched_process_template *ctx)

     

       66
       66
       +
       {

     

       67
       67
       +
       	struct task_struct *task;

     

       68
       68
       +
       	struct event *e;

     

       69
       69
       +
       	pid_t pid, tid;

     

       70
       70
       +
       	u64 id, ts, *start_ts, duration_ns = 0;

     

       71
       71
       +
       

     

       72
       72
       +
       	/* get PID and TID of exiting thread/process */

     

       73
       73
       +
       	id = bpf_get_current_pid_tgid();

     

       74
       74
       +
       	pid = id >> 32;

     

       75
       75
       +
       	tid = (u32)id;

     

       76
       76
       +
       

     

       77
       77
       +
       	/* ignore thread exits */

     

       78
       78
       +
       	if (pid != tid)

     

       79
       79
       +
       		return 0;

     

       80
       80
       +
       

     

       81
       81
       +
       	/* if we recorded start of the process, calculate lifetime duration */

     

       82
       82
       +
       	start_ts = bpf_map_lookup_elem(&exec_start, &pid);

     

       83
       83
       +
       	if (start_ts)

     

       84
       84
       +
       		duration_ns = bpf_ktime_get_ns() - *start_ts;

     

       85
       85
       +
       	else if (min_duration_ns)

     

       86
       86
       +
       		return 0;

     

       87
       87
       +
       	bpf_map_delete_elem(&exec_start, &pid);

     

       88
       88
       +
       

     

       89
       89
       +
       	/* if process didn't live long enough, return early */

     

       90
       90
       +
       	if (min_duration_ns && duration_ns < min_duration_ns)

     

       91
       91
       +
       		return 0;

     

       92
       92
       +
       

     

       93
       93
       +
       	/* reserve sample from BPF ringbuf */

     

       94
       94
       +
       	e = bpf_ringbuf_reserve(&rb, sizeof(*e), 0);

     

       95
       95
       +
       	if (!e)

     

       96
       96
       +
       		return 0;

     

       97
       97
       +
       

     

       98
       98
       +
       	/* fill out the sample with data */

     

       99
       99
       +
       	task = (struct task_struct *)bpf_get_current_task();

     

       100
       100
       +
       

     

       101
       101
       +
       	e->exit_event = true;

     

       102
       102
       +
       	e->duration_ns = duration_ns;

     

       103
       103
       +
       	e->pid = pid;

     

       104
       104
       +
       	e->ppid = BPF_CORE_READ(task, real_parent, tgid);

     

       105
       105
       +
       	e->exit_code = (BPF_CORE_READ(task, exit_code) >> 8) & 0xff;

     

       106
       106
       +
       	bpf_get_current_comm(&e->comm, sizeof(e->comm));

     

       107
       107
       +
       

     

       108
       108
       +
       	/* send data to user-space for post-processing */

     

       109
       109
       +
       	bpf_ringbuf_submit(e, 0);

     

       110
       110
       +
       	return 0;

     

       111
       111
       +
       }

+19

vendor/ocaml-libbpf/examples/bootstrap.h

···

       1
       1
       +
       /* SPDX-License-Identifier: (LGPL-2.1 OR BSD-2-Clause) */

     

       2
       2
       +
       /* Copyright (c) 2020 Facebook */

     

       3
       3
       +
       #ifndef __BOOTSTRAP_H

     

       4
       4
       +
       #define __BOOTSTRAP_H

     

       5
       5
       +
       

     

       6
       6
       +
       #define TASK_COMM_LEN	 16

     

       7
       7
       +
       #define MAX_FILENAME_LEN 127

     

       8
       8
       +
       

     

       9
       9
       +
       struct event {

     

       10
       10
       +
       	int pid;

     

       11
       11
       +
       	int ppid;

     

       12
       12
       +
       	unsigned exit_code;

     

       13
       13
       +
       	unsigned long long duration_ns;

     

       14
       14
       +
       	char comm[TASK_COMM_LEN];

     

       15
       15
       +
       	char filename[MAX_FILENAME_LEN];

     

       16
       16
       +
       	bool exit_event;

     

       17
       17
       +
       };

     

       18
       18
       +
       

     

       19
       19
       +
       #endif /* __BOOTSTRAP_H */

+78

vendor/ocaml-libbpf/examples/bootstrap.ml

···

       1
       1
       +
       open Libbpf

     

       2
       2
       +
       open Libbpf_maps

     

       3
       3
       +
       open Ctypes

     

       4
       4
       +
       

     

       5
       5
       +
       let obj_path = "bootstrap.bpf.o"

     

       6
       6
       +
       let program_names = [ "handle_exec"; "handle_exit" ]

     

       7
       7
       +
       let rb_name = "rb"

     

       8
       8
       +
       

     

       9
       9
       +
       (* event structure layout from bootstrap.h *)

     

       10
       10
       +
       let event : [ `Event ] structure typ = Ctypes.structure "event"

     

       11
       11
       +
       let ( -: ) ty label = field event label ty

     

       12
       12
       +
       let pid = int -: "pid"

     

       13
       13
       +
       let ppid = int -: "ppid"

     

       14
       14
       +
       let exit_code = uint -: "exit_code"

     

       15
       15
       +
       let duration = ullong -: "duration_ns"

     

       16
       16
       +
       let comm = array 16 char -: "comm"

     

       17
       17
       +
       let filename = array 127 char -: "filename"

     

       18
       18
       +
       let exit_event = bool -: "exit_event"

     

       19
       19
       +
       let _ = seal event

     

       20
       20
       +
       

     

       21
       21
       +
       let char_array_as_string a =

     

       22
       22
       +
         let len = CArray.length a in

     

       23
       23
       +
         let b = Buffer.create len in

     

       24
       24
       +
         try

     

       25
       25
       +
           for i = 0 to len - 1 do

     

       26
       26
       +
             let c = CArray.get a i in

     

       27
       27
       +
             if c = '\x00' then raise Exit else Buffer.add_char b c

     

       28
       28
       +
           done;

     

       29
       29
       +
           Buffer.contents b

     

       30
       30
       +
         with Exit -> Buffer.contents b

     

       31
       31
       +
       

     

       32
       32
       +
       (* Describe User callback event handler *)

     

       33
       33
       +
       let handle_event _ctx data _sz =

     

       34
       34
       +
         let ev = !@(from_voidp event data) in

     

       35
       35
       +
         let pid = getf ev pid in

     

       36
       36
       +
         let ppid = getf ev ppid in

     

       37
       37
       +
         let exit_code = getf ev exit_code |> Unsigned.UInt.to_string in

     

       38
       38
       +
         let duration = getf ev duration |> Unsigned.ULLong.to_int64 in

     

       39
       39
       +
         let comm = getf ev comm |> char_array_as_string in

     

       40
       40
       +
         let filename = getf ev filename |> char_array_as_string in

     

       41
       41
       +
         let exit_event = getf ev exit_event in

     

       42
       42
       +
         let tm = Unix.time () |> Unix.localtime in

     

       43
       43
       +
         let ts = Printf.sprintf "%d:%d:%d" tm.tm_hour tm.tm_min tm.tm_sec in

     

       44
       44
       +
         if exit_event then (

     

       45
       45
       +
           Printf.printf "%-8s %-5s %-16s %-7d %-7d [%s]" ts "EXIT" comm pid ppid

     

       46
       46
       +
             exit_code;

     

       47
       47
       +
           if duration >= 0L then

     

       48
       48
       +
             Printf.printf " (%Lums)" (Int64.div duration 1000000L);

     

       49
       49
       +
           print_newline ())

     

       50
       50
       +
         else

     

       51
       51
       +
           Printf.printf "%-8s %-5s %-16s %-7d %-7d %s\n" ts "EXEC" comm pid ppid

     

       52
       52
       +
             filename;

     

       53
       53
       +
         0

     

       54
       54
       +
       

     

       55
       55
       +
       let () =

     

       56
       56
       +
         (* Set signal handlers *)

     

       57
       57
       +
         let exitting = ref true in

     

       58
       58
       +
         let sig_handler = Sys.Signal_handle (fun _ -> exitting := false) in

     

       59
       59
       +
         Sys.(set_signal sigint sig_handler);

     

       60
       60
       +
         Sys.(set_signal sigterm sig_handler);

     

       61
       61
       +
       

     

       62
       62
       +
         (* Use auto open/load/link helper *)

     

       63
       63
       +
         with_bpf_object_open_load_link ~obj_path ~program_names (fun obj _links ->

     

       64
       64
       +
             (* Load ringbuffer map *)

     

       65
       65
       +
             let map = bpf_object_find_map_by_name obj rb_name in

     

       66
       66
       +
       

     

       67
       67
       +
             (* Set up ring buffer *)

     

       68
       68
       +
             RingBuffer.init map ~callback:handle_event (fun rb ->

     

       69
       69
       +
                 Printf.printf "%-8s %-5s %-16s %-7s %-7s %s\n%!" "TIME" "EVENT" "COMM"

     

       70
       70
       +
                   "PID" "PPID" "FILENAME/EXIT CODE";

     

       71
       71
       +
       

     

       72
       72
       +
                 while !exitting do

     

       73
       73
       +
                   ignore

     

       74
       74
       +
                     (try RingBuffer.poll rb ~timeout:100

     

       75
       75
       +
                      with _ ->

     

       76
       76
       +
                        exitting := false;

     

       77
       77
       +
                        -1)

     

       78
       78
       +
                 done))

+109

vendor/ocaml-libbpf/examples/bootstrap_c.ml

···

       1
       1
       +
       module F = Libbpf.C.Functions

     

       2
       2
       +
       module T = Libbpf.C.Types

     

       3
       3
       +
       

     

       4
       4
       +
       let bpf_obj_path = "bootstrap.bpf.o"

     

       5
       5
       +
       let program_names = [ "handle_exec"; "handle_exit" ]

     

       6
       6
       +
       let rb_name = "rb"

     

       7
       7
       +
       

     

       8
       8
       +
       exception Exit of int

     

       9
       9
       +
       

     

       10
       10
       +
       let main () =

     

       11
       11
       +
         (* Set signal handlers *)

     

       12
       12
       +
         let exitting = ref true in

     

       13
       13
       +
         let sig_handler = Sys.Signal_handle (fun _ -> exitting := false) in

     

       14
       14
       +
         Sys.(set_signal sigint sig_handler);

     

       15
       15
       +
         Sys.(set_signal sigterm sig_handler);

     

       16
       16
       +
       

     

       17
       17
       +
         (* Read BPF object *)

     

       18
       18
       +
         let obj =

     

       19
       19
       +
           match F.bpf_object__open bpf_obj_path with

     

       20
       20
       +
           | None ->

     

       21
       21
       +
               Printf.eprintf "Failed to open BPF object\n";

     

       22
       22
       +
               raise (Exit 1)

     

       23
       23
       +
           | Some obj -> obj

     

       24
       24
       +
         in

     

       25
       25
       +
       

     

       26
       26
       +
         at_exit (fun () -> F.bpf_object__close obj);

     

       27
       27
       +
       

     

       28
       28
       +
         (* Load BPF object *)

     

       29
       29
       +
         if F.bpf_object__load obj = 1 then (

     

       30
       30
       +
           Printf.eprintf "Failed to load BPF object\n";

     

       31
       31
       +
           raise (Exit 1));

     

       32
       32
       +
       

     

       33
       33
       +
         let progs =

     

       34
       34
       +
           let find_exn name =

     

       35
       35
       +
             match F.bpf_object__find_program_by_name obj name with

     

       36
       36
       +
             | None ->

     

       37
       37
       +
                 Printf.eprintf "Failed to find bpf program: %s\n" name;

     

       38
       38
       +
                 raise (Exit 1)

     

       39
       39
       +
             | Some p -> p

     

       40
       40
       +
           in

     

       41
       41
       +
           List.map find_exn program_names

     

       42
       42
       +
         in

     

       43
       43
       +
       

     

       44
       44
       +
         (* Attach tracepoint *)

     

       45
       45
       +
         let links =

     

       46
       46
       +
           let attach_exn prog =

     

       47
       47
       +
             match F.bpf_program__attach prog with

     

       48
       48
       +
             | Some linkp -> linkp

     

       49
       49
       +
             | None ->

     

       50
       50
       +
                 Printf.eprintf "Failed to attach BPF program\n";

     

       51
       51
       +
                 raise (Exit 1)

     

       52
       52
       +
           in

     

       53
       53
       +
           List.map attach_exn progs

     

       54
       54
       +
         in

     

       55
       55
       +
       

     

       56
       56
       +
         at_exit (fun () ->

     

       57
       57
       +
             List.iter (fun link -> F.bpf_link__destroy link |> ignore) links);

     

       58
       58
       +
       

     

       59
       59
       +
         (* Load maps *)

     

       60
       60
       +
         let map =

     

       61
       61
       +
           match F.bpf_object__find_map_by_name obj rb_name with

     

       62
       62
       +
           | None ->

     

       63
       63
       +
               Printf.eprintf "Failed to find map\n";

     

       64
       64
       +
               raise (Exit 1)

     

       65
       65
       +
           | Some m -> m

     

       66
       66
       +
         in

     

       67
       67
       +
         let rb_fd = F.bpf_map__fd map in

     

       68
       68
       +
       

     

       69
       69
       +
         (* Describe event handler *)

     

       70
       70
       +
         let handle_event _ctx _data _sz =

     

       71
       71
       +
           Printf.printf "Handle_event called\n%!";

     

       72
       72
       +
           0

     

       73
       73
       +
         in

     

       74
       74
       +
       

     

       75
       75
       +
         (* Coerce it to the static_funptr *)

     

       76
       76
       +
         let handle_event_f =

     

       77
       77
       +
           Ctypes.(

     

       78
       78
       +
             coerce

     

       79
       79
       +
               (Foreign.funptr ~runtime_lock:false ~check_errno:true

     

       80
       80
       +
                  (ptr void @-> ptr void @-> size_t @-> returning int))

     

       81
       81
       +
               T.ring_buffer_sample_fn handle_event)

     

       82
       82
       +
         in

     

       83
       83
       +
       

     

       84
       84
       +
         (* Set up ring buffer polling *)

     

       85
       85
       +
         let rb =

     

       86
       86
       +
           match

     

       87
       87
       +
             F.ring_buffer__new rb_fd handle_event_f Ctypes.null

     

       88
       88
       +
               Ctypes.(from_voidp T.ring_buffer_opts null)

     

       89
       89
       +
           with

     

       90
       90
       +
           | None ->

     

       91
       91
       +
               Printf.eprintf "Failed to create ring buffer\n";

     

       92
       92
       +
               raise (Exit 1)

     

       93
       93
       +
           | Some rb -> rb

     

       94
       94
       +
         in

     

       95
       95
       +
       

     

       96
       96
       +
         at_exit (fun () -> F.ring_buffer__free rb);

     

       97
       97
       +
       

     

       98
       98
       +
         while !exitting do

     

       99
       99
       +
           Printf.printf "polling\n%!";

     

       100
       100
       +
           let err = F.ring_buffer__poll rb 100 in

     

       101
       101
       +
           match err with

     

       102
       102
       +
           | e when e = Sys.sighup -> raise (Exit 0)

     

       103
       103
       +
           | e when e < 0 ->

     

       104
       104
       +
               Printf.eprintf "Error polling ring buffer, %d\n" e;

     

       105
       105
       +
               raise (Exit 1)

     

       106
       106
       +
           | _ -> ()

     

       107
       107
       +
         done

     

       108
       108
       +
       

     

       109
       109
       +
       let () = try main () with Exit i when i <> 0 -> Printf.eprintf "[Exit %d]" i

+57

vendor/ocaml-libbpf/examples/dune

···

       1
       1
       +
       (executables

     

       2
       2
       +
        (names tc bootstrap bootstrap_c kprobe minimal)

     

       3
       3
       +
        (libraries libbpf libbpf_maps))

     

       4
       4
       +
       

     

       5
       5
       +
       ; Below is repetitive build rules to compile *.bpf.c eBPF C source code that runs in the kernel

     

       6
       6
       +
       

     

       7
       7
       +
       (rule

     

       8
       8
       +
        (mode

     

       9
       9
       +
         (promote (until-clean)))

     

       10
       10
       +
        (targets minimal.bpf.o)

     

       11
       11
       +
        (deps arch minimal.bpf.c)

     

       12
       12
       +
        (action

     

       13
       13
       +
         (system

     

       14
       14
       +
          "clang -g -O2 -target bpf -I/usr/include/%{architecture}-linux-gnu/ -c minimal.bpf.c  -D__TARGET_ARCH_%{read:arch}")))

     

       15
       15
       +
       

     

       16
       16
       +
       (rule

     

       17
       17
       +
        (mode

     

       18
       18
       +
         (promote (until-clean)))

     

       19
       19
       +
        (targets kprobe.bpf.o)

     

       20
       20
       +
        (deps arch vmlinux.h kprobe.bpf.c)

     

       21
       21
       +
        (action

     

       22
       22
       +
         (system

     

       23
       23
       +
          "clang -g -O2 -target bpf -I/usr/include/%{architecture}-linux-gnu/ -c kprobe.bpf.c  -D__TARGET_ARCH_%{read:arch}")))

     

       24
       24
       +
       

     

       25
       25
       +
       (rule

     

       26
       26
       +
        (mode

     

       27
       27
       +
         (promote (until-clean)))

     

       28
       28
       +
        (targets tc.bpf.o)

     

       29
       29
       +
        (deps arch vmlinux.h tc.bpf.c)

     

       30
       30
       +
        (action

     

       31
       31
       +
         (system

     

       32
       32
       +
          "clang -g -O2 -target bpf -I/usr/include/%{architecture}-linux-gnu/ -c tc.bpf.c  -D__TARGET_ARCH_%{read:arch}")))

     

       33
       33
       +
       

     

       34
       34
       +
       (rule

     

       35
       35
       +
        (mode

     

       36
       36
       +
         (promote (until-clean)))

     

       37
       37
       +
        (targets bootstrap.bpf.o)

     

       38
       38
       +
        (deps arch vmlinux.h bootstrap.bpf.c bootstrap.h)

     

       39
       39
       +
        (action

     

       40
       40
       +
         (system

     

       41
       41
       +
          "clang -g -O2 -target bpf -I/usr/include/%{architecture}-linux-gnu/ -c bootstrap.bpf.c -D__TARGET_ARCH_%{read:arch}")))

     

       42
       42
       +
       

     

       43
       43
       +
       (rule

     

       44
       44
       +
        (mode

     

       45
       45
       +
         (promote (until-clean)))

     

       46
       46
       +
        (targets vmlinux.h arch)

     

       47
       47
       +
        (action

     

       48
       48
       +
         (progn

     

       49
       49
       +
          (with-stdout-to

     

       50
       50
       +
           vmlinux.h

     

       51
       51
       +
           (run /usr/sbin/bpftool btf dump file /sys/kernel/btf/vmlinux format c))

     

       52
       52
       +
          (with-stdout-to

     

       53
       53
       +
           arch

     

       54
       54
       +
           (bash

     

       55
       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
       56
       +
       

     

       57
       57
       +
       ; /usr/include/%{architecture}-linux-gnu/       Find asm/types.h for eBPF code

+30

vendor/ocaml-libbpf/examples/kprobe.bpf.c

···

       1
       1
       +
       // SPDX-License-Identifier: GPL-2.0 OR BSD-3-Clause

     

       2
       2
       +
       /* Copyright (c) 2021 Sartura */

     

       3
       3
       +
       #include "vmlinux.h"

     

       4
       4
       +
       #include <bpf/bpf_helpers.h>

     

       5
       5
       +
       #include <bpf/bpf_tracing.h>

     

       6
       6
       +
       #include <bpf/bpf_core_read.h>

     

       7
       7
       +
       

     

       8
       8
       +
       char LICENSE[] SEC("license") = "Dual BSD/GPL";

     

       9
       9
       +
       

     

       10
       10
       +
       SEC("kprobe/do_unlinkat")

     

       11
       11
       +
       int BPF_KPROBE(do_unlinkat, int dfd, struct filename *name)

     

       12
       12
       +
       {

     

       13
       13
       +
       	pid_t pid;

     

       14
       14
       +
       	const char *filename;

     

       15
       15
       +
       

     

       16
       16
       +
       	pid = bpf_get_current_pid_tgid() >> 32;

     

       17
       17
       +
       	filename = BPF_CORE_READ(name, name);

     

       18
       18
       +
       	bpf_printk("KPROBE ENTRY pid = %d, filename = %s\n", pid, filename);

     

       19
       19
       +
       	return 0;

     

       20
       20
       +
       }

     

       21
       21
       +
       

     

       22
       22
       +
       SEC("kretprobe/do_unlinkat")

     

       23
       23
       +
       int BPF_KRETPROBE(do_unlinkat_exit, long ret)

     

       24
       24
       +
       {

     

       25
       25
       +
       	pid_t pid;

     

       26
       26
       +
       

     

       27
       27
       +
       	pid = bpf_get_current_pid_tgid() >> 32;

     

       28
       28
       +
       	bpf_printk("KPROBE EXIT: pid = %d, ret = %ld\n", pid, ret);

     

       29
       29
       +
       	return 0;

     

       30
       30
       +
       }

+23

vendor/ocaml-libbpf/examples/kprobe.ml

···

       1
       1
       +
       open Libbpf

     

       2
       2
       +
       

     

       3
       3
       +
       let obj_path = "kprobe.bpf.o"

     

       4
       4
       +
       let program_names = [ "do_unlinkat"; "do_unlinkat_exit" ]

     

       5
       5
       +
       

     

       6
       6
       +
       let () =

     

       7
       7
       +
         with_bpf_object_open_load_link ~obj_path ~program_names (fun _obj _links ->

     

       8
       8
       +
             (* Set signal handlers *)

     

       9
       9
       +
             let exitting = ref true in

     

       10
       10
       +
             let sig_handler = Sys.Signal_handle (fun _ -> exitting := false) in

     

       11
       11
       +
             Sys.(set_signal sigint sig_handler);

     

       12
       12
       +
             Sys.(set_signal sigterm sig_handler);

     

       13
       13
       +
       

     

       14
       14
       +
             Printf.printf

     

       15
       15
       +
               "Successfully started! Please run `sudo cat \

     

       16
       16
       +
                /sys/kernel/debug/tracing/trace_pipe` to see output of the BPF \

     

       17
       17
       +
                programs.\n\

     

       18
       18
       +
                %!";

     

       19
       19
       +
       

     

       20
       20
       +
             while !exitting do

     

       21
       21
       +
               Unix.sleepf 1.0;

     

       22
       22
       +
               Printf.eprintf ".%!"

     

       23
       23
       +
             done)

+35

vendor/ocaml-libbpf/examples/minimal.bpf.c

···

       1
       1
       +
       // SPDX-License-Identifier: GPL-2.0 OR BSD-3-Clause

     

       2
       2
       +
       /* Copyright (c) 2020 Facebook */

     

       3
       3
       +
       #include <linux/bpf.h>

     

       4
       4
       +
       #include "bpf/bpf_helpers.h" /* This is from our libbpf library */

     

       5
       5
       +
       

     

       6
       6
       +
       char LICENSE[] SEC("license") = "Dual BSD/GPL";

     

       7
       7
       +
       

     

       8
       8
       +
       /* Globals implemented as an array */

     

       9
       9
       +
       struct {

     

       10
       10
       +
         __uint(type, BPF_MAP_TYPE_ARRAY);

     

       11
       11
       +
         __uint(max_entries, 5);

     

       12
       12
       +
         __type(key, int);

     

       13
       13
       +
         __type(value, long);

     

       14
       14
       +
       } globals SEC(".maps");

     

       15
       15
       +
       

     

       16
       16
       +
       int my_pid_index = 0;

     

       17
       17
       +
       

     

       18
       18
       +
       SEC("tp/syscalls/sys_enter_write")

     

       19
       19
       +
       int handle_tp(void *ctx) {

     

       20
       20
       +
         int pid = bpf_get_current_pid_tgid() >> 32;

     

       21
       21
       +
       

     

       22
       22
       +
         long *my_pid;

     

       23
       23
       +
         my_pid = bpf_map_lookup_elem(&globals, &my_pid_index);

     

       24
       24
       +
         if (my_pid == NULL) {

     

       25
       25
       +
           bpf_printk("Error got NULL");

     

       26
       26
       +
           return 1;

     

       27
       27
       +
         };

     

       28
       28
       +
       

     

       29
       29
       +
         if (pid != *my_pid)

     

       30
       30
       +
           return 0;

     

       31
       31
       +
       

     

       32
       32
       +
         bpf_printk("Hello, BPF triggered from PID %d", pid);

     

       33
       33
       +
       

     

       34
       34
       +
         return 0;

     

       35
       35
       +
       }

+31

vendor/ocaml-libbpf/examples/minimal.ml

···

       1
       1
       +
       open Libbpf

     

       2
       2
       +
       

     

       3
       3
       +
       let obj_path = "minimal.bpf.o"

     

       4
       4
       +
       let program_names = [ "handle_tp" ]

     

       5
       5
       +
       let map = "globals"

     

       6
       6
       +
       

     

       7
       7
       +
       (* Load PID into BPF map*)

     

       8
       8
       +
       let before_link obj =

     

       9
       9
       +
         let pid = Unix.getpid () |> Signed.Long.of_int in

     

       10
       10
       +
         let global_map = bpf_object_find_map_by_name obj map in

     

       11
       11
       +
         bpf_map_update_elem ~key_ty:Ctypes.int ~val_ty:Ctypes.long global_map 0 pid

     

       12
       12
       +
       

     

       13
       13
       +
       let () =

     

       14
       14
       +
         with_bpf_object_open_load_link ~obj_path ~program_names ~before_link

     

       15
       15
       +
           (fun _obj _link ->

     

       16
       16
       +
             let exitting = ref true in

     

       17
       17
       +
             let sig_handler = Sys.Signal_handle (fun _ -> exitting := false) in

     

       18
       18
       +
             Sys.(set_signal sigint sig_handler);

     

       19
       19
       +
             Sys.(set_signal sigterm sig_handler);

     

       20
       20
       +
       

     

       21
       21
       +
             Printf.printf

     

       22
       22
       +
               "Successfully started! Please run `sudo cat \

     

       23
       23
       +
                /sys/kernel/debug/tracing/trace_pipe` to see output of the BPF \

     

       24
       24
       +
                programs.\n\

     

       25
       25
       +
                %!";

     

       26
       26
       +
       

     

       27
       27
       +
             (* Loop until Ctrl-C is called *)

     

       28
       28
       +
             while !exitting do

     

       29
       29
       +
               Printf.eprintf ".%!";

     

       30
       30
       +
               Unix.sleepf 1.0

     

       31
       31
       +
             done)

+34

vendor/ocaml-libbpf/examples/tc.bpf.c

···

       1
       1
       +
       // SPDX-License-Identifier: (LGPL-2.1 OR BSD-2-Clause)

     

       2
       2
       +
       /* Copyright (c) 2022 Hengqi Chen */

     

       3
       3
       +
       #include "vmlinux.h"

     

       4
       4
       +
       #include <bpf/bpf_endian.h>

     

       5
       5
       +
       #include <bpf/bpf_helpers.h>

     

       6
       6
       +
       #include <bpf/bpf_tracing.h>

     

       7
       7
       +
       

     

       8
       8
       +
       #define TC_ACT_OK 0

     

       9
       9
       +
       #define ETH_P_IP  0x0800 /* Internet Protocol packet	*/

     

       10
       10
       +
       

     

       11
       11
       +
       SEC("tc")

     

       12
       12
       +
       int tc_ingress(struct __sk_buff *ctx)

     

       13
       13
       +
       {

     

       14
       14
       +
       	void *data_end = (void *)(__u64)ctx->data_end;

     

       15
       15
       +
       	void *data = (void *)(__u64)ctx->data;

     

       16
       16
       +
       	struct ethhdr *l2;

     

       17
       17
       +
       	struct iphdr *l3;

     

       18
       18
       +
       

     

       19
       19
       +
       	if (ctx->protocol != bpf_htons(ETH_P_IP))

     

       20
       20
       +
       		return TC_ACT_OK;

     

       21
       21
       +
       

     

       22
       22
       +
       	l2 = data;

     

       23
       23
       +
       	if ((void *)(l2 + 1) > data_end)

     

       24
       24
       +
       		return TC_ACT_OK;

     

       25
       25
       +
       

     

       26
       26
       +
       	l3 = (struct iphdr *)(l2 + 1);

     

       27
       27
       +
       	if ((void *)(l3 + 1) > data_end)

     

       28
       28
       +
       		return TC_ACT_OK;

     

       29
       29
       +
       

     

       30
       30
       +
       	bpf_printk("Got IP packet: tot_len: %d, ttl: %d", bpf_ntohs(l3->tot_len), l3->ttl);

     

       31
       31
       +
       	return TC_ACT_OK;

     

       32
       32
       +
       }

     

       33
       33
       +
       

     

       34
       34
       +
       char __license[] SEC("license") = "GPL";

+70

vendor/ocaml-libbpf/examples/tc.ml

···

       1
       1
       +
       (* This program monitors the traffic going through your loopback

     

       2
       2
       +
          interface, once this program is run, check your trace pipe with

     

       3
       3
       +
          `sudo cat /sys/kernel/debug/tracing/trace_pipe` and run `ping

     

       4
       4
       +
          127.0.0.1` to see the output *)

     

       5
       5
       +
       open Ctypes

     

       6
       6
       +
       open Libbpf

     

       7
       7
       +
       

     

       8
       8
       +
       let obj_path = "tc.bpf.o"

     

       9
       9
       +
       let program_name = "tc_ingress"

     

       10
       10
       +
       

     

       11
       11
       +
       let () =

     

       12
       12
       +
         (* Set signal handlers *)

     

       13
       13
       +
         let exitting = ref true in

     

       14
       14
       +
         let sig_handler = Sys.Signal_handle (fun _ -> exitting := false) in

     

       15
       15
       +
         Sys.(set_signal sigint sig_handler);

     

       16
       16
       +
         Sys.(set_signal sigterm sig_handler);

     

       17
       17
       +
       

     

       18
       18
       +
         let hook_created = ref false in

     

       19
       19
       +
       

     

       20
       20
       +
         let tc_hook = make C.Types.Bpf_tc.hook in

     

       21
       21
       +
         setf tc_hook C.Types.Bpf_tc.ifindex 1;

     

       22
       22
       +
         setf tc_hook C.Types.Bpf_tc.attach_point `INGRESS;

     

       23
       23
       +
         let sz = Ctypes.sizeof C.Types.Bpf_tc.hook in

     

       24
       24
       +
         setf tc_hook C.Types.Bpf_tc.sz (Unsigned.Size_t.of_int sz);

     

       25
       25
       +
       

     

       26
       26
       +
         let tc_opts = make C.Types.Bpf_tc.Opts.t in

     

       27
       27
       +
         setf tc_opts C.Types.Bpf_tc.Opts.handle (Unsigned.UInt32.of_int 1);

     

       28
       28
       +
         setf tc_opts C.Types.Bpf_tc.Opts.priority (Unsigned.UInt32.of_int 1);

     

       29
       29
       +
         let sz = Ctypes.sizeof C.Types.Bpf_tc.Opts.t in

     

       30
       30
       +
         setf tc_opts C.Types.Bpf_tc.Opts.sz (Unsigned.Size_t.of_int sz);

     

       31
       31
       +
       

     

       32
       32
       +
         (* Open and load bpf object *)

     

       33
       33
       +
         let obj = bpf_object_open obj_path in

     

       34
       34
       +
         bpf_object_load obj;

     

       35
       35
       +
         let prog = bpf_object_find_program_by_name obj program_name in

     

       36
       36
       +
       

     

       37
       37
       +
         (* Try to create hook *)

     

       38
       38
       +
         (*  The hook (i.e. qdisc) may already exists because: *)

     

       39
       39
       +
         (*  1. it is created by other processes or users *)

     

       40
       40
       +
         (*  2. or since we are attaching to the TC ingress ONLY, *)

     

       41
       41
       +
         (*     bpf_tc_hook_destroy does NOT really remove the qdisc, *)

     

       42
       42
       +
         (*     there may be an egress filter on the qdisc *)

     

       43
       43
       +
         let err = C.Functions.bpf_tc_hook_create (addr tc_hook) in

     

       44
       44
       +
         if err = 0 then hook_created := true;

     

       45
       45
       +
       

     

       46
       46
       +
         if err <> 0 && err <> -17 (*EEXIST*) then (

     

       47
       47
       +
           Printf.eprintf "Failed to create tc hook: %d\n" err;

     

       48
       48
       +
           exit 1);

     

       49
       49
       +
       

     

       50
       50
       +
         setf tc_opts C.Types.Bpf_tc.Opts.prog_fd prog.fd;

     

       51
       51
       +
         let err = C.Functions.bpf_tc_attach (addr tc_hook) (addr tc_opts) in

     

       52
       52
       +
         if err = 1 then (

     

       53
       53
       +
           Printf.eprintf "Failed to attach TC: %d\n" err;

     

       54
       54
       +
           C.Functions.bpf_tc_hook_destroy (addr tc_hook) |> ignore;

     

       55
       55
       +
           exit 1);

     

       56
       56
       +
       

     

       57
       57
       +
         Printf.printf

     

       58
       58
       +
           "Successfully started! Please run `sudo cat \

     

       59
       59
       +
            /sys/kernel/debug/tracing/trace_pipe` to see output of the BPF program.\n\

     

       60
       60
       +
            %!";

     

       61
       61
       +
       

     

       62
       62
       +
         while !exitting do

     

       63
       63
       +
           Printf.eprintf ".%!";

     

       64
       64
       +
           Unix.sleepf 1.0

     

       65
       65
       +
         done;

     

       66
       66
       +
       

     

       67
       67
       +
         let err = C.Functions.bpf_tc_detach (addr tc_hook) (addr tc_opts) in

     

       68
       68
       +
         if err = 1 then Printf.eprintf "Failed to detach TC: %d\n" err;

     

       69
       69
       +
         C.Functions.bpf_tc_hook_destroy (addr tc_hook) |> ignore;

     

       70
       70
       +
         bpf_object_close obj

+44

vendor/ocaml-libbpf/libbpf.opam

···

       1
       1
       +
       # This file is generated by dune, edit dune-project instead

     

       2
       2
       +
       opam-version: "2.0"

     

       3
       3
       +
       synopsis: "Libbpf bindings"

     

       4
       4
       +
       description: "Wrapped libbpf api's for writing BPF user programs in OCaml"

     

       5
       5
       +
       maintainer: ["Lee Koon Wen"]

     

       6
       6
       +
       authors: ["Lee Koon Wen"]

     

       7
       7
       +
       license: ["ISC" "BSD-3-Clause"]

     

       8
       8
       +
       tags: ["bindings" "bpf" "libbpf"]

     

       9
       9
       +
       homepage: "https://github.com/koonwen/ocaml-libbpf"

     

       10
       10
       +
       doc: "https://koonwen.github.io/ocaml-libbpf"

     

       11
       11
       +
       bug-reports: "https://github.com/koonwen/ocaml-libbpf/issues"

     

       12
       12
       +
       depends: [

     

       13
       13
       +
         "ocaml" {>= "4.08"}

     

       14
       14
       +
         "dune" {>= "3.13"}

     

       15
       15
       +
         "ctypes" {>= "0.22.0"}

     

       16
       16
       +
         "ppx_deriving"

     

       17
       17
       +
         "ppx_expect"

     

       18
       18
       +
         "conf-libbpf"

     

       19
       19
       +
         "conf-bpftool"

     

       20
       20
       +
         "conf-clang"

     

       21
       21
       +
         "odoc" {with-doc}

     

       22
       22
       +
       ]

     

       23
       23
       +
       build: [

     

       24
       24
       +
         ["dune" "subst"] {dev}

     

       25
       25
       +
         [

     

       26
       26
       +
           "dune"

     

       27
       27
       +
           "build"

     

       28
       28
       +
           "-p"

     

       29
       29
       +
           name

     

       30
       30
       +
           "-j"

     

       31
       31
       +
           jobs

     

       32
       32
       +
           "@install"

     

       33
       33
       +
           "@runtest" {with-test}

     

       34
       34
       +
           "@doc" {with-doc}

     

       35
       35
       +
         ]

     

       36
       36
       +
       ]

     

       37
       37
       +
       dev-repo: "git+https://github.com/koonwen/ocaml-libbpf.git"

     

       38
       38
       +
       # eBPF features by kernel version https://github.com/iovisor/bcc/blob/master/docs/kernel-versions.md

     

       39
       39
       +
       # Fix to kernel >= 6.1 to provide bound BPF map types

     

       40
       40
       +
       available: [ os = "linux" &

     

       41
       41
       +
       	   (( os-distribution = "debian" & os-version >= "12" )    # Linux 6.1 & Libbpf 1.1.0

     

       42
       42
       +
        	   |( os-distribution = "ubuntu" & os-version >= "23.04" ) # Linux 6.2 & Libbpf 1.1.0

     

       43
       43
       +
       	   |( os-distribution = "fedora" & os-version >= "38" ))   # Linux 6.2 & Libbpf 1.1.0

     

       44
       44
       +
       	   ]

vendor/ocaml-libbpf/libbpf.opam.template

···

       1
       1
       +
       # eBPF features by kernel version https://github.com/iovisor/bcc/blob/master/docs/kernel-versions.md

     

       2
       2
       +
       # Fix to kernel >= 6.1 to provide bound BPF map types

     

       3
       3
       +
       available: [ os = "linux" &

     

       4
       4
       +
       	   (( os-distribution = "debian" & os-version >= "12" )    # Linux 6.1 & Libbpf 1.1.0

     

       5
       5
       +
        	   |( os-distribution = "ubuntu" & os-version >= "23.04" ) # Linux 6.2 & Libbpf 1.1.0

     

       6
       6
       +
       	   |( os-distribution = "fedora" & os-version >= "38" ))   # Linux 6.2 & Libbpf 1.1.0

     

       7
       7
       +
       	   ]

+32

vendor/ocaml-libbpf/libbpf_maps.opam

···

       1
       1
       +
       opam-version: "2.0"

     

       2
       2
       +
       synopsis: "Libbpf maps API"

     

       3
       3
       +
       description: "High level API's for interacting with BPF maps in OCaml"

     

       4
       4
       +
       maintainer: ["Lee Koon Wen"]

     

       5
       5
       +
       authors: ["Lee Koon Wen"]

     

       6
       6
       +
       license: ["ISC" "BSD-3-Clause"]

     

       7
       7
       +
       tags: ["bindings" "bpf" "libbpf"]

     

       8
       8
       +
       homepage: "https://github.com/koonwen/ocaml-libbpf"

     

       9
       9
       +
       doc: "https://koonwen.github.io/ocaml-libbpf"

     

       10
       10
       +
       bug-reports: "https://github.com/koonwen/ocaml-libbpf/issues"

     

       11
       11
       +
       depends: [

     

       12
       12
       +
         "dune" {>= "3.13"}

     

       13
       13
       +
         "ctypes" {>= "0.22.0"}

     

       14
       14
       +
         "ctypes-foreign" {>= "0.22.0"}

     

       15
       15
       +
         "libbpf" {= version}

     

       16
       16
       +
         "odoc" {with-doc}

     

       17
       17
       +
       ]

     

       18
       18
       +
       build: [

     

       19
       19
       +
         ["dune" "subst"] {dev}

     

       20
       20
       +
         [

     

       21
       21
       +
           "dune"

     

       22
       22
       +
           "build"

     

       23
       23
       +
           "-p"

     

       24
       24
       +
           name

     

       25
       25
       +
           "-j"

     

       26
       26
       +
           jobs

     

       27
       27
       +
           "@install"

     

       28
       28
       +
           "@runtest" {with-test}

     

       29
       29
       +
           "@doc" {with-doc}

     

       30
       30
       +
         ]

     

       31
       31
       +
       ]

     

       32
       32
       +
       dev-repo: "git+https://github.com/koonwen/ocaml-libbpf.git"

vendor/ocaml-libbpf/src/bindings/c.ml

···

       1
       1
       +
       module Types = C_function_description.Types

     

       2
       2
       +
       (** Low-level C bindings of libbpf types *)

     

       3
       3
       +
       

     

       4
       4
       +
       module Functions = C_function_description.Functions (C_function_generated)

     

       5
       5
       +
       (** Low-level C bindings of libbpf functions *)

+284

vendor/ocaml-libbpf/src/bindings/c_function_description.ml

···

       1
       1
       +
       open Ctypes

     

       2
       2
       +
       

     

       3
       3
       +
       (** You probably don't mean to be looking into this section, it is

     

       4
       4
       +
           part of the stub generation process of the bindings.*)

     

       5
       5
       +
       

     

       6
       6
       +
       (* The C_types_generated module is generated by the build system to

     

       7
       7
       +
           grab the type definitions from the header files in C to ensure

     

       8
       8
       +
           that offsets and structs are aligned. *)

     

       9
       9
       +
       module Types = C_type_description.Types (C_types_generated)

     

       10
       10
       +
       

     

       11
       11
       +
       module Functions (F : Ctypes.FOREIGN) = struct

     

       12
       12
       +
         open F

     

       13
       13
       +
       

     

       14
       14
       +
         (* ======================================== Generics ======================================== *)

     

       15
       15
       +
         let libbpf_major_version =

     

       16
       16
       +
           foreign "libbpf_major_version" (void @-> returning uint32_t)

     

       17
       17
       +
       

     

       18
       18
       +
         let libbpf_minor_version =

     

       19
       19
       +
           foreign "libbpf_minor_version" (void @-> returning uint32_t)

     

       20
       20
       +
       

     

       21
       21
       +
         let libbpf_version_string =

     

       22
       22
       +
           foreign "libbpf_version_string" (void @-> returning string)

     

       23
       23
       +
       

     

       24
       24
       +
         let libbpf_strerror =

     

       25
       25
       +
           foreign "libbpf_strerror" (int @-> ptr char @-> size_t @-> returning int)

     

       26
       26
       +
       

     

       27
       27
       +
         let libbpf_bpf_attach_type_str =

     

       28
       28
       +
           foreign "libbpf_bpf_attach_type_str"

     

       29
       29
       +
             (Types.Bpf_attach_type.t @-> returning string)

     

       30
       30
       +
       

     

       31
       31
       +
         let libbpf_bpf_link_type_str =

     

       32
       32
       +
           foreign "libbpf_bpf_link_type_str"

     

       33
       33
       +
             (Types.Bpf_link_type.t @-> returning string)

     

       34
       34
       +
       

     

       35
       35
       +
         let libbpf_bpf_map_type_str =

     

       36
       36
       +
           foreign "libbpf_bpf_map_type_str" (Types.Bpf_map_type.t @-> returning string)

     

       37
       37
       +
       

     

       38
       38
       +
         let libbpf_bpf_prog_type_str =

     

       39
       39
       +
           foreign "libbpf_bpf_prog_type_str"

     

       40
       40
       +
             (Types.Bpf_prog_type.t @-> returning string)

     

       41
       41
       +
       

     

       42
       42
       +
         let libbpf_set_print =

     

       43
       43
       +
           foreign "libbpf_set_print"

     

       44
       44
       +
             (Types.libbpf_print_fn_t @-> returning Types.libbpf_print_fn_t)

     

       45
       45
       +
       

     

       46
       46
       +
         (* ================================= Open / Load / Close  =================================== *)

     

       47
       47
       +
       

     

       48
       48
       +
         (** [bpf_object__open path] creates a bpf_object by opening the BPF

     

       49
       49
       +
             ELF object file pointed to by the passed [path] and loading it

     

       50
       50
       +
             into memory.

     

       51
       51
       +
       

     

       52
       52
       +
             Returns pointer to the new bpf_object; or NULL is returned on

     

       53
       53
       +
             error, error code is stored in errno. *)

     

       54
       54
       +
         let bpf_object__open =

     

       55
       55
       +
           foreign "bpf_object__open" (string @-> returning (ptr_opt Types.bpf_object))

     

       56
       56
       +
       

     

       57
       57
       +
         (** [bpf_object__load obj_ptr] loads the BPF object into the

     

       58
       58
       +
             kernel. [obj_ptr] must be a valid BPF object instance returned

     

       59
       59
       +
             by a successful call to [bpf_object__open].

     

       60
       60
       +
       

     

       61
       61
       +
             Returns 0, on success; negative error code, otherwise, error code is stored in errno *)

     

       62
       62
       +
         let bpf_object__load =

     

       63
       63
       +
           foreign "bpf_object__load" (ptr Types.bpf_object @-> returning int)

     

       64
       64
       +
       

     

       65
       65
       +
         (** [bpf_object__find_program_by_name name] returns the BPF program

     

       66
       66
       +
             of the given [name], if it exists within the passed BPF object

     

       67
       67
       +
       

     

       68
       68
       +
             Returns the pointer to the BPF program instance, if such program

     

       69
       69
       +
             exists within the BPF object; or NULL otherwise.  *)

     

       70
       70
       +
         let bpf_object__find_program_by_name =

     

       71
       71
       +
           foreign "bpf_object__find_program_by_name"

     

       72
       72
       +
             (ptr Types.bpf_object @-> string @-> returning (ptr_opt Types.bpf_program))

     

       73
       73
       +
       

     

       74
       74
       +
         (** [bpf_object__next_program obj_ptr prog_ptr] returns the next

     

       75
       75
       +
             program after [prog_ptr] found in the passed BPF object *)

     

       76
       76
       +
         let bpf_object__next_program =

     

       77
       77
       +
           foreign "bpf_object__next_program"

     

       78
       78
       +
             (ptr Types.bpf_object @-> ptr Types.bpf_program

     

       79
       79
       +
             @-> returning (ptr Types.bpf_program))

     

       80
       80
       +
       

     

       81
       81
       +
         (** [bpf_program__pin prog path] pins the BPF program to a file in

     

       82
       82
       +
             the BPF FS specified by a [path]. This increments the programs

     

       83
       83
       +
             reference count, allowing it to stay loaded after the process

     

       84
       84
       +
             which loaded it has exited.

     

       85
       85
       +
       

     

       86
       86
       +
             @param prog BPF program to pin, must already be loaded

     

       87
       87
       +
             @param path file path in a BPF file system

     

       88
       88
       +
             @return 0, on success; negative error code, otherwise *)

     

       89
       89
       +
         let bpf_program__pin =

     

       90
       90
       +
           foreign "bpf_program__pin"

     

       91
       91
       +
             (ptr Types.bpf_program @-> ptr char @-> returning int)

     

       92
       92
       +
       

     

       93
       93
       +
         (** [bpf_program__unpin prog path] unpins the BPF program from a file in the

     

       94
       94
       +
             BPFFS specified by a path. This decrements the programs

     

       95
       95
       +
             reference count. The file pinning the BPF program can also be

     

       96
       96
       +
             unlinked by a different process in which case this function will

     

       97
       97
       +
             return an error.

     

       98
       98
       +
       

     

       99
       99
       +
             @param prog BPF program to unpin

     

       100
       100
       +
             @param path file path to the pin in a BPF file system

     

       101
       101
       +
             @return 0, on success; negative error code, otherwise  *)

     

       102
       102
       +
         let bpf_program__unpin =

     

       103
       103
       +
           foreign "bpf_program__unpin"

     

       104
       104
       +
             (ptr Types.bpf_program @-> ptr char @-> returning int)

     

       105
       105
       +
       

     

       106
       106
       +
         (** [bpf_program__attach prog] is a generic function for

     

       107
       107
       +
             attaching a BPF program based on auto-detection of program type,

     

       108
       108
       +
             attach type, and extra paremeters, where applicable.

     

       109
       109
       +
       

     

       110
       110
       +
             This is supported for:

     

       111
       111
       +
             - kprobe/kretprobe (depends on SEC() definition)

     

       112
       112
       +
             - uprobe/uretprobe (depends on SEC() definition)

     

       113
       113
       +
             - tracepoint

     

       114
       114
       +
             - raw tracepoint

     

       115
       115
       +
             - tracing programs (typed raw TP/fentry/fexit/fmod_ret)

     

       116
       116
       +
       

     

       117
       117
       +
             Returns pointer to the newly created BPF link; or NULL is

     

       118
       118
       +
             returned on error, error code is stored in errno *)

     

       119
       119
       +
         let bpf_program__attach =

     

       120
       120
       +
           foreign "bpf_program__attach"

     

       121
       121
       +
             (ptr Types.bpf_program @-> returning (ptr_opt Types.bpf_link))

     

       122
       122
       +
       

     

       123
       123
       +
         let bpf_program__fd =

     

       124
       124
       +
           foreign "bpf_program__fd" (ptr Types.bpf_program @-> returning int)

     

       125
       125
       +
       

     

       126
       126
       +
         (** [bpf_link__pin link path] pins the BPF link to a file in the

     

       127
       127
       +
             BPF FS specified by a path. This increments the links reference

     

       128
       128
       +
             count, allowing it to stay loaded after the process which loaded

     

       129
       129
       +
             it has exited.

     

       130
       130
       +
       

     

       131
       131
       +
             @param link BPF link to pin, must already be loaded

     

       132
       132
       +
             @param path file path in a BPF file system

     

       133
       133
       +
             @return 0, on success; negative error code, otherwise *)

     

       134
       134
       +
         let bpf_link__pin =

     

       135
       135
       +
           foreign "bpf_link__pin" (ptr Types.bpf_link @-> ptr char @-> returning int)

     

       136
       136
       +
       

     

       137
       137
       +
         (** [bpf_link__unpin link path] unpins the BPF link from a file in

     

       138
       138
       +
             the BPFFS specified by a path. This decrements the links

     

       139
       139
       +
             reference count. The file pinning the BPF link can also be

     

       140
       140
       +
             unlinked by a different process in which case this function will

     

       141
       141
       +
             return an error.

     

       142
       142
       +
       

     

       143
       143
       +
             @param prog BPF program to unpin

     

       144
       144
       +
             @param path file path to the pin in a BPF file system

     

       145
       145
       +
             @return 0, on success; negative error code, otherwise *)

     

       146
       146
       +
         let bpf_link__unpin =

     

       147
       147
       +
           foreign "bpf_link__unpin" (ptr Types.bpf_link @-> returning int)

     

       148
       148
       +
       

     

       149
       149
       +
         (** [bpf_link__destroy link_ptr] Removes the link to the BPF program.

     

       150
       150
       +
             Returns 0 on success or -errno *)

     

       151
       151
       +
         let bpf_link__destroy =

     

       152
       152
       +
           foreign "bpf_link__destroy" (ptr Types.bpf_link @-> returning int)

     

       153
       153
       +
       

     

       154
       154
       +
         (** [bpf_object__close obj_ptr] closes a BPF object and releases all

     

       155
       155
       +
             resources. *)

     

       156
       156
       +
         let bpf_object__close =

     

       157
       157
       +
           foreign "bpf_object__close" (ptr Types.bpf_object @-> returning void)

     

       158
       158
       +
       

     

       159
       159
       +
         (* ======================================== Maps ======================================== *)

     

       160
       160
       +
         (* Not explicitly mentioned in the documentation but keys and values look

     

       161
       161
       +
            like they're copied into the internal bpf map structure, so we

     

       162
       162
       +
            don't need to be worried about keeping references around. *)

     

       163
       163
       +
       

     

       164
       164
       +
         (** [bpf_object__find_map_by_name obj_ptr name] returns BPF map of the given

     

       165
       165
       +
             [name], if it exists within the passed BPF object.

     

       166
       166
       +
       

     

       167
       167
       +
             Returns the pointer to the BPF map instance, if such map exists

     

       168
       168
       +
             within the BPF object; or NULL otherwise.  *)

     

       169
       169
       +
         let bpf_object__find_map_by_name =

     

       170
       170
       +
           foreign "bpf_object__find_map_by_name"

     

       171
       171
       +
             (ptr Types.bpf_object @-> string @-> returning (ptr_opt Types.bpf_map))

     

       172
       172
       +
       

     

       173
       173
       +
         (** [bpf_map__fd map_ptr] gets the file descriptor of the passed BPF

     

       174
       174
       +
             map

     

       175
       175
       +
       

     

       176
       176
       +
             Returns the file descriptor; or -EINVAL in case of an error  *)

     

       177
       177
       +
         let bpf_map__fd = foreign "bpf_map__fd" (ptr Types.bpf_map @-> returning int)

     

       178
       178
       +
       

     

       179
       179
       +
         (** [bpf_map__lookup_elem map_ptr key_ptr key_sz val_ptr val_sz

     

       180
       180
       +
             flags] allows to lookup BPF map value corresponding to provided

     

       181
       181
       +
             key.

     

       182
       182
       +
       

     

       183
       183
       +
            [bpf_map__lookup_elem] is high-level equivalent of

     

       184
       184
       +
            [bpf_map_lookup_elem] API with added check for key and value

     

       185
       185
       +
             size.

     

       186
       186
       +
       

     

       187
       187
       +
             sizes are in bytes of key and value data. For per-CPU BPF maps

     

       188
       188
       +
             value size has to be a product of BPF map value size and number

     

       189
       189
       +
             of possible CPUs in the system (could be fetched with

     

       190
       190
       +
             libbpf_num_possible_cpus()). Note also that for per-CPU values

     

       191
       191
       +
             value size has to be aligned up to closest 8 bytes for alignment

     

       192
       192
       +
             reasons, so expected size is: round_up(value_size, 8)

     

       193
       193
       +
       

     

       194
       194
       +
             Returns 0, on success; negative error, otherwise *)

     

       195
       195
       +
         let bpf_map__lookup_elem =

     

       196
       196
       +
           foreign "bpf_map__lookup_elem"

     

       197
       197
       +
             (ptr Types.bpf_map @-> ptr void @-> size_t @-> ptr void @-> size_t

     

       198
       198
       +
            @-> uint64_t @-> returning int)

     

       199
       199
       +
       

     

       200
       200
       +
         (** [bpf_map__update_elem map_ptr key_ptr key_sz val_ptr val_sz

     

       201
       201
       +
             flags] allows to insert or update value in BPF map that

     

       202
       202
       +
             corresponds to provided key.

     

       203
       203
       +
       

     

       204
       204
       +
             [bpf_map__update_elem] is high-level equivalent of

     

       205
       205
       +
             [bpf_map_update_elem] API with added check for key and value

     

       206
       206
       +
             size.

     

       207
       207
       +
       

     

       208
       208
       +
             Check [bpf_map__lookup_elem] for details on sizes.

     

       209
       209
       +
             Returns 0, on success; negative error, otherwise *)

     

       210
       210
       +
         let bpf_map__update_elem =

     

       211
       211
       +
           foreign "bpf_map__update_elem"

     

       212
       212
       +
             (ptr Types.bpf_map @-> ptr void @-> size_t @-> ptr void @-> size_t

     

       213
       213
       +
            @-> uint64_t @-> returning int)

     

       214
       214
       +
       

     

       215
       215
       +
         (** [bpf_map__delete_elem map_ptr key_ptr key_sz flags] allows to

     

       216
       216
       +
             delete element in BPF map that corresponds to provided key.

     

       217
       217
       +
       

     

       218
       218
       +
             [bpf_map__delete_elem] is high-level equivalent of

     

       219
       219
       +
             [bpf_map_delete_elem] API with added check for key size.

     

       220
       220
       +
       

     

       221
       221
       +
             Returns 0, on success; negative error, otherwise *)

     

       222
       222
       +
         let bpf_map__delete_elem =

     

       223
       223
       +
           foreign "bpf_map__delete_elem"

     

       224
       224
       +
             (ptr Types.bpf_map @-> ptr void @-> size_t @-> uint64_t @-> returning int)

     

       225
       225
       +
       

     

       226
       226
       +
         (* ================================== Traffic control ================================== *)

     

       227
       227
       +
       

     

       228
       228
       +
         let bpf_tc_hook_create =

     

       229
       229
       +
           foreign "bpf_tc_hook_create" (ptr Types.Bpf_tc.hook @-> returning int)

     

       230
       230
       +
       

     

       231
       231
       +
         let bpf_tc_hook_destroy =

     

       232
       232
       +
           foreign "bpf_tc_hook_destroy" (ptr Types.Bpf_tc.hook @-> returning int)

     

       233
       233
       +
       

     

       234
       234
       +
         let bpf_tc_attach =

     

       235
       235
       +
           foreign "bpf_tc_attach"

     

       236
       236
       +
             (ptr Types.Bpf_tc.hook @-> ptr Types.Bpf_tc.Opts.t @-> returning int)

     

       237
       237
       +
       

     

       238
       238
       +
         let bpf_tc_detach =

     

       239
       239
       +
           foreign "bpf_tc_detach"

     

       240
       240
       +
             (ptr Types.Bpf_tc.hook @-> ptr Types.Bpf_tc.Opts.t @-> returning int)

     

       241
       241
       +
       

     

       242
       242
       +
         (* ====================================== RingBuf ===================================== *)

     

       243
       243
       +
       

     

       244
       244
       +
         (** [ring_buffer__new map_fd fn ctx_ptr opts] loads the callback

     

       245
       245
       +
             function [fn] into the ring buffer map provided by the file

     

       246
       246
       +
             descriptor [map_fd]. [ctx_ptr] allows the callback function to

     

       247
       247
       +
             access user provided context.

     

       248
       248
       +
       

     

       249
       249
       +
             Returns pointer to the ring_buffer manager instance or NULL

     

       250
       250
       +
             otherwise *)

     

       251
       251
       +
         let ring_buffer__new =

     

       252
       252
       +
           foreign "ring_buffer__new"

     

       253
       253
       +
             (int @-> Types.ring_buffer_sample_fn @-> ptr void

     

       254
       254
       +
            @-> ptr Types.ring_buffer_opts

     

       255
       255
       +
             @-> returning (ptr_opt Types.ring_buffer))

     

       256
       256
       +
       

     

       257
       257
       +
         (** [ring_buffer__poll ring_buf_ptr timeout] poll for available

     

       258
       258
       +
             data and consume records, if any are available.

     

       259
       259
       +
       

     

       260
       260
       +
             Returns number of records consumed (or INT_MAX, whichever is

     

       261
       261
       +
             less), or negative number, if any of the registered callbacks

     

       262
       262
       +
             returned error. *)

     

       263
       263
       +
         let ring_buffer__poll =

     

       264
       264
       +
           foreign "ring_buffer__poll" (ptr Types.ring_buffer @-> int @-> returning int)

     

       265
       265
       +
       

     

       266
       266
       +
         (** [ring_buffer__free ring_buf_ptr] Frees resources of the ring

     

       267
       267
       +
             buffer manager *)

     

       268
       268
       +
         let ring_buffer__free =

     

       269
       269
       +
           foreign "ring_buffer__free" (ptr Types.ring_buffer @-> returning void)

     

       270
       270
       +
       

     

       271
       271
       +
         (** [ring_buffer__consume ring_buf_ptr] Consume available ring

     

       272
       272
       +
             buffer(s) data without event polling.

     

       273
       273
       +
       

     

       274
       274
       +
             Returns number of records consumed across all registered ring

     

       275
       275
       +
             buffers (or INT_MAX, whichever is less), or negative number if

     

       276
       276
       +
             any of the callbacks return error.  *)

     

       277
       277
       +
         let ring_buffer__consume =

     

       278
       278
       +
           foreign "ring_buffer__consume" (ptr Types.ring_buffer @-> returning int)

     

       279
       279
       +
       

     

       280
       280
       +
         (** [ring_buffer__epoll_fd ring_buf_ptr] Gets an fd that can be used

     

       281
       281
       +
             to sleep until data is available in the ring(s) *)

     

       282
       282
       +
         let ring_buffer__epoll_fd =

     

       283
       283
       +
           foreign "ring_buffer__epoll_fd" (ptr Types.ring_buffer @-> returning int)

     

       284
       284
       +
       end

+409

vendor/ocaml-libbpf/src/bindings/c_type_description.ml

···

       1
       1
       +
       open Ctypes

     

       2
       2
       +
       

     

       3
       3
       +
       (** You probably don't mean to be looking into this section, it is

     

       4
       4
       +
           part of the stub generation process of the bindings.*)

     

       5
       5
       +
       

     

       6
       6
       +
       module Types (F : Ctypes.TYPE) = struct

     

       7
       7
       +
         open F

     

       8
       8
       +
       

     

       9
       9
       +
         let c ?(prefix = "") label = constant (prefix ^ label) int64_t

     

       10
       10
       +
       

     

       11
       11
       +
         let libbpf_print_level : [ `WARN | `INFO | `DEBUG | `UNEXPECTED ] typ =

     

       12
       12
       +
           let def = c ~prefix:"LIBBPF_" in

     

       13
       13
       +
           enum "libbpf_print_level"

     

       14
       14
       +
             ~unexpected:(fun _ -> `UNEXPECTED)

     

       15
       15
       +
             [ (`WARN, def "WARN"); (`INFO, def "INFO"); (`DEBUG, def "DEBUG") ]

     

       16
       16
       +
       

     

       17
       17
       +
         let libbpf_print_fn_t :

     

       18
       18
       +
             ([ `WARN | `INFO | `DEBUG | `UNEXPECTED ] -> string -> int) static_funptr

     

       19
       19
       +
             typ =

     

       20
       20
       +
           typedef

     

       21
       21
       +
             (static_funptr (libbpf_print_level @-> string @-> returning int))

     

       22
       22
       +
             "libbpf_print_fn_t"

     

       23
       23
       +
       

     

       24
       24
       +
         module Errno = struct

     

       25
       25
       +
           type t =

     

       26
       26
       +
             [ `LIBELF (* Something wrong in libelf *)

     

       27
       27
       +
             | `FORMAT (* BPF object format invalid *)

     

       28
       28
       +
             | `KVERSION (* Incorrect or no 'version' section *)

     

       29
       29
       +
             | `ENDIAN (* Endian mismatch *)

     

       30
       30
       +
             | `INTERNAL (* Internal error in libbpf *)

     

       31
       31
       +
             | `RELOC (* Relocation failed *)

     

       32
       32
       +
             | `LOAD (* Load program failure for unknown reason *)

     

       33
       33
       +
             | `VERIFY (* Kernel verifier blocks program loading *)

     

       34
       34
       +
             | `PROG2BIG (* Program too big *)

     

       35
       35
       +
             | `KVER (* Incorrect kernel version *)

     

       36
       36
       +
             | `PROGTYPE (* Kernel doesn't support this program type *)

     

       37
       37
       +
             | `WRNGPID (* Wrong pid in netlink message *)

     

       38
       38
       +
             | `INVSEQ (* Invalid netlink sequence *)

     

       39
       39
       +
             | `NLPARSE (* netlink parsing error *)

     

       40
       40
       +
             | `UNKNOWN ]

     

       41
       41
       +
       

     

       42
       42
       +
           let t : t typ =

     

       43
       43
       +
             let def = c ~prefix:"LIBBPF_ERRNO__" in

     

       44
       44
       +
             enum "libbpf_errno"

     

       45
       45
       +
               ~unexpected:(fun _ -> `UNKNOWN)

     

       46
       46
       +
               [

     

       47
       47
       +
                 (`LIBELF, def "LIBELF");

     

       48
       48
       +
                 (`FORMAT, def "FORMAT");

     

       49
       49
       +
                 (`KVERSION, def "KVERSION");

     

       50
       50
       +
                 (`ENDIAN, def "ENDIAN");

     

       51
       51
       +
                 (`INTERNAL, def "INTERNAL");

     

       52
       52
       +
                 (`RELOC, def "RELOC");

     

       53
       53
       +
                 (`LOAD, def "LOAD");

     

       54
       54
       +
                 (`VERIFY, def "VERIFY");

     

       55
       55
       +
                 (`PROG2BIG, def "PROG2BIG");

     

       56
       56
       +
                 (`KVER, def "KVER");

     

       57
       57
       +
                 (`PROGTYPE, def "PROGTYPE");

     

       58
       58
       +
                 (`WRNGPID, def "WRNGPID");

     

       59
       59
       +
                 (`INVSEQ, def "INVSEQ");

     

       60
       60
       +
                 (`NLPARSE, def "NLPARSE");

     

       61
       61
       +
               ]

     

       62
       62
       +
         end

     

       63
       63
       +
       

     

       64
       64
       +
         module Bpf_attach_type = struct

     

       65
       65
       +
           type cgroup =

     

       66
       66
       +
             [ `BPF_CGROUP_INET_INGRESS

     

       67
       67
       +
             | `BPF_CGROUP_INET_EGRESS

     

       68
       68
       +
             | `BPF_CGROUP_INET_SOCK_CREATE

     

       69
       69
       +
             | `BPF_CGROUP_SOCK_OPS

     

       70
       70
       +
             | `BPF_CGROUP_DEVICE

     

       71
       71
       +
             | `BPF_CGROUP_INET4_BIND

     

       72
       72
       +
             | `BPF_CGROUP_INET6_BIND

     

       73
       73
       +
             | `BPF_CGROUP_INET4_CONNECT

     

       74
       74
       +
             | `BPF_CGROUP_INET6_CONNECT

     

       75
       75
       +
             | `BPF_CGROUP_INET4_POST_BIND

     

       76
       76
       +
             | `BPF_CGROUP_INET6_POST_BIND

     

       77
       77
       +
             | `BPF_CGROUP_UDP4_SENDMSG

     

       78
       78
       +
             | `BPF_CGROUP_UDP6_SENDMSG

     

       79
       79
       +
             | `BPF_CGROUP_SYSCTL

     

       80
       80
       +
             | `BPF_CGROUP_UDP4_RECVMSG

     

       81
       81
       +
             | `BPF_CGROUP_UDP6_RECVMSG

     

       82
       82
       +
             | `BPF_CGROUP_GETSOCKOPT

     

       83
       83
       +
             | `BPF_CGROUP_SETSOCKOPT

     

       84
       84
       +
             | `BPF_CGROUP_INET4_GETPEERNAME

     

       85
       85
       +
             | `BPF_CGROUP_INET6_GETPEERNAME

     

       86
       86
       +
             | `BPF_CGROUP_INET4_GETSOCKNAME

     

       87
       87
       +
             | `BPF_CGROUP_INET6_GETSOCKNAME

     

       88
       88
       +
             | `BPF_CGROUP_INET_SOCK_RELEASE ]

     

       89
       89
       +
       

     

       90
       90
       +
           type sk =

     

       91
       91
       +
             [ `BPF_SK_SKB_STREAM_PARSER

     

       92
       92
       +
             | `BPF_SK_SKB_STREAM_VERDICT

     

       93
       93
       +
             | `BPF_SK_MSG_VERDICT

     

       94
       94
       +
             | `BPF_SK_LOOKUP

     

       95
       95
       +
             | `BPF_SK_SKB_VERDICT

     

       96
       96
       +
             | `BPF_SK_REUSEPORT_SELECT

     

       97
       97
       +
             | `BPF_SK_REUSEPORT_SELECT_OR_MIGRATE ]

     

       98
       98
       +
       

     

       99
       99
       +
           type trace =

     

       100
       100
       +
             [ `BPF_TRACE_RAW_TP

     

       101
       101
       +
             | `BPF_TRACE_FENTRY

     

       102
       102
       +
             | `BPF_TRACE_FEXIT

     

       103
       103
       +
             | `BPF_TRACE_ITER

     

       104
       104
       +
             | `BPF_TRACE_KPROBE_MULTI ]

     

       105
       105
       +
       

     

       106
       106
       +
           type xdp = [ `BPF_XDP_DEVMAP | `BPF_XDP_CPUMAP | `BPF_XDP ]

     

       107
       107
       +
       

     

       108
       108
       +
           type other =

     

       109
       109
       +
             [ `BPF_LIRC_MODE2

     

       110
       110
       +
             | `BPF_FLOW_DISSECTOR

     

       111
       111
       +
             | `BPF_MODIFY_RETURN

     

       112
       112
       +
             | `BPF_PERF_EVENT

     

       113
       113
       +
             | `BPF_LSM_MAC

     

       114
       114
       +
             | `BPF_LSM_CGROUP ]

     

       115
       115
       +
       

     

       116
       116
       +
           type t = [ cgroup | sk | trace | xdp | other | `UNKNOWN ]

     

       117
       117
       +
       

     

       118
       118
       +
           let t : t typ =

     

       119
       119
       +
             let cgroup = c ~prefix:"BPF_CGROUP_" in

     

       120
       120
       +
             let sk = c ~prefix:"BPF_SK_" in

     

       121
       121
       +
             let trace = c ~prefix:"BPF_TRACE_" in

     

       122
       122
       +
             let xdp = c ~prefix:"BPF_XDP_" in

     

       123
       123
       +
             enum "bpf_attach_type"

     

       124
       124
       +
               ~unexpected:(fun _ -> `UNKNOWN)

     

       125
       125
       +
               [

     

       126
       126
       +
                 (`BPF_CGROUP_INET_INGRESS, cgroup "INET_INGRESS");

     

       127
       127
       +
                 (`BPF_CGROUP_INET_EGRESS, cgroup "INET_EGRESS");

     

       128
       128
       +
                 (`BPF_CGROUP_INET_SOCK_CREATE, cgroup "INET_SOCK_CREATE");

     

       129
       129
       +
                 (`BPF_CGROUP_SOCK_OPS, cgroup "SOCK_OPS");

     

       130
       130
       +
                 (`BPF_CGROUP_DEVICE, cgroup "DEVICE");

     

       131
       131
       +
                 (`BPF_CGROUP_INET4_BIND, cgroup "INET4_BIND");

     

       132
       132
       +
                 (`BPF_CGROUP_INET6_BIND, cgroup "INET6_BIND");

     

       133
       133
       +
                 (`BPF_CGROUP_INET4_CONNECT, cgroup "INET4_CONNECT");

     

       134
       134
       +
                 (`BPF_CGROUP_INET6_CONNECT, cgroup "INET6_CONNECT");

     

       135
       135
       +
                 (`BPF_CGROUP_INET4_POST_BIND, cgroup "INET4_POST_BIND");

     

       136
       136
       +
                 (`BPF_CGROUP_INET6_POST_BIND, cgroup "INET6_POST_BIND");

     

       137
       137
       +
                 (`BPF_CGROUP_UDP4_SENDMSG, cgroup "UDP4_SENDMSG");

     

       138
       138
       +
                 (`BPF_CGROUP_UDP6_SENDMSG, cgroup "UDP6_SENDMSG");

     

       139
       139
       +
                 (`BPF_CGROUP_SYSCTL, cgroup "SYSCTL");

     

       140
       140
       +
                 (`BPF_CGROUP_UDP4_RECVMSG, cgroup "UDP4_RECVMSG");

     

       141
       141
       +
                 (`BPF_CGROUP_UDP6_RECVMSG, cgroup "UDP6_RECVMSG");

     

       142
       142
       +
                 (`BPF_CGROUP_GETSOCKOPT, cgroup "GETSOCKOPT");

     

       143
       143
       +
                 (`BPF_CGROUP_SETSOCKOPT, cgroup "SETSOCKOPT");

     

       144
       144
       +
                 (`BPF_CGROUP_INET4_GETPEERNAME, cgroup "INET4_GETPEERNAME");

     

       145
       145
       +
                 (`BPF_CGROUP_INET6_GETPEERNAME, cgroup "INET6_GETPEERNAME");

     

       146
       146
       +
                 (`BPF_CGROUP_INET4_GETSOCKNAME, cgroup "INET4_GETSOCKNAME");

     

       147
       147
       +
                 (`BPF_CGROUP_INET6_GETSOCKNAME, cgroup "INET6_GETSOCKNAME");

     

       148
       148
       +
                 (`BPF_CGROUP_INET_SOCK_RELEASE, cgroup "INET_SOCK_RELEASE");

     

       149
       149
       +
                 (`BPF_SK_SKB_STREAM_PARSER, sk "SKB_STREAM_PARSER");

     

       150
       150
       +
                 (`BPF_SK_SKB_STREAM_VERDICT, sk "SKB_STREAM_VERDICT");

     

       151
       151
       +
                 (`BPF_SK_MSG_VERDICT, sk "MSG_VERDICT");

     

       152
       152
       +
                 (`BPF_SK_LOOKUP, sk "LOOKUP");

     

       153
       153
       +
                 (`BPF_SK_SKB_VERDICT, sk "SKB_VERDICT");

     

       154
       154
       +
                 (`BPF_SK_REUSEPORT_SELECT, sk "REUSEPORT_SELECT");

     

       155
       155
       +
                 (`BPF_SK_REUSEPORT_SELECT_OR_MIGRATE, sk "REUSEPORT_SELECT_OR_MIGRATE");

     

       156
       156
       +
                 (`BPF_TRACE_RAW_TP, trace "RAW_TP");

     

       157
       157
       +
                 (`BPF_TRACE_FENTRY, trace "FENTRY");

     

       158
       158
       +
                 (`BPF_TRACE_FEXIT, trace "FEXIT");

     

       159
       159
       +
                 (`BPF_TRACE_ITER, trace "ITER");

     

       160
       160
       +
                 (`BPF_TRACE_KPROBE_MULTI, trace "KPROBE_MULTI");

     

       161
       161
       +
                 (`BPF_XDP_DEVMAP, xdp "DEVMAP");

     

       162
       162
       +
                 (`BPF_XDP_CPUMAP, xdp "CPUMAP");

     

       163
       163
       +
                 (`BPF_XDP, c "BPF_XDP");

     

       164
       164
       +
                 (`BPF_LIRC_MODE2, c "BPF_LIRC_MODE2");

     

       165
       165
       +
                 (`BPF_FLOW_DISSECTOR, c "BPF_FLOW_DISSECTOR");

     

       166
       166
       +
                 (`BPF_MODIFY_RETURN, c "BPF_MODIFY_RETURN");

     

       167
       167
       +
                 (`BPF_PERF_EVENT, c "BPF_PERF_EVENT");

     

       168
       168
       +
                 (`BPF_LSM_MAC, c "BPF_LSM_MAC");

     

       169
       169
       +
                 (`BPF_LSM_CGROUP, c "BPF_LSM_CGROUP");

     

       170
       170
       +
               ]

     

       171
       171
       +
         end

     

       172
       172
       +
       

     

       173
       173
       +
         module Bpf_link_type = struct

     

       174
       174
       +
           type t =

     

       175
       175
       +
             [ `UNSPEC

     

       176
       176
       +
             | `RAW_TRACEPOINT

     

       177
       177
       +
             | `TRACING

     

       178
       178
       +
             | `CGROUP

     

       179
       179
       +
             | `ITER

     

       180
       180
       +
             | `NETNS

     

       181
       181
       +
             | `XDP

     

       182
       182
       +
             | `PERF_EVENT

     

       183
       183
       +
             | `KPROBE_MULTI

     

       184
       184
       +
             | `STRUCT_OPS

     

       185
       185
       +
             | `UNKNOWN ]

     

       186
       186
       +
       

     

       187
       187
       +
           let t : t typ =

     

       188
       188
       +
             let def = c ~prefix:"BPF_LINK_TYPE_" in

     

       189
       189
       +
             enum "bpf_link_type"

     

       190
       190
       +
               ~unexpected:(fun _ -> `UNKNOWN)

     

       191
       191
       +
               [

     

       192
       192
       +
                 (`UNSPEC, def "UNSPEC");

     

       193
       193
       +
                 (`RAW_TRACEPOINT, def "RAW_TRACEPOINT");

     

       194
       194
       +
                 (`TRACING, def "TRACING");

     

       195
       195
       +
                 (`CGROUP, def "CGROUP");

     

       196
       196
       +
                 (`ITER, def "ITER");

     

       197
       197
       +
                 (`NETNS, def "NETNS");

     

       198
       198
       +
                 (`XDP, def "XDP");

     

       199
       199
       +
                 (`PERF_EVENT, def "PERF_EVENT");

     

       200
       200
       +
                 (`KPROBE_MULTI, def "KPROBE_MULTI");

     

       201
       201
       +
                 (`STRUCT_OPS, def "STRUCT_OPS");

     

       202
       202
       +
               ]

     

       203
       203
       +
         end

     

       204
       204
       +
       

     

       205
       205
       +
         module Bpf_map_type = struct

     

       206
       206
       +
           type t =

     

       207
       207
       +
             [ `UNSPEC

     

       208
       208
       +
             | `HASH

     

       209
       209
       +
             | `ARRAY

     

       210
       210
       +
             | `PROG_ARRAY

     

       211
       211
       +
             | `PERF_EVENT_ARRAY

     

       212
       212
       +
             | `PERCPU_HASH

     

       213
       213
       +
             | `PERCPU_ARRAY

     

       214
       214
       +
             | `STACK_TRACE

     

       215
       215
       +
             | `CGROUP_ARRAY

     

       216
       216
       +
             | `LRU_HASH

     

       217
       217
       +
             | `LRU_PERCPU_HASH

     

       218
       218
       +
             | `LPM_TRIE

     

       219
       219
       +
             | `ARRAY_OF_MAPS

     

       220
       220
       +
             | `HASH_OF_MAPS

     

       221
       221
       +
             | `DEVMAP

     

       222
       222
       +
             | `SOCKMAP

     

       223
       223
       +
             | `CPUMAP

     

       224
       224
       +
             | `XSKMAP

     

       225
       225
       +
             | `SOCKHASH

     

       226
       226
       +
             | `CGROUP_STORAGE

     

       227
       227
       +
             | `REUSEPORT_SOCKARRAY

     

       228
       228
       +
             | `PERCPU_CGROUP_STORAGE

     

       229
       229
       +
             | `QUEUE

     

       230
       230
       +
             | `STACK

     

       231
       231
       +
             | `SK_STORAGE

     

       232
       232
       +
             | `DEVMAP_HASH

     

       233
       233
       +
             | `STRUCT_OPS

     

       234
       234
       +
             | `RINGBUF

     

       235
       235
       +
             | `INODE_STORAGE

     

       236
       236
       +
             | `TASK_STORAGE

     

       237
       237
       +
             | `BLOOM_FILTER

     

       238
       238
       +
             | `USER_RINGBUF

     

       239
       239
       +
             | `UNKNOWN ]

     

       240
       240
       +
       

     

       241
       241
       +
           let def = c ~prefix:"BPF_MAP_TYPE_"

     

       242
       242
       +
       

     

       243
       243
       +
           let t : t typ =

     

       244
       244
       +
             enum "bpf_map_type"

     

       245
       245
       +
               ~unexpected:(fun _ -> `UNKNOWN)

     

       246
       246
       +
               [

     

       247
       247
       +
                 (`UNSPEC, def "UNSPEC");

     

       248
       248
       +
                 (`HASH, def "HASH");

     

       249
       249
       +
                 (`ARRAY, def "ARRAY");

     

       250
       250
       +
                 (`PROG_ARRAY, def "PROG_ARRAY");

     

       251
       251
       +
                 (`PERF_EVENT_ARRAY, def "PERF_EVENT_ARRAY");

     

       252
       252
       +
                 (`PERCPU_HASH, def "PERCPU_HASH");

     

       253
       253
       +
                 (`PERCPU_ARRAY, def "PERCPU_ARRAY");

     

       254
       254
       +
                 (`STACK_TRACE, def "STACK_TRACE");

     

       255
       255
       +
                 (`CGROUP_ARRAY, def "CGROUP_ARRAY");

     

       256
       256
       +
                 (`LRU_HASH, def "LRU_HASH");

     

       257
       257
       +
                 (`LRU_PERCPU_HASH, def "LRU_PERCPU_HASH");

     

       258
       258
       +
                 (`LPM_TRIE, def "LPM_TRIE");

     

       259
       259
       +
                 (`ARRAY_OF_MAPS, def "ARRAY_OF_MAPS");

     

       260
       260
       +
                 (`HASH_OF_MAPS, def "HASH_OF_MAPS");

     

       261
       261
       +
                 (`DEVMAP, def "DEVMAP");

     

       262
       262
       +
                 (`SOCKMAP, def "SOCKMAP");

     

       263
       263
       +
                 (`CPUMAP, def "CPUMAP");

     

       264
       264
       +
                 (`XSKMAP, def "XSKMAP");

     

       265
       265
       +
                 (`SOCKHASH, def "SOCKHASH");

     

       266
       266
       +
                 (`CGROUP_STORAGE, def "CGROUP_STORAGE");

     

       267
       267
       +
                 (`REUSEPORT_SOCKARRAY, def "REUSEPORT_SOCKARRAY");

     

       268
       268
       +
                 (`PERCPU_CGROUP_STORAGE, def "PERCPU_CGROUP_STORAGE");

     

       269
       269
       +
                 (`QUEUE, def "QUEUE");

     

       270
       270
       +
                 (`STACK, def "STACK");

     

       271
       271
       +
                 (`SK_STORAGE, def "SK_STORAGE");

     

       272
       272
       +
                 (`DEVMAP_HASH, def "DEVMAP_HASH");

     

       273
       273
       +
                 (`STRUCT_OPS, def "STRUCT_OPS");

     

       274
       274
       +
                 (`RINGBUF, def "RINGBUF");

     

       275
       275
       +
                 (`INODE_STORAGE, def "INODE_STORAGE");

     

       276
       276
       +
                 (`TASK_STORAGE, def "TASK_STORAGE");

     

       277
       277
       +
                 (`BLOOM_FILTER, def "BLOOM_FILTER");

     

       278
       278
       +
                 (`USER_RINGBUF, def "USER_RINGBUF");

     

       279
       279
       +
               ]

     

       280
       280
       +
         end

     

       281
       281
       +
       

     

       282
       282
       +
         module Bpf_prog_type = struct

     

       283
       283
       +
           type t =

     

       284
       284
       +
             [ `UNSPEC

     

       285
       285
       +
             | `SOCKET_FILTER

     

       286
       286
       +
             | `KPROBE

     

       287
       287
       +
             | `SCHED_CLS

     

       288
       288
       +
             | `SCHED_ACT

     

       289
       289
       +
             | `TRACEPOINT

     

       290
       290
       +
             | `XDP

     

       291
       291
       +
             | `PERF_EVENT

     

       292
       292
       +
             | `CGROUP_SKB

     

       293
       293
       +
             | `CGROUP_SOCK

     

       294
       294
       +
             | `LWT_IN

     

       295
       295
       +
             | `LWT_OUT

     

       296
       296
       +
             | `LWT_XMIT

     

       297
       297
       +
             | `SOCK_OPS

     

       298
       298
       +
             | `SK_SKB

     

       299
       299
       +
             | `CGROUP_DEVICE

     

       300
       300
       +
             | `SK_MSG

     

       301
       301
       +
             | `RAW_TRACEPOINT

     

       302
       302
       +
             | `CGROUP_SOCK_ADDR

     

       303
       303
       +
             | `LWT_SEG6LOCAL

     

       304
       304
       +
             | `LIRC_MODE2

     

       305
       305
       +
             | `SK_REUSEPORT

     

       306
       306
       +
             | `FLOW_DISSECTOR

     

       307
       307
       +
             | `CGROUP_SYSCTL

     

       308
       308
       +
             | `RAW_TRACEPOINT_WRITABLE

     

       309
       309
       +
             | `CGROUP_SOCKOPT

     

       310
       310
       +
             | `TRACING

     

       311
       311
       +
             | `STRUCT_OPS

     

       312
       312
       +
             | `EXT

     

       313
       313
       +
             | `LSM

     

       314
       314
       +
             | `SK_LOOKUP

     

       315
       315
       +
             | `SYSCALL

     

       316
       316
       +
             | `UNKNOWN ]

     

       317
       317
       +
       

     

       318
       318
       +
           let t : t typ =

     

       319
       319
       +
             let def = c ~prefix:"BPF_PROG_TYPE_" in

     

       320
       320
       +
             enum "bpf_prog_type"

     

       321
       321
       +
               ~unexpected:(fun _ -> `UNKNOWN)

     

       322
       322
       +
               [

     

       323
       323
       +
                 (`UNSPEC, def "UNSPEC");

     

       324
       324
       +
                 (`SOCKET_FILTER, def "SOCKET_FILTER");

     

       325
       325
       +
                 (`KPROBE, def "KPROBE");

     

       326
       326
       +
                 (`SCHED_CLS, def "SCHED_CLS");

     

       327
       327
       +
                 (`SCHED_ACT, def "SCHED_ACT");

     

       328
       328
       +
                 (`TRACEPOINT, def "TRACEPOINT");

     

       329
       329
       +
                 (`XDP, def "XDP");

     

       330
       330
       +
                 (`PERF_EVENT, def "PERF_EVENT");

     

       331
       331
       +
                 (`CGROUP_SKB, def "CGROUP_SKB");

     

       332
       332
       +
                 (`CGROUP_SOCK, def "CGROUP_SOCK");

     

       333
       333
       +
                 (`LWT_IN, def "LWT_IN");

     

       334
       334
       +
                 (`LWT_OUT, def "LWT_OUT");

     

       335
       335
       +
                 (`LWT_XMIT, def "LWT_XMIT");

     

       336
       336
       +
                 (`SOCK_OPS, def "SOCK_OPS");

     

       337
       337
       +
                 (`SK_SKB, def "SK_SKB");

     

       338
       338
       +
                 (`CGROUP_DEVICE, def "CGROUP_DEVICE");

     

       339
       339
       +
                 (`SK_MSG, def "SK_MSG");

     

       340
       340
       +
                 (`RAW_TRACEPOINT, def "RAW_TRACEPOINT");

     

       341
       341
       +
                 (`CGROUP_SOCK_ADDR, def "CGROUP_SOCK_ADDR");

     

       342
       342
       +
                 (`LWT_SEG6LOCAL, def "LWT_SEG6LOCAL");

     

       343
       343
       +
                 (`LIRC_MODE2, def "LIRC_MODE2");

     

       344
       344
       +
                 (`SK_REUSEPORT, def "SK_REUSEPORT");

     

       345
       345
       +
                 (`FLOW_DISSECTOR, def "FLOW_DISSECTOR");

     

       346
       346
       +
                 (`CGROUP_SYSCTL, def "CGROUP_SYSCTL");

     

       347
       347
       +
                 (`RAW_TRACEPOINT_WRITABLE, def "RAW_TRACEPOINT_WRITABLE");

     

       348
       348
       +
                 (`CGROUP_SOCKOPT, def "CGROUP_SOCKOPT");

     

       349
       349
       +
                 (`TRACING, def "TRACING");

     

       350
       350
       +
                 (`STRUCT_OPS, def "STRUCT_OPS");

     

       351
       351
       +
                 (`EXT, def "EXT");

     

       352
       352
       +
                 (`LSM, def "LSM");

     

       353
       353
       +
                 (`SK_LOOKUP, def "SK_LOOKUP");

     

       354
       354
       +
                 (`SYSCALL, def "SYSCALL");

     

       355
       355
       +
               ]

     

       356
       356
       +
         end

     

       357
       357
       +
       

     

       358
       358
       +
         type bpf_object

     

       359
       359
       +
         type bpf_program

     

       360
       360
       +
         type bpf_link

     

       361
       361
       +
         type bpf_map

     

       362
       362
       +
       

     

       363
       363
       +
         let bpf_object : bpf_object structure typ = structure "bpf_object"

     

       364
       364
       +
         let bpf_program : bpf_program structure typ = structure "bpf_program"

     

       365
       365
       +
         let bpf_link : bpf_link structure typ = structure "bpf_link"

     

       366
       366
       +
         let bpf_map : bpf_map structure typ = structure "bpf_map"

     

       367
       367
       +
       

     

       368
       368
       +
         let ring_buffer_sample_fn :

     

       369
       369
       +
             (unit ptr -> unit ptr -> Unsigned.size_t -> int) static_funptr typ =

     

       370
       370
       +
           typedef

     

       371
       371
       +
             (static_funptr (ptr void @-> ptr void @-> size_t @-> returning int))

     

       372
       372
       +
             "ring_buffer_sample_fn"

     

       373
       373
       +
       

     

       374
       374
       +
         let ring_buffer : [ `Ring_buffer ] structure typ = structure "ring_buffer"

     

       375
       375
       +
       

     

       376
       376
       +
         let ring_buffer_opts : [ `Ring_buffer_opts ] structure typ =

     

       377
       377
       +
           structure "ring_buffer_opts"

     

       378
       378
       +
       

     

       379
       379
       +
         module Bpf_tc = struct

     

       380
       380
       +
           let attach_point : [ `INGRESS | `EGRESS | `CUSTOM ] typ =

     

       381
       381
       +
             let def = c ~prefix:"BPF_TC_" in

     

       382
       382
       +
             enum "bpf_tc_attach_point"

     

       383
       383
       +
               [

     

       384
       384
       +
                 (`INGRESS, def "INGRESS");

     

       385
       385
       +
                 (`EGRESS, def "EGRESS");

     

       386
       386
       +
                 (`CUSTOM, def "CUSTOM");

     

       387
       387
       +
               ]

     

       388
       388
       +
       

     

       389
       389
       +
           module Opts = struct

     

       390
       390
       +
             let t : [ `Opts ] structure typ = structure "bpf_tc_opts"

     

       391
       391
       +
             let ( -: ) ty label = field t label ty

     

       392
       392
       +
             let sz = size_t -: "sz"

     

       393
       393
       +
             let prog_fd = int -: "prog_fd"

     

       394
       394
       +
             let flags = uint32_t -: "flags"

     

       395
       395
       +
             let prog_id = uint32_t -: "prog_id"

     

       396
       396
       +
             let handle = uint32_t -: "handle"

     

       397
       397
       +
             let priority = uint32_t -: "priority"

     

       398
       398
       +
             let () = seal t

     

       399
       399
       +
           end

     

       400
       400
       +
       

     

       401
       401
       +
           let hook : [ `Hook ] structure typ = structure "bpf_tc_hook"

     

       402
       402
       +
           let ( -: ) ty label = field hook label ty

     

       403
       403
       +
           let sz = size_t -: "sz"

     

       404
       404
       +
           let ifindex = int -: "ifindex"

     

       405
       405
       +
           let attach_point = attach_point -: "attach_point"

     

       406
       406
       +
           let parent = uint32_t -: "parent"

     

       407
       407
       +
           let () = seal hook

     

       408
       408
       +
         end

     

       409
       409
       +
       end

+47

vendor/ocaml-libbpf/src/bindings/dune

···

       1
       1
       +
       (library

     

       2
       2
       +
        (name c_type_description)

     

       3
       3
       +
        (public_name libbpf.c_type_description)

     

       4
       4
       +
        (libraries ctypes)

     

       5
       5
       +
        (modules c_type_description))

     

       6
       6
       +
       

     

       7
       7
       +
       (rule

     

       8
       8
       +
        (target c_types_generated.ml)

     

       9
       9
       +
        (deps stubgen/gen_type_bindings_from_c.exe)

     

       10
       10
       +
        (action

     

       11
       11
       +
         (with-stdout-to

     

       12
       12
       +
          %{target}

     

       13
       13
       +
          (run %{deps}))))

     

       14
       14
       +
       

     

       15
       15
       +
       (library

     

       16
       16
       +
        (name c_function_description)

     

       17
       17
       +
        (public_name libbpf.c_function_description)

     

       18
       18
       +
        (libraries ctypes c_type_description)

     

       19
       19
       +
        (modules c_types_generated c_function_description))

     

       20
       20
       +
       

     

       21
       21
       +
       (rule

     

       22
       22
       +
        (target c_function_generated.ml)

     

       23
       23
       +
        (deps stubgen/gen_function_bindings.exe)

     

       24
       24
       +
        (action

     

       25
       25
       +
         (with-stdout-to

     

       26
       26
       +
          %{target}

     

       27
       27
       +
          (run %{deps} ml))))

     

       28
       28
       +
       

     

       29
       29
       +
       (rule

     

       30
       30
       +
        (target bpf_stubs.c)

     

       31
       31
       +
        (deps stubgen/gen_function_bindings.exe)

     

       32
       32
       +
        (action

     

       33
       33
       +
         (with-stdout-to

     

       34
       34
       +
          %{target}

     

       35
       35
       +
          (run %{deps} c))))

     

       36
       36
       +
       

     

       37
       37
       +
       ; This is just a level of indirection to organize functions and type bindings

     

       38
       38
       +
       

     

       39
       39
       +
       (library

     

       40
       40
       +
        (name c)

     

       41
       41
       +
        (public_name libbpf.c)

     

       42
       42
       +
        (c_library_flags -lbpf)

     

       43
       43
       +
        (foreign_stubs

     

       44
       44
       +
         (language c)

     

       45
       45
       +
         (names bpf_stubs))

     

       46
       46
       +
        (libraries c_function_description)

     

       47
       47
       +
        (modules c c_function_generated))

+23

vendor/ocaml-libbpf/src/bindings/stubgen/dune

···

       1
       1
       +
       (executable

     

       2
       2
       +
        (name gen_type_bindings)

     

       3
       3
       +
        (modules gen_type_bindings)

     

       4
       4
       +
        (libraries ctypes.stubs c_type_description))

     

       5
       5
       +
       

     

       6
       6
       +
       (rule

     

       7
       7
       +
        (target gen_type_bindings.c)

     

       8
       8
       +
        (action

     

       9
       9
       +
         (with-stdout-to

     

       10
       10
       +
          %{target}

     

       11
       11
       +
          (run ./gen_type_bindings.exe))))

     

       12
       12
       +
       

     

       13
       13
       +
       (rule

     

       14
       14
       +
        (targets gen_type_bindings_from_c.exe)

     

       15
       15
       +
        (deps gen_type_bindings.c)

     

       16
       16
       +
        (action

     

       17
       17
       +
         (bash

     

       18
       18
       +
          "%{cc} %{deps} -I `dirname %{lib:ctypes:ctypes_cstubs_internals.h}` -I %{ocaml_where} -o %{targets}")))

     

       19
       19
       +
       

     

       20
       20
       +
       (executable

     

       21
       21
       +
        (name gen_function_bindings)

     

       22
       22
       +
        (modules gen_function_bindings)

     

       23
       23
       +
        (libraries ctypes.stubs c_function_description))

+12

vendor/ocaml-libbpf/src/bindings/stubgen/gen_function_bindings.ml

···

       1
       1
       +
       let () =

     

       2
       2
       +
         let concurrency = Cstubs.unlocked in

     

       3
       3
       +
         let errno = Cstubs.ignore_errno in

     

       4
       4
       +
         match Sys.argv.(1) with

     

       5
       5
       +
         | "ml" ->

     

       6
       6
       +
             Cstubs.write_ml ~concurrency Format.std_formatter ~prefix:"" ~errno

     

       7
       7
       +
               (module C_function_description.Functions)

     

       8
       8
       +
         | "c" ->

     

       9
       9
       +
             print_endline "#include <bpf/libbpf.h>";

     

       10
       10
       +
             Cstubs.write_c ~concurrency Format.std_formatter ~prefix:"" ~errno

     

       11
       11
       +
               (module C_function_description.Functions)

     

       12
       12
       +
         | s -> failwith ("unknown functions " ^ s)

vendor/ocaml-libbpf/src/bindings/stubgen/gen_type_bindings.ml

···

       1
       1
       +
       let () =

     

       2
       2
       +
         print_endline "#include <bpf/libbpf.h>";

     

       3
       3
       +
         Cstubs_structs.write_c Format.std_formatter (module C_type_description.Types)

vendor/ocaml-libbpf/src/dune

···

       1
       1
       +
       (library

     

       2
       2
       +
        (name libbpf)

     

       3
       3
       +
        (public_name libbpf)

     

       4
       4
       +
        (libraries c))

     

       5
       5
       +
       

     

       6
       6
       +
       (documentation

     

       7
       7
       +
        (package libbpf))

+151

vendor/ocaml-libbpf/src/index.mld

···

       1
       1
       +
       {0 ocaml-libbpf}

     

       2
       2
       +
       

     

       3
       3
       +
       OCaml bindings to {{:https://github.com/libbpf/libbpf}libbpf} C

     

       4
       4
       +
       library for loading eBPF programs into the linux kernel.

     

       5
       5
       +
       

     

       6
       6
       +
       {1 Introduction}

     

       7
       7
       +
       

     

       8
       8
       +
       Writing eBPF programs consist of two distinct parts. Implementing the

     

       9
       9
       +
       code that executes in-kernel and user-level code responsible for

     

       10
       10
       +
       loading/initializing/linking/teardown of the in-kernel code. This

     

       11
       11
       +
       OCaml library provides the latter via binding the C libbpf library. It

     

       12
       12
       +
       exposes both the raw low-level bindings as well as a set of high-level

     

       13
       13
       +
       API's for handling your eBPF objects. As of now, the kernel part must

     

       14
       14
       +
       still be written in

     

       15
       15
       +
       {{:https://stackoverflow.com/questions/57688344/what-is-not-allowed-in-restricted-c-for-ebpf}

     

       16
       16
       +
       restricted C} and compiled with llvm to eBPF bytecode.

     

       17
       17
       +
       

     

       18
       18
       +
       For the high-level APIs: {!Libbpf}

     

       19
       19
       +
       

     

       20
       20
       +
       For the low-level bindings: {!Libbpf.C}.

     

       21
       21
       +
       

     

       22
       22
       +
       {1:Tutorial Tutorial}

     

       23
       23
       +
       

     

       24
       24
       +
       This example assumes the user has knowledge of how to implement the

     

       25
       25
       +
       kernel part of a eBPF program. If not, you can check out this

     

       26
       26
       +
       {{:https://nakryiko.com/posts/libbpf-bootstrap/#the-bpf-side}

     

       27
       27
       +
       resource} first. Consider the following kernel eBPF program named {b

     

       28
       28
       +
       minimal.bpf.c}:

     

       29
       29
       +
       

     

       30
       30
       +
       {@c[

     

       31
       31
       +
       // SPDX-License-Identifier: GPL-2.0 OR BSD-3-Clause

     

       32
       32
       +
       /* Copyright (c) 2020 Facebook */

     

       33
       33
       +
       #include <linux/bpf.h>

     

       34
       34
       +
       #include "bpf/bpf_helpers.h" /* This is from our libbpf library */

     

       35
       35
       +
       

     

       36
       36
       +
       char LICENSE[] SEC("license") = "Dual BSD/GPL";

     

       37
       37
       +
       

     

       38
       38
       +
       /* Globals implemented as an array */

     

       39
       39
       +
       struct {

     

       40
       40
       +
         __uint(type, BPF_MAP_TYPE_ARRAY);

     

       41
       41
       +
         __uint(max_entries, 1);

     

       42
       42
       +
         __type(key, int);

     

       43
       43
       +
         __type(value, long);

     

       44
       44
       +
       } globals SEC(".maps");

     

       45
       45
       +
       

     

       46
       46
       +
       int my_pid_index = 0;

     

       47
       47
       +
       

     

       48
       48
       +
       SEC("tp/syscalls/sys_enter_write")

     

       49
       49
       +
       int handle_tp(void *ctx) {

     

       50
       50
       +
         int pid = bpf_get_current_pid_tgid() >> 32;

     

       51
       51
       +
       

     

       52
       52
       +
         long *my_pid;

     

       53
       53
       +
         my_pid = bpf_map_lookup_elem(&globals, &my_pid_index);

     

       54
       54
       +
         if (my_pid == NULL) {

     

       55
       55
       +
           bpf_printk("Error got NULL");

     

       56
       56
       +
           return 1;

     

       57
       57
       +
         };

     

       58
       58
       +
       

     

       59
       59
       +
         if (pid != *my_pid)

     

       60
       60
       +
           return 0;

     

       61
       61
       +
       

     

       62
       62
       +
         bpf_printk("Hello, BPF triggered from PID %d", pid);

     

       63
       63
       +
       

     

       64
       64
       +
         return 0;

     

       65
       65
       +
       }

     

       66
       66
       +
       ]}

     

       67
       67
       +
       

     

       68
       68
       +
       After compilation to eBPF ELF file as {b "minimal.o"}. Users just need

     

       69
       69
       +
       to provide the path to this ELF file along with the name of the

     

       70
       70
       +
       program and optionally an initialization function. Note that the name

     

       71
       71
       +
       of the program refers to the function identifier under the SEC(...)

     

       72
       72
       +
       attribute, in this case it is {b "handle_tp"}.

     

       73
       73
       +
       

     

       74
       74
       +
       {@ocaml[

     

       75
       75
       +
       open Libbpf

     

       76
       76
       +
       

     

       77
       77
       +
       let obj_path = "minimal.bpf.o"

     

       78
       78
       +
       let program_names = [ "handle_tp" ]

     

       79
       79
       +
       

     

       80
       80
       +
       let () =

     

       81
       81
       +
         with_bpf_object_open_load_link ~obj_path ~program_names ~before_link

     

       82
       82
       +
           (fun obj link -> (* Do something *))

     

       83
       83
       +
       ]}

     

       84
       84
       +
       

     

       85
       85
       +
       The context manager {{!Libbpf.with_bpf_object_open_load_link}

     

       86
       86
       +
       with_bpf_object_open_load_link} is a convenience wrapper for all the

     

       87
       87
       +
       neccessary steps to load up your eBPF program into the kernel.

     

       88
       88
       +
       

     

       89
       89
       +
       If we don't specify anything in the body of the function marked with

     

       90
       90
       +
       {b (* Do something *)}, our loaded kernel program will be unloaded

     

       91
       91
       +
       immediately. In this case, we will add some looping logic to keep the

     

       92
       92
       +
       program running in the kernel and add a set of signal handlers to

     

       93
       93
       +
       escape the loop.

     

       94
       94
       +
       

     

       95
       95
       +
       {@ocaml[

     

       96
       96
       +
       let obj_path = "minimal.bpf.o"

     

       97
       97
       +
       let program_names = [ "handle_tp" ]

     

       98
       98
       +
       

     

       99
       99
       +
       let () =

     

       100
       100
       +
         with_bpf_object_open_load_link ~obj_path ~program_names ~before_link

     

       101
       101
       +
           (fun obj link ->

     

       102
       102
       +
       

     

       103
       103
       +
       	(* Set up signal handlers *)

     

       104
       104
       +
             let exitting = ref true in

     

       105
       105
       +
             let sig_handler = Sys.Signal_handle (fun _ -> exitting := false) in

     

       106
       106
       +
             Sys.(set_signal sigint sig_handler);

     

       107
       107
       +
             Sys.(set_signal sigterm sig_handler);

     

       108
       108
       +
       

     

       109
       109
       +
             Printf.printf

     

       110
       110
       +
               "Successfully started! Please run `sudo cat \

     

       111
       111
       +
                /sys/kernel/debug/tracing/trace_pipe` to see output of the BPF \

     

       112
       112
       +
                programs.\n\

     

       113
       113
       +
                %!"

     

       114
       114
       +
       

     

       115
       115
       +
       	 (* Loop until Ctrl-C is called *)

     

       116
       116
       +
             while !exitting do

     

       117
       117
       +
               Printf.eprintf ".%!";

     

       118
       118
       +
               Unix.sleepf 1.0

     

       119
       119
       +
             done)

     

       120
       120
       +
       ]}

     

       121
       121
       +
       

     

       122
       122
       +
       Our bpf program is now running in the kernel until we decide to

     

       123
       123
       +
       interrupt it. However, it doesn't do exactly what we want. In

     

       124
       124
       +
       particular, it doesn't filter for our process PID. This is because we

     

       125
       125
       +
       haven't loaded our process PID into the BPF map. To do this, we need

     

       126
       126
       +
       the name of the map we declared by our {b minimal.bpf.c} program. In

     

       127
       127
       +
       this case, our BPF array map was named {b globals}.

     

       128
       128
       +
       

     

       129
       129
       +
       {@ocaml[

     

       130
       130
       +
       let map = "globals"

     

       131
       131
       +
       

     

       132
       132
       +
       (* Load PID into BPF map *)

     

       133
       133
       +
       let before_link obj =

     

       134
       134
       +
         let pid = Unix.getpid () |> Signed.Long.of_int in

     

       135
       135
       +
         let global_map = bpf_object_find_map_by_name obj map in

     

       136
       136
       +
         (* When updating an element, users need to specify the type of the key and value

     

       137
       137
       +
            declared by the map which checks that the key and value size are consistent. *)

     

       138
       138
       +
         bpf_map_update_elem ~key_ty:Ctypes.int ~val_ty:Ctypes.long global_map 0 pid

     

       139
       139
       +
       ]}

     

       140
       140
       +
       

     

       141
       141
       +
       Now if we combine the two, we can run this program and see the output

     

       142
       142
       +
       interactively being printed to the trace pipe.

     

       143
       143
       +
       

     

       144
       144
       +
       {1 Notice!}

     

       145
       145
       +
       

     

       146
       146
       +
       root permissions are required when you run eBPF programs. This is a

     

       147
       147
       +
       consequence of the fact that they are loaded into the kernel. To offer

     

       148
       148
       +
       some assurance though, eBPF programs always have to pass through a

     

       149
       149
       +
       verifier before they can be loaded. This ensures that eBPF programs

     

       150
       150
       +
       aren't able crash to crash the kernel. For more information, read

     

       151
       151
       +
       {{:https://ebpf.io/what-is-ebpf/#ebpf-safety} here}.

+153

vendor/ocaml-libbpf/src/libbpf.ml

···

       1
       1
       +
       open Ctypes

     

       2
       2
       +
       module C = C

     

       3
       3
       +
       

     

       4
       4
       +
       let major_version =

     

       5
       5
       +
         C.Functions.libbpf_major_version () |> Unsigned.UInt32.to_int

     

       6
       6
       +
       

     

       7
       7
       +
       let minor_version =

     

       8
       8
       +
         C.Functions.libbpf_minor_version () |> Unsigned.UInt32.to_int

     

       9
       9
       +
       

     

       10
       10
       +
       let version_string = C.Functions.libbpf_version_string ()

     

       11
       11
       +
       

     

       12
       12
       +
       let bpf_attach_type_str attach_type =

     

       13
       13
       +
         C.Functions.libbpf_bpf_attach_type_str attach_type

     

       14
       14
       +
       

     

       15
       15
       +
       let bpf_link_type_str link_type = C.Functions.libbpf_bpf_link_type_str link_type

     

       16
       16
       +
       let bpf_map_type_str map_type = C.Functions.libbpf_bpf_map_type_str map_type

     

       17
       17
       +
       let bpf_prog_type_str prog_type = C.Functions.libbpf_bpf_prog_type_str prog_type

     

       18
       18
       +
       

     

       19
       19
       +
       type bpf_object = C.Types.bpf_object structure ptr

     

       20
       20
       +
       

     

       21
       21
       +
       type bpf_program = {

     

       22
       22
       +
         name : string;

     

       23
       23
       +
         fd : int;

     

       24
       24
       +
         ptr : C.Types.bpf_program structure ptr;

     

       25
       25
       +
       }

     

       26
       26
       +
       

     

       27
       27
       +
       type bpf_map = { fd : int; ptr : C.Types.bpf_map structure ptr }

     

       28
       28
       +
       type bpf_link = C.Types.bpf_link structure ptr

     

       29
       29
       +
       

     

       30
       30
       +
       let failwith_f fmt =

     

       31
       31
       +
         let fails s = failwith s in

     

       32
       32
       +
         Printf.ksprintf fails fmt

     

       33
       33
       +
       

     

       34
       34
       +
       let bpf_object_open obj_file =

     

       35
       35
       +
         match C.Functions.bpf_object__open obj_file with

     

       36
       36
       +
         | Some obj -> obj

     

       37
       37
       +
         | None -> failwith_f "Error opening object file at %s" obj_file

     

       38
       38
       +
       

     

       39
       39
       +
       let bpf_object_load bpf_object =

     

       40
       40
       +
         let ret = C.Functions.bpf_object__load bpf_object in

     

       41
       41
       +
         if ret = 0 then ()

     

       42
       42
       +
         else failwith_f "Could not load bpf_object, got exit %d" ret

     

       43
       43
       +
       

     

       44
       44
       +
       let bpf_object_find_program_by_name bpf_object name =

     

       45
       45
       +
         match C.Functions.bpf_object__find_program_by_name bpf_object name with

     

       46
       46
       +
         | Some prog -> { name; fd = C.Functions.bpf_program__fd prog; ptr = prog }

     

       47
       47
       +
         | None -> failwith_f "Program name %s not found" name

     

       48
       48
       +
       

     

       49
       49
       +
       let bpf_program_attach ({ name; ptr; _ } : bpf_program) =

     

       50
       50
       +
         match C.Functions.bpf_program__attach ptr with

     

       51
       51
       +
         | Some link -> link

     

       52
       52
       +
         | None -> failwith_f "Error attaching program %s" name

     

       53
       53
       +
       

     

       54
       54
       +
       let bpf_program_fd (prog : bpf_program) = prog.fd

     

       55
       55
       +
       

     

       56
       56
       +
       let bpf_object_find_map_by_name bpf_object name =

     

       57
       57
       +
         match C.Functions.bpf_object__find_map_by_name bpf_object name with

     

       58
       58
       +
         | Some ptr -> { fd = C.Functions.bpf_map__fd ptr; ptr }

     

       59
       59
       +
         | None -> failwith_f "Map %s not found" name

     

       60
       60
       +
       

     

       61
       61
       +
       let bpf_map_fd (map : bpf_map) = map.fd

     

       62
       62
       +
       

     

       63
       63
       +
       let bpf_link_destroy bpf_link =

     

       64
       64
       +
         match C.Functions.bpf_link__destroy bpf_link with

     

       65
       65
       +
         | e when e <> 0 -> Printf.eprintf "Failed to destroy link %d\n" e

     

       66
       66
       +
         | _ -> ()

     

       67
       67
       +
       

     

       68
       68
       +
       let bpf_object_close bpf_object = C.Functions.bpf_object__close bpf_object

     

       69
       69
       +
       

     

       70
       70
       +
       let with_bpf_object_open_load_link ~obj_path ~program_names

     

       71
       71
       +
           ?(before_link = Stdlib.ignore) fn =

     

       72
       72
       +
         let obj = bpf_object_open obj_path in

     

       73
       73
       +
         bpf_object_load obj;

     

       74
       74
       +
       

     

       75
       75
       +
         let cleanup ?links obj =

     

       76
       76
       +
           Option.iter (List.iter bpf_link_destroy) links;

     

       77
       77
       +
           bpf_object_close obj

     

       78
       78
       +
         in

     

       79
       79
       +
       

     

       80
       80
       +
         (* Programs to load cannot be zero *)

     

       81
       81
       +
         if program_names = [] then (

     

       82
       82
       +
           cleanup obj;

     

       83
       83
       +
           failwith "Need to specify at least one program to load");

     

       84
       84
       +
       

     

       85
       85
       +
         (* Get list of programs *)

     

       86
       86
       +
         let programs, not_found =

     

       87
       87
       +
           List.fold_left

     

       88
       88
       +
             (fun (succ, fail) name ->

     

       89
       89
       +
               match C.Functions.bpf_object__find_program_by_name obj name with

     

       90
       90
       +
               | None -> (succ, name :: fail)

     

       91
       91
       +
               | Some prog -> ((prog, name) :: succ, fail))

     

       92
       92
       +
             ([], []) program_names

     

       93
       93
       +
         in

     

       94
       94
       +
         if not_found <> [] then (

     

       95
       95
       +
           cleanup obj;

     

       96
       96
       +
           failwith_f "Failed to find %s programs" (String.concat "," not_found));

     

       97
       97
       +
       

     

       98
       98
       +
         (* Run before_link user initialization code *)

     

       99
       99
       +
         (try before_link obj

     

       100
       100
       +
          with e ->

     

       101
       101
       +
            bpf_object_close obj;

     

       102
       102
       +
            raise e);

     

       103
       103
       +
       

     

       104
       104
       +
         (* Get list of links *)

     

       105
       105
       +
         let links, not_attached =

     

       106
       106
       +
           List.fold_left

     

       107
       107
       +
             (fun (succ, fail) (prog, name) ->

     

       108
       108
       +
               match C.Functions.bpf_program__attach prog with

     

       109
       109
       +
               | None -> (succ, name :: fail)

     

       110
       110
       +
               | Some prog -> (prog :: succ, fail))

     

       111
       111
       +
             ([], []) programs

     

       112
       112
       +
         in

     

       113
       113
       +
         if not_attached <> [] then (

     

       114
       114
       +
           (* Detached successfully attached before shutdown *)

     

       115
       115
       +
           cleanup ~links obj;

     

       116
       116
       +
           failwith_f "Failed to link %s programs" (String.concat "," not_attached));

     

       117
       117
       +
       

     

       118
       118
       +
         (* Run user program *)

     

       119
       119
       +
         (try fn obj links

     

       120
       120
       +
          with e ->

     

       121
       121
       +
            cleanup ~links obj;

     

       122
       122
       +
            raise e);

     

       123
       123
       +
       

     

       124
       124
       +
         (* Ensure proper shutdown *)

     

       125
       125
       +
         cleanup ~links obj

     

       126
       126
       +
       

     

       127
       127
       +
       let bpf_map_lookup_value ~key_ty ~val_ty ~val_zero bpf_map key =

     

       128
       128
       +
         let key = allocate key_ty key in

     

       129
       129
       +
         let sz_key = sizeof key_ty |> Unsigned.Size_t.of_int in

     

       130
       130
       +
         let value = allocate val_ty val_zero in

     

       131
       131
       +
         let sz_val = sizeof val_ty |> Unsigned.Size_t.of_int in

     

       132
       132
       +
         let err =

     

       133
       133
       +
           C.Functions.bpf_map__lookup_elem bpf_map.ptr (to_voidp key) sz_key

     

       134
       134
       +
             (to_voidp value) sz_val Unsigned.UInt64.zero

     

       135
       135
       +
         in

     

       136
       136
       +
         if err = 0 then !@value

     

       137
       137
       +
         else

     

       138
       138
       +
           let err = Printf.sprintf "bpf_map_lookup_value got %d" err in

     

       139
       139
       +
           raise (Sys_error err)

     

       140
       140
       +
       

     

       141
       141
       +
       let bpf_map_update_elem ~key_ty ~val_ty bpf_map key value =

     

       142
       142
       +
         let key = allocate key_ty key in

     

       143
       143
       +
         let sz_key = sizeof key_ty |> Unsigned.Size_t.of_int in

     

       144
       144
       +
         let value = allocate val_ty value in

     

       145
       145
       +
         let sz_val = sizeof val_ty |> Unsigned.Size_t.of_int in

     

       146
       146
       +
         let err =

     

       147
       147
       +
           C.Functions.bpf_map__update_elem bpf_map.ptr (to_voidp key) sz_key

     

       148
       148
       +
             (to_voidp value) sz_val Unsigned.UInt64.zero

     

       149
       149
       +
         in

     

       150
       150
       +
         if err = 0 then ()

     

       151
       151
       +
         else

     

       152
       152
       +
           let err = Printf.sprintf "bpf_map_update_value got %d" err in

     

       153
       153
       +
           raise (Sys_error err)

+114

vendor/ocaml-libbpf/src/libbpf.mli

···

       1
       1
       +
       (** See {!page-index} for example usage *)

     

       2
       2
       +
       

     

       3
       3
       +
       open Ctypes

     

       4
       4
       +
       

     

       5
       5
       +
       module C : module type of C

     

       6
       6
       +
       (** Entry point for the underlying C primatives *)

     

       7
       7
       +
       

     

       8
       8
       +
       val major_version : int

     

       9
       9
       +
       val minor_version : int

     

       10
       10
       +
       val version_string : string

     

       11
       11
       +
       val bpf_attach_type_str : C.Types.Bpf_attach_type.t -> string

     

       12
       12
       +
       val bpf_link_type_str : C.Types.Bpf_link_type.t -> string

     

       13
       13
       +
       val bpf_map_type_str : C.Types.Bpf_map_type.t -> string

     

       14
       14
       +
       val bpf_prog_type_str : C.Types.Bpf_prog_type.t -> string

     

       15
       15
       +
       

     

       16
       16
       +
       type bpf_object = C.Types.bpf_object structure ptr

     

       17
       17
       +
       

     

       18
       18
       +
       type bpf_program = {

     

       19
       19
       +
         name : string;

     

       20
       20
       +
         fd : int;

     

       21
       21
       +
         ptr : C.Types.bpf_program structure ptr;

     

       22
       22
       +
       }

     

       23
       23
       +
       

     

       24
       24
       +
       type bpf_map = { fd : int; ptr : C.Types.bpf_map structure ptr }

     

       25
       25
       +
       type bpf_link = C.Types.bpf_link structure ptr

     

       26
       26
       +
       

     

       27
       27
       +
       val bpf_object_open : string -> bpf_object

     

       28
       28
       +
       (** [bpf_object_open path] opens and tries to read the bpf_object

     

       29
       29
       +
           found at path [path] in the filesystem. Libbpf parses the BPF

     

       30
       30
       +
           object file and discovers BPF maps, BPF programs, and global

     

       31
       31
       +
           variables. After a BPF app is opened, user space apps can make

     

       32
       32
       +
           additional adjustments (setting BPF program types, if necessary;

     

       33
       33
       +
           pre-setting initial values for global variables, etc.) before all

     

       34
       34
       +
           the entities are created and loaded.

     

       35
       35
       +
       

     

       36
       36
       +
           Fails if object file is in invalid format or path does not exist *)

     

       37
       37
       +
       

     

       38
       38
       +
       val bpf_object_load : bpf_object -> unit

     

       39
       39
       +
       (** [bpf_object_load obj] tries to load [obj]. Libbpf parses

     

       40
       40
       +
           the BPF object file and discovers BPF maps, BPF programs, and

     

       41
       41
       +
           global variables. After a BPF app is opened, user space apps can

     

       42
       42
       +
           make additional adjustments (setting BPF program types, if

     

       43
       43
       +
           necessary; pre-setting initial values for global variables, etc.)

     

       44
       44
       +
           before all the entities are created and loaded. *)

     

       45
       45
       +
       

     

       46
       46
       +
       val bpf_object_find_program_by_name : bpf_object -> string -> bpf_program

     

       47
       47
       +
       (** [bpf_object_find_program_by_name obj name] locates the

     

       48
       48
       +
           program identifier [name] within the [obj].

     

       49
       49
       +
       

     

       50
       50
       +
           Fails if [name] is not found *)

     

       51
       51
       +
       

     

       52
       52
       +
       val bpf_program_attach : bpf_program -> bpf_link

     

       53
       53
       +
       (** [bpf_program_attach prog] attaches the [prog] in the

     

       54
       54
       +
           kernel to start respond to events. Libbpf attaches BPF programs to

     

       55
       55
       +
           various BPF hook points (e.g., tracepoints, kprobes, cgroup hooks,

     

       56
       56
       +
           network packet processing pipeline, etc.). During this phase, BPF

     

       57
       57
       +
           programs perform useful work such as processing packets, or

     

       58
       58
       +
           updating BPF maps and global variables that can be read from user

     

       59
       59
       +
           space

     

       60
       60
       +
       

     

       61
       61
       +
           Fails if link could not be attached *)

     

       62
       62
       +
       

     

       63
       63
       +
       val bpf_program_fd : bpf_program -> int

     

       64
       64
       +
       (** [bpf_map_fd prog] returns the fd of the [prog] *)

     

       65
       65
       +
       

     

       66
       66
       +
       val bpf_object_find_map_by_name : bpf_object -> string -> bpf_map

     

       67
       67
       +
       (** [bpf_object_find_map_by_name obj name] locates the bpf_map

     

       68
       68
       +
           identifier [name] within [obj].

     

       69
       69
       +
       

     

       70
       70
       +
           Fails if map is not found *)

     

       71
       71
       +
       

     

       72
       72
       +
       val bpf_map_fd : bpf_map -> int

     

       73
       73
       +
       (** [bpf_map_fd map] returns the fd of the [map] *)

     

       74
       74
       +
       

     

       75
       75
       +
       val bpf_link_destroy : bpf_link -> unit

     

       76
       76
       +
       (** [bpf_link_destroy link] detaches and unloads the bpf program

     

       77
       77
       +
           associated to [link] from the kernel *)

     

       78
       78
       +
       

     

       79
       79
       +
       val bpf_object_close : bpf_object -> unit

     

       80
       80
       +
       (** [bpf_object_close obj] tearsdown [obj]. BPF maps are destroyed,

     

       81
       81
       +
           and all the resources used by the BPF app are freed. *)

     

       82
       82
       +
       

     

       83
       83
       +
       val with_bpf_object_open_load_link :

     

       84
       84
       +
         obj_path:string ->

     

       85
       85
       +
         program_names:string list ->

     

       86
       86
       +
         ?before_link:(bpf_object -> unit) ->

     

       87
       87
       +
         (bpf_object -> bpf_link list -> unit) ->

     

       88
       88
       +
         unit

     

       89
       89
       +
       (** [with_bpf_object_open_load_link obj_path program_names

     

       90
       90
       +
           ?before_link fn] performs opening and loading of the provided

     

       91
       91
       +
           filesystem path to the bpf_object [obj_path]. This helper runs

     

       92
       92
       +
           [before_link] before the program attaches the bpf programs

     

       93
       93
       +
           specified in [program_names]. Initialization code should go

     

       94
       94
       +
           here. [fn] is passed the bpf_object and the list of program links

     

       95
       95
       +
           if all steps were successful. Ensures all the proper shutdown and

     

       96
       96
       +
           cleanup of bpf_object resources and links *)

     

       97
       97
       +
       

     

       98
       98
       +
       val bpf_map_lookup_value :

     

       99
       99
       +
         key_ty:'a typ -> val_ty:'b typ -> val_zero:'b -> bpf_map -> 'a -> 'b

     

       100
       100
       +
       (** [bpf_map_lookup_value key_ty val_ty val_zero map k flags] Looks

     

       101
       101
       +
             up the value associated with the key [k]. If key is invalid, no

     

       102
       102
       +
             value is found or the size of key/value is not in sync, it will

     

       103
       103
       +
             return an error. [bpf_map_lookup_value] expects [key_ty] and

     

       104
       104
       +
             [val_ty] to verify the types are coherent in your bpf map

     

       105
       105
       +
             declaration. [val_zero] is merely an initialization value that

     

       106
       106
       +
             will be overwritten.  *)

     

       107
       107
       +
       

     

       108
       108
       +
       val bpf_map_update_elem :

     

       109
       109
       +
         key_ty:'a typ -> val_ty:'b typ -> bpf_map -> 'a -> 'b (* -> flags *) -> unit

     

       110
       110
       +
       (** [bpf_map_update_elem key_ty val_ty map k v flags] updates the

     

       111
       111
       +
             value associated the key [k] to [v]. If key is invalid or the

     

       112
       112
       +
             size of key/value is not in sync, it will return an

     

       113
       113
       +
             error. [bpf_map_update_elem] expects [key_ty] and [val_ty] to

     

       114
       114
       +
             verify the types are coherent in your bpf map declaration. *)

vendor/ocaml-libbpf/src/libbpf_maps/dune

···

       1
       1
       +
       (library

     

       2
       2
       +
        (public_name libbpf_maps)

     

       3
       3
       +
        (name libbpf_maps)

     

       4
       4
       +
        (libraries libbpf ctypes.foreign))

+34

vendor/ocaml-libbpf/src/libbpf_maps/libbpf_maps.ml

···

       1
       1
       +
       open Libbpf

     

       2
       2
       +
       open Ctypes

     

       3
       3
       +
       

     

       4
       4
       +
       module RingBuffer = struct

     

       5
       5
       +
         type t = [ `Ring_buffer ] structure ptr

     

       6
       6
       +
       

     

       7
       7
       +
         type callback =

     

       8
       8
       +
           unit Ctypes_static.ptr -> unit Ctypes_static.ptr -> Unsigned.size_t -> int

     

       9
       9
       +
       

     

       10
       10
       +
         let init bpf_map ~callback f =

     

       11
       11
       +
           (* Coerce it to the static_funptr so it can be passed to the C function *)

     

       12
       12
       +
           let callback_c =

     

       13
       13
       +
             coerce

     

       14
       14
       +
               (Foreign.funptr ~runtime_lock:true ~check_errno:true

     

       15
       15
       +
                  (ptr void @-> ptr void @-> size_t @-> returning int))

     

       16
       16
       +
               C.Types.ring_buffer_sample_fn callback

     

       17
       17
       +
           in

     

       18
       18
       +
           let rb =

     

       19
       19
       +
             match

     

       20
       20
       +
               C.Functions.ring_buffer__new bpf_map.fd callback_c null

     

       21
       21
       +
                 (from_voidp C.Types.ring_buffer_opts null)

     

       22
       22
       +
             with

     

       23
       23
       +
             | None -> failwith "Failed to create ring buffer\n"

     

       24
       24
       +
             | Some rb -> rb

     

       25
       25
       +
           in

     

       26
       26
       +
           try f rb

     

       27
       27
       +
           with e ->

     

       28
       28
       +
             C.Functions.ring_buffer__free rb;

     

       29
       29
       +
             raise e

     

       30
       30
       +
       

     

       31
       31
       +
         let poll t ~timeout = C.Functions.ring_buffer__poll t timeout

     

       32
       32
       +
         let consume t = C.Functions.ring_buffer__consume t

     

       33
       33
       +
         let get_epoll_fd t = C.Functions.ring_buffer__epoll_fd t

     

       34
       34
       +
       end

+38

vendor/ocaml-libbpf/src/libbpf_maps/libbpf_maps.mli

···

       1
       1
       +
       open Libbpf

     

       2
       2
       +
       (** Libbpf_maps provide a convenient API's for handling maps,

     

       3
       3
       +
           currently only Ringbuffers are supported *)

     

       4
       4
       +
       

     

       5
       5
       +
       module RingBuffer : sig

     

       6
       6
       +
         type t

     

       7
       7
       +
       

     

       8
       8
       +
         type callback =

     

       9
       9
       +
           unit Ctypes_static.ptr -> unit Ctypes_static.ptr -> Unsigned.size_t -> int

     

       10
       10
       +
       

     

       11
       11
       +
         val init : bpf_map -> callback:callback -> (t -> unit) -> unit

     

       12
       12
       +
         (** [init bpf_map callback] loads [callback] into the ring buffer

     

       13
       13
       +
               map provided by [bpf_map]. bpf map is freed by default when

     

       14
       14
       +
               the OCaml process exits

     

       15
       15
       +
       

     

       16
       16
       +
               TO BE ADDED [ctx_ptr] allows the callback function to access

     

       17
       17
       +
               user provided context. *)

     

       18
       18
       +
       

     

       19
       19
       +
         val poll : t -> timeout:int -> int

     

       20
       20
       +
         (** [poll t timeout] polls the ringbuffer to execute the loaded

     

       21
       21
       +
               callbacks on any pending entries, The function returns if

     

       22
       22
       +
               there are no entries in the given timeout,

     

       23
       23
       +
       

     

       24
       24
       +
               Error code is returned if something went wrong, Ctrl-C will

     

       25
       25
       +
               cause -EINTR *)

     

       26
       26
       +
       

     

       27
       27
       +
         val consume : t -> int

     

       28
       28
       +
         (** [consume t] runs callbacks on all entries in the ringbuffer

     

       29
       29
       +
               without event polling. Use this only if trying to squeeze

     

       30
       30
       +
               extra performance with busy-waiting.

     

       31
       31
       +
       

     

       32
       32
       +
               Error code is returned if something went wrong Ctrl-C will

     

       33
       33
       +
               cause -EINTR *)

     

       34
       34
       +
       

     

       35
       35
       +
         val get_epoll_fd : t -> int

     

       36
       36
       +
         (** [get_epoll_fd t] returns a file descriptor that can be used

     

       37
       37
       +
                 to sleep until data is available in the ring(s) *)

     

       38
       38
       +
       end

+39

vendor/ocaml-libbpf/supported.json

···

       1
       1
       +
       {

     

       2
       2
       +
         "ocaml_libbpf.1.0": [

     

       3
       3
       +
           "libbpf_major_version",

     

       4
       4
       +
           "libbpf_minor_version",

     

       5
       5
       +
           "libbpf_version_string",

     

       6
       6
       +
           "libbpf_strerror",

     

       7
       7
       +
           "libbpf_bpf_attach_type_str",

     

       8
       8
       +
           "libbpf_bpf_link_type_str",

     

       9
       9
       +
           "libbpf_bpf_map_type_str",

     

       10
       10
       +
           "libbpf_bpf_prog_type_str",

     

       11
       11
       +
           "libbpf_set_print",

     

       12
       12
       +
           "bpf_object__open",

     

       13
       13
       +
           "bpf_object__load",

     

       14
       14
       +
           "bpf_object__find_program_by_name",

     

       15
       15
       +
           "bpf_object__next_program",

     

       16
       16
       +
           "bpf_program__pin",

     

       17
       17
       +
           "bpf_program__unpin",

     

       18
       18
       +
           "bpf_program_attach",

     

       19
       19
       +
           "bpf_program__fd",

     

       20
       20
       +
           "bpf_link__pin",

     

       21
       21
       +
           "bpf_link__unpin",

     

       22
       22
       +
           "bpf_link__destroy",

     

       23
       23
       +
           "bpf_object__close",

     

       24
       24
       +
           "bpf_object__find_map_by_name",

     

       25
       25
       +
           "bpf_map__fd",

     

       26
       26
       +
           "bpf_map_lookup_elem",

     

       27
       27
       +
           "bpf_map_update_elem",

     

       28
       28
       +
           "bpf_map_delete_elem",

     

       29
       29
       +
           "bpf_tc_hook_create",

     

       30
       30
       +
           "bpf_tc_hook_destroy",

     

       31
       31
       +
           "bpf_tc_attach",

     

       32
       32
       +
           "bpf_tc_detach",

     

       33
       33
       +
           "ring_buffer__new",

     

       34
       34
       +
           "ring_buffer__poll",

     

       35
       35
       +
           "ring_buffer__free",

     

       36
       36
       +
           "ring_buffer__consume",

     

       37
       37
       +
           "ring_buffer__epoll_fd"

     

       38
       38
       +
         ]

     

       39
       39
       +
       }

vendor/ocaml-libbpf/test/dune

···

       1
       1
       +
       (test

     

       2
       2
       +
        (name test_version)

     

       3
       3
       +
        (libraries libbpf unix))

vendor/ocaml-libbpf/test/test_version.ml

···

       1
       1
       +
       let () =

     

       2
       2
       +
         let open Libbpf in

     

       3
       3
       +
         Printf.printf "Major:%d, Minor:%d, Libbpf.%s" major_version minor_version

     

       4
       4
       +
           version_string