commit 47eef9f7378f32eb3efb26ce12d04ca895bfe6b2 · patrick.sirref.org/opentrace

README.md

···

       2
       2
        
       ---------

     

       3
       3
        
       

     

       4
       4
        
       Tracing open-like syscalls using eBPF via OCaml.

     

       5
       5
       +
       

     

       6
       6
       +
       ```

     

       7
       7
       +
       sudo opentrace exec -- opam list

     

       8
       8
       +
       cat trace.csv

     

       9
       9
       +
       ```

     

       10
       10
       +
       

     

       11
       11
       +

dune

···

       1
       1
        
       (executable

     

       2
       2
        
        (name opentrace)

     

       3
       3
        
        (public_name opentrace)

     

       4
       4
       +
        (modules opentrace config)

     

       4
       5
        
        (preprocess

     

       5
       6
        
         (pps ppx_blob))

     

       6
       7
        
        (preprocessor_deps

     
···

       29
       30
        
           arch

     

       30
       31
        
           (bash

     

       31
       32
        
            "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/'")))))

     

       33
       33
       +
       

     

       34
       34
       +
       (rule

     

       35
       35
       +
        (targets config.ml)

     

       36
       36
       +
        (action

     

       37
       37
       +
         (run ./include/discover.exe)))

dune-project

···

       12
       12
        
           (ocaml (>= 5.2.0))

     

       13
       13
        
           eio_main

     

       14
       14
        
           jsonm

     

       15
       15
       +
           dune-configurator

     

       15
       16
        
           libbpf

     

       16
       17
        
           libbpf_maps))

     

       17
       18

+67

include/discover.ml

···

       1
       1
       +
       module C = Configurator.V1

     

       2
       2
       +
       

     

       3
       3
       +
       let () =

     

       4
       4
       +
         C.main ~name:"discover" (fun c ->

     

       5
       5
       +
             let defs =

     

       6
       6
       +
               let values =

     

       7
       7
       +
                 C.C_define.import c ~c_flags:[ "-D_GNU_SOURCE" ]

     

       8
       8
       +
                   ~includes:[ "fcntl.h" ]

     

       9
       9
       +
                   C.C_define.Type.

     

       10
       10
       +
                     [

     

       11
       11
       +
                       ("O_RDONLY", Int);

     

       12
       12
       +
                       ("O_WRONLY", Int);

     

       13
       13
       +
                       ("O_RDWR", Int);

     

       14
       14
       +
                       ("O_CREAT", Int);

     

       15
       15
       +
                       ("O_EXCL", Int);

     

       16
       16
       +
                       ("O_NOCTTY", Int);

     

       17
       17
       +
                       ("O_TRUNC", Int);

     

       18
       18
       +
                       ("O_APPEND", Int);

     

       19
       19
       +
                       ("O_NONBLOCK", Int);

     

       20
       20
       +
                       ("O_DSYNC", Int);

     

       21
       21
       +
                       ("O_DIRECT", Int);

     

       22
       22
       +
                       (* "O_LARGEFILE", Int; *)

     

       23
       23
       +
                       ("O_DIRECTORY", Int);

     

       24
       24
       +
                       ("O_NOFOLLOW", Int);

     

       25
       25
       +
                       ("O_NOATIME", Int);

     

       26
       26
       +
                       ("O_CLOEXEC", Int);

     

       27
       27
       +
                       ("O_SYNC", Int);

     

       28
       28
       +
                       ("O_PATH", Int);

     

       29
       29
       +
                       ("O_TMPFILE", Int);

     

       30
       30
       +
                     ]

     

       31
       31
       +
               in

     

       32
       32
       +
               let defs =

     

       33
       33
       +
                 List.map

     

       34
       34
       +
                   (function

     

       35
       35
       +
                     | name, C.C_define.Value.Int v ->

     

       36
       36
       +
                         Printf.sprintf "let %s = 0x%x" (String.lowercase_ascii name) v

     

       37
       37
       +
                     | _ -> assert false)

     

       38
       38
       +
                   values

     

       39
       39
       +
               in

     

       40
       40
       +
               let of_string =

     

       41
       41
       +
                 List.fold_left

     

       42
       42
       +
                   (fun acc v ->

     

       43
       43
       +
                     match v with

     

       44
       44
       +
                     | name, C.C_define.Value.Int v ->

     

       45
       45
       +
                         let case = Printf.sprintf "| \"%s\" -> 0x%x\n" name v in

     

       46
       46
       +
                         acc ^ case

     

       47
       47
       +
                     | _ -> assert false)

     

       48
       48
       +
                   "let of_string = function\n" values

     

       49
       49
       +
               in

     

       50
       50
       +
               let to_string =

     

       51
       51
       +
                 List.fold_left

     

       52
       52
       +
                   (fun acc v ->

     

       53
       53
       +
                     match v with

     

       54
       54
       +
                     | name, C.C_define.Value.Int v ->

     

       55
       55
       +
                         let case = Printf.sprintf "| 0x%x -> \"%s\"\n" v name in

     

       56
       56
       +
                         acc ^ case

     

       57
       57
       +
                     | _ -> assert false)

     

       58
       58
       +
                   "let to_string = function\n" values

     

       59
       59
       +
               in

     

       60
       60
       +
               defs

     

       61
       61
       +
               @ [

     

       62
       62
       +
                   of_string ^ "| s -> invalid_arg(\"Unknown flag: \" ^ s)\n";

     

       63
       63
       +
                   to_string

     

       64
       64
       +
                   ^ "| s -> invalid_arg(\"Unknown flag: \" ^ string_of_int s)\n";

     

       65
       65
       +
                 ]

     

       66
       66
       +
             in

     

       67
       67
       +
             C.Flags.write_lines "config.ml" defs)

include/dune

···

       1
       1
       +
       (executable

     

       2
       2
       +
        (name discover)

     

       3
       3
       +
        (modules discover)

     

       4
       4
       +
        (libraries dune-configurator))

+49 -13

opentrace.ml

···

       28
       28
        
         in

     

       29
       29
        
         loop [] json |> List.rev

     

       30
       30
        
       

     

       31
       31
       +
       module Flags = struct

     

       32
       32
       +
         type t = int

     

       33
       33
       +
       

     

       34
       34
       +
         include Config

     

       35
       35
       +
       

     

       36
       36
       +
         let mem (v : t) i = Int.equal (i land (v :> int)) (v :> int)

     

       37
       37
       +
       end

     

       38
       38
       +
       

     

       31
       39
        
       module Open_event = struct

     

       32
       40
        
         open Ctypes

     

       33
       41
        
       

     
···

       129
       137
        
         in

     

       130
       138
        
         bpf_callback

     

       131
       139
        
       

     

       132
       132
       -
       let all poll no_header =

     

       140
       140
       +
       let filter_event_by_flag event flags =

     

       141
       141
       +
         flags = []

     

       142
       142
       +
         ||

     

       143
       143
       +
         let fs = Open_event.get_flags event in

     

       144
       144
       +
         List.for_all (fun flag -> Flags.mem flag fs) flags

     

       145
       145
       +
       

     

       146
       146
       +
       let all poll no_header open_flags =

     

       133
       147
        
         if no_header then () else Format.printf "%s" Open_event.csv_header;

     

       134
       148
        
         let callback event =

     

       135
       135
       -
           Format.printf "%s\n%!" (Open_event.to_csv_row event);

     

       149
       149
       +
           if filter_event_by_flag event open_flags then

     

       150
       150
       +
             Format.printf "%s\n%!" (Open_event.to_csv_row event);

     

       136
       151
        
           0

     

       137
       152
        
         in

     

       138
       153
        
         let bpf_callback = ringbuffer_polling_callback ~poll callback (fun _ -> ()) in

     

       139
       154
        
         run_ring_buffer bpf_callback

     

       140
       155
        
       

     

       141
       141
       -
       let exec format output user poll (prog, args) =

     

       156
       156
       +
       let exec format output user poll (prog, args) open_flags_filter =

     

       142
       157
        
         let output =

     

       143
       158
        
           match output with

     

       144
       159
        
           | Some file -> file

     
···

       190
       205
        
           match Atomic.get pid with

     

       191
       206
        
           | None -> 0

     

       192
       207
        
           | Some pid ->

     

       193
       193
       -
               (if Int.equal (Open_event.get_pid event) pid then

     

       208
       208
       +
               (if

     

       209
       209
       +
                  Int.equal (Open_event.get_pid event) pid

     

       210
       210
       +
                  && filter_event_by_flag event open_flags_filter

     

       211
       211
       +
                then

     

       194
       212
        
                  match format with

     

       195
       213
        
                  | Csv ->

     

       196
       214
        
                      Out_channel.output_string oc (Open_event.to_csv_row event);

     
···

       228
       246
        
         let doc = "Disable printing the CSV header" in

     

       229
       247
        
         Arg.(value & flag & info [ "no-header" ] ~doc)

     

       230
       248
        
       

     

       249
       249
       +
       let flag_conv =

     

       250
       250
       +
         let of_string s =

     

       251
       251
       +
           try Ok (Flags.of_string s) with Invalid_argument m -> Error (`Msg m)

     

       252
       252
       +
         in

     

       253
       253
       +
         let pp ppf v = Format.pp_print_string ppf (Flags.to_string v) in

     

       254
       254
       +
         Arg.conv (of_string, pp)

     

       255
       255
       +
       

     

       256
       256
       +
       let open_flags_filter =

     

       257
       257
       +
         let doc =

     

       258
       258
       +
           "Filter open events that include these flags (e.g. O_RDONLY, O_CREAT). \

     

       259
       259
       +
            Note the filter wants ALL of the flags to be present not just one of \

     

       260
       260
       +
            them."

     

       261
       261
       +
         in

     

       262
       262
       +
         Arg.(value & opt (list flag_conv) [] & info [ "flags" ] ~doc)

     

       263
       263
       +
       

     

       231
       264
        
       let user =

     

       232
       265
        
         let doc = "Username or UID to execute program as" in

     

       233
       266
        
         Arg.(value & opt (some string) None & info [ "u"; "user" ] ~doc ~docv:"USER")

     
···

       250
       283
        
       let output =

     

       251
       284
        
         let doc =

     

       252
       285
        
           "Output file for trace. Defaults to trace.<csv|json> depending on the \

     

       253
       253
       -
            $(format)."

     

       286
       286
       +
            format."

     

       254
       287
        
         in

     

       255
       288
        
         Arg.(

     

       256
       289
        
           value & opt (some string) None & info [ "o"; "output" ] ~docv:"OUTPUT" ~doc)

     

       257
       290
        
       

     

       258
       291
        
       let all_cmd =

     

       259
       259
       -
         let doc = "Trace all open system calls" in

     

       292
       292
       +
         let doc = "Trace all open system calls." in

     

       260
       293
        
         let man =

     

       261
       294
        
           [

     

       262
       295
        
             `P

     
···

       266
       299
        
         in

     

       267
       300
        
         Cmd.v (Cmd.info ~doc ~man "all")

     

       268
       301
        
         @@

     

       269
       269
       -
         let+ polling = polling and+ no_header = no_header in

     

       270
       270
       -
         all polling no_header

     

       302
       302
       +
         let+ polling = polling

     

       303
       303
       +
         and+ no_header = no_header

     

       304
       304
       +
         and+ open_flags_filter = open_flags_filter in

     

       305
       305
       +
         all polling no_header open_flags_filter

     

       271
       306
        
       

     

       272
       307
        
       let exec_cmd =

     

       273
       273
       -
         let doc = "Execute a program and trace its open system calls" in

     

       308
       308
       +
         let doc = "Execute a program and trace its open system calls." in

     

       274
       309
        
         let man =

     

       275
       310
        
           [

     

       276
       311
        
             `P

     
···

       287
       322
        
         and+ format = format

     

       288
       323
        
         and+ output = output

     

       289
       324
        
         and+ args = Arg.(value & pos_right 0 string [] & Arg.info [] ~docv:"ARGS")

     

       325
       325
       +
         and+ open_flags_filter = open_flags_filter

     

       290
       326
        
         and+ poll = polling in

     

       291
       291
       -
         exec format output user poll (prog, args)

     

       327
       327
       +
         exec format output user poll (prog, args) open_flags_filter

     

       292
       328
        
       

     

       293
       329
        
       let opentrace_cmd =

     

       294
       330
        
         let doc = "Trace all open system calls" in

     

       295
       331
        
         let man =

     

       296
       332
        
           [

     

       297
       333
        
             `S Manpage.s_description;

     

       298
       298
       -
             `P "$(cmd) traces all open system calls";

     

       334
       334
       +
             `P "$(tool) traces all open system calls.";

     

       299
       335
        
             `P

     

       300
       300
       -
               "$(cmd) can be used either to run an executable directly or to trace \

     

       301
       301
       -
                all open calls";

     

       336
       336
       +
               "$(tool) can be used either to run an executable directly or to trace \

     

       337
       337
       +
                all open calls.";

     

       302
       338
        
           ]

     

       303
       339
        
         in

     

       304
       340
        
         let default = Term.(ret (const (`Help (`Auto, None)))) in

opentrace.opam

···

       7
       7
        
         "ocaml" {>= "5.2.0"}

     

       8
       8
        
         "eio_main"

     

       9
       9
        
         "jsonm"

     

       10
       10
       +
         "dune-configurator"

     

       10
       11
        
         "libbpf"

     

       11
       12
        
         "libbpf_maps"

     

       12
       13
        
         "odoc" {with-doc}

     
···

       25
       26
        
           "@doc" {with-doc}

     

       26
       27
        
         ]

     

       27
       28
        
       ]

     

       29
       29
       +
       pin-depends:[

     

       30
       30
       +
         "eio.dev" "git+https://github.com/patricoferris/eio#9cb52c3c061a1bfee0c6094625415d3c95f735d5"

     

       31
       31
       +
         "eio_posix.dev" "git+https://github.com/patricoferris/eio#9cb52c3c061a1bfee0c6094625415d3c95f735d5"

     

       32
       32
       +
         "eio_linux.dev" "git+https://github.com/patricoferris/eio#9cb52c3c061a1bfee0c6094625415d3c95f735d5"

     

       33
       33
       +
         "eio_main.dev" "git+https://github.com/patricoferris/eio#9cb52c3c061a1bfee0c6094625415d3c95f735d5"

     

       34
       34
       +
       ]

opentrace.opam.template

···

       1
       1
       +
       pin-depends:[

     

       2
       2
       +
         "eio.dev" "git+https://github.com/patricoferris/eio#9cb52c3c061a1bfee0c6094625415d3c95f735d5"

     

       3
       3
       +
         "eio_posix.dev" "git+https://github.com/patricoferris/eio#9cb52c3c061a1bfee0c6094625415d3c95f735d5"

     

       4
       4
       +
         "eio_linux.dev" "git+https://github.com/patricoferris/eio#9cb52c3c061a1bfee0c6094625415d3c95f735d5"

     

       5
       5
       +
         "eio_main.dev" "git+https://github.com/patricoferris/eio#9cb52c3c061a1bfee0c6094625415d3c95f735d5"

     

       6
       6
       +
       ]