Skip to content

Commit 2fb72e3

Browse files
committed
remove Result monad
1 parent 13d8e76 commit 2fb72e3

File tree

5 files changed

+45
-40
lines changed

5 files changed

+45
-40
lines changed

examples/Makefile

Lines changed: 4 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -1,23 +1,18 @@
11
CWD=../_build/default/examples
22

3-
all: vmlinux build
4-
53
build:
64
dune build
75

8-
vmlinux:
9-
sudo bpftool btf dump file /sys/kernel/btf/vmlinux format c > vmlinux.h
10-
11-
minimal: all
6+
minimal: build
127
sudo $(CWD)/minimal.exe
138

14-
kprobe: all
9+
kprobe: build
1510
sudo $(CWD)/kprobe.exe
1611

17-
bootstrap: all
12+
bootstrap: build
1813
sudo $(CWD)/bootstrap.exe
1914

20-
bootstrap_c: all
15+
bootstrap_c: build
2116
sudo $(CWD)/bootstrap_c.exe
2217

2318
clean:

examples/bootstrap.ml

Lines changed: 11 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -66,18 +66,15 @@ let () =
6666
(* Load ringbuffer map *)
6767
let map = bpf_object_find_map_by_name obj rb_name in
6868

69-
(* Install callback to ring buffer *)
70-
let rb = Bpf_maps.RingBuffer.init map ~callback:handle_event in
69+
(* Set up ring buffer *)
70+
Bpf_maps.RingBuffer.init map ~callback:handle_event (fun rb ->
71+
Printf.printf "%-8s %-5s %-16s %-7s %-7s %s\n%!" "TIME" "EVENT" "COMM"
72+
"PID" "PPID" "FILENAME/EXIT CODE";
7173

72-
Printf.printf "%-8s %-5s %-16s %-7s %-7s %s\n%!" "TIME" "EVENT" "COMM"
73-
"PID" "PPID" "FILENAME/EXIT CODE";
74-
75-
while !exitting do
76-
match Bpf_maps.RingBuffer.poll rb ~timeout:100 with
77-
| Ok _ -> ()
78-
| Error e ->
79-
if e = Sys.sighup then failwith "Hangup"
80-
else (
81-
Printf.eprintf "Error polling ring buffer, %d" e;
82-
exitting := false)
83-
done)
74+
while !exitting do
75+
ignore
76+
(try Bpf_maps.RingBuffer.poll rb ~timeout:100
77+
with _ ->
78+
exitting := false;
79+
-1)
80+
done))

examples/minimal.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -9,7 +9,7 @@ let map = "globals"
99
let before_link obj =
1010
let pid = Unix.getpid () |> Signed.Long.of_int in
1111
let global_map = bpf_object_find_map_by_name obj map in
12-
assert (M.bpf_map_update_elem global_map 0 pid |> Result.is_ok)
12+
M.bpf_map_update_elem global_map 0 pid
1313

1414
let () =
1515
with_bpf_object_open_load_link ~obj_path ~program_names ~before_link

src/ocaml_libbpf.ml

Lines changed: 20 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -142,7 +142,10 @@ module Bpf_maps = struct
142142
C.Functions.bpf_map__lookup_elem bpf_map.ptr (to_voidp key) sz_key
143143
(to_voidp value) sz_val Unsigned.UInt64.zero
144144
in
145-
if err <> 0 then Result.error err else Result.ok !@value
145+
if err = 0 then !@value
146+
else
147+
let err = Printf.sprintf "bpf_map_lookup_value got %d" err in
148+
raise (Sys_error err)
146149

147150
let bpf_map_update_elem bpf_map key value (* flags *) =
148151
let open Ctypes in
@@ -154,14 +157,17 @@ module Bpf_maps = struct
154157
C.Functions.bpf_map__update_elem bpf_map.ptr (to_voidp key) sz_key
155158
(to_voidp value) sz_val Unsigned.UInt64.zero
156159
in
157-
if err <> 0 then Result.error err else Result.ok ()
160+
if err = 0 then ()
161+
else
162+
let err = Printf.sprintf "bpf_map_update_elem got %d" err in
163+
raise (Sys_error err)
158164
end
159165

160166
module RingBuffer = struct
161167
type t = C.Types.ring_buffer structure ptr
162168
type callback = C.Types.ring_buffer_sample_fn
163169

164-
let init bpf_map ~callback : t =
170+
let init bpf_map ~callback f =
165171
(* Coerce it to the static_funptr so it can be passed to the C function *)
166172
let callback_c =
167173
let open Ctypes in
@@ -178,15 +184,22 @@ module Bpf_maps = struct
178184
| None -> failwith "Failed to create ring buffer\n"
179185
| Some rb -> rb
180186
in
181-
at_exit (fun () -> C.Functions.ring_buffer__free rb);
182-
rb
187+
Fun.protect
188+
~finally:(fun () -> C.Functions.ring_buffer__free rb)
189+
(fun () -> f rb)
183190

184191
let poll t ~timeout =
185192
let ret = C.Functions.ring_buffer__poll t timeout in
186-
if ret < 0 then Result.error ret else Result.ok ret
193+
if ret >= 0 then ret
194+
else
195+
let err = Printf.sprintf "ring_buffer__poll got %d" ret in
196+
raise (Sys_error err)
187197

188198
let consume t =
189199
let ret = C.Functions.ring_buffer__consume t in
190-
if ret < 0 then Result.error ret else Result.ok ret
200+
if ret >= 0 then ret
201+
else
202+
let err = Printf.sprintf "ring_buffer__consume got %d" ret in
203+
raise (Sys_error err)
191204
end
192205
end

src/ocaml_libbpf.mli

Lines changed: 9 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -118,13 +118,13 @@ module Bpf_maps : sig
118118

119119
module Make : functor (Key : Conv) (Val : Conv) -> sig
120120
val bpf_map_lookup_value :
121-
bpf_map -> Key.t (* -> flags *) -> (Val.t, int) Result.t
121+
bpf_map -> Key.t (* -> flags *) -> Val.t
122122
(** [bpf_map_lookup_value map k flags] looks up the value
123123
associated with the key [k]. If key is invalid, no value is found or the size
124124
of key/value is not in sync, it will return an error *)
125125

126126
val bpf_map_update_elem :
127-
bpf_map -> Key.t -> Val.t (* -> flags *) -> (unit, int) Result.t
127+
bpf_map -> Key.t -> Val.t (* -> flags *) -> unit
128128
(** [bpf_map_update_elem map k v flags] updates the value
129129
associated the key [k] to [v]. If key is invalid or the size
130130
of key/value is not in sync, it will return an error *)
@@ -133,31 +133,31 @@ module Bpf_maps : sig
133133
module RingBuffer : sig
134134
type t
135135

136-
type callback =
137-
unit Ctypes_static.ptr -> unit Ctypes_static.ptr -> Unsigned.size_t -> int
136+
type callback
138137

139-
val init : bpf_map -> callback:callback -> t
138+
139+
val init : bpf_map -> callback:callback -> (t -> unit) -> unit
140140
(** [init bpf_map callback] loads [callback] into the ring buffer
141141
map provided by [bpf_map]. bpf map is freed by default when
142142
the OCaml process exits
143143
144144
TO BE ADDED [ctx_ptr] allows the callback function to access
145145
user provided context. *)
146146

147-
val poll : t -> timeout:int -> (int, int) Result.t
147+
val poll : t -> timeout:int -> int
148148
(** [poll t timeout] polls the ringbuffer to execute the loaded
149149
callbacks on any pending entries, The function returns if
150150
there are no entries in the given timeout,
151151
152-
Error code is returned if soemthing went wrong, Ctrl-C will
152+
Error code is returned if something went wrong, Ctrl-C will
153153
cause -EINTR *)
154154

155-
val consume : t -> (int, int) Result.t
155+
val consume : t -> int
156156
(** [consume t] runs callbacks on all entries in the ringbuffer
157157
without event polling. Use this only if trying to squeeze
158158
extra performance with busy-waiting.
159159
160-
Error code is returned if soemthing went wrong Ctrl-C will
160+
Error code is returned if something went wrong Ctrl-C will
161161
cause -EINTR *)
162162
end
163163
end

0 commit comments

Comments
 (0)